home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / rexx / rdebug / rdbprof.kex < prev    next >
Encoding:
Text File  |  1993-03-25  |  4.1 KB  |  146 lines
  1. /*H* RDBPROF.KEX 02-10-93 12:13*/
  2.  parse arg dborigin dbw1 dbtrigger dbpath dbsize dbdfile'!'dbprof,
  3.  '!'dbuc'!'dboptions'!' . dbw2 dbrem
  4.  signal on error;   signal ON FAILURE;  signal on halt
  5.  signal ON NOVALUE; signal ON NOTREADY; signal ON SYNTAX
  6.  Parse Value 'COMMAND SET!COMMAND EXT' With dbcs'!'dbce
  7.  Parse Value 'COMMAND!COMMAND SOS!COMMAND X' With dbc'!'dbso'!'dbxx
  8.  dbce '/OPSYS'
  9.  dbme='rdbPROF'
  10.  dbsys=opsys.1
  11.  if dbsys='OS/2' then dbsys='OS2'     /*O*/
  12.  dbmsg=''
  13.  parse value 0 with dbtrc dbtrap dbtrapp dbmsg
  14.  dbs='.'
  15.  call get_options
  16.  select
  17.  
  18.    when dborigin='/SETCTL' then do
  19.      if dbtrc=-7 then return -7 dbtrap
  20.      call db3setctl
  21.      if dbtrc=-7 then return -7 dbtrap
  22.      call create_profile
  23.    end
  24.    when dborigin='/SETSW' then do
  25.      if dbtrc=-7 then return -7 dbtrap
  26.      call db3setsw
  27.      if dbtrc=-7 then return -7 dbtrap
  28.      call create_profile
  29.    end
  30.    when dborigin='/CTRL' then do
  31.      Call  create_profile; end
  32.    otherwise /*Exit*/ Return tell(dbme);
  33.  end
  34.  if dbtrc=-7 then return -7 dbtrap
  35.  if dborigin='/CTRL' then return 0
  36.  /*Exit*/ Return 0 dbfullsw dberrorsw dblogsw dbtracesw,
  37.  dbtallysw dbwatchsw dblimit dbwait dbwatch'!'dbmsg
  38.  
  39.  return 0; db3SETCTL:
  40.  dbptr='db'dbw1
  41.  if dbw2=''then dbmsg=dbmsg rdbmsg(337 dbw1 'is:' value(dbptr))
  42.  else do
  43.    if dbw1='WATCH' then do
  44.      if datatype(dbw2,'N') then do
  45.        call db3setsw 'WATCH' dbw1 dbw2
  46.        if dbtrc=-7 then return -7 dbtrap
  47.        return dbtrc dbtrap; end
  48.      else do
  49.      end
  50.      dbwatch=dbwatch dbw2 dbrem
  51.      dbmsg=dbmsg rdbmsg(335 dbwatch)
  52.  
  53.    end
  54.    else if datatype('0'dbw2,'W')=1 then do
  55.      dbmsg=dbmsg rdbmsg(337 dbw1 'is:' dbw2)
  56.      interpret dbptr'='dbw2;end
  57.    else dbmsg=dbmsg rdbmsg(340 dbw1)
  58.  end
  59.  
  60.  return 0;  DB3SETSW:
  61.  dbptr='db'dbw1'sw'
  62.  If dbw2=''then dbmsg=dbmsg rdbmsg(345 dbw1 'is:' value(dbptr))
  63.  Else Do
  64.    If dbw2=-1 Then interpret 'dbw2=(db'dbw1'sw=0)'
  65.    If dbw2=-2 Then dbw2=(dbwatchsw=0)
  66.    If dbw2>=0&dbw2<=1 Then Do;
  67.      dbmsg=dbmsg rdbmsg(345 dbw1 'is:' dbw2)
  68.      dbmsg=dbmsg rdbmsg(345 dbw1 'is:' dbw2)
  69.      Interpret dbptr'='dbw2; End
  70.    Else dbmsg=dbmsg rdbmsg(360 dbw1 'is:' value(dbptr))
  71.  
  72.  End;
  73.  
  74.  return 0;     CREATE_PROFILE:
  75.  dbce '/FN/FT/LINE'
  76.  
  77.  dbxx dbprof
  78.  if dbtrc=-7 then return -7 dbtrap
  79.  call assemble_options_table
  80.  if dbtrc=-7 then return -7 dbtrap
  81.  dbxx dbdfile
  82.  call get_control_table
  83.  if dbtrc=-7 then return -7 dbtrap
  84.  dbxx dbprof
  85.  dbc 'bot'
  86.  call assemble_control_table
  87.  if dbtrc=-7 then return -7 dbtrap
  88.  dbc 'FFILE'
  89.  dbxx fname.1''dbs''ftype.1
  90.  dbc ':'line.1
  91.  
  92.  return 0; GET_CONTROL_TABLE:
  93.  dbtbl.=''
  94.  dbtbl.1='1 B'
  95.  dbno=dbsize%42+1;
  96.  dbtbl.dbno=dbtbl.dbno dbsize 'B';
  97.  dby=words(dbopts);
  98.  ':2'
  99.  
  100.  do dbx=2 to dbsize
  101.    '+1EXT /CURL'
  102.    parse upper var curline.3 dbcall dbopt dbj .
  103.    dbopt=left(dbopt,5)
  104.    /*if (dbopt='DEBUG')+(dbcall<>'CALL')+(left(dbj,1)<>'J')>0 then iterate*/
  105.    if (dbopt='DEBUG')+(dbcall<>'CALL')>0 then iterate
  106.    dbno=dbx%42+1
  107.    dbtbl.dbno=dbtbl.dbno dbx left(dbopt,1)
  108.  end;
  109.  
  110.  return; ASSEMBLE_CONTROL_TABLE:
  111.  do dbx=1 to 24;
  112.    if dbtbl.dbx='' then iterate;
  113.    dby=dby+1;
  114.    '+1 INP' dbx dbtbl.dbx;
  115.  end
  116.  
  117.  return; ASSEMBLE_OPTIONS_TABLE:
  118.  dbc ':0 del *'
  119.  signal off novalue
  120.  do dbx=1 to words(dbopts)
  121.    interpret dbc 'INP' word(dbopts,dbx) word(dbset,dbx)
  122.  end
  123.  signal on novalue
  124.  
  125.  return 0; GET_OPTIONS:
  126.  dbopts='FULLSW ERRORSW LOGSW TRACESW TALLYSW WATCHSW COUNT WAIT WATCH'
  127.  dbset='dbfullsw dberrorsw dblogsw dbtracesw dbtallysw dbwatchsw',
  128.  'dblimit dbwait dbwatch'
  129.  parse value dboptions with,
  130.  dbfullsw dberrorsw dblogsw dbtracesw dbtallysw dbwatchsw,
  131.  dblimit dbwait dbwatch
  132.  return 0;
  133.  
  134.  ERROR:    return db9trap(sigl 80e) sourceline(sigl)
  135.  FAILURE:  return db9trap(sigl 80f) sourceline(sigl)
  136.  HALT:     return db9trap(sigl 80h)
  137.  NOTREADY: return db9trap(sigl 80r) sourceline(sigl)
  138.  NOVALUE:  return db9trap(sigl 80v)
  139.  SYNTAX:   return db9trap(sigl 80e) errortext(rc)'~'sourceline(sigl)
  140.  db9TRAP:
  141.  if dbtrc=-7 then dbtrapp=dbtrap
  142.  parse arg dbsigl dbtcode dbtrest
  143.  dbtrap = 0 dbme dbsigl dbtcode dbmsg rdbmsg(dbtcode dbme dbsigl) dbtrest
  144.  dbtrc=-7
  145.  return -7 dbtrapp'~'dbtrap
  146.