home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 499.lha / Rxgen_v1.0 / rexx / fd.rexx < prev    next >
OS/2 REXX Batch file  |  1991-04-08  |  5KB  |  154 lines
  1. /* This file is Copyright(C) 1990 Francois Rouaix and the Software Winery */
  2. /* This file must be distributed unmodified in the RXGEN package          */
  3.  
  4. /* Fd.rexx
  5.     Syntax : FD INFO <functionname> [<libraryname>]
  6.     Example: FD INFO FindPort exec
  7.     Result : prints the description of the function (offset, registers)
  8.  
  9.     Syntax : FD OFFS <offset> [<libraryname>]
  10.     Example: FD OFFS FF7A exec
  11.     Result : prints the description of the function
  12.  
  13.     Syntax : FD LIBS
  14.     Result : prints the available libraries (described by an FD.FILE)
  15. */
  16.  
  17. parse arg comselect others
  18.  
  19. do while (words(getclip('FDDIR')) == 0)
  20.     say "Please enter the directory where the FD.FILES reside:"
  21.     say "Exemple:      Extras 1.3:FD1.3"
  22.     pull fddir
  23.     fddir = strip(fddir)
  24.     call setclip('FDDIR',fddir)
  25. end
  26. fddir=getclip('FDDIR')
  27. fdfiles=showdir(fddir,'File')
  28. comselect = upper(comselect)
  29. select
  30.    when comselect=='INFO' then do
  31.             parse var others functionname libname
  32.             if length(libname) == 0
  33.                 then call map('findin  '''functionname"',", fdfiles)
  34.             else call findin(functionname,strip(libname)||'_LIB.FD')
  35.             end
  36.     when comselect=='OFFS' then do
  37.         parse var others offs libname
  38.         select
  39.             when datatype(offs) == NUM then nop
  40.             when datatype(offs) == CHAR then offs=x2d(offs) - 65536
  41.             otherwise do
  42.                     say "Offset: -num (-30)"
  43.                     say "         hex (FFA0)"
  44.                     exit 0
  45.                 end
  46.             end
  47.         if length(libname) == 0
  48.             then call map('getfunc ' offs ",", fdfiles)
  49.             else call getfunc(offs,strip(libname)||'_LIB.FD')
  50.         end
  51.     when comselect=='LIBS' then do
  52.         fdlibs = map('fname2libname', fdfiles)
  53.         say "Libraries:" fdlibs
  54.         end
  55.     otherwise
  56.         do
  57.             say "Syntax  :  FD INFO <functionname> [<libraryname>]"
  58.             say "           FD OFFS <offset> [<libraryname>]"
  59.             say "           FD LIBS"
  60.         end
  61.     end
  62.  
  63. exit 0
  64.  
  65. /* this should be familiar to you ol' lispers */
  66. map: procedure expose fddir
  67.     if (words(arg(2)) == 0)
  68.         then return('')
  69.         else
  70.             parse value arg(2) with _car _cdr
  71.             interpret 'call' arg(1) '_car'
  72.             leftval = result
  73.            return( leftval  map(arg(1), _cdr))
  74.  
  75. fname2libname: procedure
  76.     arg _fname
  77.     parse upper var _fname _libname '_LIB.FD'
  78.     return _libname
  79.  
  80. findin: procedure expose fddir
  81.     success = open('handle',fddir||'/'||arg(2),'Read')
  82.     found = 0
  83.     offset = 0
  84.     privateflag = 'public '
  85.     if success then do until (found | eof('handle'))
  86.         line = readln('handle')
  87.         select
  88.             when left(line,1) == '*' then nop
  89.             when left(line,6) == '##bias' then  do
  90.                 parse var line '##bias' offset
  91.                 offset = strip(offset)
  92.                 end
  93.             when left(line,8) == '##public'  then privateflag = 'public '
  94.             when left(line,9) == '##private' then privateflag = 'private'
  95.             when left(line,5) == '##end' then do close('handle') ; return('') ; end
  96.             when left(line,6) == '##base' then nop
  97.             otherwise do
  98.                 if upper(left(line,length(arg(1)))) == upper(arg(1))
  99.                     then found = 1
  100.                     else offset = offset + 6
  101.  
  102.                 end
  103.             end
  104.         end
  105.     else do
  106.         say "I don't find" arg(2) "in" fddir
  107.         return('')
  108.         end
  109.     call close('handle')
  110.     if found
  111.         then do
  112.             res=left(fname2libname(arg(2)),20) privateflag left('-'offset,4) d2x(65536 - offset) line
  113.             say res
  114.             return('')
  115.             end
  116.         else return('')
  117.  
  118. getfunc: procedure expose fddir /* offs library */
  119.     success = open('handle',fddir||'/'||arg(2),'Read')
  120.     found = 0
  121.     offset = 0
  122.     privateflag = 'public '
  123.     if success then do until (found | eof('handle'))
  124.         line = readln('handle')
  125.         select
  126.             when left(line,1) == '*' then nop
  127.             when left(line,6) == '##bias' then  do
  128.                 parse var line '##bias' offset
  129.                 offset = strip(offset)
  130.                 end
  131.             when left(line,8) == '##public'  then privateflag = 'public '
  132.             when left(line,9) == '##private' then privateflag = 'private'
  133.             when left(line,5) == '##end' then do close('handle') ; return('') ; end
  134.             when left(line,6) == '##base' then nop
  135.             otherwise do
  136.                 if (offset == -arg(1))
  137.                     then found = 1
  138.                     else offset = offset + 6
  139.                 end
  140.             end
  141.         end
  142.     else do
  143.         say "I don't find" arg(2) "in" fddir
  144.         return('')
  145.         end
  146.     call close('handle')
  147.     if found
  148.         then do
  149.             res=left(fname2libname(arg(2)),20) privateflag left('-'offset,4) d2x(65536 - offset) line
  150.             say res
  151.             return('')
  152.             end
  153.         else return('')
  154.