home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / rexx / rdebug / rxref.kex < prev    next >
Encoding:
Text File  |  1993-03-25  |  8.5 KB  |  306 lines
  1. /*H* RXREF.KEX 02-09-93 10:57*/
  2.  /*      test seperately
  3.  signal on error
  4.  signal on halt
  5.  signal on syntax
  6.  */
  7.  Parse source sys .
  8.  if      sys='OS/2'  then sys='OS2'
  9.  else if sys='PCDOS' then sys='DOS'
  10.  if (sys='DOS') + (sys='OS2')>0 then pc?=1
  11.  me='rXREF'
  12.  If arg(1)='?' Then Exit tell(me)
  13.  Arg origin num auto .
  14.  /* cross reference all labels used in a REXX exec or Macro.*/
  15.  /*      test seperately
  16.  signal on error
  17.  signal on halt
  18.  signal on syntax
  19.  */
  20.  If origin='/XR' Then origin='*EXEC*'
  21.  If origin<>'*EXEC*' Then Arg num auto .
  22.  Call xref_initial
  23.  
  24.  Do k=1 To num  Until rc<>0
  25.    '+1 COMMAND EXTRACT /LINE/CURLINE'
  26.    string=strip(curline.3,'b')
  27.    If string='' Then Iterate
  28.    if k//10=0 then 'COMMAND REFRESH'
  29.    Call continued_lines
  30.    word1=word(string,1)
  31.    word2=word(string,2)
  32.    i=wordpos(word1,listextract)+wordpos(word2,listextract)
  33.    If pc? & i>0 Then string=translate(string,'7c'x'~',sq''dq)
  34.    Else  If i>0 Then string=translate(string,'4f'x'~',sq''dq) /* bar */
  35.    i=wordpos('interpret',string)
  36.    If i>0 Then string=translate(delword(string,i,1),' ',sq''dq)
  37.    Call check_delimiters
  38.    Call split_lines
  39.    Call process_stack
  40.  End
  41.  Call eoj
  42.  Exit 0
  43.  
  44.  DEFINE_LABEL:
  45.  rest=word(wd1,2) rest
  46.  wd1=word(wd1,1)
  47.  If wd1='.' Then Return
  48.  Call update_xref_table 'def'
  49.  
  50.  Return; UPDATE_XREF_TABLE:
  51.  If datatype(wd1,'w') Then Return
  52.  If wd1='' Then Return
  53.  Parse Arg refordef
  54.  m=wordpos(wd1,items)
  55.  If m>0 Then Do
  56.    If refordef='ref'
  57.    Then ref.m=ref.m line.1
  58.    Else def.m=def.m line.1; End
  59.  Else Do
  60.    n=n+1;
  61.    items=items wd1
  62.    def.n='undef'
  63.    If refordef='ref'
  64.    Then ref.n=line.1
  65.    Else def.n=line.1; End
  66.  Return
  67.  CONTINUED_LINES:
  68.  If right(string,1)=',' Then Do;
  69.    Do Forever While right(string,1)=','
  70.      '+1 Command extract /curline'
  71.      string=string curline.3
  72.    End
  73.  End
  74.  Return
  75.  CHECK_DELIMITERS:
  76.  Do Forever
  77.    Parse Value pos(sq,string) pos(dq,string) pos('/*',string),
  78.    With h i j;
  79.    If h=0 Then h=500;
  80.    If i=0 Then i=500;
  81.    If j=0 Then j=500;
  82.    i=min(h,i,j);
  83.    If i=500 Then Leave;
  84.    delimiter=substr(string,i,1);
  85.    If delimiter='/' Then Parse Value '*/' 2 With delimiter width
  86.    Else width=1;
  87.    temp=substr(string,1,i-1)
  88.    string=substr(string,i+1)
  89.    Do k=k;
  90.      j=pos(delimiter,string)
  91.      If j>0 Then Leave;
  92.      If k>ssize Then Leave
  93.      'COMMAND +1 EXTRACT /CURLINE';
  94.      string=curline.3;
  95.    End;
  96.    string=temp substr(string,j+width)
  97.  End
  98.  Return
  99.  SPLIT_LINES:
  100.  colon=''
  101.  string=strip(string,'b')
  102.  Do Forever
  103.    i=max(lastpos(';',string),lastpos(':',string))
  104.    i=max(i,lastpos(' Then ', string))
  105.    If i=0 Then Leave
  106.    delimiter=substr(string,i,1)
  107.    width=1
  108.    If delimiter=' ' Then width=5
  109.    temp=substr(string,i+width)
  110.    If temp<>'' Then Push temp''colon
  111.    colon=''
  112.    If delimiter=':' Then colon=':'
  113.    string=left(string,i-1)
  114.  End
  115.  Push string''colon
  116.  Return
  117.  PROCESS_STACK:
  118.  Do queued()
  119.    Pull string
  120.    string=strip(string,'b')
  121.    Parse Var string wd1 wd2 rest
  122.    If (wd1=xthen)+(wd1=xelse)>0 Then Parse Var string . wd1 wd2 rest
  123.    If wd1=xdo Then Parse Var string . wd1 wd2 rest
  124.    If (wd1=xthen)+(wd1=xelse)>0 Then Parse Var string . wd1 wd2 rest
  125.    If wd1=xdo Then Parse Var string . wd1 wd2 rest
  126.    If wd1''wd2''rest='' Then Iterate
  127.    If (wd2='=')+(right(wd1,1)=':')>0 Then Do
  128.      If right(wd1,1)=':' Then Do
  129.        wd1=left(wd1,length(wd1)-1)
  130.        calledby=left(wd1,4); End
  131.      Call define_label
  132.      wd1=''; wd2=''
  133.    End
  134.    If wordpos(wd1,parse Arg Pull xextract)+(wd2=xextract)>0 Then Do
  135.      string=translate(wd2 rest,' ',"/,()+-*%")
  136.      Do  y=1 To words(string)
  137.        wd1=word(string,y)
  138.        If wordpos(wd1,upper Arg Pull xextract Value Var With source)>0
  139.        Then Iterate
  140.        Call define_label
  141.      End
  142.    End
  143.    codes=',-+=><&+/%:*)'
  144.    If pc? Then Nop
  145.    Else codes=codes'4f'x'5f'x
  146.    string=translate(wd1 wd2 rest,' ',codes)
  147.    Call drop_numerics
  148.    Call drop_names
  149.    Call data_labels
  150.  End
  151.  Return
  152.  DROP_NUMERICS:
  153.  Do x=words(string) By -1 To 2
  154.    If datatype(word(string,x),'w') Then string=delword(string,x,1)
  155.  End;
  156.  
  157.  Return;DROP_NAMES:
  158.  Do d=1 To names
  159.    labels=value(word(list,d))
  160.    Do x=words(string) To 1 By -1
  161.      If wordpos(word(string,x),labels)>0
  162.      Then string=delword(string,x,1)
  163.    End
  164.  End
  165.  string=translate(string,' ','7c'x'()')  /*broken bar */
  166.  
  167.  Return;DATA_LABELS:
  168.  wd1='x'
  169.  Do x=1 While wd1<>''
  170.    wd1=word(string,x)
  171.    if wd1='.' then iterate
  172.    Call update_xref_table 'ref'
  173.    words=translate(wd1,' ','.')
  174.    If words(words)<2 Then Iterate
  175.    Do While wd1<>''
  176.      Parse Var words wd1 words
  177.      Call update_xref_table 'ref'
  178.    End;
  179.  End;
  180.  Return
  181.  CREATE_NUMBERED_FILE:
  182.  Address Command 'DROPBUF'
  183.  'COMMAND SET MSGMODE ON'
  184.  ':0 PUT *' temp
  185.  'XEDIT' temp
  186.  'COMMAND EXTRACT /SIZE'
  187.  Do m=1 Until m>size.1
  188.    'COMMAND +1 CINSERT' right(m,4)
  189.  End
  190.  'COMMAND FILE' number
  191.  
  192.  Return; XREF_INITIAL:
  193.  'COMMAND PRESERVE'
  194.  'COMMAND EXTRACT /FN/FT/LINE/SIZE'
  195.  sname=fname.1
  196.  ssize=size.1
  197.  If pc? Then Do
  198.    temp    ='TEMP.REX'
  199.    number  =sname'.NUM'
  200.    xrefmap ='XREFMAP.KEX'
  201.    xrefdata='XREFDATA.KEX'; End
  202.  Else Do
  203.    temp    ='TEMP EXEC A3'
  204.    number  =sname 'NUMBERED'
  205.    xrefmap ='XREFMAP XEDIT'
  206.    xrefdata='XREFDATA XEDIT'; End
  207.  /*
  208.  If line.1<10 Then line.1=1
  209.  sline=line.1
  210.  ':'sline
  211.  If (num='*')+(num='')>0 Then Do
  212.    'COMMAND TOP'
  213.    num=size.1; End
  214.  If datatype('0'num,'w') Then Nop
  215.  Else Call msg '10 num not numeric'
  216.  */
  217.  sline=line.1
  218.  ':1'
  219.  num=size.1
  220.  c1=' If Then Else Forever Do End To By For When While Until '
  221.  c2=' Otherwise Address Call Exit Leave Drop Nop Interpret iterate'
  222.  c3=' Numeric Signal Options Procedure Pull Push Queue Return Say '
  223.  c4=' Parse Arg External Source Version Expose On Off '
  224.  c5=' Select digits Trace Upper Var Value With Xedit Cms Command '
  225.  f1=' abs( arg( cmsflag( abbrev( bitand(  bitor( bitxor('
  226.  f2=' compare( centre( center( copies( c2d( c2x( datatype( date( delstr('
  227.  f3=' delword( diag( diagrc( d2c( d2x( errortext( external( wordpos('
  228.  f4=' format( index( insert( justify( lastpos( left( length( address( '
  229.  f5=' linesize( max( min( overlay( pos( queued( random( '
  230.  f6=' reverse( right( translate( trunc( userid( verify( word( wordindex('
  231.  f7=' wordlength( words( xrange( x2c( x2d( value( sign( sourceline('
  232.  f8=' space( storage( strip( substr( subword( symbol( time('
  233.  commands=c1 c2 c3; commands2=c4 c5;
  234.  functions1=f1 f2 f3 f4; functions2=f5 f6 f7; functions3=f8
  235.  Upper   commands commands2 functions1 functions2 functions3
  236.  list='COMMANDs commands2 functions1 functions2 functions3'
  237.  names=words(list)
  238.  Parse Value 0 "01"x '02'x 0 With n sq dq rc labels def. ref. items
  239.  Parse Value 'do' 'else' 'then' 'EXTRACT' With xdo xelse xthen xe        xtract
  240.  Upper xdo xthen xelse xextract
  241.  listextract='EXTRACT' sq'EXTRACT' dq'EXTRACT'
  242.  'ERASE' xrefdata
  243.  /*':1 COMMAND PUT' num+line.1 xrefdata*/
  244.  ':1 COMMAND PUT *' xrefdata
  245.  If auto='COMMAND QUIT' Then 'COMMAND QUIT'
  246.  /*':'sline 'COMMAND RESTORE'*/
  247.  ':1 COMMAND RESTORE'
  248.  'COMMAND XEDIT' xrefdata
  249.  'COMMAND EXTRACT /WRAP/CASE/AUTOSAVE/MSGMODE'
  250.  'COMMAND SET WRAP OFF'
  251.  'COMMAND SET CASE M I'
  252.  'COMMAND SET MSGMODE OFF'
  253.  'COMMAND SET AUTOSAVE OFF'
  254.  /*'COMMAND :'LINE.1 'COMMAND CHANGE /=/ = /' num '*'*/
  255.  'COMMAND CHANGE /=/ = /' num '*'
  256.  'COMMAND CHANGE /(/( /' num '*'
  257.  "COMMAND CHANGE /'/"SQ"/" num '*'
  258.  'COMMAND CHANGE /"/'DQ'/' num '*'
  259.  Return;
  260.  
  261.  EOJ:
  262.  'XEDIT' xrefdata
  263.  'qq'
  264.  'ERASE' xrefdata
  265.  /* Call create_numbered_file*/
  266.  'COMMAND XEDIT' xrefmap
  267.  'COMMAND SET MSGMODE OFF'
  268.  lgt1=132;
  269.  Do n=1 To n
  270.    item  =left(word(items,n),20)
  271.    firstd=item 'def' def.n
  272.    firstr=item 'ref' ref.n
  273.    'COMMAND INPUT' left(firstd,lgt1)
  274.    'COMMAND INPUT' left(firstr,lgt1)
  275.    firstr=item 'ref' substr(firstr,112)
  276.    If words(firstr)>2 Then 'COMMAND input' left(firstr,lgt1)
  277.    firstr=item 'ref' substr(firstr,112)
  278.    If words(firstr)>2 Then 'COMMAND input' left(firstr,lgt1)
  279.  End
  280.  'COMMAND SET MSGMODE ON'
  281.  'COMMAND FT MAP';
  282.  ':1 COMMAND FN' sname;
  283.  If origin='*EXEC*' Then Do
  284.    'MACRO SORT * 1 22'
  285.    'COMMAND FM' fmode.1
  286.    'COMMAND FILE'
  287.    'COMMAND QUIT'; End
  288.  Else Do
  289.  /*
  290.    'COMMAND CMSG SORT * 1 22'
  291.    'COMMAND EMSG hit enter To sort By symbol.';
  292.  */
  293.    'SORT * 1 22'
  294.  End
  295.  Return
  296.  
  297.  signal on error
  298.  signal on halt
  299.  signal on syntax
  300.  ERROR:   return -7 0 sigl rdbmsg(810 rc 'in line:' sigl' of' me)
  301.  
  302.  HALT:    return -7 0 sigl rdbmsg(820 'in line:' sigl' of' me)
  303.  
  304.  SYNTAX:  return -7 0 sigl rdbmsg(830 rc 'in line:' sigl' of' me)
  305.  
  306.