home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / rexx / rdebug / rdxgen.kex < prev    next >
Encoding:
Text File  |  1993-03-25  |  3.8 KB  |  158 lines
  1.  /*H* RDXGEN.KEX 02-09-93 10:51*/
  2.  trace o?r /*T*/
  3.  arg dborigin dbtarget dbpullsay dbfullsw dbmacro? dbtest? dbdfile dbrun dbsize
  4.  arg .        dbrun2 dbtarget2 dbbbs dbpath
  5.  if dbtarget='(PROF' then
  6.  parse value dosenv('RDPARMS') with dborigin dbrun2 dbtarget2 dbbbs? dbpath
  7.    '@set rdparms=' files.i target dbbbs? drive''directory'\'
  8.  Parse Value 'COMMAND SET!COMMAND EXT' With dbcs'!'dbce
  9.  Parse Value 'COMMAND!COMMAND SOS!COMMAND X' With dbc'!'dbso '!'dbxx
  10.  dbcs 'MSGM OFF'
  11.  dbme='rdxGEN'
  12.  dbce '/OPSYS'
  13.  dbsys=opsys.1
  14.  if dbsys='OS/2' then dbsys='OS2'  /*O*/
  15.  address KEDIT
  16.  dbcomment=space('/ * !',0)
  17.  select
  18.    when dborigin='/CODE' then call dbget_code
  19.    when dborigin='/GEN'  then do
  20.      call dbgen_system dbrun2 dbtarget2 dbbbs?
  21.      dbc 'FFILE' dbpath; end
  22.    otherwise do
  23.      Parse Value rdbvars() with dbtrc dbtrap
  24.      if dbtrc=-7 then return -7 dbtrap
  25.      interpret dbtrc dbtrap
  26.      dbtarget=dbsys
  27.      dbpullsay=1
  28.  
  29.      call dbget_code
  30.    end
  31.  end
  32.  exit 0
  33.  
  34.  DBGET_CODE:
  35.  dbxx dbrun
  36.  dbcs 'MSGM ON'
  37.  dbc 'MSG Please wait'
  38.  dbc 'REFRESH'
  39.  dbcs 'MSGM OFF'
  40.  dbc 'BOT'
  41.  list=''
  42.  if dbsys='DOS' then do
  43.    if dbsize < 200 then list=list '\RDEBUG\RDBUI.KEX'
  44.  /*
  45.    if dbsize < 400 then list=list '\RDEBUG\RDBMENU.KEX'
  46.    if dbsize < 600 then list=list '\RDEBUG\RDBTASK.KEX'
  47.  */
  48.    if list<>'' then call assemble list
  49.  end
  50.  if dbsys='OS2' then call assemble ,
  51.  '  \RDEBUG\RDBCMDS.KEX \RDEBUG\RDBUI.KEX \RDEBUG\RDBUIEXT.os2',
  52.  '  \RDEBUG\RDBMENU.KEX \RDEBUG\RDBTASK.KEX \RDEBUG\RDBMISC.KEX',
  53.  '                      \RDEBUG\RDBPROF.KEX'
  54.  if dbsys<>'CMS' then if dbpullsay then call assemble '\RDEBUG\RDBIO.OS'
  55.  
  56.  if dbtest?=0 then call delete_sys   /*?F*/
  57.  call deletecode /*?F*/
  58.  ':0PUT *' dbdfile
  59.  
  60.  Return; DELETECODE:
  61.  ':'0
  62.  dbcs 'MSGM OFF'
  63.  if dbtest? then nop
  64.  else do
  65.    If dbmacro? Then nop
  66.    Else Call db72delete '/*M*/'
  67.  /*     DELETE AFTER TESTING
  68.    If dbfullsw=0 Then Call db72delete '/*F*/'
  69.  */
  70.    Call db72delete dbcomment
  71.  end
  72.  dbcs 'MSGM ON'
  73.  
  74.  Return 0; DB72DELETE:  Parse Arg tag
  75.  dbce '/LINE'
  76.  Do Forever
  77.    sline=line.1
  78.    '-1 LOC `'tag'`'
  79.    If rc <> 0 Then Leave;
  80.    dbce '/LINE'
  81.    If line.1<sline Then Leave;
  82.    Else Do
  83.      If tag = dbcomment Then Do
  84.        dbce '/CURL'
  85.        i=pos(tag,curline.3)
  86.        If i>3 Then dbc 'REP' substr(curline.3,1,i-1);
  87.        Else dbc 'DEL'; End
  88.      Else dbc 'DEL'
  89.    End
  90.  End
  91.  ':'0
  92.  
  93.  return 0; ASSEMBLE:   arg list
  94.  dbcs 'WRAP OFF'
  95.  dbcs 'MSGM OFF'
  96.  do n=1 to words(list)
  97.    dbc 'BOT'
  98.    dbce '/LINE'
  99.    file=word(list,n)
  100.    i=lastpos('\',file)
  101.    j=lastpos('.',file)
  102.    prgm=substr(file,i+1,j-i-1)
  103.    ext=substr(file,j+1)
  104.    if ext='KEX' then procedure='Procedure  Expose dbsize'
  105.    else procedure=''
  106.    dbc 'INPUT' prgm':'  procedure
  107.    dbc 'GET' file
  108.    ':'line.1
  109.    dbc 'FIND ERROR:'
  110.    if rc=0 then dbc 'DEL *'
  111.  end
  112.  dbcs 'MSGM ON'
  113.  return 0
  114.  
  115.  DBGEN_SYSTEM:
  116.  arg dbrun dbtarget dbbbs?
  117.  dbce '/FN/FT'
  118.  if dbtarget='' then dbtarget=dbsys
  119.  dbbbs?=(dbbbs?=1)
  120.  if dbbbs?=1 then do
  121.    dbfullsw=1
  122.    dbtest?=0; end
  123.  else do
  124.    dbfullsw=1
  125.    dbtest?=0; end
  126.  dbmacro?=1
  127.  if dbtarget='ALL' then nop
  128.  else do
  129.    call deletecode
  130.    call delete_sys; end
  131.  Return;
  132.  
  133.  DELETE_SYS:
  134.  dbmark=' /*'
  135.  select
  136.    when dbtarget='ALL' then nop
  137.    when dbtarget='OS2' then do
  138.      Call db72delete dbmark'C*/'
  139.      Call db72delete dbmark'D*/'
  140.      Call db72delete dbmark'NO*/'
  141.    end
  142.    when dbtarget='DOS' then do
  143.      Call db72delete dbmark'C*/'
  144.      Call db72delete dbmark'O*/'
  145.      Call db72delete dbmark'ND*/'
  146.    end
  147.    when dbtarget='CMS' then do
  148.      Call db72delete dbmark'D*/'
  149.      Call db72delete dbmark'O*/'
  150.      Call db72delete dbmark'NC*/'
  151.    end
  152.    otherwise
  153.      dbc 'EMSG Invalid target system code:' dbtarget ', press any key to abort'
  154.      dbc 'READV KEY'
  155.      exit
  156.  end
  157.  Return;
  158.