home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / rexx / rdebug / rdbcmds.kex < prev    next >
Encoding:
Text File  |  1993-03-25  |  8.8 KB  |  294 lines
  1. /*H* RDBCMDS.KEX 02-11-93 10:53*/
  2.  Signal On Error;   Signal On Failure;  Signal On Halt
  3.  Signal On Novalue; Signal On Notready; Signal ON Syntax
  4.  Parse Value 'COMMAND SET!COMMAND X!COMMAND EXT' With dbcs'!'dbxx'!'dbce
  5.  Parse Value 'COMMAND!COMMAND SOS' With dbc'!'dbso
  6.  dbce '/FN/OPSYS'
  7.  Parse Value 'RDBCMDS' opsys.1 With dbme dbsys
  8.  if dbsys='OS/2' then dbsys='OS2'     /*O*/
  9.  parse arg dbw1 dbn dbfullsw dbpath
  10.  arg dborigin .
  11.  Parse Value 0 With dbtrc dbtrap dbtrapp dbmsg
  12.  exitstr="rdbmisc('/EXIT' dbpath dbdfile'!'dbinvoke"
  13.  initstr="* parse value RDBINIT('/FI C' dbpath dbsize'!'dblogsw'!'dbuc'!0'",
  14.  "'!'dbsession'!'dbdfile'!UNZOOM') with dbtrc dtrap;"
  15.  dbstr="* dbstr;"
  16.  sourcestr=,
  17.    "dbxx dbpath''dbsource '(PROF RDPROFIL' ;"
  18.  tools="*" sourcestr "'macro'"
  19.  definequit=""
  20.  dbprefix="parse value"
  21.  dbsuffix="dbstr) with dbtrc dbtrap; if dbtrc=-7 then return -7 dbtrap"
  22.  variable= "dbmsg='key =' key"
  23.  
  24.  dbprefixsw= "* parse value rdbprof('/SETSW'"
  25.  dbprefixctl="* trace 'o?r'; parse value rdbprof('/SETCTL'"
  26.  dbswitches="dbfullsw dberrorsw dblogsw dbtracesw",
  27.  " dbtallysw dbwatchsw dblimit dbwait dbwatch "
  28.  dbsuffixsw="dbtrigger dbpath dbsize dbdfile'!'dbprof'!'dbuc'!'" dbswitches,
  29.  "'!'" dbsuffix "; parse value dbtrap with" dbswitches"'!'dbmsg"
  30.  
  31.  finis=,
  32.  " with dborigin . dbw2 dbrem ;",
  33.  " if dbw2<>''then dbparms=dbw2 dbrem ;",
  34.  " dbsourc=dbsource ;",
  35.  " if dborigin='SAVEAS' then dbsourc=dbw2 dbrem ;",
  36.  " parse value RDBEND('/'dborigin dbpath dbdfile'!'dbuc dbsize dbmacro? ",
  37.  " dbalt dbsourc'!'dbprgm'!'dbinvoke'!'dbfileid'!'dbparms) ",
  38.  " with dbtrc dbtrap ;",
  39.  " if dbtrc=0 then do ;",
  40.  "   queue dbtrap ;",
  41.  "   exit ;end ;",
  42.  " dbmsg=dbtrap ;",
  43.  ";"
  44.  dbmsg=''
  45.  select
  46.    When dborigin='?' then return tell(dbme)
  47.    When dborigin<>'' then dbcmdstr= dbcmds( dbw1 dbn dbfullsw)
  48.    otherwise return tell(dbme)
  49.  end
  50.  parse value dbcmdstr with dbtrc dbtrap
  51.  if dbtrc=-7 then return -7 dbtrap
  52.  if dbmsg<>'' then 'MSG' dbmsg
  53.  if dbcmdstr=0 then dbn=''
  54.  return dbn dbcmdstr
  55.  
  56.  DBJUMP:
  57.  arg dbn
  58.  if      dbw1< 'G' then part=1
  59.  else if dbw1< 'N' then part=2
  60.  else if dbw1< 'S' then part=3
  61.  else part=4
  62.  signal value 'C'dbn''part
  63.  
  64.  
  65.  DBCMDS:
  66.  arg dbw1 dbn dbfullsw .
  67.  do 3
  68.    call dbjump dbn
  69.    if dbtrc=-7 then return -7 dbtrap
  70.    if getcmd()=0 then do
  71.      if dbtrc=-7 then return -7 dbtrap
  72.      dbn=dbn+1
  73.    end
  74.  end
  75.  return dboutput
  76.  
  77.  GETCMD:
  78.  if dbn=3
  79.  then dbi=wordpos('$'dbw1,dblist.dbn);
  80.  else dbi=    pos('$'dbw1,dblist.dbn);
  81.  if dbi>0 then do
  82.    dbcmdstr=substr(dblist.dbn,dbi,pos('$',dblist.dbn,dbi+2)-dbi);
  83.    if dbtrc=-7 then return -7 dbtrap
  84.    parse var dbcmdstr . dbast dbcmd
  85.    if dbast='F' then do
  86.      dbfullsw=1  /*    test thoroughly & remove this line*/
  87.      if dbfullsw then
  88.      parse var dbcmdstr . . dbast dbcmd
  89.      else dbcmdstr="'dbmsg='dbmsg rdbmsg(998 '-' dbw1)" /*F*/
  90.  
  91.  
  92.    end
  93.    if dbast='F' then dbast=''        /* see above */
  94.    if dbast='*' then dboutput=dbcmd
  95.    else dboutput=dbprefix dbast dbcmd dbsuffix
  96.  end
  97.  else dboutput=0
  98.  return dboutput
  99.  
  100.  C11:
  101.  DBLIST.1=,
  102.  "$CANCEL   F" exitstr "'! 0 QQUIT'",
  103.  "$CASE     F" tools "'RCASE';" definequit "; ",
  104.  "$*****CALL        F * call db3show dbcallstack",
  105.  "$COUNT   " dbprefixctl "'LIMIT'"  dbsuffixsw,
  106.  "$DISCARD  F * parse value rdbmisc('/DROP' dbstr'!'dbwatch) with",
  107.  "   dbwatch'!'dbmsg",
  108.  "$ERROR    F" dbprefixsw  "'ERROR'" dbsuffixsw,
  109.  "$ENVIRONMENT F *" sourcestr "macro rdINFO;",
  110.  "$EXIT      * do; parse value 'EXIT' dbstr" finis "end",
  111.  "$FULL     " dbprefixsw  "'FULL'" dbsuffixsw,
  112.  "$1FFILE    " exitstr "'! 1  FILE'",
  113.  "$FFILE    " exitstr "'! 1  FFILE'",
  114.  "$FILE     " exitstr "'! 1  FILE'",
  115.  "$ "
  116.  return 0
  117.  C12:
  118.  DBLIST.1=,
  119.  "$GT      * dbgt=(dbgt=0)",
  120.  "$HELP      rdbhelp( ",
  121.  "$INDENTATION F" tools "'RPP';" definequit "; ",
  122.  "$KEDIT   * dbstr  /*NC*/ ",
  123.  "$LASTMSG  * dbmsg=dblastm",
  124.  "$MATCH     F" tools "'RMATCH';" definequit "; ",
  125.  "$ "
  126.  return 0
  127.  C13:
  128.  DBLIST.1=,
  129.  "$OUTPUT  F * dbfc?=1; if dbinside? then dbxx dbpath''dbuser '(PROF RDPROFIL';",
  130.  "  else dbxx dbpath''dbdfile '(PROF RDPROFIL'",
  131.  "$PRINT   *",
  132.  "  if dbw2='' then do ;",
  133.  "    dbw1=db8thisfile() ;",
  134.  "    dbxx dbpath''dbsession '(PROF RDPROFIL';",
  135.  "    'SSAVE' ;",
  136.  "    dbxx dbpath''dbw1 '(PROF RDPROFIL';",
  137.  "    dbw2=dbpath''dbsession; end ;",
  138.  "  'DOSN COPY' dbw2 dbprinter ;",
  139.  "$PROFILER  F *" sourcestr ,
  140.  "  ':0 MSGM OFF';",
  141.  "  'PREFIX ON LEFT';",
  142.  "  'NUM ON';",
  143.  "  do dbx=1 to dbsize; '+1 CI' right(db.dbx,4)' ';end;",
  144.  "  ':1 FT' left(dbdfile,4);",
  145.  "  ':1 FN PROFILER';" definequit "; ",
  146.  "$QQUIT    " exitstr "'! 1 QQUIT'",
  147.  "$QUIT     " exitstr "'! 1  QUIT'",
  148.  "$RDEBUG   * dbmsg=dbmsg rdbmsg(330);",
  149.  "$REFRESH F" initstr ,
  150.  "$RING   F * dbc 'QUERY RING'",
  151.  "$RUN      * dbmsg=dbmsg rdbmsg(330);",
  152.  "$ "
  153.  return 0
  154.  C14:
  155.  DBLIST.1=,
  156.  "$SAVE   F * trace o?r; if db8thisfile()<> dbpath''dbdfile then dbc 'SAVE'; ",
  157.  "  else do; parse value 'SAVE' dbstr" finis "end",
  158.  "$SAVEAS F * if db8thisfile()<> dbpath''ddbdfile then dbc 'SAVE' dbw1 dbw2; ",
  159.  "  else do; parse value 'SAVEAS' dbstr" finis "end",
  160.  "$SHOW     *" variable ,
  161.  "$SHOWWATCH * do dbi=1 to words(dbwatch); db1=word(dbwatch,dbi) ;",
  162.  "  db1=word(dbwatch,dbi); dbw=db1 ;",
  163.  "  if left(db1,1)='(' then interpret 'db1=' dbw ;",
  164.  "  dbmsg=dbmsg dbw'='value(db1)';'; end ;",
  165.  "$STRUCTURE F" tools "'RSTRUC'; dbcs 'SHAD OFF';" definequit "; ",
  166.  "$SWITCHES  * dbmsg='Fullsw' dbfullsw 'Errorsw' dberrorsw 'Logsw'",
  167.  "  dblogsw 'Tracesw' dbtracesw 'Tallysw' dbtallysw 'Watchsw' dbwatchsw",
  168.  "$SYNTAX    F" tools "'RSYNTAX';" definequit "; ",
  169.  "$TEST      db3test(",
  170.  "$UNZOOM  F" initstr ,
  171.  "$WATCH   " dbprefixctl "'WATCH'"  dbsuffixsw,
  172.  "$XEDIT    * dbstr",
  173.  "$XREF      F" tools "'RXREF';" definequit "; ",
  174.  "$ "
  175.  return 0
  176.  
  177.  C21:
  178.  DBLIST.2=,
  179.  "$BREAK     db4prefix('BREAK'",
  180.  "$DEBUG     db4prefix('DEBUG'",
  181.  "$EXCLUDE   db4prefix('EXCLU'",
  182.  "$ "
  183.  return 0
  184.  C22:
  185.  DBLIST.2=,
  186.  "$GOTO * parse value 1 0 0 with dbw1 dbbreak? dbstep? ;",
  187.  "  if dbw2='' then dbw1=1 ;",
  188.  "  else do ;",
  189.  "    if dbw2<1 then do ;",
  190.  "      if dbw2=0 then parse value 1 0 dbg with dbbreak? dbstep? dbg dbw2;",
  191.  "      else if dbw2=-1 then Parse Value 1 1 dbg With dbbreak? dbstep? dbg dbw2;",
  192.  "      else if dbw2=-2 then Parse Value dbrem 1 With dbresume dbg dbw2;",
  193.  "    end ;",
  194.  "    else dbg=dbw2 ;",
  195.  "    if dbw2<>'' then dbw1=(db3back(dbg,,'G')<>0) ;",
  196.  "  end ;",
  197.  "$LOG     " dbprefixsw  "'LOG'" dbsuffixsw,
  198.  "$ "
  199.  return 0
  200.  C23:
  201.  DBLIST.2=,
  202.  "$NEXT    * call db3back dbg",
  203.  "$OPEN    F * do; parse value 'OP' dbstr" finis "end",
  204.  "$RESTART F * do; parse value 'RS' dbstr" finis "end",
  205.  "$ "
  206.  return 0
  207.  C24:
  208.  DBLIST.2=,
  209.  "$SKIP      db4prefix('SKIP'",
  210.  "$TALLY   " dbprefixsw  "'TALLY'" dbsuffixsw,
  211.  "$TRACE F " dbprefixsw  "'TRACE'" dbsuffixsw,
  212.  "$WAIT    " dbprefixctl "'WAIT'"  dbsuffixsw,
  213.  "$ "
  214.  return 0
  215.  C31:
  216.  dblist.3=,
  217.  "$ADDRESS  *" dbstr,
  218.  "$ARG      *" dbstr,
  219.  "$CALL     *" dbstr,
  220.  "$DO       *" dbstr,
  221.  "$DROP     *" dbstr,
  222.  "$EXIT     *" dbstr,
  223.  "$ "
  224.  return 0
  225.  C32:
  226.  dblist.3=,
  227.  "$IF       *" dbstr,
  228.  "$INTERPRET*" dbstr,
  229.  "$ITERATE  *" dbstr,
  230.  "$LEAVE    *" dbstr,
  231.  "$NOP      *" dbstr,
  232.  "$NUMERIC  *" dbstr,
  233.  "$ "
  234.  return 0
  235.  C33:
  236.  dblist.3=,
  237.  "$OPTIONS  *" dbstr,
  238.  "$PARSE    *" dbstr,
  239.  "$PULL     *" dbstr,
  240.  "$PUSH     *" dbstr,
  241.  "$QUEUE    *" dbstr,
  242.  "$RETURN   *" dbstr,
  243.  "$ "
  244.  return 0
  245.  C34:
  246.  dblist.3=,
  247.  "$SAY      * dbcmsg=dbstr; dbstr",
  248.  "$SIGNAL   *" dbstr,
  249.  "$ "
  250.  return 0
  251.  
  252.  C51:
  253.  dblist.5=,
  254.  "$DB9PREFIX * dbstr.='' ;",
  255.  "dbcalls='BREAK EXCLU SKIP';",
  256.  " do dbz=1 to 24 ;",
  257.    " if dbtbl.dbz=''then iterate ;",
  258.    " do dby=1 by 2 to words(dbtbl.dbz) ;",
  259.      " dbi=wordpos(word(dbtbl.dbz,dby+1),dbcodes) ;",
  260.      " dbstr.dbi=dbstr.dbi word(dbtbl.dbz,dby) ;",
  261.    " end dby ;",
  262.    " do dbi=1 to 3 ;",
  263.      " if dbstr.dbi<>'' then do ;",
  264.        " call db43setcall word(dbcalls,dbi) '.' dbstr.dbi ;",
  265.        " if dbtrc=-7 then return -7 dbtrap; end ;",
  266.    " end dbi ;",
  267.  " end dbz ;",
  268.  " drop dbcodes dbcalls dbstr. dbi dby dbz ;",
  269.  "$ "
  270.  return 0
  271.  
  272.  C71:
  273.  dblist.7=,
  274.  "$DB9SYN * ",
  275.  " parse value dbtrap with dbint dbxme dbsigl dbtcode dbtrap ;",
  276.  " if dbinside? then dbmsg=dbmsg dbstr ;",
  277.  " if dbcallstack<>'' then dbtrap=dbtrap rdbmsg(842 dbcallstack) ;",
  278.  " dbmsg=dbmsg dbtrtn dbtrap ;",
  279.  " Parse Value 0 With dbtrc dbtrapp dbtrap ;",
  280.  "$ "
  281.  return 0
  282.  ERROR:    return db9trap(sigl 80e) sourceline(sigl)
  283.  FAILURE:  return db9trap(sigl 80f) sourceline(sigl)
  284.  HALT:     return db9trap(sigl 80h)
  285.  NOTREADY: return db9trap(sigl 80r) sourceline(sigl)
  286.  NOVALUE:  return db9trap(sigl 80v)
  287.  SYNTAX:   return db9trap(sigl 80e) errortext(rc)'~' sourceline(sigl)
  288.  db9TRAP:
  289.  if dbtrc=-7 then dbtrapp=dbtrap
  290.  parse arg dbsigl dbtcode dbtrest
  291.  dbtrap = 0 dbme dbsigl dbtcode dbmsg rdbmsg(dbtcode dbme dbsigl) dbtrest
  292.  dbtrc=-7
  293.  return -7 dbtrapp dbtrap
  294.