home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
rdebug21.zip
/
RDEBUG.KEX
< prev
next >
Wrap
Text File
|
1993-03-25
|
17KB
|
571 lines
/*H* RDEBUG.KEX 02-09-93 15:07*/
dbprinter='PRN' /* modify this value to one of PRN LPT1 or LPT2 */
Parse Arg dborigin dbprgm dbparms
Call db9initial dborigin dbprgm dbparms
if db8exist(dbsource)=0 then Call db0source rdbmsg(001)
Call db1verify_logs
Call db0validate_source
dbxx dbsource '(PROF RDPROFIL'
dbpullsay=rdxmimic()
Call db2process_profile
Call db5create_dfile
Call db6create_profile
Call db7pass_to_runtime
call rdxgen '/CODE' dbsys dbpullsay dbfullsw dbmacro? dbtest? dbdfile dbrun dbsize
call rdxwrap '/WRAPUP' dbmacro? dbprgmmacro dbdprgm'!'dbparms,
'!'dbdfile'!'dbsource'!'dbinvoke'!'dbrun'!'dbsession'!'dbprgm
queue ' MACRO' dbdprgm dbparms
Exit 0; DB0EVENT: arg dbmsgno
dbcs 'MSGM ON'
parse value rdbcmds('DB9SYN 7' dbfullsw) with . dbstr
interpret dbstr
dbc 'emsg' rdbmsg(dbmsgno)
dbc 'EMSG ABORTING rDEBUG, Press any key'
dbc 'READV KEY' /*NC*/
call db8cleanup
Exit
DB0SOURCE: Parse Arg dbmsg
Parse Value 'SOURCE UNTITLED' dbdemo With dbdemo dbsource dbmenu
Call db0editfile dbsource
':1 MSG' dbmsg
call db8flush
Do Forever
Call db01user_prompt '* 1 7'
dbce '/FN/FT/SIZE'
Select
When dbaction='NEW' Then Do
If rest<>'' Then Do
call db0editfile dbsource
'QQ'
dbsource=rest
call definesource
call db0editfile dbsource; End
End
When dbaction='OPEN' Then Do
call db0editfile dbsource
'QQ'
dbsource=rest
call definesource
Call db0editfile dbsource; End
When dbaction='SAVE' Then dbc 'SAVE'
When dbaction='SAVEAS' Then If rest<>'' Then dbc 'SSAVE' rest
When dbaction='PRINT' Then do
dbc 'SAVE AAPRINT'
call db8print 'PRINT'; end
When dbaction='DONE' Then Leave
Otherwise
Call db1testor
End
End
Parse Value size.1 ftype.1 With dbsize dbft
If dbprgm='' Then do
dbprgm=fname.1
parse value rdbtask('* P 1') with dialog.2 dialog.1
if dialog.2='OK' then dbparms=dialog.1; else dbparms=''
end
dbmacro?=word(dbtype,wordpos(dbft,dbtype)+1)
dbc 'QQ'
drop dbaction dbmenu dbtype dbsys
Return 0;DB0EDITFILE:
dbmenu=''
Arg dbfile
dbcs 'MSGM OFF'
dbxx dbfile '(PROF RDPROFIL'
if rc=12 then do
dbcs 'MSGM ON'
return 0; end
dbc 'REFRESH' /*?O*/
dbc 'MSG .' /*?O*/
dbc 'msgl on 2 16 O'
dbcs 'MSGM ON'
dbce '/SIZE/FN/FT/RESER'
dbcs 'PREF OFF'
dbcs 'VER 1'
dbcs 'RESER 1 REVERSE File' left(dbmenu,20) 'rDEBUG, the REXX Debugger ',
left(fname.1''dbs''ftype.1,14)
dbcs 'STATUSL OFF' /*NC*/
dbcs 'RESER -1 REVERSE Esc=Reset Up/Dn=Select 1st-Letter/Enter=Choose',
' F1-Help F2-Menu/Data'
If size.1=0 Then do
dbc 'BOT'
dbc 'ADD 20'; end
Return 0; DB0VALIDATE_SOURCE:
if dbread? then return
call db0editfile dbsource
dbc 'MSG Please wait...'
dbc 'REFRESH'
dbcs 'WRAP OFF'
dbcs 'MSGM OFF'
':0 / SIGL /'
dbce '/LINE/SIZE'
dbsize=size.1
If line.1>0 Then dbsigl=',sigl;'
Else dbsigl=';'
If db8exist(dbprof)=0 Then Do
':0 / Procedure /'
dbce '/LINE'
If line.1>0 Then dbmsg=dbmsg rdbmsg(008)
':1 MACRO RMATCH'
':0'
'.1'
dbce '/LINE'
If line.1>0 Then dbmsg=dbmsg rdbmsg(008)
End
dbcs 'MSGM ON'
If dbmsg<>'' Then Do
dbc 'MSG' dbmsg
dbmenu=' Validate source'
call db8flush
Do Forever
dbc 'MSG' rdbmsg(018)
Call db01user_prompt '* 4 4'
Select
When dbaction='SAVE' Then dbc 'SSAVE'
When dbaction='SAVEAS' Then If rest<>'' Then dbc 'SSAVE' rest
When dbaction='DONE' Then Leave
Otherwise
Call db1testor
End
End
dbce '/SIZE'
dbsize=size.1
End
dbsource0=dbprgm'.'left(dbft,2)'!'
drop dbaction dbmenu
Return 0;DB01USER_PROMPT:
Parse Arg dbmsg
If word(dbmsg,1)='*' Then Nop
Else If dbmsg<>'' Then Do; dbc 'EMSG' dbmsg; dbmsg=''; End
if dbprgm='DEMO' then do
interpret rddemo(dbdemo dbmsg)
if dbstr='EXIT' then call db8cleanup; end
else do
parse value rdbui(dbmsg) with dbtrc dbtrap
if dbtrc=-7 then call db0event 750
dbstr=dbtrc dbtrap
end
Parse Value dbstr with dbaction rest
dbmsg=''
Parse Upper Var dbaction dbaction
If (dbaction='ABORT')+(dbaction='EXIT') Then do;
call db8cleanup
dbaction=1
end
drop dbstr dialog.2
Return 0; DB99TEST:
Call db1testor
Return 0; DB1TESTOR:
dbstr=dbaction rest
dbi=pos('=',dbstr)
if dbi>1 then do
parse value substr(dbstr,1,dbi-1) with dbw1 dbw2 .
if dbw1<>'' & dbw2='' then interpret dbstr;
else interpret "'"dbstr"'"; end
else interpret "'"dbstr"'"
drop dbstr
Return 0; DB1VERIFY_LOGS:
If db8exist(dbinclude) & db8exist(dbsession)=0
Then call db8shell 'RENAME' dbinclude dbsession
dbdemo='LOG'
If db8exist(dbsession) Then do
dbmenu=' Modify session log'
Call db0editfile dbsession
dbcs 'CURL ON M'
call db8flush
/*':1 MSG' rdbmsg(016)*/
':1 MSG' rdbmsg(017)
Do Forever
Call db01user_prompt '* 2 7'
Select
When dbaction='NEW' Then Leave
When dbaction='SAVE' Then dbc 'SSAVE'
When dbaction='SAVEAS' Then If rest<>'' Then dbc 'SSAVE' rest
When dbaction='PRINT' Then Do;
dbc 'SSAVE AAPRINT';
call db8print 'PRINT'; End
When dbaction='DONE' Then Leave
Otherwise
Call db1testor
End
End
'QQ'
end
If (dbread?+(dbprgm='DEMO'))>0 Then Do;
If db8exist(dbinclude) Then call db8shell 'ERASE' dbinclude
call db8shell 'RENAME' dbsession dbinclude; End
Else do
if dbaction='NEW' then call db8shell 'ERASE' dbsession
end
Return 0; DB2PROCESS_PROFILE:
dbmsg = rdbmsg(019)
dbdemo='PROFILE'
dbmenu=' Modify profile'
Do Forever Until dbmsg=''
If db8exist(dbprof)=0 Then do
call db8defaults
Call db6create_profile; end
Call db0editfile dbprof
':1'
Call db22_profile_ui dbmsg
If dbaction<>'NEW' Then Call db24read_profile
End
If dbaction<>'NEW' Then Do
Call db0editfile dbprof
'FFILE'; End
If dbfullsw=0 Then dbtest?=0
dbc 'MSG Please wait...'
dbc 'REFRESH'
Return 0;DB22_PROFILE_UI:
Parse Arg dbmsg
If dbmsg<>'' Then dbc 'MSG' dbmsg
dbmsg=''
call db8flush
Do Forever
Call db01user_prompt '* 3 6'
Select
When dbaction='NEW' Then Do;
'QQ';
call db8shell 'ERASE' dbprof
leave; end
When dbaction='SAVE' Then dbc 'SSAVE'
When dbaction='DONE' Then Leave
When dbaction='PRINT' Then Do;
dbc 'SSAVE AAPRINT'
call db8print 'PRINT'; End
Otherwise
Call db1testor
End
End
Return 0; DB24READ_PROFILE:
Call db0editfile dbprof
/* Parse Value '' With dbtbl. dbtemp dbtemp2*/
Parse Value '' With dbtemp dbtemp2
':1EXT /CURL'
Parse Upper Var curline.3 dbno dbvalue
Do Until dbno=''
dbptr=wordpos(dbno,dbopts)
If datatype(dbno,'w') Then Call db25validate_control_table
Else If dbptr>0
Then Call db26validate_options
Else dbtemp2=dbtemp2 dbno
'+1EXT /CURL'
Parse Upper Var curline.3 dbno dbvalue
End
If dbtemp<>''Then dbmsg=dbmsg rdbmsg(005 dbtemp)
If dbtemp2<>'' Then dbmsg=dbmsg rdbmsg(004 dbtemp2)
drop temp temp2
Return 0; DB25VALIDATE_CONTROL_TABLE:
Parse Var dbvalue dbw1 dbw2 dbws
Do While dbw1<>''
If datatype(dbw1,'w')& pos(' 'dbw2' ',' 'dbcodes' ')>0
Then dbtbl.dbno=dbtbl.dbno dbw1 dbw2
Else dbtemp=dbtemp dbw1 dbw2
Parse Var dbws dbw1 dbw2 dbws
End
Return 0; DB26VALIDATE_OPTIONS:
if dbvalue='' then dbvalue="''" /*O*/
If dbno='WATCH' Then do
Interpret word(dbset,dbptr) '=' strip(dbvalue,'T')
Return 0; end
Interpret word(dbset,dbptr) '=' strip(dbvalue,'T')
If (dbno='COUNT')+(dbno='WAIT')>0&datatype(dbvalue,'W') Then Return 0
If (dbvalue=0)+(dbvalue=1)<1 Then dbtemp=dbtemp dbno dbvalue
Return 0; DB5CREATE_DFILE:
if dbread? then call db0editfile dbsource0
else call db0editfile dbsource
dbcs 'FN' dbdprgm
dbcs 'FT' dbmft
dbcs 'AUTOS OFF'
':1EXT /CURL/SIZE'
If dberrorsw Then dbe='ON'; Else dbe='OFF'
dbjump1=' 1'
dbsiglempty=copies(' ',length(dbsigl))
if dbsize>999 then dbwidth=4
else dbwidth=3
Parse Value 10+2+length(dbsigl)+dbwidth+1+2 0 size.1,
With dbuc swcont dbsize
dbc "REP /**/parse Arg dbparms;Call dbi;db:Call debug 1; 1:"curline.3,
" ;;;If dberrorsw Then Call ON Error; Else Call OFF Error"
'+1'
Do y=2 Until rc<>0
dbce '/CURL'
string=strip(curline.3,'t')
If string<>'' Then Do
If right(string,1)=';' Then string=left(string,length(string)-1)
Parse Upper Value translate(string,'@ ','";') With dbstr
Parse Var dbstr wd1 .
dbstr=db8pairs(dbstr)
i=pos(':',dbstr)
If i>0 Then do
j=max(lastpos(' ',dbstr,i),lastpos(';',dbstr,i))
dbproc=" ;;;DBPROC='"strip(substr(dbstr,j+1,i-j))"'"; end
Else dbproc=''
prefix='Call debug'
If (wordpos(wd1,'ELSE THEN WHEN OTHERWISE SELECT')+(swcont))>0
Then prefix=left(' ',dbuc-2)
Else If dblevel=0
Then prefix=prefix''dbjump1''dbsigl''right(y,dbwidth)':'
Else prefix=prefix''dbjump1';'dbsiglempty' '
If pos("*EXIT*",dbstr)>0 & prefix<>'' Then Do
dbno=y%42+1
dbtbl.dbno=dbtbl.dbno y 'B'; End
If wordpos('RETURN',dbstr)>0 & prefix<>''
Then dblast=dblast ' ;;;DBPROC=0'
Parse Value 0 words(dbstr) With swcont i
If i>0 Then Do
Parse Value word(dbstr,1) word(dbstr,i) With fw lw
If fw='THEN'| fw='ELSE'|lw='THEN'| lw='ELSE'|,
right(string,1)=',' Then swcont=1
End
End
'-1'
If y<>2 & dblast<>'' Then dbc 'REP' dblast
If string='' Then dblast=''
Else Parse Value prefix string dbproc'!.!',
With dblast'!.!'prefix string
'+2'
End;
y=y+1
'-1 REP' dblast
':'dbsize+1
dbc 'INP Call debug 1'dbsigl''right(y,dbwidth)': Return 0' /*!1*/
dbtbl.1=dbtbl.1 '1 B'
dbno=y%42+1
dbtbl.dbno=dbtbl.dbno y 'B'
drop lw fw swcont
dbc 'SSAVE' dbdfile
Return 0; DB6CREATE_PROFILE:
':'dbsize+50
If db8exist(dbprof) Then call db8shell 'ERASE' dbprof
Do dbx=1 To words(dbopts)
Interpret dbc 'REP' word(dbopts,dbx) word(dbset,dbx)
dbc 'PUT 1' dbprof
End
Do x=1 To 24
dbc 'REP' x dbtbl.x
If dbtbl.x<>'' Then dbc 'PUT 1' dbprof
End
dbc 'DEL'
drop string dbstr curline.3 dbprefix
Return 0; DB7PASS_TO_RUNTIME:
dbxx dbsource
if dbread? then return
if dbprgm='DEMO' then dbread?=1
If db8exist(dbvars) Then call db8shell 'ERASE' dbvars
dbxx dbdfile
dbc 'QQ'
dbxx dbdfile
':'dbsize+2
dbvarlist='dbcodes dbdefenv dbdfile dbenvir dbfileid',
' dbft dbinclude dbinvoke dbmacro? dbopts dbprgm dbprof dbprinter',
' dbread? dbrun dbs dbsession dbset dbsize dbsys dbsource',
' dbpath dbtest? dbuc dbuser dbvars dbdprgm',
' dbfullsw dberrorsw dblogsw dbtracesw dbtallysw',
' dbwatchsw dblimit dbcount dbwait dbwatch',
' dbtbl.1 dbtbl.2 dbtbl.3 dbtbl.4 dbtbl.5 dbtbl.6',
' dbtbl.7 dbtbl.8 dbtbl.9 dbtbl.10 dbtbl.11 dbtbl.12',
' dbtbl.13 dbtbl.14 dbtbl.15 dbtbl.16 dbtbl.17 dbtbl.18',
' dbtbl.19 dbtbl.20 dbtbl.21 dbtbl.22 dbtbl.23 dbtbl.24'
dbc 'INP /**/Return,'
do until dbvarlist=''
parse value dbvarlist with dbw dbvarlist
dbstr= value(dbw)
if dbstr='' then if left(dbw,6)='dbtbl.' then iterate
dbc 'INP "'dbw"='"dbstr"';"'",'
end
dbc 'INP ;'
dbc ':'dbsize+2 'PUT *' dbvars
dbc ':'dbsize+2 'DEL *'
drop dbstr dbstr dbvarlist
'QQ'
Return 0; DB8PAIRS:
Procedure Expose dbsq dbdq
Parse Arg str
Do Forever
Parse Value pos(dbsq,str) pos(dbdq,str) pos('/*',str),
With h i j
If h=0 Then h=256
If i=0 Then i=256
If j=0 Then j=256
j=min(h,i,j)
If j=256 Then Leave
Parse Value 1 substr(str,j,1) With width delimiter
If delimiter='/' Then Parse Value '*/' 2 With delimiter width
Parse Value substr(str,1,j-1)'!'substr(str,j+width),
With temp'!'str
j=pos(delimiter,str)
If j>0 Then str=temp substr(str,j+width)
Else Do;str=temp;leave;end
End
Return str; DB8print:
dbcs 'SWAP OFF'
if dbsys='DOS' then 'DOSN COPY AAPRINT PRN'
else if dbsys='OS2' then 'DOSN COPY AAPRINT PRN'
else if dbsys='CMS' then do
Address value dbcommand
'PRINT AAPRINT'
address XEDIT; end
dbcs 'SWAP ON'
Return 0; DB8SHELL: parse arg dbstring
dbcs 'SWAP OFF'
if dbsys='DOS' then 'DOSN' dbstring
else if dbsys='OS2' then 'DOSN' dbstring
else if dbsys='CMS' then do
Address value dbcommand
dbstring
address XEDIT; end
dbcs 'SWAP ON'
Return 0;db8GETFT:
if dbmacro? then dblist=' ',
'OS2 KEX CMD KEDIT KEDIT KEX ', /*O*/
' '
else dblist=' ',
'OS2 CMD CMD KEDIT CMD KEX ', /*O*/
' '
i=wordpos(dbsys,dblist)
parse value word(dblist,i+1) word(dblist,i+2) word(dblist,i+3) ,
word(dblist,i+4) word(dblist,i+5),
with dbft dbcommand dbenvir dbdefenv dbmft
return 0; db8cleanup:
parse value rdbmisc('/ABORT' dbsession) with dbtrc dbtrap
if dbtrc=-7 then return -7 dbtrap
if dbtrc=1 then do
call rdxwrap '/WRAPUP' dbmacro? dbprgmmacro dbdprgm'!'dbparms,
'!'dbdfile'!'dbsource'!'dbinvoke'!'dbrun'!'dbsession'!'dbprgm
Exit; end
Return 0;db8defaults:
parse value '1 1 1 1 1 1 50 0 0' with,
dbfullsw dberrorsw dblogsw dbtracesw dbtallysw,
dbwatchsw dblimit dbcount dbwait dbwatch
dbtbl.=''
dbcodes='B E S'
Return 0;DB8EXIST:
arg dbefile
if dbsys='OS2' then do /*O*/
call db0editfile dbefile /*O*/
dbrc=(size.1<>0); end; else do /*O*/
call lineout dbefile /*O*/
If lines(dbefile) Then dbrc=1
else dbrc=0
call lineout dbefile
end /*O*/
Return dbrc;DB8FLUSH:
Return
do forever
dbc 'READV KEY'
if readv.1='' then leave
end
Return 0;DB9INITIAL:
Parse Value 'COMMAND SET!COMMAND X!COMMAND EXT' With dbcs'!'dbxx'!'dbce
Parse Value 'COMMAND!COMMAND SOS' With dbc'!'dbso
Parse Arg dborigin dbprgm dbparms
Parse Value 0 2 0 "'" '"' With dbread? y dblevel dbsq dbdq dbmsg
dbce '/OPSYS'
dbme='rDEBUG'
Parse Value 0 opsys.1 '' With dbinside? dbsys dbcallstack dbtrtn dbtrapp
if dbsys='OS/2' then dbsys='OS2' /*O*/
if dbsys='CMS' then address XEDIT
else address KEDIT
if queued()>0 then do /*O*/
parse Pull dborigin dbprgm dbparms /*O*/
if queued()>0 then /*O*/
parse Pull dborigin dbprgm dbparms /*O*/
call rdprofil; end /*O*/
else /*O*/
If dborigin<>0 Then Parse Arg dbprgm dbparms
If (dborigin=?)+(dborigin='')>0 Then /*Exit*/ Return tell(dbme)
dbcheck=0
dbcheck=1 /*O*/
if dbcheck=0 then rdbmsg(010 dbsys)
dbi=pos('.',dbprgm) /*NC*/
if dbi>1 then dbprgm=left(dbprgm,dbi-1) /*NC*/
dbce '/FN/FT/FM'
dbifile=fname.1
Parse Value (dborigin<>0) '' '' With dbmacro? rexxver
dbtest?=0
dbset='dbfullsw dberrorsw dblogsw dbtracesw dbtallysw dbwatchsw dblimit dbwait dbwatch'
dbopts='FULLSW ERRORSW LOGSW TRACESW TALLYSW WATCHSW COUNT WAIT WATCH'
dbrun='\rDEBUG\DEBUGRUN.KEX'
dbsession='SESSION.LOG'
dbvars='rdbVARS.KEX'
dbinclude='INCLUDE.LOG'
call db8defaults
call db8getft
if dbprgm='' then do
call db8shell 'RDDEMO 2'
Parse Value 0 0 'DEMO' '....' With dbmacro?,
dbtest? dbprgm dbparms dbwatch; end
Parse Upper Var dbprgm dbprgm
dbs='.' /*NC*/
dbce '/FN/FT/FM'
dbinvoke=fname.1''dbs''ftype.1
if dbsys='OS2' then dbpath=directory()'\' /*O*/
call RDBINIT '/LO R' dbpath '1000!0!38!'dbtest?'!'dbsession'!'dbinvoke
parse value result with dbtrc dbtrap
if dbtrc=-7 then call db0event 750
dbcs 'SCR1'
if dbprgm='DEMO' then do
interpret rddemo('WELCOME')
if dbstr='EXIT' then call db8cleanup; end
call definesource
call db0editfile dbinvoke
/* note, define these file w/ a path? */
dbfileid=dbifile'.SCR'
dbuser=dbifile'.SCR'
if db8exist(dbrun)=0 then do
'MSG' rdbmsg(009 dbrun); dbc 'READV KEY'
call db8cleanup; exit; end
dbmenu='Missing file'
Call lineout dbsource
Call lineout dbsession
drop dbifile
Return 0
DEFINESOURCE:
dbi=pos('.',dbprgm) /*NC*/
if dbi>1 then do /*NC*/
dbft=substr(dbprgm,dbi+1) /*NC*/
prgm=left(dbprgm,dbi-1) /*NC*/
dbtype='REX 0 CMD 0 EXEC 0 XEDIT 1 KEX 1'
dbmacro?=word(dbtype,wordpos(dbft,dbtype)+1)/*NC*/
end /*NC*/
dbsource=dbprgm''dbs''dbft
dbmenu='Incomplete Spec'
call db8getft
If dbprgm='' Then do
Call db0source rdbmsg(000)
call db8getft; end
dbmenu=''
dbdprgm=strip(left('D'dbprgm,8))
dbdfile=''dbdprgm''dbs''dbmft
dbprgmmacro=dbprgm''dbs''dbmft
dbprof=dbprgm'.PRO'
return