home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / rexx / rdebug / rdebug.kex < prev    next >
Encoding:
Text File  |  1993-03-25  |  16.7 KB  |  571 lines
  1. /*H* RDEBUG.KEX 02-09-93 15:07*/
  2.  dbprinter='PRN'   /* modify this value to one of PRN LPT1 or LPT2 */
  3.  Parse Arg dborigin dbprgm dbparms
  4.  Call db9initial dborigin dbprgm dbparms
  5.  if db8exist(dbsource)=0 then Call db0source rdbmsg(001)
  6.  Call db1verify_logs
  7.  Call db0validate_source
  8.  dbxx dbsource '(PROF RDPROFIL'
  9.  dbpullsay=rdxmimic()
  10.  
  11.  Call db2process_profile
  12.  Call db5create_dfile
  13.  Call db6create_profile
  14.  Call db7pass_to_runtime
  15.  call rdxgen '/CODE' dbsys dbpullsay dbfullsw dbmacro? dbtest? dbdfile dbrun dbsize
  16.  call rdxwrap '/WRAPUP' dbmacro? dbprgmmacro dbdprgm'!'dbparms,
  17.  '!'dbdfile'!'dbsource'!'dbinvoke'!'dbrun'!'dbsession'!'dbprgm
  18.  queue ' MACRO' dbdprgm dbparms
  19.  
  20.  Exit 0;  DB0EVENT:   arg dbmsgno
  21.  dbcs 'MSGM ON'
  22.  parse value    rdbcmds('DB9SYN 7' dbfullsw) with . dbstr
  23.  interpret dbstr
  24.  dbc 'emsg' rdbmsg(dbmsgno)
  25.  dbc 'EMSG ABORTING rDEBUG, Press any key'
  26.  dbc 'READV KEY'                              /*NC*/
  27.  call db8cleanup
  28.  Exit
  29.  
  30.  DB0SOURCE: Parse Arg dbmsg
  31.  Parse Value 'SOURCE UNTITLED' dbdemo With dbdemo dbsource dbmenu
  32.  Call db0editfile dbsource
  33.  ':1 MSG' dbmsg
  34.  call db8flush
  35.  Do Forever
  36.    Call db01user_prompt '* 1 7'
  37.    dbce '/FN/FT/SIZE'
  38.    Select
  39.      When dbaction='NEW' Then Do
  40.        If rest<>'' Then Do
  41.          call db0editfile dbsource
  42.          'QQ'
  43.          dbsource=rest
  44.          call definesource
  45.          call db0editfile dbsource; End
  46.      End
  47.      When dbaction='OPEN'   Then Do
  48.        call db0editfile dbsource
  49.        'QQ'
  50.        dbsource=rest
  51.        call definesource
  52.        Call db0editfile dbsource; End
  53.      When dbaction='SAVE'   Then dbc 'SAVE'
  54.      When dbaction='SAVEAS' Then If rest<>'' Then dbc 'SSAVE' rest
  55.      When dbaction='PRINT' Then do
  56.        dbc 'SAVE AAPRINT'
  57.        call db8print 'PRINT'; end
  58.      When dbaction='DONE'  Then Leave
  59.      Otherwise
  60.      Call db1testor
  61.    End
  62.  End
  63.  Parse Value size.1 ftype.1 With dbsize dbft
  64.  If dbprgm='' Then do
  65.    dbprgm=fname.1
  66.    parse value rdbtask('* P 1') with dialog.2 dialog.1
  67.    if dialog.2='OK' then dbparms=dialog.1; else dbparms=''
  68.  end
  69.  dbmacro?=word(dbtype,wordpos(dbft,dbtype)+1)
  70.  dbc 'QQ'
  71.  drop dbaction dbmenu dbtype dbsys
  72.  
  73.  Return 0;DB0EDITFILE:
  74.  dbmenu=''
  75.  Arg dbfile
  76.  dbcs 'MSGM OFF'
  77.  dbxx dbfile '(PROF RDPROFIL'
  78.  if rc=12 then do
  79.    dbcs 'MSGM ON'
  80.    return 0; end
  81.  dbc 'REFRESH'    /*?O*/
  82.  dbc 'MSG .'      /*?O*/
  83.  dbc 'msgl on 2 16 O'
  84.  dbcs 'MSGM ON'
  85.  dbce '/SIZE/FN/FT/RESER'
  86.  dbcs 'PREF OFF'
  87.  dbcs 'VER 1'
  88.  dbcs 'RESER 1 REVERSE File' left(dbmenu,20) 'rDEBUG, the REXX Debugger     ',
  89.  left(fname.1''dbs''ftype.1,14)
  90.  dbcs 'STATUSL OFF'                                       /*NC*/
  91.  dbcs 'RESER -1 REVERSE Esc=Reset    Up/Dn=Select   1st-Letter/Enter=Choose',
  92.  '   F1-Help   F2-Menu/Data'
  93.  If size.1=0 Then do
  94.    dbc 'BOT'
  95.    dbc 'ADD 20'; end
  96.  
  97.  Return 0; DB0VALIDATE_SOURCE:
  98.  if dbread? then return
  99.  call db0editfile dbsource
  100.  dbc 'MSG Please wait...'
  101.  dbc 'REFRESH'
  102.  dbcs 'WRAP OFF'
  103.  dbcs 'MSGM OFF'
  104.  ':0 / SIGL /'
  105.  dbce '/LINE/SIZE'
  106.  dbsize=size.1
  107.  If line.1>0 Then dbsigl=',sigl;'
  108.  Else dbsigl=';'
  109.  If db8exist(dbprof)=0 Then Do
  110.    ':0 / Procedure /'
  111.    dbce '/LINE'
  112.    If line.1>0 Then dbmsg=dbmsg rdbmsg(008)
  113.    ':1 MACRO RMATCH'
  114.    ':0'
  115.    '.1'
  116.    dbce '/LINE'
  117.    If line.1>0 Then dbmsg=dbmsg rdbmsg(008)
  118.  
  119.  End
  120.  dbcs 'MSGM ON'
  121.  If dbmsg<>'' Then Do
  122.    dbc 'MSG' dbmsg
  123.    dbmenu=' Validate source'
  124.    call db8flush
  125.    Do Forever
  126.      dbc 'MSG' rdbmsg(018)
  127.      Call db01user_prompt '* 4 4'
  128.      Select
  129.        When dbaction='SAVE'   Then dbc 'SSAVE'
  130.        When dbaction='SAVEAS' Then If rest<>'' Then dbc 'SSAVE' rest
  131.        When dbaction='DONE'   Then Leave
  132.        Otherwise
  133.        Call db1testor
  134.      End
  135.    End
  136.    dbce '/SIZE'
  137.    dbsize=size.1
  138.  End
  139.  dbsource0=dbprgm'.'left(dbft,2)'!'
  140.  drop dbaction dbmenu
  141.  
  142.  Return 0;DB01USER_PROMPT:
  143.  Parse Arg dbmsg
  144.  If word(dbmsg,1)='*' Then Nop
  145.  Else If dbmsg<>'' Then Do; dbc 'EMSG' dbmsg; dbmsg=''; End
  146.  if dbprgm='DEMO' then do
  147.    interpret rddemo(dbdemo dbmsg)
  148.    if dbstr='EXIT' then call db8cleanup; end
  149.  else do
  150.    parse value    rdbui(dbmsg)     with dbtrc dbtrap
  151.    if dbtrc=-7 then call db0event 750
  152.    dbstr=dbtrc dbtrap
  153.  end
  154.  Parse Value dbstr with dbaction rest
  155.  dbmsg=''
  156.  Parse Upper Var dbaction dbaction
  157.  If (dbaction='ABORT')+(dbaction='EXIT') Then do;
  158.    call db8cleanup
  159.    dbaction=1
  160.  end
  161.  drop dbstr dialog.2
  162.  
  163.  Return 0; DB99TEST:
  164.  Call db1testor
  165.  
  166.  Return 0; DB1TESTOR:
  167.  dbstr=dbaction rest
  168.  dbi=pos('=',dbstr)
  169.  if dbi>1 then do
  170.    parse value substr(dbstr,1,dbi-1) with dbw1 dbw2 .
  171.    if dbw1<>'' & dbw2='' then interpret dbstr;
  172.    else interpret "'"dbstr"'"; end
  173.  else interpret "'"dbstr"'"
  174.  drop dbstr
  175.  
  176.  Return 0; DB1VERIFY_LOGS:
  177.  If db8exist(dbinclude) & db8exist(dbsession)=0
  178.  Then call db8shell 'RENAME' dbinclude dbsession
  179.  dbdemo='LOG'
  180.  If db8exist(dbsession) Then do
  181.    dbmenu=' Modify session log'
  182.    Call db0editfile dbsession
  183.    dbcs 'CURL ON M'
  184.    call db8flush
  185.    /*':1 MSG' rdbmsg(016)*/
  186.    ':1 MSG' rdbmsg(017)
  187.    Do Forever
  188.      Call db01user_prompt '* 2 7'
  189.      Select
  190.        When dbaction='NEW'  Then Leave
  191.        When dbaction='SAVE'  Then dbc 'SSAVE'
  192.        When dbaction='SAVEAS' Then If rest<>'' Then dbc 'SSAVE' rest
  193.        When dbaction='PRINT' Then Do;
  194.          dbc 'SSAVE AAPRINT';
  195.          call db8print 'PRINT'; End
  196.        When dbaction='DONE'  Then Leave
  197.        Otherwise
  198.        Call db1testor
  199.      End
  200.    End
  201.    'QQ'
  202.  end
  203.  If (dbread?+(dbprgm='DEMO'))>0 Then Do;
  204.    If db8exist(dbinclude) Then call db8shell 'ERASE' dbinclude
  205.    call db8shell 'RENAME' dbsession dbinclude; End
  206.  Else do
  207.    if dbaction='NEW' then call db8shell 'ERASE' dbsession
  208.  end
  209.  
  210.  Return 0; DB2PROCESS_PROFILE:
  211.  dbmsg = rdbmsg(019)
  212.  dbdemo='PROFILE'
  213.  dbmenu=' Modify profile'
  214.  Do Forever Until dbmsg=''
  215.    If db8exist(dbprof)=0 Then do
  216.      call db8defaults
  217.      Call db6create_profile; end
  218.    Call db0editfile dbprof
  219.    ':1'
  220.    Call db22_profile_ui dbmsg
  221.    If dbaction<>'NEW' Then Call db24read_profile
  222.  End
  223.  If dbaction<>'NEW' Then Do
  224.    Call db0editfile dbprof
  225.    'FFILE'; End
  226.  If dbfullsw=0 Then dbtest?=0
  227.  dbc 'MSG Please wait...'
  228.  dbc 'REFRESH'
  229.  
  230.  Return 0;DB22_PROFILE_UI:
  231.  Parse Arg dbmsg
  232.  If dbmsg<>'' Then dbc 'MSG' dbmsg
  233.  dbmsg=''
  234.  call db8flush
  235.  Do Forever
  236.    Call db01user_prompt '* 3 6'
  237.    Select
  238.      When dbaction='NEW' Then Do;
  239.        'QQ';
  240.        call db8shell 'ERASE' dbprof
  241.        leave; end
  242.      When dbaction='SAVE' Then dbc 'SSAVE'
  243.      When dbaction='DONE' Then Leave
  244.      When dbaction='PRINT'  Then Do;
  245.        dbc 'SSAVE AAPRINT'
  246.        call db8print 'PRINT'; End
  247.      Otherwise
  248.      Call db1testor
  249.    End
  250.  End
  251.  
  252.  Return 0; DB24READ_PROFILE:
  253.  Call db0editfile dbprof
  254. /* Parse Value '' With dbtbl. dbtemp dbtemp2*/
  255.  Parse Value '' With dbtemp dbtemp2
  256.  ':1EXT /CURL'
  257.  Parse Upper Var curline.3 dbno dbvalue
  258.  Do Until dbno=''
  259.    dbptr=wordpos(dbno,dbopts)
  260.    If datatype(dbno,'w') Then Call db25validate_control_table
  261.    Else If dbptr>0
  262.    Then Call db26validate_options
  263.    Else dbtemp2=dbtemp2 dbno
  264.    '+1EXT /CURL'
  265.    Parse Upper Var curline.3 dbno dbvalue
  266.  End
  267.  If dbtemp<>''Then dbmsg=dbmsg rdbmsg(005 dbtemp)
  268.  If dbtemp2<>'' Then dbmsg=dbmsg rdbmsg(004 dbtemp2)
  269.  drop temp temp2
  270.  
  271.  Return 0; DB25VALIDATE_CONTROL_TABLE:
  272.  Parse Var dbvalue dbw1 dbw2 dbws
  273.  Do While dbw1<>''
  274.    If datatype(dbw1,'w')& pos(' 'dbw2' ',' 'dbcodes' ')>0
  275.    Then dbtbl.dbno=dbtbl.dbno dbw1 dbw2
  276.    Else dbtemp=dbtemp dbw1 dbw2
  277.    Parse Var dbws dbw1 dbw2 dbws
  278.  End
  279.  
  280.  Return 0; DB26VALIDATE_OPTIONS:
  281.  if dbvalue='' then dbvalue="''"                         /*O*/
  282.  If dbno='WATCH' Then do
  283.    Interpret word(dbset,dbptr) '=' strip(dbvalue,'T')
  284.    Return 0; end
  285.  Interpret word(dbset,dbptr) '=' strip(dbvalue,'T')
  286.  If (dbno='COUNT')+(dbno='WAIT')>0&datatype(dbvalue,'W') Then Return 0
  287.  If (dbvalue=0)+(dbvalue=1)<1 Then dbtemp=dbtemp dbno dbvalue
  288.  
  289.  Return 0; DB5CREATE_DFILE:
  290.  if dbread? then call db0editfile dbsource0
  291.  else            call db0editfile dbsource
  292.  dbcs 'FN' dbdprgm
  293.  dbcs 'FT' dbmft
  294.  dbcs 'AUTOS OFF'
  295.  ':1EXT /CURL/SIZE'
  296.  If dberrorsw Then dbe='ON'; Else dbe='OFF'
  297.  dbjump1=' 1'
  298.  dbsiglempty=copies(' ',length(dbsigl))
  299.  if dbsize>999 then dbwidth=4
  300.  else dbwidth=3
  301.  Parse Value 10+2+length(dbsigl)+dbwidth+1+2 0 size.1,
  302.  With dbuc swcont dbsize
  303.  dbc "REP /**/parse Arg dbparms;Call dbi;db:Call debug 1; 1:"curline.3,
  304.  "     ;;;If dberrorsw Then Call ON Error; Else Call OFF Error"
  305.  '+1'
  306.  Do y=2 Until rc<>0
  307.    dbce '/CURL'
  308.    string=strip(curline.3,'t')
  309.    If string<>'' Then Do
  310.      If right(string,1)=';' Then string=left(string,length(string)-1)
  311.      Parse Upper Value translate(string,'@ ','";') With dbstr
  312.      Parse Var dbstr wd1 .
  313.      dbstr=db8pairs(dbstr)
  314.      i=pos(':',dbstr)
  315.      If i>0 Then do
  316.        j=max(lastpos(' ',dbstr,i),lastpos(';',dbstr,i))
  317.        dbproc="                  ;;;DBPROC='"strip(substr(dbstr,j+1,i-j))"'"; end
  318.      Else dbproc=''
  319.      prefix='Call debug'
  320.      If (wordpos(wd1,'ELSE THEN WHEN OTHERWISE SELECT')+(swcont))>0
  321.      Then prefix=left(' ',dbuc-2)
  322.      Else If dblevel=0
  323.      Then prefix=prefix''dbjump1''dbsigl''right(y,dbwidth)':'
  324.      Else prefix=prefix''dbjump1';'dbsiglempty'   '
  325.      If pos("*EXIT*",dbstr)>0 & prefix<>'' Then Do
  326.        dbno=y%42+1
  327.        dbtbl.dbno=dbtbl.dbno y 'B'; End
  328.      If wordpos('RETURN',dbstr)>0 & prefix<>''
  329.      Then dblast=dblast '                  ;;;DBPROC=0'
  330.      Parse Value 0 words(dbstr) With swcont i
  331.      If i>0 Then Do
  332.        Parse Value word(dbstr,1) word(dbstr,i) With fw lw
  333.        If fw='THEN'| fw='ELSE'|lw='THEN'| lw='ELSE'|,
  334.        right(string,1)=',' Then swcont=1
  335.      End
  336.    End
  337.    '-1'
  338.    If y<>2 & dblast<>'' Then dbc 'REP' dblast
  339.    If string='' Then dblast=''
  340.    Else Parse Value prefix string dbproc'!.!',
  341.    With dblast'!.!'prefix string
  342.    '+2'
  343.  End;
  344.  y=y+1
  345.  '-1 REP' dblast
  346.  ':'dbsize+1
  347.  dbc 'INP Call debug 1'dbsigl''right(y,dbwidth)': Return 0' /*!1*/
  348.  dbtbl.1=dbtbl.1 '1 B'
  349.  dbno=y%42+1
  350.  dbtbl.dbno=dbtbl.dbno y 'B'
  351.  drop lw fw swcont
  352.  dbc 'SSAVE' dbdfile
  353.  
  354.  Return 0; DB6CREATE_PROFILE:
  355.  ':'dbsize+50
  356.  If db8exist(dbprof) Then call db8shell 'ERASE' dbprof
  357.  Do dbx=1 To words(dbopts)
  358.    Interpret dbc 'REP' word(dbopts,dbx) word(dbset,dbx)
  359.    dbc 'PUT 1' dbprof
  360.  End
  361.  Do x=1 To 24
  362.    dbc 'REP' x dbtbl.x
  363.    If dbtbl.x<>'' Then dbc 'PUT 1' dbprof
  364.  End
  365.  dbc 'DEL'
  366.  drop string dbstr curline.3 dbprefix
  367.  
  368.  Return 0; DB7PASS_TO_RUNTIME:
  369.  dbxx dbsource
  370.  if dbread? then return
  371.  if dbprgm='DEMO' then dbread?=1
  372.  If db8exist(dbvars) Then call db8shell 'ERASE' dbvars
  373.  dbxx dbdfile
  374.  dbc 'QQ'
  375.  dbxx dbdfile
  376.  ':'dbsize+2
  377.  dbvarlist='dbcodes dbdefenv dbdfile dbenvir dbfileid',
  378.  ' dbft dbinclude dbinvoke dbmacro? dbopts dbprgm dbprof dbprinter',
  379.  ' dbread? dbrun dbs dbsession dbset dbsize dbsys dbsource',
  380.  ' dbpath dbtest? dbuc dbuser dbvars dbdprgm',
  381.  ' dbfullsw dberrorsw dblogsw dbtracesw dbtallysw',
  382.  ' dbwatchsw dblimit dbcount dbwait dbwatch',
  383.  ' dbtbl.1 dbtbl.2 dbtbl.3 dbtbl.4 dbtbl.5 dbtbl.6',
  384.  ' dbtbl.7 dbtbl.8 dbtbl.9 dbtbl.10 dbtbl.11 dbtbl.12',
  385.  ' dbtbl.13 dbtbl.14 dbtbl.15 dbtbl.16 dbtbl.17 dbtbl.18',
  386.  ' dbtbl.19 dbtbl.20 dbtbl.21 dbtbl.22 dbtbl.23 dbtbl.24'
  387.  dbc 'INP /**/Return,'
  388.  do until dbvarlist=''
  389.    parse value dbvarlist with dbw dbvarlist
  390.    dbstr= value(dbw)
  391.    if dbstr='' then if left(dbw,6)='dbtbl.' then iterate
  392.    dbc 'INP "'dbw"='"dbstr"';"'",'
  393.  end
  394.  dbc 'INP ;'
  395.  dbc ':'dbsize+2 'PUT *' dbvars
  396.  dbc ':'dbsize+2 'DEL *'
  397.  drop dbstr dbstr dbvarlist
  398.  'QQ'
  399.  
  400.  Return 0; DB8PAIRS:
  401.  Procedure Expose dbsq dbdq
  402.  Parse Arg str
  403.  Do Forever
  404.    Parse Value pos(dbsq,str) pos(dbdq,str) pos('/*',str),
  405.    With h i j
  406.    If h=0 Then h=256
  407.    If i=0 Then i=256
  408.    If j=0 Then j=256
  409.    j=min(h,i,j)
  410.    If j=256 Then Leave
  411.    Parse Value 1 substr(str,j,1) With width delimiter
  412.    If delimiter='/' Then Parse Value '*/' 2 With delimiter width
  413.    Parse Value substr(str,1,j-1)'!'substr(str,j+width),
  414.    With temp'!'str
  415.    j=pos(delimiter,str)
  416.    If j>0 Then str=temp substr(str,j+width)
  417.    Else Do;str=temp;leave;end
  418.  End
  419.  
  420.  Return str; DB8print:
  421.  dbcs 'SWAP OFF'
  422.  if      dbsys='DOS' then 'DOSN COPY AAPRINT PRN'
  423.  else if dbsys='OS2' then 'DOSN COPY AAPRINT PRN'
  424.  else if dbsys='CMS' then do
  425.    Address value dbcommand
  426.    'PRINT AAPRINT'
  427.    address XEDIT; end
  428.  dbcs 'SWAP ON'
  429.  
  430.  Return 0;  DB8SHELL:  parse arg dbstring
  431.  dbcs 'SWAP OFF'
  432.  if      dbsys='DOS' then 'DOSN' dbstring
  433.  else if dbsys='OS2' then 'DOSN' dbstring
  434.  else if dbsys='CMS' then do
  435.    Address value dbcommand
  436.    dbstring
  437.    address XEDIT; end
  438.  dbcs 'SWAP ON'
  439.  
  440.  Return 0;db8GETFT:
  441.  if dbmacro? then dblist=' ',
  442.  'OS2 KEX   CMD KEDIT KEDIT KEX   ',  /*O*/
  443.  ' '
  444.  else dblist=' ',
  445.  'OS2 CMD  CMD  KEDIT CMD   KEX   ',  /*O*/
  446.  ' '
  447.  i=wordpos(dbsys,dblist)
  448.  parse value word(dblist,i+1) word(dblist,i+2) word(dblist,i+3) ,
  449.  word(dblist,i+4) word(dblist,i+5),
  450.  with dbft dbcommand dbenvir dbdefenv dbmft
  451.  
  452.  return 0; db8cleanup:
  453.  parse value rdbmisc('/ABORT' dbsession) with dbtrc dbtrap
  454.  if dbtrc=-7 then return -7 dbtrap
  455.  if dbtrc=1 then do
  456.    call rdxwrap '/WRAPUP' dbmacro? dbprgmmacro dbdprgm'!'dbparms,
  457.    '!'dbdfile'!'dbsource'!'dbinvoke'!'dbrun'!'dbsession'!'dbprgm
  458.    Exit; end
  459.  
  460.  Return 0;db8defaults:
  461.  parse value '1 1 1 1 1 1 50 0 0' with,
  462.  dbfullsw dberrorsw dblogsw dbtracesw dbtallysw,
  463.  dbwatchsw dblimit dbcount dbwait dbwatch
  464.  dbtbl.=''
  465.  dbcodes='B E S'
  466.  
  467.  Return 0;DB8EXIST:
  468.  arg dbefile
  469.  if dbsys='OS2' then do           /*O*/
  470.    call db0editfile dbefile       /*O*/
  471.    dbrc=(size.1<>0); end; else do /*O*/
  472.    call lineout dbefile           /*O*/
  473.    If lines(dbefile) Then dbrc=1
  474.    else dbrc=0
  475.    call lineout dbefile
  476.  end                           /*O*/
  477.  
  478.  Return dbrc;DB8FLUSH:
  479.  Return
  480.  do forever
  481.    dbc 'READV KEY'
  482.    if readv.1='' then leave
  483.  end
  484.  
  485.  Return 0;DB9INITIAL:
  486.  Parse Value 'COMMAND SET!COMMAND X!COMMAND EXT' With dbcs'!'dbxx'!'dbce
  487.  Parse Value 'COMMAND!COMMAND SOS' With dbc'!'dbso
  488.  Parse Arg dborigin dbprgm dbparms
  489.  Parse Value 0 2 0 "'" '"' With dbread? y dblevel dbsq dbdq dbmsg
  490.  dbce '/OPSYS'
  491.  dbme='rDEBUG'
  492.  Parse Value 0 opsys.1 '' With dbinside? dbsys dbcallstack dbtrtn dbtrapp
  493.  if dbsys='OS/2' then dbsys='OS2' /*O*/
  494.  if dbsys='CMS' then address XEDIT
  495.  else address KEDIT
  496.  if queued()>0 then do                /*O*/
  497.    parse Pull dborigin dbprgm dbparms /*O*/
  498.    if queued()>0 then                 /*O*/
  499.    parse Pull dborigin dbprgm dbparms /*O*/
  500.    call rdprofil; end                 /*O*/
  501.  else                                 /*O*/
  502.  If dborigin<>0 Then Parse Arg dbprgm dbparms
  503.  If (dborigin=?)+(dborigin='')>0 Then /*Exit*/ Return tell(dbme)
  504.  dbcheck=0
  505.  dbcheck=1  /*O*/
  506.  if dbcheck=0 then rdbmsg(010 dbsys)
  507.  dbi=pos('.',dbprgm)                  /*NC*/
  508.  if dbi>1 then dbprgm=left(dbprgm,dbi-1)   /*NC*/
  509.  dbce '/FN/FT/FM'
  510.  dbifile=fname.1
  511.  Parse Value (dborigin<>0) '' '' With dbmacro? rexxver
  512.  dbtest?=0
  513.  dbset='dbfullsw dberrorsw dblogsw dbtracesw dbtallysw dbwatchsw dblimit dbwait dbwatch'
  514.  dbopts='FULLSW ERRORSW LOGSW TRACESW TALLYSW WATCHSW COUNT WAIT WATCH'
  515.  dbrun='\rDEBUG\DEBUGRUN.KEX'
  516.  dbsession='SESSION.LOG'
  517.  dbvars='rdbVARS.KEX'
  518.  dbinclude='INCLUDE.LOG'
  519.  call db8defaults
  520.  call db8getft
  521.  if dbprgm='' then do
  522.    call db8shell 'RDDEMO 2'
  523.    Parse Value  0 0 'DEMO' '....'  With dbmacro?,
  524.    dbtest? dbprgm dbparms dbwatch; end
  525.  Parse Upper Var dbprgm dbprgm
  526.  dbs='.'               /*NC*/
  527.  dbce '/FN/FT/FM'
  528.  dbinvoke=fname.1''dbs''ftype.1
  529.  if dbsys='OS2' then dbpath=directory()'\'   /*O*/
  530.  call RDBINIT '/LO R' dbpath '1000!0!38!'dbtest?'!'dbsession'!'dbinvoke
  531.  parse value result with dbtrc dbtrap
  532.  if dbtrc=-7 then call db0event 750
  533.  dbcs 'SCR1'
  534.  if dbprgm='DEMO' then do
  535.    interpret rddemo('WELCOME')
  536.    if dbstr='EXIT' then call db8cleanup; end
  537.  call definesource
  538.  call db0editfile dbinvoke
  539.  /* note, define these file w/ a path? */
  540.  dbfileid=dbifile'.SCR'
  541.  dbuser=dbifile'.SCR'
  542.  if db8exist(dbrun)=0 then do
  543.    'MSG' rdbmsg(009 dbrun); dbc 'READV KEY'
  544.    call db8cleanup; exit; end
  545.  dbmenu='Missing file'
  546.  Call lineout dbsource
  547.  Call lineout dbsession
  548.  drop dbifile
  549.  Return 0
  550.  
  551.  DEFINESOURCE:
  552.  dbi=pos('.',dbprgm)                            /*NC*/
  553.  if dbi>1 then do                               /*NC*/
  554.     dbft=substr(dbprgm,dbi+1)                   /*NC*/
  555.     prgm=left(dbprgm,dbi-1)                     /*NC*/
  556.     dbtype='REX 0 CMD 0 EXEC 0 XEDIT 1 KEX 1'
  557.     dbmacro?=word(dbtype,wordpos(dbft,dbtype)+1)/*NC*/
  558.  end                                            /*NC*/
  559.  dbsource=dbprgm''dbs''dbft
  560.  dbmenu='Incomplete Spec'
  561.  call db8getft
  562.  If dbprgm='' Then do
  563.    Call db0source rdbmsg(000)
  564.    call db8getft; end
  565.  dbmenu=''
  566.  dbdprgm=strip(left('D'dbprgm,8))
  567.  dbdfile=''dbdprgm''dbs''dbmft
  568.  dbprgmmacro=dbprgm''dbs''dbmft
  569.  dbprof=dbprgm'.PRO'
  570.  return
  571.