home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
rdebug21.zip
/
RDBPROF.KEX
< prev
next >
Wrap
Text File
|
1993-03-25
|
4KB
|
146 lines
/*H* RDBPROF.KEX 02-10-93 12:13*/
parse arg dborigin dbw1 dbtrigger dbpath dbsize dbdfile'!'dbprof,
'!'dbuc'!'dboptions'!' . dbw2 dbrem
signal on error; signal ON FAILURE; signal on halt
signal ON NOVALUE; signal ON NOTREADY; signal ON SYNTAX
Parse Value 'COMMAND SET!COMMAND EXT' With dbcs'!'dbce
Parse Value 'COMMAND!COMMAND SOS!COMMAND X' With dbc'!'dbso'!'dbxx
dbce '/OPSYS'
dbme='rdbPROF'
dbsys=opsys.1
if dbsys='OS/2' then dbsys='OS2' /*O*/
dbmsg=''
parse value 0 with dbtrc dbtrap dbtrapp dbmsg
dbs='.'
call get_options
select
when dborigin='/SETCTL' then do
if dbtrc=-7 then return -7 dbtrap
call db3setctl
if dbtrc=-7 then return -7 dbtrap
call create_profile
end
when dborigin='/SETSW' then do
if dbtrc=-7 then return -7 dbtrap
call db3setsw
if dbtrc=-7 then return -7 dbtrap
call create_profile
end
when dborigin='/CTRL' then do
Call create_profile; end
otherwise /*Exit*/ Return tell(dbme);
end
if dbtrc=-7 then return -7 dbtrap
if dborigin='/CTRL' then return 0
/*Exit*/ Return 0 dbfullsw dberrorsw dblogsw dbtracesw,
dbtallysw dbwatchsw dblimit dbwait dbwatch'!'dbmsg
return 0; db3SETCTL:
dbptr='db'dbw1
if dbw2=''then dbmsg=dbmsg rdbmsg(337 dbw1 'is:' value(dbptr))
else do
if dbw1='WATCH' then do
if datatype(dbw2,'N') then do
call db3setsw 'WATCH' dbw1 dbw2
if dbtrc=-7 then return -7 dbtrap
return dbtrc dbtrap; end
else do
end
dbwatch=dbwatch dbw2 dbrem
dbmsg=dbmsg rdbmsg(335 dbwatch)
end
else if datatype('0'dbw2,'W')=1 then do
dbmsg=dbmsg rdbmsg(337 dbw1 'is:' dbw2)
interpret dbptr'='dbw2;end
else dbmsg=dbmsg rdbmsg(340 dbw1)
end
return 0; DB3SETSW:
dbptr='db'dbw1'sw'
If dbw2=''then dbmsg=dbmsg rdbmsg(345 dbw1 'is:' value(dbptr))
Else Do
If dbw2=-1 Then interpret 'dbw2=(db'dbw1'sw=0)'
If dbw2=-2 Then dbw2=(dbwatchsw=0)
If dbw2>=0&dbw2<=1 Then Do;
dbmsg=dbmsg rdbmsg(345 dbw1 'is:' dbw2)
dbmsg=dbmsg rdbmsg(345 dbw1 'is:' dbw2)
Interpret dbptr'='dbw2; End
Else dbmsg=dbmsg rdbmsg(360 dbw1 'is:' value(dbptr))
End;
return 0; CREATE_PROFILE:
dbce '/FN/FT/LINE'
dbxx dbprof
if dbtrc=-7 then return -7 dbtrap
call assemble_options_table
if dbtrc=-7 then return -7 dbtrap
dbxx dbdfile
call get_control_table
if dbtrc=-7 then return -7 dbtrap
dbxx dbprof
dbc 'bot'
call assemble_control_table
if dbtrc=-7 then return -7 dbtrap
dbc 'FFILE'
dbxx fname.1''dbs''ftype.1
dbc ':'line.1
return 0; GET_CONTROL_TABLE:
dbtbl.=''
dbtbl.1='1 B'
dbno=dbsize%42+1;
dbtbl.dbno=dbtbl.dbno dbsize 'B';
dby=words(dbopts);
':2'
do dbx=2 to dbsize
'+1EXT /CURL'
parse upper var curline.3 dbcall dbopt dbj .
dbopt=left(dbopt,5)
/*if (dbopt='DEBUG')+(dbcall<>'CALL')+(left(dbj,1)<>'J')>0 then iterate*/
if (dbopt='DEBUG')+(dbcall<>'CALL')>0 then iterate
dbno=dbx%42+1
dbtbl.dbno=dbtbl.dbno dbx left(dbopt,1)
end;
return; ASSEMBLE_CONTROL_TABLE:
do dbx=1 to 24;
if dbtbl.dbx='' then iterate;
dby=dby+1;
'+1 INP' dbx dbtbl.dbx;
end
return; ASSEMBLE_OPTIONS_TABLE:
dbc ':0 del *'
signal off novalue
do dbx=1 to words(dbopts)
interpret dbc 'INP' word(dbopts,dbx) word(dbset,dbx)
end
signal on novalue
return 0; GET_OPTIONS:
dbopts='FULLSW ERRORSW LOGSW TRACESW TALLYSW WATCHSW COUNT WAIT WATCH'
dbset='dbfullsw dberrorsw dblogsw dbtracesw dbtallysw dbwatchsw',
'dblimit dbwait dbwatch'
parse value dboptions with,
dbfullsw dberrorsw dblogsw dbtracesw dbtallysw dbwatchsw,
dblimit dbwait dbwatch
return 0;
ERROR: return db9trap(sigl 80e) sourceline(sigl)
FAILURE: return db9trap(sigl 80f) sourceline(sigl)
HALT: return db9trap(sigl 80h)
NOTREADY: return db9trap(sigl 80r) sourceline(sigl)
NOVALUE: return db9trap(sigl 80v)
SYNTAX: return db9trap(sigl 80e) errortext(rc)'~'sourceline(sigl)
db9TRAP:
if dbtrc=-7 then dbtrapp=dbtrap
parse arg dbsigl dbtcode dbtrest
dbtrap = 0 dbme dbsigl dbtcode dbmsg rdbmsg(dbtcode dbme dbsigl) dbtrest
dbtrc=-7
return -7 dbtrapp'~'dbtrap