home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Professional
/
OS2PRO194.ISO
/
os2
/
prgramer
/
rexx
/
rdebug
/
rxref.kex
< prev
next >
Wrap
Text File
|
1993-03-25
|
9KB
|
306 lines
/*H* RXREF.KEX 02-09-93 10:57*/
/* test seperately
signal on error
signal on halt
signal on syntax
*/
Parse source sys .
if sys='OS/2' then sys='OS2'
else if sys='PCDOS' then sys='DOS'
if (sys='DOS') + (sys='OS2')>0 then pc?=1
me='rXREF'
If arg(1)='?' Then Exit tell(me)
Arg origin num auto .
/* cross reference all labels used in a REXX exec or Macro.*/
/* test seperately
signal on error
signal on halt
signal on syntax
*/
If origin='/XR' Then origin='*EXEC*'
If origin<>'*EXEC*' Then Arg num auto .
Call xref_initial
Do k=1 To num Until rc<>0
'+1 COMMAND EXTRACT /LINE/CURLINE'
string=strip(curline.3,'b')
If string='' Then Iterate
if k//10=0 then 'COMMAND REFRESH'
Call continued_lines
word1=word(string,1)
word2=word(string,2)
i=wordpos(word1,listextract)+wordpos(word2,listextract)
If pc? & i>0 Then string=translate(string,'7c'x'~',sq''dq)
Else If i>0 Then string=translate(string,'4f'x'~',sq''dq) /* bar */
i=wordpos('interpret',string)
If i>0 Then string=translate(delword(string,i,1),' ',sq''dq)
Call check_delimiters
Call split_lines
Call process_stack
End
Call eoj
Exit 0
DEFINE_LABEL:
rest=word(wd1,2) rest
wd1=word(wd1,1)
If wd1='.' Then Return
Call update_xref_table 'def'
Return; UPDATE_XREF_TABLE:
If datatype(wd1,'w') Then Return
If wd1='' Then Return
Parse Arg refordef
m=wordpos(wd1,items)
If m>0 Then Do
If refordef='ref'
Then ref.m=ref.m line.1
Else def.m=def.m line.1; End
Else Do
n=n+1;
items=items wd1
def.n='undef'
If refordef='ref'
Then ref.n=line.1
Else def.n=line.1; End
Return
CONTINUED_LINES:
If right(string,1)=',' Then Do;
Do Forever While right(string,1)=','
'+1 Command extract /curline'
string=string curline.3
End
End
Return
CHECK_DELIMITERS:
Do Forever
Parse Value pos(sq,string) pos(dq,string) pos('/*',string),
With h i j;
If h=0 Then h=500;
If i=0 Then i=500;
If j=0 Then j=500;
i=min(h,i,j);
If i=500 Then Leave;
delimiter=substr(string,i,1);
If delimiter='/' Then Parse Value '*/' 2 With delimiter width
Else width=1;
temp=substr(string,1,i-1)
string=substr(string,i+1)
Do k=k;
j=pos(delimiter,string)
If j>0 Then Leave;
If k>ssize Then Leave
'COMMAND +1 EXTRACT /CURLINE';
string=curline.3;
End;
string=temp substr(string,j+width)
End
Return
SPLIT_LINES:
colon=''
string=strip(string,'b')
Do Forever
i=max(lastpos(';',string),lastpos(':',string))
i=max(i,lastpos(' Then ', string))
If i=0 Then Leave
delimiter=substr(string,i,1)
width=1
If delimiter=' ' Then width=5
temp=substr(string,i+width)
If temp<>'' Then Push temp''colon
colon=''
If delimiter=':' Then colon=':'
string=left(string,i-1)
End
Push string''colon
Return
PROCESS_STACK:
Do queued()
Pull string
string=strip(string,'b')
Parse Var string wd1 wd2 rest
If (wd1=xthen)+(wd1=xelse)>0 Then Parse Var string . wd1 wd2 rest
If wd1=xdo Then Parse Var string . wd1 wd2 rest
If (wd1=xthen)+(wd1=xelse)>0 Then Parse Var string . wd1 wd2 rest
If wd1=xdo Then Parse Var string . wd1 wd2 rest
If wd1''wd2''rest='' Then Iterate
If (wd2='=')+(right(wd1,1)=':')>0 Then Do
If right(wd1,1)=':' Then Do
wd1=left(wd1,length(wd1)-1)
calledby=left(wd1,4); End
Call define_label
wd1=''; wd2=''
End
If wordpos(wd1,parse Arg Pull xextract)+(wd2=xextract)>0 Then Do
string=translate(wd2 rest,' ',"/,()+-*%")
Do y=1 To words(string)
wd1=word(string,y)
If wordpos(wd1,upper Arg Pull xextract Value Var With source)>0
Then Iterate
Call define_label
End
End
codes=',-+=><&+/%:*)'
If pc? Then Nop
Else codes=codes'4f'x'5f'x
string=translate(wd1 wd2 rest,' ',codes)
Call drop_numerics
Call drop_names
Call data_labels
End
Return
DROP_NUMERICS:
Do x=words(string) By -1 To 2
If datatype(word(string,x),'w') Then string=delword(string,x,1)
End;
Return;DROP_NAMES:
Do d=1 To names
labels=value(word(list,d))
Do x=words(string) To 1 By -1
If wordpos(word(string,x),labels)>0
Then string=delword(string,x,1)
End
End
string=translate(string,' ','7c'x'()') /*broken bar */
Return;DATA_LABELS:
wd1='x'
Do x=1 While wd1<>''
wd1=word(string,x)
if wd1='.' then iterate
Call update_xref_table 'ref'
words=translate(wd1,' ','.')
If words(words)<2 Then Iterate
Do While wd1<>''
Parse Var words wd1 words
Call update_xref_table 'ref'
End;
End;
Return
CREATE_NUMBERED_FILE:
Address Command 'DROPBUF'
'COMMAND SET MSGMODE ON'
':0 PUT *' temp
'XEDIT' temp
'COMMAND EXTRACT /SIZE'
Do m=1 Until m>size.1
'COMMAND +1 CINSERT' right(m,4)
End
'COMMAND FILE' number
Return; XREF_INITIAL:
'COMMAND PRESERVE'
'COMMAND EXTRACT /FN/FT/LINE/SIZE'
sname=fname.1
ssize=size.1
If pc? Then Do
temp ='TEMP.REX'
number =sname'.NUM'
xrefmap ='XREFMAP.KEX'
xrefdata='XREFDATA.KEX'; End
Else Do
temp ='TEMP EXEC A3'
number =sname 'NUMBERED'
xrefmap ='XREFMAP XEDIT'
xrefdata='XREFDATA XEDIT'; End
/*
If line.1<10 Then line.1=1
sline=line.1
':'sline
If (num='*')+(num='')>0 Then Do
'COMMAND TOP'
num=size.1; End
If datatype('0'num,'w') Then Nop
Else Call msg '10 num not numeric'
*/
sline=line.1
':1'
num=size.1
c1=' If Then Else Forever Do End To By For When While Until '
c2=' Otherwise Address Call Exit Leave Drop Nop Interpret iterate'
c3=' Numeric Signal Options Procedure Pull Push Queue Return Say '
c4=' Parse Arg External Source Version Expose On Off '
c5=' Select digits Trace Upper Var Value With Xedit Cms Command '
f1=' abs( arg( cmsflag( abbrev( bitand( bitor( bitxor('
f2=' compare( centre( center( copies( c2d( c2x( datatype( date( delstr('
f3=' delword( diag( diagrc( d2c( d2x( errortext( external( wordpos('
f4=' format( index( insert( justify( lastpos( left( length( address( '
f5=' linesize( max( min( overlay( pos( queued( random( '
f6=' reverse( right( translate( trunc( userid( verify( word( wordindex('
f7=' wordlength( words( xrange( x2c( x2d( value( sign( sourceline('
f8=' space( storage( strip( substr( subword( symbol( time('
commands=c1 c2 c3; commands2=c4 c5;
functions1=f1 f2 f3 f4; functions2=f5 f6 f7; functions3=f8
Upper commands commands2 functions1 functions2 functions3
list='COMMANDs commands2 functions1 functions2 functions3'
names=words(list)
Parse Value 0 "01"x '02'x 0 With n sq dq rc labels def. ref. items
Parse Value 'do' 'else' 'then' 'EXTRACT' With xdo xelse xthen xe xtract
Upper xdo xthen xelse xextract
listextract='EXTRACT' sq'EXTRACT' dq'EXTRACT'
'ERASE' xrefdata
/*':1 COMMAND PUT' num+line.1 xrefdata*/
':1 COMMAND PUT *' xrefdata
If auto='COMMAND QUIT' Then 'COMMAND QUIT'
/*':'sline 'COMMAND RESTORE'*/
':1 COMMAND RESTORE'
'COMMAND XEDIT' xrefdata
'COMMAND EXTRACT /WRAP/CASE/AUTOSAVE/MSGMODE'
'COMMAND SET WRAP OFF'
'COMMAND SET CASE M I'
'COMMAND SET MSGMODE OFF'
'COMMAND SET AUTOSAVE OFF'
/*'COMMAND :'LINE.1 'COMMAND CHANGE /=/ = /' num '*'*/
'COMMAND CHANGE /=/ = /' num '*'
'COMMAND CHANGE /(/( /' num '*'
"COMMAND CHANGE /'/"SQ"/" num '*'
'COMMAND CHANGE /"/'DQ'/' num '*'
Return;
EOJ:
'XEDIT' xrefdata
'qq'
'ERASE' xrefdata
/* Call create_numbered_file*/
'COMMAND XEDIT' xrefmap
'COMMAND SET MSGMODE OFF'
lgt1=132;
Do n=1 To n
item =left(word(items,n),20)
firstd=item 'def' def.n
firstr=item 'ref' ref.n
'COMMAND INPUT' left(firstd,lgt1)
'COMMAND INPUT' left(firstr,lgt1)
firstr=item 'ref' substr(firstr,112)
If words(firstr)>2 Then 'COMMAND input' left(firstr,lgt1)
firstr=item 'ref' substr(firstr,112)
If words(firstr)>2 Then 'COMMAND input' left(firstr,lgt1)
End
'COMMAND SET MSGMODE ON'
'COMMAND FT MAP';
':1 COMMAND FN' sname;
If origin='*EXEC*' Then Do
'MACRO SORT * 1 22'
'COMMAND FM' fmode.1
'COMMAND FILE'
'COMMAND QUIT'; End
Else Do
/*
'COMMAND CMSG SORT * 1 22'
'COMMAND EMSG hit enter To sort By symbol.';
*/
'SORT * 1 22'
End
Return
signal on error
signal on halt
signal on syntax
ERROR: return -7 0 sigl rdbmsg(810 rc 'in line:' sigl' of' me)
HALT: return -7 0 sigl rdbmsg(820 'in line:' sigl' of' me)
SYNTAX: return -7 0 sigl rdbmsg(830 rc 'in line:' sigl' of' me)