$CHECKING:OFF SUB vwatch (globalVariables AS _OFFSET, localVariables AS _OFFSET) STATIC AS LONG vw_ideHost, vw_breakpointCount, vw_skipCount, vw_timeout, vw_startLevel, vw_lastLine STATIC AS LONG vw_runToLine STATIC AS _BYTE vw_pauseMode, vw_stepOver, vw_bypass, vw_setNextLine STATIC AS _OFFSET vw_idehwnd STATIC vw_buffer$, vw_endc$ DIM AS LONG vw_i, vw_tempIndex, vw_localIndex, vw_varSize, vw_sequence DIM AS _OFFSET vw_address DIM AS _MEM vw_m, vw_m2 DIM vw_start!, vw_temp$, vw_cmd$, vw_value$, vw_k&, vw_buf$, vw_scope$ DECLARE LIBRARY SUB vwatch_stoptimers ALIAS stop_timers SUB vwatch_starttimers ALIAS start_timers SUB unlockvWatchHandle SUB set_qbs_size (target AS _OFFSET, BYVAL length&) FUNCTION stop_program_state& END DECLARE $IF WIN THEN DECLARE DYNAMIC LIBRARY "user32" FUNCTION SetForegroundWindow& (BYVAL hWnd AS _OFFSET) END DECLARE $END IF IF vw_bypass THEN EXIT SUB vwatch_goto = 0 IF vw_ideHost = 0 THEN vw_timeout = 10 vw_endc$ = "" 'initial setup GOSUB Connect 'send this binary's path/exe name vw_cmd$ = "me:" + COMMAND$(0) GOSUB SendCommand vw_cmd$ = "hwnd:" + _MK$(_OFFSET, _WINDOWHANDLE) GOSUB SendCommand DO GOSUB GetCommand SELECT CASE vw_cmd$ CASE "vwatch" IF vw_value$ <> "ok" THEN unlockvWatchHandle: CLOSE #vw_ideHost vw_bypass = -1 EXIT SUB END IF CASE "line count" REDIM vwatch_breakpoints(CVL(vw_value$)) AS _BYTE REDIM vwatch_skiplines(CVL(vw_value$)) AS _BYTE CASE "breakpoint count" vw_breakpointCount = CVL(vw_value$) CASE "breakpoint list" IF LEN(vw_value$) \ 4 <> vw_breakpointCount THEN vw_cmd$ = "quit:Communication error." GOSUB SendCommand unlockvWatchHandle: CLOSE #vw_ideHost vw_bypass = -1 EXIT SUB END IF FOR vw_i = 1 TO vw_breakpointCount vw_temp$ = MID$(vw_value$, vw_i * 4 - 3, 4) vwatch_breakpoints(CVL(vw_temp$)) = -1 NEXT CASE "hwnd" vw_idehwnd = _CV(_OFFSET, vw_value$) CASE "skip count" vw_skipCount = CVL(vw_value$) CASE "skip list" IF LEN(vw_value$) \ 4 <> vw_skipCount THEN vw_cmd$ = "quit:Communication error." GOSUB SendCommand unlockvWatchHandle: CLOSE #vw_ideHost vw_bypass = -1 EXIT SUB END IF FOR vw_i = 1 TO vw_skipCount vw_temp$ = MID$(vw_value$, vw_i * 4 - 3, 4) vwatch_skiplines(CVL(vw_temp$)) = -1 NEXT CASE "run" IF vwatch_breakpoints(vwatch_linenumber) THEN EXIT DO vw_pauseMode = 0 EXIT SUB CASE "break" vw_pauseMode = -1 EXIT DO END SELECT LOOP END IF IF vwatch_linenumber = 0 THEN GOSUB SendCallStack vw_cmd$ = "quit:Program ended." GOSUB SendCommand unlockvWatchHandle: CLOSE #vw_ideHost vw_bypass = -1 vw_ideHost = 0 EXIT SUB ELSEIF vwatch_linenumber = -1 THEN 'report an error in the most recent line GOSUB SendCallStack vw_cmd$ = "error:" + MKL$(vw_lastLine) GOSUB SendCommand EXIT SUB ELSEIF vwatch_linenumber = -2 THEN 'report a new sub/function has been "entered" IF vwatch_sublevel > UBOUND(vwatch_stack) THEN REDIM _PRESERVE vwatch_stack(UBOUND(vwatch_stack) + 1000) AS STRING END IF vwatch_stack(vwatch_sublevel) = vwatch_internalsubname$ + "," + vwatch_subname$ + ", line" + STR$(vw_lastLine) EXIT SUB ELSEIF vwatch_linenumber = -3 THEN 'handle STOP - instead of quitting, pause execution vw_pauseMode = -1 vw_stepOver = 0 EXIT SUB END IF IF vwatch_linenumber = vw_lastLine AND vw_setNextLine = 0 THEN EXIT SUB vw_setNextLine = 0 vw_lastLine = vwatch_linenumber GOSUB GetCommand SELECT CASE vw_cmd$ CASE "break" vw_pauseMode = -1 vw_stepOver = 0 vw_runToLine = 0 vw_cmd$ = "" CASE "set breakpoint" vwatch_breakpoints(CVL(vw_value$)) = -1 vwatch_skiplines(CVL(vw_value$)) = 0 CASE "clear breakpoint" vwatch_breakpoints(CVL(vw_value$)) = 0 CASE "set skip line" vwatch_skiplines(CVL(vw_value$)) = -1 vwatch_breakpoints(CVL(vw_value$)) = 0 CASE "clear skip line" vwatch_skiplines(CVL(vw_value$)) = 0 CASE "clear all breakpoints" REDIM vwatch_breakpoints(UBOUND(vwatch_breakpoints)) AS _BYTE CASE "clear all skips" REDIM vwatch_skiplines(UBOUND(vwatch_skiplines)) AS _BYTE END SELECT IF vwatch_skiplines(vwatch_linenumber) THEN vwatch_goto = -vwatch_linenumber: EXIT SUB IF vw_stepOver = -1 AND vwatch_sublevel > vw_startLevel AND vwatch_breakpoints(vwatch_linenumber) = 0 THEN EXIT SUB ELSEIF vw_stepOver = -1 AND vwatch_sublevel = vw_startLevel THEN vw_stepOver = 0 vw_pauseMode = -1 END IF IF vw_runToLine > 0 AND vw_runToLine <> vwatch_linenumber THEN EXIT SUB ELSEIF vw_runToLine > 0 AND vw_runToLine = vwatch_linenumber THEN vw_pauseMode = -1 vw_runToLine = 0 END IF IF vwatch_breakpoints(vwatch_linenumber) = 0 AND vw_pauseMode = 0 THEN EXIT SUB END IF vwatch_stoptimers vw_cmd$ = "line number:" IF vwatch_breakpoints(vwatch_linenumber) THEN vw_cmd$ = "breakpoint:" vw_cmd$ = vw_cmd$ + MKL$(vwatch_linenumber) GOSUB SendCommand vw_cmd$ = "current sub:" + LEFT$(vwatch_stack(vwatch_sublevel), INSTR(vwatch_stack(vwatch_sublevel), ",") - 1) GOSUB SendCommand $IF WIN THEN vw_i = SetForegroundWindow&(vw_idehwnd) $END IF DO 'main loop IF stop_program_state& THEN vw_bypass = -1: EXIT DO SELECT CASE vw_cmd$ CASE "run" vw_pauseMode = 0 vw_stepOver = 0 vwatch_starttimers EXIT SUB CASE "run to line" vw_pauseMode = 0 vw_stepOver = 0 vw_runToLine = CVL(vw_value$) vwatch_starttimers EXIT SUB CASE "step" vw_pauseMode = -1 vw_stepOver = 0 EXIT SUB CASE "step over" vw_pauseMode = -1 vw_stepOver = -1 vw_startLevel = vwatch_sublevel vwatch_starttimers EXIT SUB CASE "step out" vw_pauseMode = -1 vw_stepOver = -1 vw_startLevel = vwatch_sublevel - 1 vwatch_starttimers EXIT SUB CASE "free" unlockvWatchHandle: CLOSE #vw_ideHost vw_ideHost = 0 vw_bypass = -1 vwatch_starttimers EXIT SUB CASE "set breakpoint" vwatch_breakpoints(CVL(vw_value$)) = -1 vwatch_skiplines(CVL(vw_value$)) = 0 CASE "clear breakpoint" vwatch_breakpoints(CVL(vw_value$)) = 0 CASE "clear all breakpoints" REDIM vwatch_breakpoints(UBOUND(vwatch_breakpoints)) AS _BYTE CASE "clear all skips" REDIM vwatch_skiplines(UBOUND(vwatch_skiplines)) AS _BYTE CASE "call stack" 'send call stack history GOSUB SendCallStack CASE "global var", "local var" vw_tempIndex = CVL(LEFT$(vw_value$, 4)) vw_localIndex = CVL(MID$(vw_value$, 5, 4)) vw_scope$ = MID$(vw_value$, 9) IF vw_cmd$ = "global var" THEN vw_address = _OFFSET(globalVariables) + LEN(vw_address) * vw_localIndex ELSE IF vw_scope$ = LEFT$(vwatch_stack(vwatch_sublevel), INSTR(vwatch_stack(vwatch_sublevel), ",") - 1) THEN vw_address = _OFFSET(localVariables) + LEN(vw_address) * vw_localIndex ELSE GOTO cmdProcessingDone END IF END IF vw_address = _MEMGET(vw_m, vw_address, _OFFSET) 'first resolve pass vw_address = _MEMGET(vw_m, vw_address, _OFFSET) 'second resolve pass vw_cmd$ = vw_cmd$ + ":" + MKL$(vw_tempIndex) + _MK$(_OFFSET, vw_address) GOSUB SendCommand CASE "get address" vw_tempIndex = CVL(LEFT$(vw_value$, 4)) vw_sequence = CVI(MID$(vw_value$, 5, 2)) vw_varSize = CVL(MID$(vw_value$, 7, 4)) vw_address = _CV(_OFFSET, MID$(vw_value$, 11, LEN(vw_address))) vw_buf$ = SPACE$(vw_varSize) vw_m = _MEM(vw_address, vw_varSize) vw_m2 = _MEM(_OFFSET(vw_buf$), vw_varSize) _MEMCOPY vw_m, vw_m.OFFSET, vw_m.SIZE TO vw_m2, vw_m2.OFFSET vw_cmd$ = "address read:" + MKL$(vw_tempIndex) + MKI$(vw_sequence) + vw_buf$ GOSUB SendCommand CASE "set global address", "set local address" vw_localIndex = CVL(LEFT$(vw_value$, 4)) vw_varSize = CVL(MID$(vw_value$, 5, 4)) vw_value$ = RIGHT$(vw_value$, vw_varSize) IF vw_cmd$ = "set global address" THEN vw_address = _OFFSET(globalVariables) + LEN(vw_address) * vw_localIndex ELSE vw_address = _OFFSET(localVariables) + LEN(vw_address) * vw_localIndex END IF vw_address = _MEMGET(vw_m, vw_address, _OFFSET) 'first resolve pass vw_address = _MEMGET(vw_m, vw_address, _OFFSET) 'second resolve pass 'vw_address now points to the actual data vw_m = _MEM(vw_address, vw_varSize) _MEMPUT vw_m, vw_m.OFFSET, vw_value$ CASE "set global string", "set local string" vw_localIndex = CVL(LEFT$(vw_value$, 4)) vw_varSize = CVL(MID$(vw_value$, 5, 4)) vw_value$ = RIGHT$(vw_value$, vw_varSize) IF vw_cmd$ = "set global string" THEN vw_address = _OFFSET(globalVariables) + LEN(vw_address) * vw_localIndex ELSE vw_address = _OFFSET(localVariables) + LEN(vw_address) * vw_localIndex END IF vw_address = _MEMGET(vw_m, vw_address, _OFFSET) 'first resolve pass vw_address = _MEMGET(vw_m, vw_address, _OFFSET) 'second resolve pass 'vw_address now points to the qbs struct set_qbs_size vw_address, vw_varSize vw_varSize = LEN(vw_address) + LEN(vw_varSize) vw_buf$ = SPACE$(vw_varSize) vw_m = _MEM(vw_address, vw_varSize) vw_m2 = _MEM(_OFFSET(vw_buf$), vw_varSize) _MEMCOPY vw_m, vw_m.OFFSET, vw_m.SIZE TO vw_m2, vw_m2.OFFSET vw_address = _CV(_OFFSET, LEFT$(vw_buf$, LEN(vw_address))) 'pointer to actual data vw_varSize = CVL(MID$(vw_buf$, LEN(vw_address) + 1)) IF vw_varSize < LEN(vw_value$) THEN vw_value$ = LEFT$(vw_value$, vw_varSize) END IF vw_m = _MEM(vw_address, vw_varSize) _MEMPUT vw_m, vw_m.OFFSET, vw_value$ CASE "current sub" vw_cmd$ = "current sub:" + LEFT$(vwatch_stack(vwatch_sublevel), INSTR(vwatch_stack(vwatch_sublevel), ",") - 1) GOSUB SendCommand CASE "set next line" vw_pauseMode = -1 vw_stepOver = 0 vw_setNextLine = -1 vwatch_goto = CVL(vw_value$) EXIT SUB CASE "set skip line" vwatch_skiplines(CVL(vw_value$)) = -1 vwatch_breakpoints(CVL(vw_value$)) = 0 CASE "clear skip line" vwatch_skiplines(CVL(vw_value$)) = 0 END SELECT cmdProcessingDone: GOSUB GetCommand _LIMIT 100 LOOP vwatch_starttimers EXIT SUB Connect: DIM vw_ideport$ vw_ideport$ = ENVIRON$("QB64DEBUGPORT") IF vw_ideport$ = "" THEN vw_bypass = -1: EXIT SUB vw_start! = TIMER DO vw_k& = _KEYHIT vw_ideHost = _OPENCLIENT("QB64IDE:" + vw_ideport$ + ":localhost") _LIMIT 30 LOOP UNTIL vw_k& = 27 OR vw_ideHost <> 0 OR TIMER - vw_start! > vw_timeout IF vw_ideHost = 0 THEN vw_bypass = -1: EXIT SUB RETURN GetCommand: GET #vw_ideHost, , vw_temp$ vw_buffer$ = vw_buffer$ + vw_temp$ IF INSTR(vw_buffer$, vw_endc$) THEN vw_cmd$ = LEFT$(vw_buffer$, INSTR(vw_buffer$, vw_endc$) - 1) vw_buffer$ = MID$(vw_buffer$, INSTR(vw_buffer$, vw_endc$) + LEN(vw_endc$)) IF INSTR(vw_cmd$, ":") THEN vw_value$ = MID$(vw_cmd$, INSTR(vw_cmd$, ":") + 1) vw_cmd$ = LEFT$(vw_cmd$, INSTR(vw_cmd$, ":") - 1) ELSE vw_value$ = "" END IF ELSE vw_cmd$ = "": vw_value$ = "" END IF RETURN SendCallStack: IF vwatch_sublevel - 1 > 0 THEN vwatch_callstack = MID$(vwatch_stack(2), INSTR(vwatch_stack(2), ",") + 1) FOR vw_i = 3 TO vwatch_sublevel vwatch_callstack = vwatch_callstack + CHR$(0) + MID$(vwatch_stack(vw_i), INSTR(vwatch_stack(vw_i), ",") + 1) NEXT ELSE vwatch_callstack = "" END IF vw_cmd$ = "call stack size:" + MKL$(vwatch_sublevel - 1) GOSUB SendCommand vw_cmd$ = "call stack:" + vwatch_callstack GOSUB SendCommand RETURN SendCommand: vw_cmd$ = vw_cmd$ + vw_endc$ PUT #vw_ideHost, , vw_cmd$ vw_cmd$ = "" RETURN END SUB