home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 1 / LSD Compendium Deluxe 1.iso / a / programming / arexx / arexg10c.lha / ARexxGuide / Arx_Trace.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1993-10-15  |  10.1 KB  |  322 lines
  1. /*    $VER: 1.2a   ARx_Trace.rexx   by Robin Evans (14 Oct 1993) */
  2.  
  3. /* Demonstrate various trace options                                      **
  4. **   Thanks to Dean Adams for suggested changes.                          */
  5.  
  6. call trace(b)
  7.  
  8. call addlib('rexxsupport.library',0,-30,0)
  9. signal on syntax; signal on failure
  10.  
  11. LF = '0a'x;    LFS = LF'   '
  12. csi='9b'x;
  13. slant=csi'3m';bold=csi'1m';norm=csi'0m';
  14. black=csi'31m';white=csi'32m';blue=csi'33m'
  15. CLS = csi'0;0H'csi'J';NoCursor = csi'302070'x
  16. CursorOn=csi'2070'
  17. FontSize = FontInfo()
  18. MaxHi = 400
  19.  
  20. Tr. = ''
  21. Tr.1 = I; Tr.I.1Num = 1; Tr.I = 'Intermediates'
  22. Tr.2 = R; Tr.R.1Num = 2; Tr.R = 'Results'
  23. Tr.3 = A; Tr.A.1Num = 3; Tr.A = 'All'
  24. Tr.4 = C; Tr.C.1Num = 4; Tr.C = 'Commands'
  25. Tr.5 = E; Tr.E.1Num = 5; Tr.E = 'Errors'
  26. Tr.6 = N; Tr.N.1Num = 6; Tr.N = 'Normal'
  27. Tr.7 = O; Tr.O.1Num = 7; Tr.O = 'Off'
  28. Tr.8 = B; Tr.B.1Num = 8; Tr.B = 'Background'
  29. Tr.9 = S; Tr.S.1Num = 9; Tr.S = 'Scan'
  30. Tr.10= L; Tr.L.1Num =10; Tr.L = 'Labels'
  31. Char = '?'
  32. Tr.11 = Char; Tr.Char.1Num = 11; Tr.Char = 'Interactive'
  33. Tr.12 = '!'; Tr.!.1Num = 11; Tr.! = 'No commands'
  34.  
  35. ColPos = 90
  36. OpenMode:
  37. if open(ModeWin, 'raw:0/'ColPos'/128/'min(MaxHi, 27*FontSize)'/Modes/NOCLOSE/INACTIVE/NOALT/NOPROP/NOSIZE/', W) then do
  38.         /* cursor invisible, don't wordwrap, move to top left  */
  39.     call writech(ModeWin, '9b3020709b3f376c9b48'x' ')
  40.     call writech(ModeWin, '9b302071'x)
  41.     BoundRpt = readch(ModeWin, 12)
  42.     parse var BoundRpt ';'. ';' WinLines ';' .
  43.     if WinLines < 25 then do
  44.         if MaxHi = 400 then do
  45.             MaxHi = 200
  46.             MinPos = 1
  47.             call close ModeWin
  48.             ColPos = 0
  49.             signal OpenMode
  50.         end
  51.     end
  52.  
  53.     do j = 1 to WinLines%2
  54.         call writeln ModeWin, white||value('Tr.'Tr.j)
  55.         call writeln ModeWin, blue' --'black Tr.j
  56.     end
  57.         /* get window bounds report */
  58. end
  59. else
  60.     signal error
  61.  
  62. ExampleLine = LocateEx()
  63.  
  64.  
  65. ListPos = 14*FontSize
  66. if MinPos = 1 then
  67.     RowPos = 11
  68. else
  69.     RowPos = ListPos - 11
  70.  
  71. ListOpen = open(ListWin, 'con:70/0/468/'ListPos'/Program being traced/NOCLOSE/INACTIVE', 'W')
  72. if ListOpen then do
  73.         /* cursor invisible */
  74.     call writech(ListWin, NoCursor)
  75.         /* don't word wrap */
  76.     call writech(ListWin, '9b3f376c'x)
  77. end
  78.  
  79.         /* is the trace console open? If so, close it */
  80. if show(F, STDERR) then do
  81.     call writeln(stderr, 'Trying to close this stream')
  82.     address command 'TE'
  83.     address command 'TCC'
  84. end
  85.  
  86. call close STDOUT
  87. if open(STDOUT, 'con:70/'RowPos'/570/'MaxHi-RowPos'/ARexxGuide Examples', W) then do
  88.     call close STDIN
  89.     call open STDIN, "*", R
  90.     call close STDERR
  91.     call open  STDERR, "*"
  92.     say CLS
  93.  
  94.     say white||'This demonstration will show how the various options to the TRACE()'
  95.     say 'function and TRACE instruction affect the display of a program.'
  96.     say LF'We will output the trace to this window rather than redirecting'
  97.     say 'it to the trace console.'||black
  98.  
  99.     if ListOpen then do
  100.         call CopyPrg(ExampleLine ListWin)
  101.         say '0a'x'The program we will trace is listed in the window above.'
  102.         say 'The available modes are listed to the left.'
  103.     end
  104.  
  105.     else
  106.         signal error
  107.     drop i
  108.  
  109.     if AKey() then return 0
  110.     Options prompt white'   Enter the tracing mode to use: 'black
  111.     do MPrompt = 1 until TMode = 'Q'
  112.         say LF||blue'Enter <'black'Q'blue'> to quit or mode code.'black
  113.         pull TMode 4
  114.         TOpt = ''
  115.         if TMode ~= 'Q' & TMode ~= '' then do
  116.             if verify(TMode, '!?', 'M') > 0 then do
  117.                     /* Is option char the 1st or 2nd one? */
  118.                 if pos(verify(TMode, '?!', 'M'), '12') = 0 then do
  119.                     say 'The characters "?" or "!" must precede the letter option.'
  120.                     iterate MPrompt
  121.                 end
  122.                 TStr = strip(TMode,,'?! ')
  123.                 parse var TMode TOpt (TStr)
  124.                 TMode = TStr
  125.                 if TMode = '' then TMode = TOpt
  126.             end
  127.             else do
  128.                 TOpt = ''
  129.                 TMode = left(TMode, 1)
  130.                 if Tr.Tmode = '' then do
  131.                     say TMode 'is not a recognized trace option.'LF
  132.                     iterate MPrompt
  133.                     end
  134.                 end
  135.                 say CLS
  136.                 say blue'************ TRACE' upper(value('Tr.'strip(TMode,,'?! ')))':'black
  137.                 if verify(TOpt,'!','M') > 0 then say white'Commands will not be executed'black
  138.                 select
  139.                     when datatype(TMode, 'N') then do
  140.                         say cls||white'You may enter a positive number to temporarily disable'
  141.                         say 'interactive tracing. A negative number will turn off tracing'
  142.                         say 'altogether for the specified number of lines.'
  143.                         say 'We''ll start the trace as' black'?R'white'.'
  144.                         say blue'At any of the >+> pause points below, you may:'white
  145.                         say '   Enter' black'TRACE' abs(TMode) white'to disable the pause through' abs(TMode) 'lines'
  146.                         say '   Enter' black'TRACE -'abs(TMode) white'to quiet the trace for' abs(TMode) 'lines.'
  147.                         say black'                 Press <Enter> to continue.'NoCursor
  148.                         call readln(STDIN)
  149.                         TMode = '?R'
  150.                     end
  151.                     when Tr.TMode.1Num = 12 then do
  152.                         say white'"!" is one of the options that can be used in conjunction with'
  153.                         say 'any of the letter options.'black
  154.                     end
  155.                     when Tr.TMode.1Num = 11 then do
  156.                         say white'The "?" symbol works as a toggle. We''ll start the trace as'
  157.                         say 'TRACE ?R which will show results. Enter TRACE ? again at any'
  158.                         say 'pause point to end the interactive trace.'black
  159.                         TMode = '?R'
  160.                     end
  161.                     when Tr.TMode.1Num = 10 then do
  162.                         say white'Since there are no function calls in the program being'
  163.                         say 'traced, the "Label" option will be turned on before reaching'
  164.                         say 'the subroutine that contains the code being traced.'black
  165.                         OldT = trace(TMode)
  166.                     end
  167.                     when Tr.TMode.1Num = 9 then do
  168.                         say white'We cannot run a scan trace on a subroutine in this program'
  169.                         say 'because the RETURN that ends the subroutine will not be'
  170.                         say 'recognized. The example will be copied to T: and scanned'
  171.                         say 'from there.'LF||black
  172.                         if ~exists('t:ScanTrace') then
  173.                             if open(1Prg, 't:ScanTrace', W) then do
  174.                                 call writeln(1Prg, '/**/ SIGNAL ON SYNTAX')
  175.                                 call CopyPrg(ExampleLine 1Prg)
  176.                                 call writeln(1Prg, 'SYNTAX:')
  177.                                 call writeln(1Prg, '   return 0')
  178.                                 call close 1Prg
  179.                             end
  180.                         address REXX 't:ScanTrace' TOpt'S'
  181.                         iterate MPrompt
  182.                     end
  183.                     when Tr.TMode.1Num > 6 then do
  184.                         say white'TRACE' Tr.TMode 'will turn off tracing. To see how it works,'
  185.                         say 'enter TRACE' TMode 'at any of the pause points ( >+> ).'
  186.                         say 'You will be presented with one more pause point before the new'
  187.                         say 'option takes effect.'||black
  188.                         TMode = '?R'
  189.                     end
  190.                     when Tr.TMode.1Num = 5 then do
  191.                         say white'This dummy command executed in an external environment'
  192.                         say 'will show how the option works. Note that AmigaDOS outputs'
  193.                         say 'the initial error message -- the first two lines.'LF||black
  194.                         call ErrCmd E
  195.                         iterate MPrompt
  196.                     end
  197.                     when Tr.TMode.1Num = 6 then do
  198.                         say white'TRACE Normal will output only those clauses that contain a'
  199.                         say 'command that sets a return code higher than the current'
  200.                         say 'failure level which would cause the ARexx exec to terminate.'LF
  201.                         say 'This dummy command executed in an external environment'
  202.                         say 'will show how the option works. Note that AmigaDOS outputs'
  203.                         say 'the initial error message -- the first two lines.'LF||black
  204.                         call ErrCmd N
  205.                         iterate MPrompt
  206.                     end
  207.                     when TMode = 'A' then do
  208.                         say white'Only the clauses in the program will be output. Results are not'
  209.                         say 'shown with this option.'LF||black
  210.                     end
  211.                     otherwise
  212.                 end
  213.                 say ''
  214.                 call TracePrg TOpt||TMode
  215.                 if show('F', IactWin) then
  216.                     call close IactWin
  217.                         /* With interactve tracing, it's possible for the user **
  218.                         ** to cause DirFile not to be closed. This makes sure  **
  219.                         ** it is now closed.                                   */
  220.                 if show('F', DirFile) then
  221.                     call close DirFile
  222.                 if exists('t:dirs') then
  223.                     call delete('t:dirs')
  224.                 if pos('L', trace()) > 0 then
  225.                     call trace(OldT)
  226.             end
  227.         end
  228.         call close ListWin
  229.         call close ModeWin
  230.         call close STDOUT
  231.         call close STDIN
  232.         call pragma('*')
  233.     end
  234.     return 0
  235. end
  236. else
  237.     signal error
  238.  
  239. SYNTAX:
  240.     ErrCo = rc
  241. ERROR:
  242. FAILURE:
  243.     signal off SYNTAX            /* to prevent any possibility of an endless loop */
  244.  
  245.     say '0a0a'x||'Sorry, an unexpected error has occured in line' SIGL
  246.     if datatype(ErrCo, 'N') then
  247.         say '      'ErrCo':' errortext(ErrCo)
  248.     options prompt '                Press <Enter>'
  249.     pull .
  250.     drop ErrCo
  251. return 9
  252.  
  253. BREAK_C:
  254.     return
  255.  
  256. CopyPrg: procedure
  257.  
  258.     arg PgLn1 CopyTo .
  259.     do i = PgLn1 while sourceline(i) ~= 'return'
  260.         call writeln(CopyTo, sourceline(i))
  261.     end
  262. return 0
  263.  
  264. LocateEx:     /* used to locate the line number of the preceding */
  265.     Signal SendLine:
  266. SendLine:
  267.     return Sigl +7
  268.  
  269. TracePrg: procedure expose LF DirFile
  270. signal on failure; signal on break_c
  271.  
  272.  /*******  FileName.rexx  ** Demonstrate TRACE *******/
  273.  arg TMode; call trace TMode
  274.  address command "list nohead quick : dirs to t:dirs"
  275.  if open(DirFile, 't:dirs', R) then do
  276.      FDir = readln(DirFile);    call close DirFile
  277.  end
  278.  parse source . . . FilePath .
  279.  DivPos =  1 + max(lastpos(':', FilePath),,
  280.      lastpos('/', FilePath))
  281.  parse var FilePath Dir =DivPos FileName
  282.  say LF'File: "'Filename'" Directory: "'Dir'".'LF
  283. return
  284.  
  285. AKey:
  286.     options prompt LF||blue'   Type <'black'Q'blue'> and <'black'Enter'blue'> to quit. Press <'black'Enter'blue'> alone to continue.'
  287.     pull AKey
  288.     if AKey = Q then return 1
  289.     else return 0
  290.  
  291. IactMsg:
  292.     if open(IactWin, 'con:3/6/472/'9*FontSize'/Interactive tracing options/NOCLOSE/INACTIVE/NOALT/NOPROP/NOSIZE/', W) then do
  293.         call writeln(IactWin, white||'    You have these options at the >+> prompt:')
  294.         call writeln(IactWin, LF' -- Press <'black'Enter'white'> to continue to next clause')
  295.         call writeln(IactWin, ' -- Type = and <'black'Enter'white'> to reexecute previous clause.    ')
  296.         call writeln(IactWin, ' -- Enter any valid ARexx clause.')
  297.         call writeln(IactWin, '    That clause will be interpreted as though it was a')
  298.         call writeln(IactWin, '    part of the program. Try changing the value of the')
  299.         call writeln(IactWin, '    variable [FileName], for instance.')
  300.     end
  301.     else
  302.         signal error
  303. return 0
  304.  
  305. ErrCmd: procedure
  306.     arg TOpt
  307.     signal off failure
  308.     signal off error
  309.     address command "RX ""call trace" TOpt "; address command 'copy foo moo'"""
  310. return
  311.  
  312. FontInfo: procedure
  313.         /* Get default font */
  314.  
  315.     gfxbase=showlist(l, 'graphics.library',,a)
  316.  
  317.     FontAddr = next(gfxbase,154)
  318.     call forbid()
  319.     FSize = c2d(import(offset(FontAddr, 20),2))
  320.     call permit()
  321. return FSize
  322.