home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
dumptool.zip
/
TRUTILS.ZIP
/
maptsf.cmd
< prev
next >
Wrap
OS/2 REXX Batch file
|
1998-07-27
|
17KB
|
534 lines
/* rexx */
/* MAPTSF Map to TSF conversion utility */
/* R.J.Moore 6 May 1997 */
/* version 1.7 */
say ";MAPTSF: Map to TSF conversion utility version 1.7"
say ";Author: Richard Moore - 27th July 98"
say ';Copyright (C) 1997, IBM UK Ltd.'
trace 'o'
signal on halt name haltexit
parse arg parms
?.=''
?tmpl16.=''
?tmpl16ret.=''
?tmpl32.=''
?tmpl32ret.=''
?tmpl16.0=0
?tmpl16ret.0=0
?tmpl32.0=0
?tmpl32ret.0=0
rc=parse_parms(parms)
if rc=0 then rc=readmap()
if rc=0 then rc=gentsf()
haltexit:
exit rc
parse_parms: procedure expose ?. ?codeobjs. ?publics. ?tp16. ?tp32.,
?tmpl16. ?tmpl16ret. ?tmpl32. ?tmpl32ret.
parse arg parms
parse var parms mapfile parms
if mapfile='' then do
call emsg 'Map file required'
call syntax_help
return 4
end /* do */
else ?.0mapfile=mapfile
?.0retep=0=1
?.0logreturn=0=1
?.0logstack=0
?.0case=0=1
?.0types=0=1
rc=0
tin= 'abcdefghijklmnopqrstuvwzyz,'
tout='ABCDEFGHIJKLMNOPQRSTUVWZYZ '
include=''
exclude=''
do while parms<>''
parse var parms key parms
parse var key . '/' key . '=' value .
key=transkey(key)
select
when key='TYPES' then ?.0types=0=0
when key='CASESENSITIVE' then ?.0case=0=0
when key='MAJOR' then ?.0major=value
when key='MAXDATALENGTH' then ?.0maxdatalength=value
when key='MINORSTART' then ?.0minors=value
when key='RETEP' then ?.0retep=0=0
when key='MODNAME' then ?.0modname=value
when key='TEMPLATE' then rc=readtmplt(value)
when key='LOGSTACK' & value<>'' then ?.0logstack=value
when key='LOGSTACK' & value='' then ?.0logstack=16
when key='LOGRETURN' then ?.0logreturn=0=0
when key='EXCLUDE' then exclude=value
when key='INCLUDE' then include=value
when key='REGISTERS' then ?.0regs=translate(value,tout,tin)
when key='GROUPS' then ?.0groups=translate(value,tout,tin)
otherwise
call emsg 'Invalid or ambiguous parameter:' key
call syntax_help
return 8
end /* select */
end /* do */
if ?.0case then do
if exclude <> '' then ?.0exclude=translate(exclude,' ',',')
if include <> '' then ?.0include=translate(include,' ',',')
end /* do */
else do
if exclude <> '' then ?.0exclude=translate(exclude,tout,tin)
if include <> '' then ?.0include=translate(include,tout,tin)
end /* do */
/* sort into length order */
?.0include=sortbylen(?.0include)
?.0exclude=sortbylen(?.0exclude)
if ?.0regs<>'' then do i=1 to words(?.0regs)
r=word(?.0regs,i)
if length(r)=3 | r='EFLAGS' then ?.0rfmt=?.0rfmt r'=%F'
else ?.0rfmt=?.0rfmt r'=%W'
end /* do */
?.0rfmt=strip(?.0rfmt,'b',' ')
?.0regs=translate(?.0regs,',',' ')
return rc
transkey: procedure expose ?. ?codeobjs. ?publics. ?tp16. ?tp32. ,
?tmpl16. ?tmpl16ret. ?tmpl32. ?tmpl32ret.
arg key
if pos(key,'CASESENSITIVE')=1 & length(key)>0 then return 'CASESENSITIVE'
if pos(key,'EXCLUDE')=1 & length(key)>0 then return 'EXCLUDE'
if pos(key,'GROUPS')=1 & length(key)>0 then return 'GROUPS'
if pos(key,'INCLUDE')=1 & length(key)>0 then return 'INCLUDE'
if pos(key,'LOGRETURN')=1 & length(key)>3 then return 'LOGRETURN'
if pos(key,'LOGSTACK')=1 & length(key)>3 then return 'LOGSTACK'
if pos(key,'MAJOR')=1 & length(key)>2 then return 'MAJOR'
if pos(key,'MAXDATALENGTH')=1 & length(key)>2 then return 'MAXDATALENGTH'
if pos(key,'MINORSTART')=1 & length(key)>1 then return 'MINORSTART'
if pos(key,'MODNAME')=1 & length(key)>1 then return 'MODNAME'
if pos(key,'REGISTERS')=1 & length(key)>2 then return 'REGISTERS'
if pos(key,'REGS')=1 & length(key)>2 then return 'REGISTERS'
if pos(key,'RETEP')=1 & length(key)>2 then return 'RETEP'
if pos(key,'TEMPLATE')=1 & length(key)>1 then return 'TEMPLATE'
if pos(key,'TYPES')=1 & length(key)>1 then return 'TYPES'
return key
syntax_help: procedure expose ?. ?codeobjs. ?publics. ?tp16. ?tp32. ,
?tmpl16. ?tmpl16ret. ?tmpl32. ?tmpl32ret.
call emsg 'MAPTSF map_file [/MAJOR=major_code]'
call emsg ' [/MODNAME=name]'
call emsg ' [/MAXDATALENGTH=max_data_length]'
call emsg ' [/MINORSTART=minor_code]'
call emsg ' [/TEMPLATE=template_file]'
call emsg ' [/LOGSTACK=stack_bytes]'
call emsg ' [/EXCLUDE=string[*],....]'
call emsg ' [/INCLUDE=string[*],....]'
call emsg ' [/REGISTERS=reg[,reg]...]'
call emsg ' [/LOGRETURN]'
call emsg ' [/RETEP]'
call emsg ' [/CASESENSITIVE]'
call emsg ' [/TYPES]'
call emsg ' [/GROUPS=string,...]'
call emsg ''
call emsg 'Minimum abbreviations for keywords are permissible'
call emsg 'Template file contains one to four template TRACEPOINT definitions in'
call emsg 'TRCUST syntax, where:'
call emsg ' TP=@16 signifies a 16-bit entry-point'
call emsg ' TP=@16,RETEP signifies a 16-bit return-point'
call emsg ' TP=@32 signifies a 32-bit entry-point'
call emsg ' TP=@32,RETEP signifies a 32-bit return-point'
call emsg ''
return
readmap: procedure expose ?. ?codeobjs. ?publics. ?tp16. ?tp32. ,
?tmpl16. ?tmpl16ret. ?tmpl32. ?tmpl32ret.
?.0codeobjs=0
?codeobjs.=0=1
?codeobj16.=0=1
?publics.=0=1
?.0tp16=0
?.0tp32=0
if lines(?.0mapfile)>0 then do
mapline=getline(?.0mapfile)
do while words(mapline)<>1 & lines(?.0mapfile)>0
mapline=getline(?.0mapfile)
end /* do */
if words(mapline)=1 & ?.0modname='' then ?.0modname=mapline
mapline=getline(?.0mapfile)
do while word(mapline,1)<> 'Start' & lines(?.0mapfile)>0
mapline=getline(?.0mapfile)
end /* do */
mapline=getline(?.0mapfile)
do while words(mapline)>=4
parse var mapline obj . ':' off len name class type .
if (pos('CODE',class)>0 & ¬?codeobjs.obj) then do
?codeobjs.obj=0=0
if length(off)=4 | type='16-bit' then ?codeobj16.obj=0=0
end /* do */
mapline=getline(?.0mapfile)
end /* do */
do while (lines(?.0mapfile)>0 & pos('Publics by Value',mapline)=0)
mapline=getline(?.0mapfile)
end /* do */
mapline=getline(?.0mapfile)
do while (lines(?.0mapfile)>0 & substr(mapline,5,1)=':')
parse var mapline obj . ':' off rest
if ?codeobjs.obj then do
parse var rest label .
if allow(label) then do
if ¬?publics.obj.off then do
?publics.obj.off=0=0
if ?codeobj16.obj then do
k=?.0tp16
k=k+1
?tp16.k=label
?.0tp16=k
end /* do */
else do
k=?.0tp32
k=k+1
?tp32.k=label
?.0tp32=k
end /* do */
end /* do */
end /* do */
end /* do */
mapline=getline(?.0mapfile)
end /* do */
call lineout ?.0mapfile
end /* do */
else do
call emsg 'Null map file'
return 8
end /* do */
return 0
gentsf: procedure expose ?. ?codeobjs. ?publics. ?tp16. ?tp32. ,
?tmpl16. ?tmpl16ret. ?tmpl32. ?tmpl32ret.
say 'MODNAME='?.0modname
if ?.0maxdatalenth<>'' then say 'MAXDATALENGTH='?.0maxdatalength
if ?.0major<>'' then say 'MAJOR='?.0major
say ''
if ?.0types then do
say 'TYPELIST NAME=PRE,ID=1,'
say ' NAME=POST,ID=2,'
say ' NAME=PUB,ID=4,'
say ' NAME=PRIV,ID=8'
say ''
end /* do */
g=words(?.0groups)
if g>0 then do
if g=1 then say 'GROUPLIST NAME='word(?.0groups,1)',ID=1'
else do
say 'GROUPLIST NAME='word(?.0groups,1)',ID=1,'
do i=2 to g-1
say ' NAME='word(?.0groups,i)',ID='i','
end /* do */
say ' NAME='word(?.0groups,g)',ID='g
end /* do */
end /* do */
if ?.0minors='' then ?.0curmin=1
else ?.0curmin=?.0minors
do i=1 to ?.0tp16
say '/* minor' ?.0curmin '*/'
say 'TRACE TP=.'?tp16.i',' /* bug */
if ?.0types then do
t=strip(?tp16.i,'l','_')
if datatype(left(t,1),'L') then say ' TYPE=(PRE,PRIV),'
else say ' TYPE=(PRE,PUB),'
end /* do */
grp=getgroup(?tp16.i)
if grp <> '' then say ' GROUP='grp','
if ?.0minors<>'' then say ' MINOR='?.0curmin','
?.0curmin=?.0curmin+1
say ' DESC="'?.0modname ?tp16.i 'Entry"'
if ?.0regs<>'' then do
say ' REGS=('?.0regs'),'
say ' FMT="'?.0rfmt'",'
end /* do */
if ?.0logstack>0 then do
say ' REGS=(SP,SS),'
say ' FMT="Stack pointer SS:SP=%A->",'
say ' MEM=(RSS+SP,D,'?.0logstack')'
say ' FMT="%R%W"'
end /* do */
do j=1 to ?tmpl16.0
say ' '?tmpl16.j
end /* do */
say ''
if ?.0retep then do
say '/* minor' ?.0curmin '*/'
say 'TRACE TP=.'?tp16.i',RETEP,' /* bug */
if ?.0types then do
t=strip(?tp16.i,'l','_')
if datatype(left(t,1),'L') then say ' TYPE=(POST,PRIV),'
else say ' TYPE=(POST,PUB),'
end /* do */
grp=getgroup(?tp16.i)
if grp <> '' then say ' GROUP='grp','
if ?.0minors<>'' then say ' MINOR='?.0curmin','
?.0curmin=?.0curmin+1
say ' DESC="'?.0modname ?tp16.i 'Return"'
if ?.0logreturn then do
say ' REGS=(AX)'
say ' FMT="Returns (ax) %W"'
end /* do */
do j=1 to ?tmpl16ret.0
say ' '?tmpl16ret.j
end /* do */
say ''
end /* do */
end /* do */
do i=1 to ?.0tp32
say '/* minor' ?.0curmin '*/'
say 'TRACE TP=.'?tp32.i','
if ?.0types then do
t=strip(?tp32.i,'l','_')
if datatype(left(t,1),'L') then say ' TYPE=(PRE,PRIV),'
else say ' TYPE=(PRE,PUB),'
end /* do */
grp=getgroup(?tp32.i)
if grp <> '' then say ' GROUP='grp','
if ?.0minors<>'' then say ' MINOR='?.0curmin','
?.0curmin=?.0curmin+1
say ' DESC="'?.0modname ?tp32.i 'Entry"'
if ?.0regs<>'' then do
say ' REGS=('?.0regs'),'
say ' FMT="'?.0rfmt'",'
end /* do */
if ?.0logstack>0 then do
say ' REGS=(ESP),'
say ' FMT="Stack pointer ESP=%F->",'
say ' MEM32=(FESP,D,'?.0logstack')'
say ' FMT="%R%F"'
end /* do */
do j=1 to ?tmpl32.0
say ' '?tmpl32.j
end /* do */
say ''
if ?.0retep then do
say '/* minor' ?.0curmin '*/'
say 'TRACE TP=.'?tp32.i',RETEP,'
if ?.0types then do
t=strip(?tp32.i,'l','_')
if datatype(left(t,1),'L') then say ' TYPE=(POST,PRIV),'
else say ' TYPE=(POST,PUB),'
end /* do */
grp=getgroup(?tp32.i)
if grp <> '' then say ' GROUP='grp','
if ?.0minors<>'' then say ' MINOR='?.0curmin','
?.0curmin=?.0curmin+1
say ' DESC="'?.0modname ?tp32.i 'Return"'
if ?.0logreturn then do
say ' REGS=(EAX)'
say ' FMT="Returns (eax) %F"'
end /* do */
do j=1 to ?tmpl32ret.0
say ' '?tmpl32ret.j
end /* do */
say ''
end /* do */
end /* do */
return 0
readtmplt: procedure expose ?. ?codeobjs. ?publics. ?tp16. ?tp32.,
?tmpl16. ?tmpl16ret. ?tmpl32. ?tmpl32ret.
arg tfile .
if lines(tfile)=0 then do
call emsg 'Null template file' tfile
return 8
end /* do */
do while lines(tfile)>0
tline=getline(tfile)
do while word(tline,1)='TRACE' & tline<>''
parse var tline . 'TP=@' type . ',' ret ',' .
select
when type=16 & ret='' then do
k=0
if tline='' then do
call emsg 'Incomplete tracepoint specification in' tfile
iterate
end /* do */
tline=getline(tfile)
do while word(tline,1)<>'TRACE' & tline<>''
k=k+1
?tmpl16.k=tline
tline=getline(tfile)
end /* do */
?tmpl16.0=k
end /* do */
when type=16 & ret='RETEP' then do
k=0
if tline=0 then do
call emsg 'Incomplete tracepoint specification in' tfile
iterate
end /* do */
tline=getline(tfile)
do while word(tline,1)<>'TRACE' & tline<>''
k=k+1
?tmpl16ret.k=tline
tline=getline(tfile)
end /* do */
?tmpl16ret.0=k
end /* do */
when type=32 & ret='' then do
k=0
if tline='' then do
call emsg 'Incomplete tracepoint specification in' tfile
iterate
end /* do */
tline=getline(tfile)
do while word(tline,1)<>'TRACE' & tline<>''
k=k+1
?tmpl32.k=tline
tline=getline(tfile)
end /* do */
?tmpl32.0=k
end /* do */
when type=32 & ret='RETEP' then do
k=0
if tline='' then do
call emsg 'Incomplete tracepoint specification in' tfile
iterate
end /* do */
tline=getline(tfile)
do while word(tline,1)<>'TRACE' & tline<>''
k=k+1
?tmpl32ret.k=tline
tline=getline(tfile)
end /* do */
?tmpl32ret.0=k
end /* do */
otherwise
call emsg 'Invalid TP specification in' tfile
end /* select */
end /* do */
end /* do */
call lineout tfile
return 0
getline: procedure expose ?. ?codeobjs. ?publics. ?tp16. ?tp32. ,
?tmpl16. ?tmpl16ret. ?tmpl32. ?tmpl32ret.
arg file
if lines(file)=0 then return ''
nextline=linein(file)
nextline=translate(nextline,,xrange('00'x,'1f'x),' ')
nextline=strip(nextline,'b',' ')
if nextline='' then nextline=getline(file)
return nextline
included: procedure expose ?. ?codeobjs. ?publics. ?tp16. ?tp32. ,
?tmpl16. ?tmpl16ret. ?tmpl32. ?tmpl32ret.
if ?.0case then parse arg label
else arg label
if ?.0include='' then return 0=0
else do i=1 to words(?.0include)
w=word(?.0include,i)
if right(w,1)='*' then do
if pos(substr(w,1,length(w)-1),label)=1 then return length(w)-1
end /* do */
else if w=label then return length(w)
end /* do */
return 0
excluded: procedure expose ?. ?codeobjs. ?publics. ?tp16. ?tp32. ,
?tmpl16. ?tmpl16ret. ?tmpl32. ?tmpl32ret.
if ?.0case then parse arg label
else arg label
if ?.0exclude='' then return 0=1
else do i=1 to words(?.0exclude)
w=word(?.0exclude,i)
if right(w,1)='*' then do
if pos(substr(w,1,length(w)-1),label)=1 then return length(w)-1
end /* do */
else if w=label then return length(w)
end /* do */
return 0
allow: procedure expose ?. ?codeobjs. ?publics. ?tp16. ?tp32. ,
?tmpl16. ?tmpl16ret. ?tmpl32. ?tmpl32ret.
if ?.0case then parse arg label
else arg label
if (?.0exclude<>'' & ?.0include<>'') then,
return (excluded(label) < included(label))
else if (?.0exclude<>'') then return (excluded(label)=0)
else if (?.0include<>'') then return (included(label)<>0)
else return 0=0
emsg: procedure
parse arg message
x=lineout('STDERR',message)
return
getgroup: procedure expose ?. ?codeobjs. ?publics. ?tp16. ?tp32. ,
?tmpl16. ?tmpl16ret. ?tmpl32. ?tmpl32ret.
arg tp
tp=strip(tp,'l','_')
do i=1 to words(?.0groups)
grp=word(?.0groups,i)
if pos(grp,tp)=1 then return grp
end /* do */
return ''
/* sort generics into length order */
/* after specifics */
sortbylen: procedure
parse arg sortstr
temp=''
temp2=''
if words(sortstr)>0 then do
do i=1 to words(sortstr)
w=word(sortstr,i)
l=length(w)
if right(w,1)='*' then do
l=l-1
do j=1 to words(temp)
if l>=length(word(temp,j)) then do
j=j-1
leave
end /* do */
end /* do */
templ = subword(temp,1,j)
tempr = subword(temp,j+1)
temp = templ w tempr
end /* do */
else temp2 = w temp2
end /* do */
temp=strip(temp2 temp,'b',' ')
end /* do */
return temp