QB64/qb64
QB64/qb64
1
1
Fork 0
mirror of https://github.com/QB64Official/qb64.git synced 2024-07-03 07:41:21 +00:00
Code Releases Wiki Activity

$DEBUG mode now in working state.

Browse source 
F9 (or clicking a line number) will toggle a breakpoint; When running a 
program, F8 will pause/step line by line, F9 will still be usable to 
toggle breakpoints and F5 will continue execution. ESC exits $DEBUG 
mode.
This commit is contained in:
Fellippe Heitor 2021-07-11 21:05:03 -03:00
parent 7b853bf9f2
commit 19219dbfe5
6 changed files with 236 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
source/ide/ide_global.bas
View file

@ -30,6 +30,8 @@ END TYPE
REDIM SHARED IdeBmk(1) AS IdeBmkType
DIM SHARED IdeBmkN
REDIM SHARED IdeBreakpoints(1) AS _BYTE
'GetInput global variables
DIM SHARED iCHECKLATER 'the values will be checked later
DIM SHARED iCHANGED

200
source/ide/ide_methods.bas
View file

@ -456,6 +456,7 @@ FUNCTION ide2 (ignore)
'new blank text field
idet$ = MKL$(0) + MKL$(0): idel = 1: ideli = 1: iden = 1: IdeBmkN = 0
REDIM IdeBreakpoints(iden) AS _BYTE
ideunsaved = -1
idechangemade = 1
@ -546,6 +547,7 @@ FUNCTION ide2 (ignore)
LOOP UNTIL asca = 13
lineinput3buffer = ""
iden = n: IF n = 0 THEN idet$ = MKL$(0) + MKL$(0): iden = 1 ELSE idet$ = LEFT$(idet$, i2 - 1)
REDIM IdeBreakpoints(iden) AS _BYTE
IF ideStartAtLine > 0 AND ideStartAtLine <= iden THEN
idecy = ideStartAtLine
IF idecy - 10 >= 1 THEN idesy = idecy - 10
@ -672,6 +674,14 @@ FUNCTION ide2 (ignore)
IF ideautorun THEN ideautorun = 0: GOTO idemrunspecial
END IF
IF c$ = CHR$(254) THEN
'$DEBUG mode on
idecompiling = 0
ready = 1
DebugMode
GOTO ideloop
END IF
IF c$ = CHR$(11) THEN
idecompiling = 0
ready = 1
@ -1505,6 +1515,10 @@ FUNCTION ide2 (ignore)
END IF
END IF
IF KB = KEY_F9 THEN 'toggle breakpoint
IdeBreakpoints(idecy) = NOT IdeBreakpoints(idecy)
END IF
IF KB = KEY_F11 THEN 'make exe only
idemexe:
iderunmode = 2
@ -2873,23 +2887,25 @@ FUNCTION ide2 (ignore)
END IF
ELSEIF mX > 1 AND mX <= 1 + maxLineNumberLength AND mY > 2 AND mY < (idewy - 5) AND ShowLineNumbers THEN
'line numbers are visible and been clicked
ideselect = 1
idecy = mY - 2 + idesy - 1
IF idecy < iden THEN
IF (NOT KSHIFT) THEN ideselectx1 = 1: ideselecty1 = idecy
idecy = idecy + 1
idecx = 1
ELSEIF idecy = iden THEN
a$ = idegetline$(idecy)
IF (NOT KSHIFT) THEN ideselectx1 = 1: ideselecty1 = idecy
idecx = LEN(a$) + 1
ELSEIF idecy > iden THEN
idecy = iden
ideselect = 0
idecx = 1
ideselect = 0
idecytemp = mY - 2 + idesy - 1
IF idecytemp =< iden THEN
'IF (NOT KSHIFT) THEN ideselectx1 = 1: ideselecty1 = idecy
'idecy = idecy + 1
'idecx = 1
idecy = idecytemp
IdeBreakpoints(idecy) = NOT IdeBreakpoints(idecy)
'ELSEIF idecy = iden THEN
' a$ = idegetline$(idecy)
' IF (NOT KSHIFT) THEN ideselectx1 = 1: ideselecty1 = idecy
' idecx = LEN(a$) + 1
'ELSEIF idecy > iden THEN
' idecy = iden
' ideselect = 0
' idecx = 1
END IF
wholeword.select = 0
idemouseselect = 0
'wholeword.select = 0
'idemouseselect = 0
END IF
END IF
@ -5570,6 +5586,7 @@ FUNCTION ide2 (ignore)
END IF
ideunsaved = -1
'new blank text field
REDIM IdeBreakpoints(1) AS _BYTE
idet$ = MKL$(0) + MKL$(0): idel = 1: ideli = 1: iden = 1: IdeBmkN = 0
idesx = 1
idesy = 1
@ -5950,6 +5967,149 @@ FUNCTION ide2 (ignore)
END FUNCTION
SUB DebugMode
STATIC host&
DIM PauseMode AS _BYTE
SCREEN , , 3, 0
dummy = DarkenFGBG(1)
clearStatusWindow
COLOR 15, 1
_PRINTSTRING (2, idewy - 3), "Entering $DEBUG mode..."
PCOPY 3, 0
IF host& = 0 THEN
host& = _OPENHOST("TCP/IP:9000")
IF host& = 0 THEN
clearStatusWindow
dummy = DarkenFGBG(0)
COLOR 7, 1
_PRINTSTRING (2, idewy - 3), "Failed to initiate debug session."
PCOPY 3, 0
EXIT SUB
END IF
END IF
endc$ = "<END>"
DO
client& = _OPENCONNECTION(host&)
IF client& THEN EXIT DO
k& = _KEYHIT
IF k& = 27 THEN
clearStatusWindow
dummy = DarkenFGBG(0)
COLOR 7, 1
_PRINTSTRING (2, idewy - 3), "Debug session aborted."
PCOPY 3, 0
EXIT SUB
END IF
_LIMIT 100
LOOP
clearStatusWindow
COLOR 15, 1
_PRINTSTRING (2, idewy - 3), "$DEBUG MODE: <F5=Continue> <F8=Step> <F9=Toggle Breakpoint> <ESC=Abort>"
PCOPY 3, 0
IF client& THEN
a$ = "": b$ = ""
DO UNTIL INSTR(a$, endc$) > 0
GET #client&, , b$
a$ = a$ + b$
LOOP
program$ = LEFT$(a$, INSTR(a$, endc$) - 1)
IF LEFT$(program$, 2) = "./" THEN program$ = MID$(program$, 3)
IF program$ <> lastBinaryGenerated$ THEN
COLOR 7, 1
_PRINTSTRING (2, idewy - 3), "Failed to initiate debug session."
clearStatusWindow
dummy = DarkenFGBG(0)
PCOPY 3, 0
EXIT SUB
END IF
a$ = "vwatch:ok" + endc$
PUT #client&, , a$
DO
'Waiting for line number...
a$ = "": b$ = ""
DO UNTIL INSTR(a$, endc$) > 0
IF k& = 27 THEN
a$ = "free" + endc$
PUT #client&, , a$
CLOSE #client&
client& = 0
clearStatusWindow
dummy = DarkenFGBG(0)
COLOR 7, 1
_PRINTSTRING (2, idewy - 3), "Debug session aborted."
PCOPY 3, 0
EXIT SUB
END IF
GET #client&, , b$
a$ = a$ + b$
_LIMIT 100
LOOP
a$ = LEFT$(a$, INSTR(a$, endc$) - 1)
IF LEFT$(a$, 12) = "line number:" THEN
l = CVL(RIGHT$(a$, 4))
END IF
idecy = l
ideshowtext
PCOPY 3, 0
k& = _KEYHIT
IF k& = 16896 THEN 'F8
PauseMode = -1
END IF
IF IdeBreakpoints(l) = 0 AND PauseMode = 0 THEN
a$ = "run" + endc$
PUT #client&, , a$
ELSE
DO
k& = _KEYHIT
IF k& = 27 THEN
a$ = "free" + endc$
PUT #client&, , a$
CLOSE #client&
client& = 0
clearStatusWindow
dummy = DarkenFGBG(0)
COLOR 7, 1
_PRINTSTRING (2, idewy - 3), "Debug session aborted."
PCOPY 3, 0
EXIT SUB
ELSEIF k& = 16896 THEN 'F8
PauseMode = -1
a$ = "run" + endc$
PUT #client&, , a$
EXIT DO
ELSEIF k& = 16128 THEN 'F5
PauseMode = 0
a$ = "run" + endc$
PUT #client&, , a$
EXIT DO
ELSEIF k& = 17152 THEN 'F9
IdeBreakpoints(l) = NOT IdeBreakpoints(l)
ideshowtext
PCOPY 3, 0
END IF
_LIMIT 100
LOOP
END IF
LOOP
END IF
END SUB
SUB idebox (x, y, w, h)
_PRINTSTRING (x, y), CHR$(218) + STRING$(w - 2, 196) + CHR$(191)
FOR y2 = y + 1 TO y + h - 2
@ -6526,6 +6686,11 @@ SUB idedelline (i)
END IF
NEXT
FOR b = i + 1 TO iden
IdeBreakpoints(b - 1) = IdeBreakpoints(b)
NEXT
REDIM _PRESERVE IdeBreakpoints(iden) AS _BYTE
idegotoline i
textlen = CVL(MID$(idet$, ideli, 4))
idet$ = LEFT$(idet$, ideli - 1) + RIGHT$(idet$, LEN(idet$) - ideli + 1 - 8 - textlen)
@ -7337,6 +7502,7 @@ SUB ideinsline (i, text$)
textlen = LEN(text$)
idet$ = LEFT$(idet$, ideli - 1) + MKL$(textlen) + text$ + MKL$(textlen) + RIGHT$(idet$, LEN(idet$) - ideli + 1)
iden = iden + 1
REDIM _PRESERVE IdeBreakpoints(iden) AS _BYTE
END SUB
FUNCTION ideinputbox$(title$, caption$, initialvalue$, validinput$, boxwidth, maxlength)
@ -7890,6 +8056,7 @@ FUNCTION idefiledialog$(programname$, mode AS _BYTE)
LOOP UNTIL asca = 13
lineinput3buffer = ""
iden = n: IF n = 0 THEN idet$ = MKL$(0) + MKL$(0): iden = 1 ELSE idet$ = LEFT$(idet$, i2 - 1)
REDIM IdeBreakpoints(iden) AS _BYTE
ideerror = 1
ideprogname = f$: _TITLE ideprogname + " - " + WindowTitle
listOfCustomKeywords$ = LEFT$(listOfCustomKeywords$, customKeywordsLength)
@ -8637,6 +8804,7 @@ SUB ideshowtext
_PRINTSTRING (2, y + 3), SPACE$(maxLineNumberLength)
IF l <= iden THEN
l2$ = STR$(l)
IF IdeBreakpoints(l) THEN COLOR , 4
IF 2 + maxLineNumberLength - (LEN(l2$) + 1) >= 2 THEN
_PRINTSTRING (2 + maxLineNumberLength - (LEN(l2$) + 1), y + 3), l2$
END IF

57
source/qb64.bas
View file

@ -121,7 +121,7 @@ DIM SHARED viFileDescription$, viFileVersion$, viInternalName$
DIM SHARED viLegalCopyright$, viLegalTrademarks$, viOriginalFilename$
DIM SHARED viProductName$, viProductVersion$, viComments$, viWeb$
DIM SHARED NoChecks, vWatch, addingvWatch
DIM SHARED NoChecks, vWatchOn, addingvWatch
DIM SHARED Console
DIM SHARED ScreenHide
@ -1088,7 +1088,11 @@ IF C = 9 THEN 'run
dummy = DarkenFGBG(0)
END IF
sendc$ = CHR$(6) 'ready
IF vWatchOn THEN
sendc$ = CHR$(254) 'launch debug interface
ELSE
sendc$ = CHR$(6) 'ready
END IF
GOTO sendcommand
END IF
@ -1376,8 +1380,7 @@ fooindwel = 0
layout = ""
layoutok = 0
NoChecks = 0
vWatch = 0
addingvWatch = 0
vWatchOn = 0
inclevel = 0
errorLineInInclude = 0
addmetainclude$ = ""
@ -1595,7 +1598,8 @@ DO
IF lastLine <> 0 OR firstLine <> 0 THEN
lineBackup$ = wholeline$ 'backup the real line (will be blank when lastline is set)
IF vWatch THEN
forceIncludeFromRoot$ = ""
IF vWatchOn THEN
addingvWatch = 1
IF lastLine <> 0 THEN forceIncludeFromRoot$ = "source\utilities\vwatch.bm"
ELSE
@ -1603,7 +1607,7 @@ DO
IF lastLine <> 0 THEN forceIncludeFromRoot$ = "source\utilities\vwatch_stub.bm"
END IF
firstLine = 0: lastLine = 0
GOTO forceInclude_prepass
IF LEN(forceIncludeFromRoot$) THEN GOTO forceInclude_prepass
forceIncludeCompleted_prepass:
addingvWatch = 0
wholeline$ = lineBackup$
@ -2815,7 +2819,8 @@ DO
IF lastLine <> 0 OR firstLine <> 0 THEN
lineBackup$ = a3$ 'backup the real first line (will be blank when lastline is set)
IF vWatch THEN
forceIncludeFromRoot$ = ""
IF vWatchOn THEN
addingvWatch = 1
IF lastLine <> 0 THEN forceIncludeFromRoot$ = "source\utilities\vwatch.bm"
ELSE
@ -2823,7 +2828,7 @@ DO
IF lastLine <> 0 THEN forceIncludeFromRoot$ = "source\utilities\vwatch_stub.bm"
END IF
firstLine = 0: lastLine = 0
GOTO forceInclude
IF LEN(forceIncludeFromRoot$) THEN GOTO forceInclude
forceIncludeCompleted:
addingvWatch = 0
a3$ = lineBackup$
@ -3079,19 +3084,21 @@ DO
END IF
IF a3u$ = "$DEBUG" THEN
IF vWatchOn THEN
a$ = "Duplicate $DEBUG metacommand": GOTO errmes
END IF
layout$ = SCase$("$Debug")
IF NoChecks THEN
addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "$DEBUG is disabled in $CHECKING:OFF blocks", ""
END IF
vWatch = 1
addmetainclude$ = getfilepath$(COMMAND$(0)) + "source" + pathsep$ + "utilities" + pathsep$ + "vwatch.bi"
vWatchOn = 1
GOTO finishednonexec
END IF
IF a3u$ = "$CHECKING:OFF" THEN
layout$ = SCase$("$Checking:Off")
IF vWatch = 1 AND addingvWatch = 0 THEN
addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "$DEBUG is disabled in $CHECKING:OFF blocks", ""
END IF
NoChecks = 1
GOTO finishednonexec
END IF
@ -5505,8 +5512,8 @@ DO
IF Error_Happened THEN GOTO errmes
IF stringprocessinghappened THEN e$ = cleanupstringprocessingcall$ + e$ + ")"
IF (typ AND ISSTRING) THEN a$ = "WHILE ERROR! Cannot accept a STRING type.": GOTO errmes
IF NoChecks = 0 AND vWatch = 1 THEN
PRINT #12, "vwatch(" + str2$(linenumber) + ");"
IF NoChecks = 0 AND vWatchOn = 1 THEN
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH(__LONG_VWATCH_LINENUMBER);"
END IF
PRINT #12, "while((" + e$ + ")||new_error){"
ELSE
@ -5567,8 +5574,8 @@ DO
controltype(controllevel) = 4
ELSE
controltype(controllevel) = 3
IF vWatch THEN
PRINT #12, "do{vwatch(" + str2$(linenumber) + ");"
IF vWatchOn = 1 AND NoChecks = 0 THEN
PRINT #12, "do{*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH(__LONG_VWATCH_LINENUMBER);"
ELSE
PRINT #12, "do{"
END IF
@ -5605,8 +5612,8 @@ DO
ELSE
PRINT #12, "dl_continue_" + str2$(controlid(controllevel)) + ":;"
IF NoChecks = 0 AND vWatch = 1 THEN
PRINT #12, "vwatch(" + str2$(linenumber) + ");"
IF NoChecks = 0 AND vWatchOn = 1 THEN
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH(__LONG_VWATCH_LINENUMBER);"
END IF
IF controltype(controllevel) = 4 THEN
@ -5758,8 +5765,8 @@ DO
e$ = evaluatetotyp(e$, ctyp)
IF Error_Happened THEN GOTO errmes
IF NoChecks = 0 AND vWatch = 1 THEN
PRINT #12, "vwatch(" + str2$(linenumber) + ");"
IF NoChecks = 0 AND vWatchOn = 1 THEN
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH(__LONG_VWATCH_LINENUMBER);"
END IF
PRINT #12, "fornext_step" + u$ + "=" + e$ + ";"
@ -6391,8 +6398,8 @@ DO
'static scope commands:
IF NoChecks = 0 THEN
IF vWatch THEN
PRINT #12, "do{vwatch(" + str2$(linenumber) + ");"
IF vWatchOn THEN
PRINT #12, "do{*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH(__LONG_VWATCH_LINENUMBER);"
ELSE
PRINT #12, "do{"
END IF
@ -9583,6 +9590,10 @@ DO
a$ = "Cannot call SUB _GL directly": GOTO errmes
END IF
IF firstelement$ = "VWATCH" THEN
a$ = "Cannot call SUB VWATCH directly": GOTO errmes
END IF
IF firstelement$ = "OPEN" THEN
'gwbasic or qbasic version?
B = 0
@ -12301,7 +12312,7 @@ IF DEPENDENCY(DEPENDENCY_ZLIB) THEN
END IF
END IF
'IF vWatch THEN
'IF vWatchOn THEN
' defines$ = defines$ + defines_header$ + "VWATCH"
'END IF

4
source/utilities/vwatch.bi Normal file
View file

@ -0,0 +1,4 @@
$CHECKING:OFF
DIM SHARED vwatch_linenumber AS LONG
vwatch_linenumber = 0
$CHECKING:ON

12
source/utilities/vwatch.bm
View file

@ -7,16 +7,21 @@ SUB vwatch (linenumber AS LONG)
endc$ = "<END>"
IF ide = 0 THEN
ide = _OPENCLIENT("TCP/IP:9000:localhost")
start! = TIMER
DO
ide = _OPENCLIENT("TCP/IP:9000:localhost")
_LIMIT 30
LOOP UNTIL ide <> 0 OR TIMER - start! > 10
IF ide = 0 THEN bypass = -1: EXIT SUB
me$ = COMMAND$(0) + endc$
PUT #ide, , me$
'start! = TIMER
DO
GET #ide, , temp$
buffer$ = buffer$ + temp$
LOOP UNTIL INSTR(buffer$, endc$) > 0
LOOP UNTIL INSTR(buffer$, endc$) > 0 'OR TIMER - start! > 2
buffer$ = LEFT$(buffer$, INSTR(buffer$, endc$) - 1)
IF buffer$ <> "vwatch:ok" THEN
@ -38,6 +43,9 @@ SUB vwatch (linenumber AS LONG)
buffer$ = LEFT$(buffer$, INSTR(buffer$, endc$) - 1)
IF buffer$ = "run" THEN
EXIT SUB
ELSEIF buffer$ = "free" THEN
bypass = -1
EXIT SUB
END IF
LOOP
END SUB

3
source/utilities/vwatch_stub.bm
View file

@ -1,2 +1,3 @@
SUB vwatch
SUB vwatch (linenumber AS LONG)
linenumber = 0
END SUB