$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, vw_arrayIndex STATIC AS _BYTE vw_pauseMode, vw_stepOver, vw_bypass, vw_setNextLine, vw_hwndsent STATIC AS _OFFSET vw_idehwnd STATIC vw_buffer$ DIM AS LONG vw_i, vw_tempIndex, vw_localIndex, vw_varSize, vw_cmdsize DIM AS LONG vw_arrayelementsize, vw_element, vw_elementoffset, vw_storage DIM AS _OFFSET vw_address, vw_lbound, vw_ubound DIM AS _MEM vw_m, vw_m2 DIM AS _BYTE vw_isarray DIM vw_start!, vw_temp$, vw_cmd$, vw_value$, vw_k&, vw_buf$, vw_scope$, vw_varType$ DIM vw_dummy%& 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& FUNCTION check_lbound%& (array AS _OFFSET) FUNCTION check_ubound%& (array AS _OFFSET) 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 'initial setup GOSUB Connect 'send this binary's path/exe name vw_cmd$ = "me:" + COMMAND$(0) GOSUB SendCommand IF _WINDOWHANDLE THEN vw_hwndsent = -1 vw_cmd$ = "hwnd:" + _MK$(_OFFSET, _WINDOWHANDLE) GOSUB SendCommand END IF 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 vw_hwndsent = 0 THEN IF _WINDOWHANDLE > 0 THEN vw_hwndsent = -1 vw_cmd$ = "hwnd:" + _MK$(_OFFSET, _WINDOWHANDLE) GOSUB SendCommand END IF 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 ELSEIF vwatch_linenumber = -4 THEN 'handle INPUT/LINE INPUT - tell the IDE we'll be hanging for a while vw_cmd$ = "enter input:" + MKL$(vw_lastLine) GOSUB SendCommand EXIT SUB ELSEIF vwatch_linenumber = -5 THEN 'handle end of INPUT/LINE INPUT - tell the IDE we're moving on vw_cmd$ = "leave input" GOSUB SendCommand 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 "get global var", "get local var" vw_tempIndex = CVL(LEFT$(vw_value$, 4)) vw_isarray = _CV(_BYTE, MID$(vw_value$, 5, 1)) vw_localIndex = CVL(MID$(vw_value$, 6, 4)) vw_arrayIndex = CVL(MID$(vw_value$, 10, 4)) vw_arrayelementsize = CVL(MID$(vw_value$, 14, 4)) vw_element = CVL(MID$(vw_value$, 18, 4)) vw_elementoffset = CVL(MID$(vw_value$, 22, 4)) vw_varSize = CVL(MID$(vw_value$, 26, 4)) IF vw_varSize = 0 THEN GOTO cmdProcessingDone vw_storage = CVL(MID$(vw_value$, 30, 4)) vw_i = CVI(MID$(vw_value$, 34, 2)) IF vw_i THEN vw_scope$ = MID$(vw_value$, 36, vw_i) vw_i = CVI(MID$(vw_value$, 36 + vw_i, 2)) vw_varType$ = RIGHT$(vw_value$, vw_i) ELSE vw_i = CVI(MID$(vw_value$, 36, 2)) vw_varType$ = RIGHT$(vw_value$, vw_i) END IF IF vw_cmd$ = "get 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 IF vw_isarray THEN vw_lbound = check_lbound%&(vw_address) vw_ubound = check_ubound%&(vw_address) IF vw_arrayIndex < vw_lbound OR vw_arrayIndex > vw_ubound THEN GOTO cmdProcessingDone END IF 'get the address of where this array's data is stored vw_buf$ = SPACE$(LEN(vw_dummy%&)) vw_m = _MEM(vw_address, LEN(vw_dummy%&)) vw_m2 = _MEM(_OFFSET(vw_buf$), LEN(vw_dummy%&)) _MEMCOPY vw_m, vw_m.OFFSET, vw_m.SIZE TO vw_m2, vw_m2.OFFSET IF LEN(vw_dummy%&) = 8 THEN vw_address = _CV(_INTEGER64, vw_buf$) 'Pointer to data ELSE vw_address = _CV(LONG, vw_buf$) 'Pointer to data END IF 'vw_address now points to the actual data 'find the required element for this array IF INSTR(vw_varType$, "STRING *") THEN vw_varSize = VAL(MID$(vw_varType$, _INSTRREV(vw_varType$, " ") + 1)) ELSEIF vw_varType$ = "STRING" THEN vw_varSize = LEN(vw_dummy%&) END IF 'this is where we calculate the actual element position in memory IF vw_arrayelementsize = 0 THEN vw_address = vw_address + ((vw_arrayIndex - vw_lbound) * vw_varSize) ELSE vw_address = vw_address + ((vw_arrayIndex - vw_lbound) * vw_arrayelementsize) END IF END IF 'vw_address now points to the actual data vw_address = vw_address + vw_elementoffset 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 IF INSTR(vw_varType$, "STRING *") > 0 AND (vw_isarray <> 0 OR vw_elementoffset > 0) THEN 'actual data already fetched; nothing else to do ELSEIF INSTR(vw_varType$, "STRING") THEN IF vw_isarray <> 0 OR vw_elementoffset > 0 THEN 'First pass vw_varSize = LEN(vw_dummy%&) 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 IF LEN(vw_dummy%&) = 8 THEN vw_address = _CV(_INTEGER64, vw_buf$) 'Pointer to data ELSE vw_address = _CV(LONG, vw_buf$) 'Pointer to data END IF 'Second pass vw_varSize = LEN(vw_dummy%&) + 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 END IF 'vw_buf$ now contains a pointer to the string data 'as well as the number of bytes we have to read IF LEN(vw_dummy%&) = 8 THEN vw_address = _CV(_INTEGER64, LEFT$(vw_buf$, 8)) 'Pointer to data vw_varSize = CVL(MID$(vw_buf$, 9)) ELSE vw_address = _CV(LONG, LEFT$(vw_buf$, 4)) 'Pointer to data vw_varSize = CVL(MID$(vw_buf$, 5)) END IF 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 END IF vw_cmd$ = "address read:" + MKL$(vw_tempIndex) + MKL$(vw_arrayIndex) + MKL$(vw_element) + MKL$(vw_storage) + 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 LEN(vw_buffer$) >= 4 THEN vw_cmdsize = CVL(LEFT$(vw_buffer$, 4)) ELSE vw_cmdsize = 0 IF vw_cmdsize > 0 AND LEN(vw_buffer$) >= vw_cmdsize THEN vw_cmd$ = MID$(vw_buffer$, 5, vw_cmdsize) vw_buffer$ = MID$(vw_buffer$, 5 + vw_cmdsize) 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$ = MKL$(LEN(vw_cmd$)) + vw_cmd$ PUT #vw_ideHost, , vw_cmd$ vw_cmd$ = "" RETURN END SUB