QB64-PE/internal/support/vwatch/vwatch.bm

$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