QB64/qb64
QB64/qb64
1
1
Fork 0
mirror of https://github.com/QB64Official/qb64.git synced 2024-07-15 23:05:14 +00:00
Code Releases Wiki Activity

Merge branch 'var-export' into development

Browse source
This commit is contained in:
Fellippe Heitor 2021-07-21 18:27:46 -03:00
parent ef65cc152d 77daecccbc
commit 5cbe6d87f2
6 changed files with 1177 additions and 609 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
source/ide/ide_global.bas
View file

@ -42,6 +42,7 @@ DIM SHARED QuickNavTotal AS LONG
DIM SHARED QuickNavHistory(0) AS QuickNavType
REDIM SHARED IdeBreakpoints(1) AS _BYTE
REDIM SHARED IdeSkipLines(1) AS _BYTE
'GetInput global variables
DIM SHARED iCHECKLATER 'the values will be checked later

434
source/ide/ide_methods.bas
View file

@ -342,9 +342,8 @@ FUNCTION ide2 (ignore)
menuDesc$(m, i - 1) = "Sets/clears breakpoint at cursor location"
menu$(m, i) = "#Clear All Breakpoints F10": i = i + 1
menuDesc$(m, i - 1) = "Removes all breakpoints"
'menu$(m, i) = "-": i = i + 1
'menu$(m, i) = "#Clear All Breakpoints F10": i = i + 1
'menuDesc$(m, i - 1) = "Removes all breakpoints"
menu$(m, i) = "Toggle #Skip Line Ctrl+P": i = i + 1
menuDesc$(m, i - 1) = "Sets/clears flag to skip line"
menusize(m) = i - 1
m = m + 1: i = 0: OptionsMenuID = m
@ -474,6 +473,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
REDIM IdeSkipLines(iden) AS _BYTE
callstacklist$ = "": callStackLength = 0
ideunsaved = -1
idechangemade = 1
@ -566,6 +566,7 @@ FUNCTION ide2 (ignore)
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
REDIM IdeSkipLines(iden) AS _BYTE
IF ideStartAtLine > 0 AND ideStartAtLine <= iden THEN
idecy = ideStartAtLine
IF idecy - 10 >= 1 THEN idesy = idecy - 10
@ -721,10 +722,15 @@ FUNCTION ide2 (ignore)
_RESIZE OFF
DebugMode
SELECT CASE IdeDebugMode
CASE 1
CASE 1 'clean exit
IdeDebugMode = 0
idefocusline = 0
debugnextline = 0
CASE 2 'right-click detected; invoke contextual menu
PCOPY 3, 0
IdeMakeContextualMenu
idecontextualmenu = 1
GOTO showmenu
END SELECT
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
IF idesubwindow <> 0 THEN _RESIZE OFF ELSE _RESIZE ON
@ -1568,6 +1574,7 @@ FUNCTION ide2 (ignore)
END IF
IF KB = KEY_F8 OR startPausedPending = -1 THEN
startPausedPending = 0
GOTO startPausedMenuHandler
END IF
@ -1582,7 +1589,13 @@ FUNCTION ide2 (ignore)
END IF
IF KB = KEY_F4 THEN
IF callStackLength > 0 THEN
GOTO showCallStackDialog
ELSE
result = idemessagebox("$DEBUG MODE", "No call stack log available.", "")
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
END IF
IF KB = KEY_F5 THEN 'Note: F5 or SHIFT+F5 accepted
@ -2954,10 +2967,14 @@ FUNCTION ide2 (ignore)
idecytemp = mY - 2 + idesy - 1
IF idecytemp =< iden THEN
idecy = idecytemp
IF _KEYDOWN(100304) OR _KEYDOWN(100303) THEN
GOTO toggleSkipLine
ELSE
GOTO toggleBreakpoint
END IF
END IF
END IF
END IF
DoneWholeWord:
@ -3185,6 +3202,10 @@ FUNCTION ide2 (ignore)
GOTO ctrlOpen
END IF
IF KCONTROL AND UCASE$(K$) = "P" THEN 'Debug -> Toggle Skip Line
GOTO toggleSkipLine
END IF
IF (NOT KSHIFT) AND KCONTROL AND UCASE$(K$) = "R" THEN 'Comment (add ') - R for REMark
GOTO ctrlAddComment
END IF
@ -4411,20 +4432,27 @@ FUNCTION ide2 (ignore)
GOTO ideloop
END IF
IF _RESIZE THEN
IF (_RESIZE <> 0) AND IdeDebugMode <> 2 THEN
ForceResize = -1: skipdisplay = 0: GOTO ideloop
END IF
LOOP UNTIL KALT = 0 'wait till alt is released
PCOPY 3, 0: SCREEN , , 3, 0
GOTO startmenu2
END IF
IF _EXIT THEN ideexit = 1: GOTO ideloop
IF _EXIT THEN
IF IdeDebugMode = 2 THEN
IdeDebugMode = 9: GOTO EnterDebugMode
ELSE
ideexit = 1: GOTO ideloop
END IF
END IF
IF _WINDOWHASFOCUS = 0 AND (os$ = "WIN" OR MacOSX = 1) THEN
COLOR 0, 7: _PRINTSTRING (1, 1), menubar$
PCOPY 3, 0: SCREEN , , 3, 0
IF IdeDebugMode = 2 THEN GOTO EnterDebugMode
GOTO ideloop
END IF
IF _RESIZE THEN
IF (_RESIZE <> 0) AND IdeDebugMode <> 2 THEN
ForceResize = -1: skipdisplay = 0: GOTO ideloop
END IF
_LIMIT 100
@ -4434,6 +4462,7 @@ FUNCTION ide2 (ignore)
IF mWHEEL THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF IdeDebugMode = 2 THEN GOTO EnterDebugMode
GOTO ideloop
END IF
@ -4441,6 +4470,16 @@ FUNCTION ide2 (ignore)
IF (mX > 1 AND mX < idewx AND mY > 2 AND mY < (idewy - 5)) OR _
(mY >= idewy AND mY < idewy + idesubwindow) THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF IdeDebugMode = 2 THEN
bkpidecy = idecy
idecy = mY - 2 + idesy - 1
IF idecy > iden THEN idecy = iden
IF bkpidecy <> idecy THEN
ideshowtext
PCOPY 3, 0
END IF
GOTO showmenu
END IF
GOTO invokecontextualmenu
ELSE
PCOPY 3, 0: SCREEN , , 3, 0
@ -4473,6 +4512,7 @@ FUNCTION ide2 (ignore)
IF mX < xx - 2 OR mX >= xx - 2 + w + 4 OR mY > yy + menusize(m) + 1 OR (mY < yy AND idecontextualmenu = 1) THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF IdeDebugMode = 2 THEN GOTO EnterDebugMode
GOTO ideloop
END IF
END IF
@ -4504,7 +4544,7 @@ FUNCTION ide2 (ignore)
END IF
IF oldmx <> mX THEN
checkmenubarhover:
IF mY = 1 AND idecontextualmenu <> 1 THEN 'Check if we're hovering on menu bar
IF IdeDebugMode <> 2 AND mY = 1 AND idecontextualmenu <> 1 THEN 'Check if we're hovering on menu bar
lastm = m
FOR i = 1 TO menus
x = CVI(MID$(MenuLocations, i * 2 - 1, 2))
@ -4526,7 +4566,7 @@ FUNCTION ide2 (ignore)
IF mB THEN
'top row
IF mY = 1 THEN
IF mY = 1 AND IdeDebugMode <> 2 THEN
lastm = m
x = 3
FOR i = 1 TO menus
@ -4582,6 +4622,7 @@ FUNCTION ide2 (ignore)
IF m > menus AND idecontextualmenu = 0 THEN m = 1
IF KB = KEY_ESC THEN
PCOPY 3, 0: SCREEN , , 3, 0
IF IdeDebugMode = 2 THEN GOTO EnterDebugMode
GOTO ideloop
END IF
IF KB = KEY_DOWN THEN
@ -5232,7 +5273,11 @@ FUNCTION ide2 (ignore)
GOTO ideloop
END IF
IF menu$(m, s) = "#SUBs... F2" THEN
IF menu$(m, s) = "#SUBs... F2" OR menu$(m, s) = "SUBs... F2" THEN
IF IdeDebugMode = 2 THEN
IdeDebugMode = 14
GOTO EnterDebugMode
ELSE
PCOPY 2, 0
idesubsjmp:
r$ = idesubs
@ -5240,6 +5285,7 @@ FUNCTION ide2 (ignore)
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
END IF
IF menu$(m, s) = "#Line Numbers " + CHR$(16) THEN
idecontextualmenu = 2
@ -5308,15 +5354,6 @@ FUNCTION ide2 (ignore)
GOTO ideloop
END IF
IF menu$(m, s) = "Call #Stack... F4" THEN
PCOPY 2, 0
showCallStackDialog:
retval = idecallstackbox
'retval is ignored
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
IF menu$(m, s) = "#Find... Ctrl+F3" THEN
PCOPY 2, 0
idefindjmp:
@ -5424,6 +5461,7 @@ FUNCTION ide2 (ignore)
IF x THEN
ideselect = 1
idecx = x: idecy = y
idecentercurrentline
ideselectx1 = x + LEN(s$): ideselecty1 = y
found = 1
@ -5625,7 +5663,55 @@ FUNCTION ide2 (ignore)
END IF
END IF
IF menu$(m, s) = "Call #Stack... F4" OR menu$(m, s) = "Call Stack... F4" THEN
IF IdeDebugMode = 2 THEN
IdeDebugMode = 3
GOTO EnterDebugMode
ELSE
PCOPY 2, 0
showCallStackDialog:
retval = idecallstackbox
'retval is ignored
PCOPY 3, 0: SCREEN , , 3, 0
GOTO ideloop
END IF
END IF
IF menu$(m, s) = "#Continue F5" THEN
IdeDebugMode = 4
GOTO EnterDebugMode
END IF
IF menu$(m, s) = "Step O#ut F6" THEN
IdeDebugMode = 5
GOTO EnterDebugMode
END IF
IF menu$(m, s) = "Step #Over F7" THEN
IdeDebugMode = 6
GOTO EnterDebugMode
END IF
IF menu$(m, s) = "Ste#p Into F8" THEN
IdeDebugMode = 7
GOTO EnterDebugMode
END IF
IF menu$(m, s) = "#Run To This Line Ctrl+Shift+G" THEN
IdeDebugMode = 8
GOTO EnterDebugMode
END IF
IF menu$(m, s) = "#Exit $DEBUG mode ESC" THEN
IdeDebugMode = 9
GOTO EnterDebugMode
END IF
IF menu$(m, s) = "Toggle #Breakpoint F9" THEN
IF IdeDebugMode = 2 THEN
IdeDebugMode = 10
GOTO EnterDebugMode
ELSE
PCOPY 3, 0: SCREEN , , 3, 0
toggleBreakpoint:
IF vWatchOn = 0 THEN
@ -5640,14 +5726,50 @@ FUNCTION ide2 (ignore)
ELSE
IdeBreakpoints(idecy) = NOT IdeBreakpoints(idecy)
END IF
IF IdeBreakpoints(idecy) THEN IdeSkipLines(idecy) = 0
GOTO ideloop
END IF
END IF
IF menu$(m, s) = "#Clear All Breakpoints F10" THEN
IF menu$(m, s) = "#Clear All Breakpoints F10" OR menu$(m, s) = "Clear All Breakpoints F10" THEN
IF IdeDebugMode = 2 THEN
IdeDebugMode = 11
GOTO EnterDebugMode
ELSE
PCOPY 3, 0: SCREEN , , 3, 0
REDIM IdeBreakpoints(iden) AS _BYTE
GOTO ideloop
END IF
END IF
IF menu$(m, s) = "Toggle #Skip Line Ctrl+P" THEN
IF IdeDebugMode = 2 THEN
IdeDebugMode = 12
GOTO EnterDebugMode
ELSE
PCOPY 3, 0: SCREEN , , 3, 0
toggleSkipLine:
IF vWatchOn = 0 THEN
result = idemessagebox("Toggle Breakpoint", "Insert $DEBUG metacommand?", "#Yes;#No")
IF result = 1 THEN
ideselect = 0
ideinsline 1, SCase$("$Debug")
idecy = idecy + 1
idechangemade = 1
IdeSkipLines(idecy) = NOT IdeSkipLines(idecy)
END IF
ELSE
IdeSkipLines(idecy) = NOT IdeSkipLines(idecy)
END IF
IF IdeSkipLines(idecy) THEN IdeBreakpoints(idecy) = 0
GOTO ideloop
END IF
END IF
IF menu$(m, s) = "Set #Next Line Ctrl+G" THEN
IdeDebugMode = 13
GOTO EnterDebugMode
END IF
IF menu$(m, s) = "E#xit" THEN
PCOPY 2, 0
@ -5702,6 +5824,7 @@ FUNCTION ide2 (ignore)
ideunsaved = -1
'new blank text field
REDIM IdeBreakpoints(1) AS _BYTE
REDIM IdeSkipLines(1) AS _BYTE
callstacklist$ = "": callStackLength = 0
idet$ = MKL$(0) + MKL$(0): idel = 1: ideli = 1: iden = 1: IdeBmkN = 0
idesx = 1
@ -6085,17 +6208,66 @@ END FUNCTION
SUB DebugMode
STATIC PauseMode AS _BYTE
STATIC client&
STATIC buffer$
STATIC endc$
timeout = 10
_KEYCLEAR
IF IdeDebugMode = 1 THEN
SCREEN , , 3, 0
SELECT CASE IdeDebugMode
CASE 1
PauseMode = 0
callStackLength = 0
callstacklist$ = ""
END IF
buffer$ = ""
client& = 0
CASE 2
IdeDebugMode = 1
GOTO returnFromContextMenu
CASE 3
IdeDebugMode = 1
GOTO requestCallStack
CASE 4
IdeDebugMode = 1
GOTO requestContinue
CASE 5
IdeDebugMode = 1
GOTO requestStepOut
CASE 6
IdeDebugMode = 1
GOTO requestStepOver
CASE 7
IdeDebugMode = 1
GOTO requestPause
CASE 8
IdeDebugMode = 1
result = idecy
GOTO requestRunToThisLine
CASE 9
IdeDebugMode = 1
GOTO requestQuit
CASE 10
IdeDebugMode = 1
GOTO requestToggleBreakpoint
CASE 11
IdeDebugMode = 1
GOTO requestClearBreakpoints
CASE 12
IdeDebugMode = 1
result = idecy
GOTO requestToggleSkipLine
CASE 13
IdeDebugMode = 1
result = idecy
GOTO requestSetNextLine
CASE 14
IdeDebugMode = 1
GOTO requestSubsDialog
END SELECT
SCREEN , , 3, 0
COLOR 0, 7: _PRINTSTRING (1, 1), SPACE$(LEN(menubar$))
m$ = "$DEBUG MODE ACTIVE"
COLOR 0
@ -6205,6 +6377,21 @@ SUB DebugMode
GOSUB SendCommand
END IF
skipCount = 0
skipList$ = ""
FOR i = 1 TO UBOUND(IdeSkipLines)
IF IdeSkipLines(i) THEN
skipCount = skipCount + 1
skipList$ = skipList$ + MKL$(i)
END IF
NEXT
IF skipCount THEN
cmd$ = "skip count:" + MKL$(skipCount)
GOSUB SendCommand
cmd$ = "skip list:" + skipList$
GOSUB SendCommand
END IF
clearStatusWindow 1
IF startPaused THEN
cmd$ = "break"
@ -6235,6 +6422,33 @@ SUB DebugMode
mX = _MOUSEX
mY = _MOUSEY
IF mB2 THEN
IF mouseDown2 = 0 THEN
mouseDown2 = -1
mouseDownOnX2 = mX
mouseDownOnY2 = mY
ELSE
END IF
ELSE
IF mouseDown2 THEN
IF mouseDownOnX2 = mX AND mouseDownOnY2 = mY THEN
IF (mX > 1 AND mX <= 1 + maxLineNumberLength AND mY > 2 AND mY < (idewy - 5) AND ShowLineNumbers) OR _
(mX = 1 AND mY > 2 AND mY < (idewy - 5) AND ShowLineNumbers = 0) OR _
(mX > 1 + maxLineNumberLength AND mX < idewx AND mY > 2 AND mY < (idewy - 5)) THEN
bkpidecy = idecy
idecy = mY - 2 + idesy - 1
IF idecy > iden THEN idecy = iden
IF bkpidecy <> idecy THEN GOSUB UpdateDisplay
IdeDebugMode = 2
IF PauseMode = 0 THEN GOSUB requestPause: dummy = DarkenFGBG(0)
EXIT SUB
returnFromContextMenu:
END IF
END IF
END IF
mouseDown2 = 0
END IF
IF mB THEN
IF mouseDown = 0 THEN
mouseDown = -1
@ -6307,9 +6521,26 @@ SUB DebugMode
ideselect = 0
idecytemp = mY - 2 + idesy - 1
IF idecytemp =< iden THEN
IdeBreakpoints(idecytemp) = NOT IdeBreakpoints(idecytemp)
IF IdeBreakpoints(idecytemp) THEN cmd$ = "set breakpoint:" ELSE cmd$ = "clear breakpoint:"
IF _KEYDOWN(100304) OR _KEYDOWN(100303) THEN
IF IdeSkipLines(idecytemp) = -1 THEN
IdeSkipLines(idecytemp) = 0
cmd$ = "clear skip line:" + MKL$(idecytemp)
ELSE
IdeSkipLines(idecytemp) = -1
IdeBreakpoints(idecytemp) = 0
cmd$ = "set skip line:" + MKL$(idecytemp)
END IF
ELSE
IF IdeBreakpoints(idecytemp) THEN
IdeBreakpoints(idecytemp) = 0
cmd$ = "clear breakpoint:"
ELSE
IdeBreakpoints(idecytemp) = -1
IdeSkipLines(idecytemp) = 0
cmd$ = "set breakpoint:"
END IF
cmd$ = cmd$ + MKL$(idecytemp)
END IF
GOSUB SendCommand
GOSUB UpdateDisplay
END IF
@ -6410,6 +6641,7 @@ SUB DebugMode
IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN idecy = iden
IF bkpidecy <> idecy OR bkpidesy <> idesy THEN GOSUB UpdateDisplay
CASE 27
requestQuit:
cmd$ = "free"
GOSUB SendCommand
CLOSE #client&
@ -6420,18 +6652,20 @@ SUB DebugMode
_KEYCLEAR
EXIT SUB
CASE 15360 'F2
requestSubsDialog:
r$ = idesubs
PCOPY 3, 0: SCREEN , , 3, 0
GOSUB UpdateDisplay
CASE 15872 'F4
IF PauseMode THEN
requestCallStack:
cmd$ = "call stack"
GOSUB SendCommand
IF BypassRequestCallStack THEN GOTO ShowCallStack
dummy = DarkenFGBG(0)
clearStatusWindow 0
setStatusMessage 1, "Requesting call stack...", 7
noFocusMessage = -1
start! = TIMER
DO
@ -6443,6 +6677,7 @@ SUB DebugMode
IF cmd$ = "call stack" THEN
'display call stack
callstacklist$ = value$
ShowCallStack:
retval = idecallstackbox
PCOPY 3, 0: SCREEN , , 3, 0
clearStatusWindow 0
@ -6451,8 +6686,10 @@ SUB DebugMode
clearStatusWindow 0
setStatusMessage 1, "Error retrieving call stack.", 2
END IF
noFocusMessage = NOT noFocusMessage
END IF
CASE 16128 'F5
requestContinue:
PauseMode = 0
debugnextline = 0
cmd$ = "run"
@ -6462,6 +6699,7 @@ SUB DebugMode
GOSUB UpdateDisplay
dummy = DarkenFGBG(1)
CASE 16384 'F6
requestStepOut:
IF PauseMode THEN
PauseMode = 0
cmd$ = "step out"
@ -6471,6 +6709,7 @@ SUB DebugMode
dummy = DarkenFGBG(1)
END IF
CASE 16640 'F7
requestStepOver:
IF PauseMode THEN
cmd$ = "step over"
PauseMode = 0
@ -6481,6 +6720,7 @@ SUB DebugMode
END IF
CASE 16896 'F8
IF PauseMode = 0 THEN
requestPause:
cmd$ = "break"
PauseMode = -1
GOSUB SendCommand
@ -6491,25 +6731,74 @@ SUB DebugMode
END IF
clearStatusWindow 1
setStatusMessage 1, "Paused.", 2
IF IdeDebugMode = 2 THEN RETURN
CASE 17152 'F9
requestToggleBreakpoint:
IF PauseMode THEN
IdeBreakpoints(idecy) = NOT IdeBreakpoints(idecy)
IF IdeBreakpoints(idecy) THEN cmd$ = "set breakpoint:" ELSE cmd$ = "clear breakpoint:"
IF IdeBreakpoints(idecy) THEN
IdeSkipLines(idecy) = 0
cmd$ = "set breakpoint:"
ELSE
cmd$ = "clear breakpoint:"
END IF
cmd$ = cmd$ + MKL$(idecy)
GOSUB SendCommand
GOSUB UpdateDisplay
END IF
CASE 17408 'F10
requestClearBreakpoints:
REDIM IdeBreakpoints(iden) AS _BYTE
cmd$ = "clear all breakpoints"
GOSUB SendCommand
GOSUB UpdateDisplay
CASE 103, 71 'g, G
IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN
IF _KEYDOWN(100304) OR _KEYDOWN(100303) THEN
result = idegetlinenumberbox("Run To Line", idecy)
PCOPY 3, 0: SCREEN , , 3, 0
requestRunToThisLine:
IF result > 0 AND result < iden THEN
PauseMode = 0
debugnextline = 0
cmd$ = "run to line:" + MKL$(result)
GOSUB SendCommand
clearStatusWindow 1
setStatusMessage 1, "Running...", 10
GOSUB UpdateDisplay
dummy = DarkenFGBG(1)
END IF
ELSE
result = idegetlinenumberbox("Set Next Line", idecy)
PCOPY 3, 0: SCREEN , , 3, 0
requestSetNextLine:
IF result > 0 AND result < iden THEN
cmd$ = "set next line:" + MKL$(result)
GOSUB SendCommand
END IF
END IF
END IF
CASE 112, 80 'p, P
IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN
result = idegetlinenumberbox("Skip Line", idecy)
PCOPY 3, 0: SCREEN , , 3, 0
requestToggleSkipLine:
IF result > 0 AND result <= iden THEN
IdeSkipLines(result) = NOT IdeSkipLines(result)
cmd$ = "set skip line:"
IF IdeSkipLines(result) = 0 THEN cmd$ = "clear skip line:"
cmd$ = cmd$ + MKL$(result)
GOSUB SendCommand
GOSUB UpdateDisplay
END IF
END IF
END SELECT
GOSUB GetCommand
SELECT CASE cmd$
CASE "breakpoint", "line number"
BypassRequestCallStack = 0
l = CVL(value$)
idecy = l
debugnextline = l
@ -6542,10 +6831,12 @@ SUB DebugMode
clearStatusWindow 1
COLOR , 4
setStatusMessage 1, "Error occurred on line" + STR$(l), 13
BypassRequestCallStack = -1
PauseMode = -1
CASE "call stack size"
'call stack is only received without having been
'requested when the program is about to quit
'requested when the program is about to quit or
'when an error just occurred
callStackLength = CVL(value$)
start! = TIMER
DO
@ -7300,6 +7591,18 @@ SUB idedelline (i)
END IF
NEXT
IF vWatchOn THEN
FOR b = i TO iden - 1
SWAP IdeBreakpoints(b), IdeBreakpoints(b + 1)
NEXT
REDIM _PRESERVE IdeBreakpoints(iden - 1) AS _BYTE
FOR b = i TO iden - 1
SWAP IdeSkipLines(b), IdeSkipLines(b - 1)
NEXT
REDIM _PRESERVE IdeSkipLines(iden - 1) AS _BYTE
END IF
idegotoline i
textlen = CVL(MID$(idet$, ideli, 4))
idet$ = LEFT$(idet$, ideli - 1) + RIGHT$(idet$, LEN(idet$) - ideli + 1 - 8 - textlen)
@ -7930,6 +8233,7 @@ SUB idefindagain (showFlags AS _BYTE)
IF idefindbackwards = 0 THEN idefindbackwards = 1 ELSE idefindbackwards = 0
idefindinvert = 0
END IF
idecentercurrentline
EXIT SUB
END IF
@ -8103,12 +8407,20 @@ SUB ideinsline (i, text$)
END IF
NEXT
IF vWatchOn THEN
REDIM _PRESERVE IdeBreakpoints(iden + 1) AS _BYTE
FOR b = iden + 1 TO i STEP -1
SWAP IdeBreakpoints(b), IdeBreakpoints(b - 1)
NEXT
IdeBreakpoints(i) = 0
REDIM _PRESERVE IdeSkipLines(iden + 1) AS _BYTE
FOR b = iden + 1 TO i STEP -1
SWAP IdeSkipLines(b), IdeSkipLines(b - 1)
NEXT
IdeSkipLines(i) = 0
END IF
text$ = RTRIM$(text$)
IF i = -1 THEN i = idel
@ -8676,6 +8988,7 @@ FUNCTION idefiledialog$(programname$, mode AS _BYTE)
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
REDIM IdeSkipLines(iden) AS _BYTE
callstacklist$ = "": callStackLength = 0
ideerror = 1
@ -9424,14 +9737,27 @@ SUB ideshowtext
DO WHILE l > UBOUND(IdeBreakpoints)
REDIM _PRESERVE IdeBreakpoints(UBOUND(IdeBreakpoints) + 100) AS _BYTE
LOOP
DO WHILE l > UBOUND(IdeSkipLines)
REDIM _PRESERVE IdeSkipLines(UBOUND(IdeSkipLines) + 100) AS _BYTE
LOOP
IF ShowLineNumbers THEN
IF ShowLineNumbersUseBG THEN COLOR , 6
IF vWatchOn = 1 AND IdeBreakpoints(l) <> 0 THEN COLOR , 4
IF vWatchOn = 1 AND IdeSkipLines(l) <> 0 THEN COLOR 14
_PRINTSTRING (2, y + 3), SPACE$(maxLineNumberLength)
IF l <= iden THEN
l2$ = STR$(l)
IF 2 + maxLineNumberLength - (LEN(l2$) + 1) >= 2 THEN
_PRINTSTRING (2 + maxLineNumberLength - (LEN(l2$) + 1), y + 3), l2$
IF vWatchOn THEN
IF IdeBreakpoints(l) <> 0 THEN
_PRINTSTRING (2, y + 3), CHR$(7)
ELSEIF IdeSkipLines(l) <> 0 THEN
_PRINTSTRING (2, y + 3), "!"
END IF
END IF
END IF
END IF
IF ShowLineNumbersSeparator THEN
@ -9449,13 +9775,16 @@ SUB ideshowtext
END IF
COLOR , 1
ELSE
IF vWatchOn = 1 AND IdeBreakpoints(l) <> 0 THEN
IF vWatchOn = 1 AND (IdeBreakpoints(l) <> 0 OR IdeSkipLines(l) <> 0) THEN
COLOR 7, 4
IF l = debugnextline THEN
COLOR 10
_PRINTSTRING (1, y + 3), CHR$(16)
ELSEIF IdeSkipLines(l) <> 0 THEN
COLOR 14, 1
_PRINTSTRING (1, y + 3), "!"
ELSE
_PRINTSTRING (1, y + 3), CHR$(179)
_PRINTSTRING (1, y + 3), CHR$(7)
END IF
END IF
END IF
@ -10324,6 +10653,7 @@ FUNCTION idewarningbox
idegotobox_LastLineNum = warningLines(y)
AddQuickNavHistory
idecy = idegotobox_LastLineNum
idecentercurrentline
IF warningIncLines(y) > 0 THEN
warningInInclude = idecy
warningInIncludeLine = warningIncLines(y)
@ -11449,10 +11779,22 @@ SUB idegotobox
idegotobox_LastLineNum = v&
AddQuickNavHistory
idecy = v&
idecentercurrentline
ideselect = 0
END SUB
FUNCTION idegetlinenumberbox(title$, initialValue&)
a2$ = str2$(initialValue&)
IF a2$ = "0" THEN a2$ = ""
v$ = ideinputbox$(title$, "#Line", a2$, "0123456789", 30, 8)
IF v$ = "" THEN EXIT FUNCTION
v& = VAL(v$)
IF v& < 1 THEN v& = 1
IF v& > iden THEN v& = iden
idegetlinenumberbox = v&
END FUNCTION
@ -14079,6 +14421,36 @@ SUB IdeMakeContextualMenu
m = idecontextualmenuID: i = 0
menu$(m, i) = "Contextual": i = i + 1
IF IdeDebugMode = 2 THEN
menu$(m, i) = "#Continue F5": i = i + 1
menuDesc$(m, i - 1) = "Runs until the end of the current procedure is reached"
menu$(m, i) = "Step O#ut F6": i = i + 1
menuDesc$(m, i - 1) = "Runs until the end of the current procedure is reached"
menu$(m, i) = "Step #Over F7": i = i + 1
menuDesc$(m, i - 1) = "Runs the next line of code without entering subs/functions"
menu$(m, i) = "Ste#p Into F8": i = i + 1
menuDesc$(m, i - 1) = "Runs the next line of code and pauses execution"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "Set #Next Line Ctrl+G": i = i + 1
menuDesc$(m, i - 1) = "Jumps to the selected line before continuing execution"
menu$(m, i) = "#Run To This Line Ctrl+Shift+G": i = i + 1
menuDesc$(m, i - 1) = "Runs until the selected line is reached"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "Toggle #Breakpoint F9": i = i + 1
menuDesc$(m, i - 1) = "Sets/clears breakpoint at cursor location"
menu$(m, i) = "Clear All Breakpoints F10": i = i + 1
menuDesc$(m, i - 1) = "Removes all breakpoints"
menu$(m, i) = "Toggle #Skip Line Ctrl+P": i = i + 1
menuDesc$(m, i - 1) = "Sets/clears flag to skip line"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "SUBs... F2": i = i + 1
menuDesc$(m, i - 1) = "Displays a list of SUB/FUNCTION procedures"
menu$(m, i) = "Call Stack... F4": i = i + 1
menuDesc$(m, i - 1) = "Displays the call stack of the current program's execution"
menu$(m, i) = "-": i = i + 1
menu$(m, i) = "#Exit $DEBUG mode ESC": i = i + 1
menuDesc$(m, i - 1) = "Disconnects from the running program and returns control to the IDE"
ELSE
IF IdeSystem = 1 OR IdeSystem = 2 THEN
'Figure out if the user wants to search for a selected term
Selection$ = getSelectedText$(0)
@ -14325,6 +14697,7 @@ SUB IdeMakeContextualMenu
menu$(m, i) = "Clo#se Help ESC": i = i + 1
menuDesc$(m, i - 1) = "Closes help window"
END IF
END IF
menusize(m) = i - 1
END SUB
@ -14529,7 +14902,6 @@ SUB ideupdatehelpbox
i = 0
w2 = LEN(titlestr$) + 4
IF w < w2 THEN w = w2
IF w < buttonsLen THEN w = buttonsLen
IF w > idewx - 4 THEN w = idewx - 4
idepar p, 60, 6, "Update Help"

2
source/ide/wiki/wiki_methods.bas
View file

@ -174,7 +174,7 @@ SUB Help_NewLine
IF Help_Pos > help_w THEN help_w = Help_Pos
Help_Txt_Len = Help_Txt_Len + 1: ASC(Help_Txt$, Help_Txt_Len) = 13
Help_Txt_Len = Help_Txt_Len + 1: ASC(Help_Txt$, Help_Txt_Len) = col + Help_BG_Col * 16
Help_Txt_Len = Help_Txt_Len + 1: ASC(Help_Txt$, Help_Txt_Len) = Help_BG_Col * 16
Help_Txt_Len = Help_Txt_Len + 1: ASC(Help_Txt$, Help_Txt_Len) = 0
Help_Txt_Len = Help_Txt_Len + 1: ASC(Help_Txt$, Help_Txt_Len) = 0

309
source/qb64.bas
View file

@ -27,6 +27,7 @@ REDIM SHARED PP_TypeMod(0) AS STRING, PP_ConvertedMod(0) AS STRING 'Prepass Name
Set_OrderOfOperations
DIM SHARED vWatchOn, vWatchRecompileAttempts, vWatchDesiredState, vWatchErrorCall$
DIM SHARED vWatchNewVariable$
vWatchErrorCall$ = "if (stop_program) {*__LONG_VWATCH_LINENUMBER=0; SUB_VWATCH((ptrszint*)vwatch_local_vars);};if(new_error){bkp_new_error=new_error;new_error=0;*__LONG_VWATCH_LINENUMBER=-1; SUB_VWATCH((ptrszint*)vwatch_local_vars);new_error=bkp_new_error;};"
DIM SHARED qb64prefix_set_recompileAttempts, qb64prefix_set_desiredState
@ -778,6 +779,8 @@ DIM SHARED findidinternal AS LONG
DIM SHARED currentid AS LONG 'is the index of the last ID accessed
DIM SHARED linenumber AS LONG, reallinenumber AS LONG, totallinenumber AS LONG, definingtypeerror AS LONG
DIM SHARED wholeline AS STRING
DIM SHARED firstLineNumberLabelvWatch AS LONG, lastLineNumberLabelvWatch AS LONG
DIM SHARED vWatchUsedLabels AS STRING
DIM SHARED linefragment AS STRING
'COMMON SHARED bitmask() AS _INTEGER64
'COMMON SHARED bitmaskinv() AS _INTEGER64
@ -1455,6 +1458,8 @@ duplicateConstWarning = 0
emptySCWarning = 0
warningListItems = 0
lastWarningHeader = ""
vWatchUsedLabels = SPACE$(1000)
firstLineNumberLabelvWatch = 0
REDIM SHARED warning$(1000)
REDIM SHARED warningLines(1000) AS LONG
REDIM SHARED warningIncLines(1000) AS LONG
@ -5278,18 +5283,7 @@ DO
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
IF vWatchOn = 1 THEN
totalLocalVariables = 0
localVariablesList$ = ""
FOR i = 1 TO totalVariablesCreated
IF usedVariableList(i).scope = subfuncn THEN
totalLocalVariables = totalLocalVariables + 1
localVariablesList$ = localVariablesList$ + "vwatch_local_vars[" + str2$(totalLocalVariables - 1) + "] = &" + usedVariableList(i).cname + ";" + CRLF
END IF
NEXT
IF totalLocalVariables > 0 THEN
PRINT #13, "void *vwatch_local_vars["; totalLocalVariables; "];"
PRINT #13, localVariablesList$
END IF
vWatchVariable "", 1
END IF
staticarraylist = "": staticarraylistn = 0 'remove previously listed arrays
@ -5297,9 +5291,45 @@ DO
PRINT #12, "exit_subfunc:;"
IF vWatchOn = 1 THEN
IF NoChecks = 0 THEN
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars);"
vWatchAddLabel linenumber, 0
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
vWatchAddLabel 0, -1
END IF
PRINT #12, "*__LONG_VWATCH_SUBLEVEL=*__LONG_VWATCH_SUBLEVEL- 1 ;"
IF subfunc <> "SUB_VWATCH" AND firstLineNumberLabelvWatch > 0 THEN
PRINT #12, "goto VWATCH_SKIPSETNEXTLINE;"
PRINT #12, "VWATCH_SETNEXTLINE:;"
PRINT #12, "switch (*__LONG_VWATCH_GOTO) {"
FOR i = firstLineNumberLabelvWatch TO lastLineNumberLabelvWatch
WHILE i > LEN(vWatchUsedLabels)
vWatchUsedLabels = vWatchUsedLabels + SPACE$(1000)
WEND
IF ASC(vWatchUsedLabels, i) = 1 THEN
PRINT #12, " case " + str2$(i) + ":"
PRINT #12, " goto VWATCH_LABEL_" + str2$(i) + ";"
PRINT #12, " break;"
END IF
NEXT
PRINT #12, " default:"
PRINT #12, " *__LONG_VWATCH_GOTO=*__LONG_VWATCH_LINENUMBER;"
PRINT #12, " goto VWATCH_SETNEXTLINE;"
PRINT #12, "}"
PRINT #12, "VWATCH_SKIPLINE:;"
PRINT #12, "switch (*__LONG_VWATCH_GOTO) {"
FOR i = firstLineNumberLabelvWatch TO lastLineNumberLabelvWatch
IF ASC(vWatchUsedLabels, i) = 1 THEN
PRINT #12, " case -" + str2$(i) + ":"
PRINT #12, " goto VWATCH_SKIPLABEL_" + str2$(i) + ";"
PRINT #12, " break;"
END IF
NEXT
PRINT #12, "}"
PRINT #12, "VWATCH_SKIPSETNEXTLINE:;"
END IF
firstLineNumberLabelvWatch = 0
END IF
'release _MEM lock for this scope
@ -5528,6 +5558,10 @@ DO
IF controltype(controllevel) <> 2 THEN a$ = "NEXT without FOR": GOTO errmes
IF n <> 1 AND controlvalue(controllevel) <> currentid THEN a$ = "Incorrect variable after NEXT": GOTO errmes
PRINT #12, "fornext_continue_" + str2$(controlid(controllevel)) + ":;"
IF vWatchOn = 1 AND inclinenumber(inclevel) = 0 AND NoChecks = 0 THEN
vWatchAddLabel linenumber, 0
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
END IF
PRINT #12, "}"
PRINT #12, "fornext_exit_" + str2$(controlid(controllevel)) + ":;"
controllevel = controllevel - 1
@ -5575,7 +5609,8 @@ DO
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 vWatchOn = 1 THEN
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars);"
vWatchAddLabel linenumber, 0
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
END IF
PRINT #12, "while((" + e$ + ")||new_error){"
ELSE
@ -5634,13 +5669,15 @@ DO
IF (typ AND ISSTRING) THEN a$ = "DO ERROR! Cannot accept a STRING type.": GOTO errmes
IF whileuntil = 1 THEN PRINT #12, "while((" + e$ + ")||new_error){" ELSE PRINT #12, "while((!(" + e$ + "))||new_error){"
IF NoChecks = 0 AND vWatchOn = 1 THEN
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars);"
vWatchAddLabel linenumber, 0
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
END IF
controltype(controllevel) = 4
ELSE
controltype(controllevel) = 3
IF vWatchOn = 1 AND inclinenumber(inclevel) = 0 AND NoChecks = 0 THEN
PRINT #12, "do{*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars);"
vWatchAddLabel linenumber, 0
PRINT #12, "do{*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
ELSE
PRINT #12, "do{"
END IF
@ -5674,14 +5711,16 @@ DO
IF (typ AND ISSTRING) THEN a$ = "LOOP ERROR! Cannot accept a STRING type.": GOTO errmes
PRINT #12, "dl_continue_" + str2$(controlid(controllevel)) + ":;"
IF NoChecks = 0 AND vWatchOn = 1 THEN
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars);"
vWatchAddLabel linenumber, 0
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
END IF
IF whileuntil = 1 THEN PRINT #12, "}while((" + e$ + ")&&(!new_error));" ELSE PRINT #12, "}while((!(" + e$ + "))&&(!new_error));"
ELSE
PRINT #12, "dl_continue_" + str2$(controlid(controllevel)) + ":;"
IF NoChecks = 0 AND vWatchOn = 1 THEN
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars);"
vWatchAddLabel linenumber, 0
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
END IF
IF controltype(controllevel) = 4 THEN
@ -5834,7 +5873,8 @@ DO
IF Error_Happened THEN GOTO errmes
IF NoChecks = 0 AND vWatchOn = 1 THEN
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars);"
vWatchAddLabel linenumber, 0
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
END IF
PRINT #12, "fornext_step" + u$ + "=" + e$ + ";"
@ -5921,7 +5961,8 @@ DO
IF NoChecks = 0 THEN
PRINT #12, "S_" + str2$(statementn) + ":;": dynscope = 1
IF vWatchOn = 1 AND inclinenumber(inclevel) = 0 THEN
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars);"
vWatchAddLabel linenumber, 0
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
END IF
END IF
FOR i = controllevel TO 1 STEP -1
@ -5962,7 +6003,8 @@ DO
IF NoChecks = 0 THEN
PRINT #12, "S_" + str2$(statementn) + ":;": dynscope = 1
IF vWatchOn = 1 AND inclinenumber(inclevel) = 0 THEN
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars);"
vWatchAddLabel linenumber, 0
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
END IF
END IF
@ -6043,6 +6085,11 @@ DO
IF LEN(layout$) = 0 THEN layout$ = l$ ELSE layout$ = layout$ + sp + l$
END IF
IF vWatchOn = 1 AND inclinenumber(inclevel) = 0 THEN
vWatchAddLabel linenumber, 0
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
END IF
PRINT #12, "}"
FOR i = 1 TO controlvalue(controllevel)
PRINT #12, "}"
@ -6060,7 +6107,8 @@ DO
IF NoChecks = 0 THEN
PRINT #12, "S_" + str2$(statementn) + ":;": dynscope = 1
IF vWatchOn = 1 AND inclinenumber(inclevel) = 0 THEN
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars);"
vWatchAddLabel linenumber, 0
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
END IF
END IF
@ -6180,9 +6228,15 @@ DO
controllevel = controllevel - 1
IF EveryCaseSet(SelectCaseCounter) THEN PRINT #12, "} /* End of SELECT EVERYCASE ELSE */"
END IF
PRINT #12, "sc_" + str2$(controlid(controllevel)) + "_end:;"
IF controltype(controllevel) < 10 OR controltype(controllevel) > 17 THEN a$ = "END SELECT without SELECT CASE": GOTO errmes
IF vWatchOn = 1 AND inclinenumber(inclevel) = 0 THEN
vWatchAddLabel linenumber, 0
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
END IF
IF SelectCaseCounter > 0 AND SelectCaseHasCaseBlock(SelectCaseCounter) = 0 THEN
'warn user of empty SELECT CASE block
IF NOT IgnoreWarnings THEN
@ -6298,7 +6352,8 @@ DO
IF NoChecks = 0 THEN
PRINT #12, "S_" + str2$(statementn) + ":;": dynscope = 1
IF vWatchOn = 1 AND inclinenumber(inclevel) = 0 THEN
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars);"
vWatchAddLabel linenumber, 0
PRINT #12, "*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
END IF
END IF
@ -6486,7 +6541,8 @@ DO
IF NoChecks = 0 THEN
IF vWatchOn = 1 AND inclinenumber(inclevel) = 0 THEN
PRINT #12, "do{*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars);"
vWatchAddLabel linenumber, 0
PRINT #12, "do{*__LONG_VWATCH_LINENUMBER= " + str2$(linenumber) + "; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
ELSE
PRINT #12, "do{"
END IF
@ -7467,6 +7523,7 @@ DO
IF optionexplicit THEN a$ = "Variable '" + n$ + "' (" + symbol2fulltypename$(typ$) + ") not defined": GOTO errmes
bypassNextVariable = -1
retval = dim2(n$, typ$, method, "")
manageVariableList "", vWatchNewVariable$, 2
IF Error_Happened THEN GOTO errmes
'note: variable created!
@ -8833,7 +8890,8 @@ DO
IF vWatchOn = 1 THEN
PRINT #12, "*__LONG_VWATCH_LINENUMBER= 0; SUB_VWATCH((ptrszint*)vwatch_local_vars);"
vWatchAddLabel linenumber, 0
PRINT #12, "*__LONG_VWATCH_LINENUMBER= 0; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
END IF
PRINT #12, "if (sub_gl_called) error(271);"
PRINT #12, "close_program=1;"
@ -8856,7 +8914,8 @@ DO
END IF
layoutdone = 1: IF LEN(layout$) THEN layout$ = layout$ + sp + l$ ELSE layout$ = l$
IF vWatchOn = 1 AND NoChecks = 0 THEN
PRINT #12, "*__LONG_VWATCH_LINENUMBER=-3; SUB_VWATCH((ptrszint*)vwatch_local_vars);"
vWatchAddLabel linenumber, 0
PRINT #12, "*__LONG_VWATCH_LINENUMBER=-3; SUB_VWATCH((ptrszint*)vwatch_local_vars); if (*__LONG_VWATCH_GOTO>0) goto VWATCH_SETNEXTLINE; if (*__LONG_VWATCH_GOTO<0) goto VWATCH_SKIPLINE;"
ELSE
PRINT #12, "close_program=1;"
PRINT #12, "end();"
@ -11652,18 +11711,7 @@ END IF
CLOSE #fh
IF vWatchOn = 1 THEN
totalLocalVariables = 0
localVariablesList$ = ""
FOR i = 1 TO totalVariablesCreated
IF usedVariableList(i).scope = 0 THEN
totalLocalVariables = totalLocalVariables + 1
localVariablesList$ = localVariablesList$ + "vwatch_local_vars[" + str2$(totalLocalVariables - 1) + "] = &" + usedVariableList(i).cname + ";" + CRLF
END IF
NEXT
IF totalLocalVariables > 0 THEN
PRINT #13, "void *vwatch_local_vars["; totalLocalVariables; "];"
PRINT #13, localVariablesList$
END IF
vWatchVariable "", 1
END IF
@ -14009,7 +14057,7 @@ END FUNCTION
FUNCTION arrayreference$ (indexes$, typ)
arrayprocessinghappened = 1
'*returns an array reference: idnumber CHR$(179) index$
'*returns an array reference: idnumber | index$
'*does not take into consideration the type of the array
'*expects array id to be passed in the global id structure
@ -14146,18 +14194,128 @@ SUB clearid
id = cleariddata
END SUB
SUB vWatchVariable (this$, action AS _BYTE)
STATIC totalLocalVariables AS LONG, localVariablesList$
STATIC totalMainModuleVariables AS LONG, mainModuleVariablesList$
STATIC exclusions$
IF LEN(exclusions$) = 0 THEN
exclusions$ = "@__LONG_VWATCH_LINENUMBER@__LONG_VWATCH_SUBLEVEL@__LONG_VWATCH_GOTO@" + _
"@__STRING_VWATCH_SUBNAME@__STRING_VWATCH_CALLSTACK@__ARRAY_BYTE_VWATCH_BREAKPOINTS" + _
"@__ARRAY_BYTE_VWATCH_SKIPLINES@"
END IF
SELECT CASE action
CASE 0 'add
IF INSTR(exclusions$, "@" + this$ + "@") > 0 OR LEFT$(this$, 12) = "_SUB_VWATCH_" THEN
EXIT SUB
END IF
vWatchNewVariable$ = this$
IF subfunc = "" THEN
totalMainModuleVariables = totalMainModuleVariables + 1
mainModuleVariablesList$ = mainModuleVariablesList$ + "vwatch_local_vars[" + str2$(totalMainModuleVariables - 1) + "] = &" + this$ + ";" + CRLF
ELSE
totalLocalVariables = totalLocalVariables + 1
localVariablesList$ = localVariablesList$ + "vwatch_local_vars[" + str2$(totalLocalVariables - 1) + "] = &" + this$ + ";" + CRLF
END IF
manageVariableList RTRIM$(id.cn), this$, 0
CASE 1 'dump to data[].txt & reset
IF subfunc = "" THEN
IF totalMainModuleVariables > 0 THEN
PRINT #13, "void *vwatch_local_vars["; totalMainModuleVariables; "];"
PRINT #13, mainModuleVariablesList$
ELSE
PRINT #13, "void *vwatch_local_vars[0];"
END IF
mainModuleVariablesList$ = ""
totalMainModuleVariables = 0
ELSE
IF totalLocalVariables > 0 THEN
PRINT #13, "void *vwatch_local_vars["; totalLocalVariables; "];"
PRINT #13, localVariablesList$
ELSE
PRINT #13, "void *vwatch_local_vars[0];"
END IF
localVariablesList$ = ""
totalLocalVariables = 0
END IF
END SELECT
END SUB
SUB vWatchAddLabel (this AS LONG, lastLine AS _BYTE)
STATIC prevLabel AS LONG, prevSkip AS LONG
IF lastLine = 0 THEN
WHILE this > LEN(vWatchUsedLabels)
vWatchUsedLabels = vWatchUsedLabels + SPACE$(1000)
WEND
IF firstLineNumberLabelvWatch = 0 THEN
firstLineNumberLabelvWatch = this
ELSE
IF prevSkip <> prevLabel THEN
PRINT #12, "VWATCH_SKIPLABEL_" + str2$(prevLabel) + ":;"
prevSkip = prevLabel
END IF
END IF
IF prevLabel <> this THEN
ASC(vWatchUsedLabels, this) = 1
PRINT #12, "VWATCH_LABEL_" + str2$(this) + ":;"
prevLabel = this
lastLineNumberLabelvWatch = this
END IF
ELSE
IF prevSkip <> prevLabel THEN
PRINT #12, "VWATCH_SKIPLABEL_" + str2$(prevLabel) + ":;"
prevSkip = prevLabel
END IF
END IF
END SUB
SUB closemain
xend
PRINT #12, "return;"
IF vWatchOn AND firstLineNumberLabelvWatch > 0 THEN
PRINT #12, "VWATCH_SETNEXTLINE:;"
PRINT #12, "switch (*__LONG_VWATCH_GOTO) {"
FOR i = firstLineNumberLabelvWatch TO lastLineNumberLabelvWatch
IF ASC(vWatchUsedLabels, i) = 1 THEN
PRINT #12, " case " + str2$(i) + ":"
PRINT #12, " goto VWATCH_LABEL_" + str2$(i) + ";"
PRINT #12, " break;"
END IF
NEXT
PRINT #12, " default:"
PRINT #12, " *__LONG_VWATCH_GOTO=*__LONG_VWATCH_LINENUMBER;"
PRINT #12, " goto VWATCH_SETNEXTLINE;"
PRINT #12, "}"
PRINT #12, "VWATCH_SKIPLINE:;"
PRINT #12, "switch (*__LONG_VWATCH_GOTO) {"
FOR i = firstLineNumberLabelvWatch TO lastLineNumberLabelvWatch
IF ASC(vWatchUsedLabels, i) = 1 THEN
PRINT #12, " case -" + str2$(i) + ":"
PRINT #12, " goto VWATCH_SKIPLABEL_" + str2$(i) + ";"
PRINT #12, " break;"
END IF
NEXT
PRINT #12, "}"
END IF
PRINT #12, "}"
PRINT #15, "}" 'end case
PRINT #15, "}"
PRINT #15, "error(3);" 'no valid return possible
closedmain = 1
firstLineNumberLabelvWatch = 0
END SUB
FUNCTION countelements (a$)
@ -14284,6 +14442,7 @@ FUNCTION dim2 (varname$, typ2$, method, elements$)
id.arrayelements = nume
id.callname = n$
regid
vWatchVariable n$, 0
IF Error_Happened THEN EXIT FUNCTION
GOTO dim2exitfunc
END IF
@ -14321,6 +14480,7 @@ FUNCTION dim2 (varname$, typ2$, method, elements$)
END IF
END IF
regid
vWatchVariable n$, 0
IF Error_Happened THEN EXIT FUNCTION
GOTO dim2exitfunc
END IF
@ -14487,6 +14647,7 @@ FUNCTION dim2 (varname$, typ2$, method, elements$)
id.musthave = "$" + str2(bytes)
END IF
regid
vWatchVariable n$, 0
IF Error_Happened THEN EXIT FUNCTION
GOTO dim2exitfunc
END IF
@ -14577,6 +14738,7 @@ FUNCTION dim2 (varname$, typ2$, method, elements$)
id.musthave = "$"
END IF
regid
vWatchVariable n$, 0
IF Error_Happened THEN EXIT FUNCTION
GOTO dim2exitfunc
END IF
@ -14680,6 +14842,7 @@ FUNCTION dim2 (varname$, typ2$, method, elements$)
IF unsgn THEN id.musthave = "~`" + str2(bits) ELSE id.musthave = "`" + str2(bits)
END IF
regid
vWatchVariable n$, 0
IF Error_Happened THEN EXIT FUNCTION
GOTO dim2exitfunc
END IF
@ -14765,6 +14928,7 @@ FUNCTION dim2 (varname$, typ2$, method, elements$)
IF unsgn THEN id.musthave = "~%%" ELSE id.musthave = "%%"
END IF
regid
vWatchVariable n$, 0
IF Error_Happened THEN EXIT FUNCTION
GOTO dim2exitfunc
END IF
@ -14847,6 +15011,7 @@ FUNCTION dim2 (varname$, typ2$, method, elements$)
IF unsgn THEN id.musthave = "~%" ELSE id.musthave = "%"
END IF
regid
vWatchVariable n$, 0
IF Error_Happened THEN EXIT FUNCTION
GOTO dim2exitfunc
END IF
@ -14934,6 +15099,7 @@ FUNCTION dim2 (varname$, typ2$, method, elements$)
IF unsgn THEN id.musthave = "~%&" ELSE id.musthave = "%&"
END IF
regid
vWatchVariable n$, 0
IF Error_Happened THEN EXIT FUNCTION
GOTO dim2exitfunc
END IF
@ -15018,6 +15184,7 @@ FUNCTION dim2 (varname$, typ2$, method, elements$)
IF unsgn THEN id.musthave = "~&" ELSE id.musthave = "&"
END IF
regid
vWatchVariable n$, 0
IF Error_Happened THEN EXIT FUNCTION
GOTO dim2exitfunc
END IF
@ -15102,6 +15269,7 @@ FUNCTION dim2 (varname$, typ2$, method, elements$)
IF unsgn THEN id.musthave = "~&&" ELSE id.musthave = "&&"
END IF
regid
vWatchVariable n$, 0
IF Error_Happened THEN EXIT FUNCTION
GOTO dim2exitfunc
END IF
@ -15186,6 +15354,7 @@ FUNCTION dim2 (varname$, typ2$, method, elements$)
id.musthave = "!"
END IF
regid
vWatchVariable n$, 0
IF Error_Happened THEN EXIT FUNCTION
GOTO dim2exitfunc
END IF
@ -15268,6 +15437,7 @@ FUNCTION dim2 (varname$, typ2$, method, elements$)
id.musthave = "#"
END IF
regid
vWatchVariable n$, 0
IF Error_Happened THEN EXIT FUNCTION
GOTO dim2exitfunc
END IF
@ -15350,6 +15520,7 @@ FUNCTION dim2 (varname$, typ2$, method, elements$)
id.musthave = "##"
END IF
regid
vWatchVariable n$, 0
IF Error_Happened THEN EXIT FUNCTION
GOTO dim2exitfunc
END IF
@ -15357,9 +15528,6 @@ FUNCTION dim2 (varname$, typ2$, method, elements$)
Give_Error "Unknown type": EXIT FUNCTION
dim2exitfunc:
IF bypassNextVariable = 0 THEN
manageVariableList cvarname$, n$, 0
END IF
bypassNextVariable = 0
IF dimsfarray THEN
@ -15450,7 +15618,7 @@ FUNCTION udtreference$ (o$, a$, typ AS LONG)
GOTO udtfindelenext
END IF
'Change e reference to u CHR$(179) 0 reference?
'Change e reference to u | 0 reference?
IF udtetype(E) AND ISUDT THEN
u = udtetype(E) AND 511
E = 0
@ -15950,6 +16118,7 @@ FUNCTION evaluate$ (a2$, typ AS LONG)
IF optionexplicit THEN Give_Error "Variable '" + x$ + "' (" + symbol2fulltypename$(typ$) + ") not defined": EXIT FUNCTION
bypassNextVariable = -1
retval = dim2(x$, typ$, 1, "")
manageVariableList "", vWatchNewVariable$, 3
IF Error_Happened THEN EXIT FUNCTION
simplevarfound:
@ -18286,7 +18455,7 @@ FUNCTION findid& (n2$)
''' END IF 'safeguard
END IF
'optomizations for later comparisons
'optimizations for later comparisons
insf$ = subfunc + SPACE$(256 - LEN(subfunc))
secondarg$ = secondarg$ + SPACE$(256 - LEN(secondarg$))
IF LEN(sc$) THEN scpassed = 1: sc$ = sc$ + SPACE$(8 - LEN(sc$)) ELSE scpassed = 0
@ -18390,33 +18559,8 @@ FUNCTION findid& (n2$)
id = ids(i)
t = id.t
IF id.subfunc = 0 THEN
IF t = 0 THEN
t = id.arraytype
IF t AND ISUDT THEN
manageVariableList "", scope$ + "ARRAY_UDT_" + RTRIM$(id.n), 1
ELSE
n$ = id2shorttypename$
IF LEFT$(n$, 1) = "_" THEN
manageVariableList "", scope$ + "ARRAY" + n$ + "_" + RTRIM$(id.n), 2
ELSE
manageVariableList "", scope$ + "ARRAY_" + n$ + "_" + RTRIM$(id.n), 3
END IF
END IF
ELSE
IF t AND ISUDT THEN
manageVariableList "", scope$ + "UDT_" + RTRIM$(id.n), 4
ELSE
n$ = id2shorttypename$
IF LEFT$(n$, 1) = "_" THEN
'manageVariableList "", scope$ + MID$(n$, 2) + "_" + RTRIM$(id.n), 5
ELSE
manageVariableList "", scope$ + n$ + "_" + RTRIM$(id.n), 6
END IF
END IF
END IF
END IF
temp$ = refer$(str2$(i), t, 1)
manageVariableList "", temp$, 1
currentid = i
EXIT FUNCTION
@ -19617,7 +19761,7 @@ FUNCTION isvalidvariable (a$)
NEXT
isvalidvariable = 1
IF i > n THEN EXIT FUNCTION
IF i > n THEN EXIT FUNCTION 'i is always greater than n because n is undefined here. Why didn't I remove this line and the ones below it, which will never run? Cause I'm a coward. F.h.
e$ = RIGHT$(a$, LEN(a$) - i - 1)
IF e$ = "%%" OR e$ = "~%%" THEN EXIT FUNCTION
IF e$ = "%" OR e$ = "~%" THEN EXIT FUNCTION
@ -21952,7 +22096,6 @@ SUB setrefer (a2$, typ2 AS LONG, e2$, method AS LONG)
directudt:
IF u <> u2 OR e2 <> 0 THEN Give_Error "Expected = similar user defined type": EXIT SUB
dst$ = "((char*)" + lhsscope$ + n$ + ")+(" + o$ + ")"
copy_full_udt dst$, src$, 12, 0, u
'print "setFULLUDTrefer!"
@ -21989,7 +22132,6 @@ SUB setrefer (a2$, typ2 AS LONG, e2$, method AS LONG)
'print "setUDTrefer:"+r$,e$
tlayout$ = tl$
IF LEFT$(r$, 1) = "*" THEN r$ = MID$(r$, 2)
manageVariableList "", scope$ + n$, 7
EXIT SUB
END IF
@ -22024,7 +22166,6 @@ SUB setrefer (a2$, typ2 AS LONG, e2$, method AS LONG)
PRINT #12, cleanupstringprocessingcall$ + "0);"
tlayout$ = tl$
IF LEFT$(r$, 1) = "*" THEN r$ = MID$(r$, 2)
manageVariableList "", r$, 8
EXIT SUB
END IF
@ -22100,7 +22241,6 @@ SUB setrefer (a2$, typ2 AS LONG, e2$, method AS LONG)
IF arrayprocessinghappened THEN arrayprocessinghappened = 0
tlayout$ = tl$
IF LEFT$(r$, 1) = "*" THEN r$ = MID$(r$, 2)
manageVariableList "", r$, 9
EXIT SUB
END IF
@ -22132,7 +22272,6 @@ SUB setrefer (a2$, typ2 AS LONG, e2$, method AS LONG)
IF arrayprocessinghappened THEN arrayprocessinghappened = 0
tlayout$ = tl$
IF LEFT$(r$, 1) = "*" THEN r$ = MID$(r$, 2)
manageVariableList "", r$, 10
EXIT SUB
END IF
@ -22161,8 +22300,6 @@ SUB setrefer (a2$, typ2 AS LONG, e2$, method AS LONG)
tlayout$ = tl$
IF LEFT$(r$, 1) = "*" THEN r$ = MID$(r$, 2)
manageVariableList "", r$, 11
EXIT SUB
END IF 'variable
@ -22206,7 +22343,7 @@ FUNCTION typ2ctyp$ (t AS LONG, tstr AS STRING)
IF b = 16 THEN ctyp$ = "int16"
IF b = 32 THEN ctyp$ = "int32"
IF b = 64 THEN ctyp$ = "int64"
IF typ AND ISOFFSET THEN ctyp$ = "ptrszint"
IF t AND ISOFFSET THEN ctyp$ = "ptrszint"
IF (t AND ISUNSIGNED) THEN ctyp$ = "u" + ctyp$
END IF
IF t AND ISOFFSET THEN
@ -22617,6 +22754,7 @@ END FUNCTION
SUB xend
IF vWatchOn = 1 THEN
vWatchAddLabel 0, -1
PRINT #12, "*__LONG_VWATCH_LINENUMBER= 0; SUB_VWATCH((ptrszint*)vwatch_local_vars);"
END IF
PRINT #12, "sub_end();"
@ -25712,8 +25850,9 @@ SUB dump_udts
CLOSE #f
END SUB
SUB manageVariableList (name$, __cname$, action AS _BYTE)
DIM findItem AS LONG, cname$, i AS LONG
SUB manageVariableList (__name$, __cname$, action AS _BYTE)
DIM findItem AS LONG, cname$, i AS LONG, name$
name$ = __name$
cname$ = __cname$
IF LEN(cname$) = 0 THEN EXIT SUB
@ -25748,15 +25887,13 @@ SUB manageVariableList (name$, __cname$, action AS _BYTE)
END IF
usedVariableList(i).scope = subfuncn
usedVariableList(i).cname = cname$
IF LEN(RTRIM$(id.musthave)) > 0 THEN name$ = name$ + RTRIM$(id.musthave)
usedVariableList(i).name = name$
totalVariablesCreated = totalVariablesCreated + 1
END IF
CASE ELSE 'find and mark as used
IF found THEN
usedVariableList(i).used = -1
ELSE
manageVariableList name$, __cname$, 0
manageVariableList name$, __cname$, 12
END IF
END SELECT
END SUB

5
source/utilities/vwatch/vwatch.bi
View file

@ -1,11 +1,14 @@
$CHECKING:OFF
DIM SHARED AS LONG vwatch_linenumber, vwatch_sublevel
DIM SHARED AS LONG vwatch_linenumber, vwatch_sublevel, vwatch_goto
DIM SHARED AS STRING vwatch_subname, vwatch_callstack
REDIM SHARED vwatch_breakpoints(0) AS _BYTE
REDIM SHARED vwatch_skiplines(0) AS _BYTE
'next lines are just to avoid "unused variable" warnings:
vwatch_linenumber = 0
vwatch_sublevel = 0
vwatch_goto = 0
vwatch_breakpoints(0) = 0
vwatch_skiplines(0) = 0
vwatch_subname = ""
vwatch_callstack = ""
$CHECKING:ON

103
source/utilities/vwatch/vwatch.bm
View file

@ -1,9 +1,9 @@
$CHECKING:OFF
SUB vwatch (localVariables AS _OFFSET)
STATIC AS LONG ide, breakpointCount, timeout, startLevel, lastLine
STATIC AS LONG callStackLength
STATIC AS _BYTE pauseMode, stepOver, bypass
STATIC AS LONG ideHost, breakpointCount, skipCount, timeout, startLevel, lastLine
STATIC AS LONG callStackLength, runToLine
STATIC AS _BYTE pauseMode, stepOver, bypass, setNextLine
STATIC buffer$, endc$
DIM AS LONG i
DIM AS _OFFSET address
@ -17,7 +17,9 @@ SUB vwatch (localVariables AS _OFFSET)
IF bypass THEN EXIT SUB
IF ide = 0 THEN
vwatch_goto = 0
IF ideHost = 0 THEN
timeout = 10
endc$ = "<END>"
@ -33,19 +35,20 @@ SUB vwatch (localVariables AS _OFFSET)
SELECT CASE cmd$
CASE "vwatch"
IF value$ <> "ok" THEN
CLOSE #ide
CLOSE #ideHost
bypass = -1
EXIT SUB
END IF
CASE "line count"
REDIM vwatch_breakpoints(CVL(value$)) AS _BYTE
REDIM vwatch_skiplines(CVL(value$)) AS _BYTE
CASE "breakpoint count"
breakpointCount = CVL(value$)
CASE "breakpoint list"
IF LEN(value$) \ 4 <> breakpointCount THEN
cmd$ = "quit:Communication error."
GOSUB SendCommand
CLOSE #ide
CLOSE #ideHost
bypass = -1
EXIT SUB
END IF
@ -53,6 +56,20 @@ SUB vwatch (localVariables AS _OFFSET)
temp$ = MID$(value$, i * 4 - 3, 4)
vwatch_breakpoints(CVL(temp$)) = -1
NEXT
CASE "skip count"
skipCount = CVL(value$)
CASE "skip list"
IF LEN(value$) \ 4 <> skipCount THEN
cmd$ = "quit:Communication error."
GOSUB SendCommand
CLOSE #ideHost
bypass = -1
EXIT SUB
END IF
FOR i = 1 TO skipCount
temp$ = MID$(value$, i * 4 - 3, 4)
vwatch_skiplines(CVL(temp$)) = -1
NEXT
CASE "run"
IF vwatch_breakpoints(vwatch_linenumber) THEN EXIT DO
pauseMode = 0
@ -65,18 +82,16 @@ SUB vwatch (localVariables AS _OFFSET)
END IF
IF vwatch_linenumber = 0 THEN
cmd$ = "call stack size:" + MKL$(callStackLength)
GOSUB SendCommand
cmd$ = "call stack:" + vwatch_callstack
GOSUB SendCommand
GOSUB SendCallStack
cmd$ = "quit:Program ended."
GOSUB SendCommand
CLOSE #ide
CLOSE #ideHost
bypass = -1
ide = 0
ideHost = 0
EXIT SUB
ELSEIF vwatch_linenumber = -1 THEN
'report an error in the most recent line
GOSUB SendCallStack
cmd$ = "error:" + MKL$(lastLine)
GOSUB SendCommand
EXIT SUB
@ -97,7 +112,8 @@ SUB vwatch (localVariables AS _OFFSET)
EXIT SUB
END IF
IF vwatch_linenumber = lastLine THEN EXIT SUB
IF vwatch_linenumber = lastLine AND setNextLine = 0 THEN EXIT SUB
setNextLine = 0
lastLine = vwatch_linenumber
GOSUB GetCommand
@ -105,15 +121,24 @@ SUB vwatch (localVariables AS _OFFSET)
CASE "break"
pauseMode = -1
stepOver = 0
runToLine = 0
cmd$ = ""
CASE "set breakpoint"
vwatch_breakpoints(CVL(value$)) = -1
vwatch_skiplines(CVL(value$)) = 0
CASE "clear breakpoint"
vwatch_breakpoints(CVL(value$)) = 0
CASE "set skip line"
vwatch_skiplines(CVL(value$)) = -1
vwatch_breakpoints(CVL(value$)) = 0
CASE "clear skip line"
vwatch_skiplines(CVL(value$)) = 0
CASE "clear all breakpoints"
REDIM vwatch_breakpoints(UBOUND(vwatch_breakpoints)) AS _BYTE
END SELECT
IF vwatch_skiplines(vwatch_linenumber) THEN vwatch_goto = -vwatch_linenumber: EXIT SUB
IF stepOver = -1 AND vwatch_sublevel > startLevel AND vwatch_breakpoints(vwatch_linenumber) = 0 THEN
EXIT SUB
ELSEIF stepOver = -1 AND vwatch_sublevel = startLevel THEN
@ -121,6 +146,13 @@ SUB vwatch (localVariables AS _OFFSET)
pauseMode = -1
END IF
IF runToLine > 0 AND runToLine <> vwatch_linenumber THEN
EXIT SUB
ELSEIF runToLine > 0 AND runToLine = vwatch_linenumber THEN
pauseMode = -1
runToLine = 0
END IF
IF vwatch_breakpoints(vwatch_linenumber) = 0 AND pauseMode = 0 THEN
EXIT SUB
END IF
@ -138,6 +170,12 @@ SUB vwatch (localVariables AS _OFFSET)
stepOver = 0
vwatch_starttimers
EXIT SUB
CASE "run to line"
pauseMode = 0
stepOver = 0
runToLine = CVL(value$)
vwatch_starttimers
EXIT SUB
CASE "step"
pauseMode = -1
stepOver = 0
@ -155,27 +193,36 @@ SUB vwatch (localVariables AS _OFFSET)
vwatch_starttimers
EXIT SUB
CASE "free"
CLOSE #ide
ide = 0
CLOSE #ideHost
ideHost = 0
bypass = -1
vwatch_starttimers
EXIT SUB
CASE "set breakpoint"
vwatch_breakpoints(CVL(value$)) = -1
vwatch_skiplines(CVL(value$)) = 0
CASE "clear breakpoint"
vwatch_breakpoints(CVL(value$)) = 0
CASE "clear all breakpoints"
REDIM vwatch_breakpoints(UBOUND(vwatch_breakpoints)) AS _BYTE
CASE "call stack"
'send call stack history"
cmd$ = "call stack size:" + MKL$(callStackLength)
GOSUB SendCommand
cmd$ = "call stack:" + vwatch_callstack
GOSUB SendCommand
GOSUB SendCallStack
CASE "local"
i = CVL(value$)
address = localVariables + LEN(address) * i
PRINT "Local"; i; "is at"; _MEMGET(m, address, _OFFSET)
CASE "set next line"
pauseMode = -1
stepOver = 0
setNextLine = -1
vwatch_goto = CVL(value$)
EXIT SUB
CASE "set skip line"
vwatch_skiplines(CVL(value$)) = -1
vwatch_breakpoints(CVL(value$)) = 0
CASE "clear skip line"
vwatch_skiplines(CVL(value$)) = 0
END SELECT
GOSUB GetCommand
@ -186,20 +233,21 @@ SUB vwatch (localVariables AS _OFFSET)
EXIT SUB
Connect:
DIM ideport$
ideport$ = ENVIRON$("QB64DEBUGPORT")
IF ideport$ = "" THEN bypass = -1: EXIT SUB
start! = TIMER
DO
k& = _KEYHIT
ide = _OPENCLIENT("TCP/IP:" + ideport$ + ":localhost")
ideHost = _OPENCLIENT("TCP/IP:" + ideport$ + ":localhost")
_LIMIT 30
LOOP UNTIL k& = 27 OR ide <> 0 OR TIMER - start! > timeout
IF ide = 0 THEN bypass = -1: EXIT SUB
LOOP UNTIL k& = 27 OR ideHost <> 0 OR TIMER - start! > timeout
IF ideHost = 0 THEN bypass = -1: EXIT SUB
RETURN
GetCommand:
GET #ide, , temp$
GET #ideHost, , temp$
buffer$ = buffer$ + temp$
IF INSTR(buffer$, endc$) THEN
@ -217,9 +265,16 @@ SUB vwatch (localVariables AS _OFFSET)
END IF
RETURN
SendCallStack:
cmd$ = "call stack size:" + MKL$(callStackLength)
GOSUB SendCommand
cmd$ = "call stack:" + vwatch_callstack
GOSUB SendCommand
RETURN
SendCommand:
cmd$ = cmd$ + endc$
PUT #ide, , cmd$
PUT #ideHost, , cmd$
cmd$ = ""
RETURN
END SUB