QB64/QB64-PE
QB64/QB64-PE
1
1
Fork 0
mirror of https://github.com/QB64-Phoenix-Edition/QB64pe.git synced 2024-07-06 00:00:22 +00:00
Code Issues Releases Wiki Activity
QB64-PE/internal/support/vwatch/vwatch.bm
Fellippe Heitor 7bad19cb94 Update vwatch.bm so qb64.bas can be debugged
2022-02-22 23:39:00 -03:00

882 lines
40 KiB
Plaintext
Raw Blame History

$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_originalVarLineNumber
STATIC AS _BYTE vw_pauseMode, vw_stepOver, vw_bypass, vw_setNextLine, vw_hwndSent
STATIC AS _OFFSET vw_ideHwnd
STATIC vw_buffer$, vw_globalWatchpoints$, vw_localWatchpoints$, vw_lastWatchpoint$
DIM AS LONG vw_i, vw_j, vw_tempIndex, vw_localIndex, vw_varSize, vw_cmdSize
DIM AS LONG vw_arrayElementSize, vw_element, vw_elementOffset, vw_storage, vw_blockSize
DIM AS LONG vw_arrayDimension, vw_arrayTotalDimensions, vw_arrayIndex, vw_realArrayIndex
DIM AS LONG vw_wpi, vw_wpj
DIM AS _INTEGER64 vw_tempBitValue
DIM AS _OFFSET vw_address, vw_lBound, vw_uBound
DIM AS _MEM vw_m, vw_m2
DIM AS _BYTE vw_isArray, vw_isUDT, vw_checkingWatchpoints
DIM vw_start!, vw_temp$, vw_cmd$, vw_value$, vw_k&, vw_buf$, vw_scope$, vw_varType$
DIM vw_getBytes&, vw_getBytesPosition&, vw_valueBytes$, vw_dummy%&, vw_dummy##
DIM vw_arrayIndexes$, vw_wpExpression$, vw_wpTemp$, vw_v1$, vw_v2$, vw_op$
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&)
SUB call_setbits (BYVAL bsize AS _UNSIGNED LONG, array AS _OFFSET, BYVAL index AS _OFFSET, BYVAL value AS _INTEGER64)
SUB set_fg ALIAS set_foreground_window (BYVAL hwnd AS _OFFSET)
FUNCTION stop_program_state&
FUNCTION check_lbound%& (array AS _OFFSET, BYVAL index AS LONG, BYVAL num_indexes AS LONG)
FUNCTION check_ubound%& (array AS _OFFSET, BYVAL index AS LONG, BYVAL num_indexes AS LONG)
FUNCTION call_getubits~&& (BYVAL bsize AS _UNSIGNED LONG, array AS _OFFSET, BYVAL index AS _OFFSET)
FUNCTION call_getbits&& (BYVAL bsize AS _UNSIGNED LONG, array AS _OFFSET, BYVAL index AS _OFFSET)
END DECLARE
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
set_fg vw_ideHwnd
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 LEN(vw_globalWatchpoints$) > 0 OR LEN(vw_localWatchpoints$) > 0 THEN
vw_checkingWatchpoints = -1
GOSUB CheckWatchpoints
IF vw_checkingWatchpoints = 2 THEN
vw_checkingWatchpoints = 0
vw_pauseMode = -1
vw_stepOver = 0
vw_runToLine = 0
vw_cmd$ = "watchpoint:" + MKL$(vw_tempIndex) + MKL$(LEN(vw_arrayIndexes$)) + vw_arrayIndexes$ + MKL$(vw_elementOffset) + MKI$(LEN(vw_wpExpression$)) + vw_wpExpression$
GOTO breakReached
END IF
END IF
vw_checkingWatchpoints = 0
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
vw_cmd$ = "line number:"
IF vwatch_breakpoints(vwatch_linenumber) THEN vw_cmd$ = "breakpoint:"
breakReached:
vwatch_stoptimers
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
set_fg vw_ideHwnd
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
_KEYCLEAR: vwatch_starttimers
EXIT SUB
CASE "run to line"
vw_pauseMode = 0
vw_stepOver = 0
vw_runToLine = CVL(vw_value$)
_KEYCLEAR: 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
_KEYCLEAR: vwatch_starttimers
EXIT SUB
CASE "step out"
vw_pauseMode = -1
vw_stepOver = -1
vw_startLevel = vwatch_sublevel - 1
_KEYCLEAR: vwatch_starttimers
EXIT SUB
CASE "free"
unlockvWatchHandle: CLOSE #vw_ideHost
vw_ideHost = 0
vw_bypass = -1
_KEYCLEAR: 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"
getGlobalLocal:
vw_getBytes& = 4: GOSUB GetBytes: vw_tempIndex = CVL(vw_valueBytes$)
vw_getBytes& = 1: GOSUB GetBytes: vw_isArray = _CV(_BYTE, vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_originalVarLineNumber = CVL(vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_localIndex = CVL(vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_arrayTotalDimensions = CVL(vw_valueBytes$)
vw_getBytes& = vw_arrayTotalDimensions: GOSUB GetBytes: vw_arrayIndexes$ = vw_valueBytes$
vw_arrayTotalDimensions = vw_arrayTotalDimensions \ 4
vw_getBytes& = 4: GOSUB GetBytes: vw_arrayElementSize = CVL(vw_valueBytes$)
IF vw_checkingWatchpoints THEN
vw_getBytes& = 4: GOSUB GetBytes: vw_isUDT = (CVL(vw_valueBytes$) <> 0)
ELSE
vw_isUDT = 0
END IF
vw_getBytes& = 4: GOSUB GetBytes: vw_element = CVL(vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_elementOffset = CVL(vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_varSize = CVL(vw_valueBytes$)
IF vw_varSize = 0 THEN
IF vw_checkingWatchpoints THEN RETURN
GOTO cmdProcessingDone
END IF
vw_getBytes& = 4: GOSUB GetBytes: vw_storage = CVL(vw_valueBytes$)
vw_getBytes& = 2: GOSUB GetBytes: vw_i = CVI(vw_valueBytes$)
IF vw_i THEN
vw_getBytes& = vw_i: GOSUB GetBytes: vw_scope$ = vw_valueBytes$
END IF
vw_getBytes& = 2: GOSUB GetBytes: vw_i = CVI(vw_valueBytes$)
vw_getBytes& = vw_i: GOSUB GetBytes: vw_varType$ = vw_valueBytes$
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
IF vw_checkingWatchpoints THEN vw_varType$ = "": RETURN
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
IF vw_originalVarLineNumber > 0 THEN
'prevent fetching array data before DIM line
IF vwatch_linenumber <= vw_originalVarLineNumber THEN
IF vw_checkingWatchpoints THEN vw_varType$ = "": RETURN
GOTO cmdProcessingDone
END IF
END IF
vw_realArrayIndex = 0
vw_blockSize = 1
FOR vw_arrayDimension = 1 TO vw_arrayTotalDimensions
vw_lBound = check_lbound%&(vw_address, vw_arrayDimension, vw_arrayTotalDimensions)
vw_uBound = check_ubound%&(vw_address, vw_arrayDimension, vw_arrayTotalDimensions)
vw_arrayIndex = CVL(MID$(vw_arrayIndexes$, vw_arrayDimension * 4 - 3, 4))
IF vw_arrayIndex < vw_lBound OR vw_arrayIndex > vw_uBound THEN
IF vw_checkingWatchpoints THEN vw_varType$ = "": RETURN
GOTO cmdProcessingDone
END IF
vw_arrayIndex = (vw_arrayIndex - VAL(STR$(vw_lBound))) * vw_blockSize
vw_realArrayIndex = vw_realArrayIndex + vw_arrayIndex
vw_blockSize = vw_blockSize * VAL(STR$(vw_uBound - vw_lBound + 1))
NEXT
'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%&)
ELSEIF INSTR(vw_varType$, "FLOAT") > 0 THEN
vw_varSize = 16 'long double...
END IF
IF INSTR(vw_varType$, "BIT") THEN
vw_i = INSTR(vw_varType$, "*")
IF vw_i > 0 THEN
vw_i = VAL(MID$(vw_varType$, vw_i + 1))
ELSE
vw_i = 1
END IF
IF INSTR(vw_varType$, "UNSIGNED") THEN
vw_buf$ = _MK$(_UNSIGNED _INTEGER64, call_getubits~&&(vw_i, vw_address, vw_realArrayIndex))
ELSE
vw_buf$ = _MK$(_INTEGER64, call_getbits&&(vw_i, vw_address, vw_realArrayIndex))
END IF
IF vw_checkingWatchpoints THEN RETURN
vw_cmd$ = "address read:" + MKL$(vw_tempIndex) + MKL$(vw_arrayIndex) + MKL$(vw_element) + MKL$(vw_storage) + vw_buf$
GOSUB SendCommand
GOTO cmdProcessingDone
ELSE
'this is where we calculate the actual array index position in memory
IF vw_arrayElementSize = 0 THEN
vw_address = vw_address + (vw_realArrayIndex * vw_varSize)
ELSE
vw_address = vw_address + (vw_realArrayIndex * vw_arrayElementSize)
END IF
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_element > 0 OR vw_isUDT <> 0) THEN
'actual data already fetched; nothing else to do
ELSEIF INSTR(vw_varType$, "STRING") > 0 THEN
IF vw_isArray <> 0 OR vw_element > 0 OR vw_isUDT <> 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
ELSEIF INSTR(vw_varType$, "FLOAT") > 0 THEN
vw_buf$ = vw_buf$ + STRING$(16, 0) 'pad with zeroes...
END IF
IF vw_checkingWatchpoints THEN RETURN
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_getBytes& = 4: GOSUB GetBytes: vw_tempIndex = CVL(vw_valueBytes$)
vw_getBytes& = 1: GOSUB GetBytes: vw_isArray = _CV(_BYTE, vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_originalVarLineNumber = CVL(vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_localIndex = CVL(vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_arrayTotalDimensions = CVL(vw_valueBytes$)
vw_getBytes& = vw_arrayTotalDimensions: GOSUB GetBytes: vw_arrayIndexes$ = vw_valueBytes$
vw_arrayTotalDimensions = vw_arrayTotalDimensions \ 4
vw_getBytes& = 4: GOSUB GetBytes: vw_arrayElementSize = CVL(vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_isUDT = (CVL(vw_valueBytes$) <> 0)
vw_getBytes& = 4: GOSUB GetBytes: vw_element = CVL(vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_elementOffset = CVL(vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_varSize = CVL(vw_valueBytes$)
IF vw_varSize = 0 THEN GOTO cmdProcessingDone
vw_getBytes& = 4: GOSUB GetBytes: vw_storage = CVL(vw_valueBytes$)
vw_getBytes& = 2: GOSUB GetBytes: vw_i = CVI(vw_valueBytes$)
IF vw_i THEN
vw_getBytes& = vw_i: GOSUB GetBytes: vw_scope$ = vw_valueBytes$
END IF
vw_getBytes& = 2: GOSUB GetBytes: vw_i = CVI(vw_valueBytes$)
vw_getBytes& = vw_i: GOSUB GetBytes: vw_varType$ = vw_valueBytes$
vw_getBytes& = 2: GOSUB GetBytes: vw_i = CVI(vw_valueBytes$)
vw_getBytes& = vw_i: GOSUB GetBytes: vw_value$ = vw_valueBytes$
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
'--------
IF vw_isArray THEN
vw_realArrayIndex = 0
vw_blockSize = 1
FOR vw_arrayDimension = 1 TO vw_arrayTotalDimensions
vw_lBound = check_lbound%&(vw_address, vw_arrayDimension, vw_arrayTotalDimensions)
vw_uBound = check_ubound%&(vw_address, vw_arrayDimension, vw_arrayTotalDimensions)
vw_arrayIndex = CVL(MID$(vw_arrayIndexes$, vw_arrayDimension * 4 - 3, 4))
IF vw_arrayIndex < vw_lBound OR vw_arrayIndex > vw_uBound THEN
GOTO cmdProcessingDone
END IF
vw_arrayIndex = (vw_arrayIndex - VAL(STR$(vw_lBound))) * vw_blockSize
vw_realArrayIndex = vw_realArrayIndex + vw_arrayIndex
vw_blockSize = vw_blockSize * VAL(STR$(vw_uBound - vw_lBound + 1))
NEXT
'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%&)
ELSEIF INSTR(vw_varType$, "FLOAT") > 0 THEN
vw_varSize = 16 'long double...
vw_value$ = LEFT$(vw_value$, vw_varSize)
END IF
IF INSTR(vw_varType$, "BIT") THEN
vw_i = INSTR(vw_varType$, "*")
IF vw_i > 0 THEN
vw_i = VAL(MID$(vw_varType$, vw_i + 1))
ELSE
vw_i = 1
END IF
vw_buf$ = vw_value$ + STRING$(4, 0) 'pad with zeroes in case a LONG was sent
GOSUB GetV2
vw_tempBitValue = VAL(vw_v2$)
call_setbits vw_i, vw_address, vw_realArrayIndex, vw_tempBitValue
GOTO cmdProcessingDone
ELSE
'this is where we calculate the actual array index position in memory
IF vw_arrayElementSize = 0 THEN
vw_address = vw_address + (vw_realArrayIndex * vw_varSize)
ELSE
vw_address = vw_address + (vw_realArrayIndex * vw_arrayElementSize)
END IF
END IF
ELSE
IF vw_isUDT = 0 THEN
IF INSTR(vw_varType$, "STRING") = 0 THEN
'numeric variables need no further dereferencing
GOTO setAddress
ELSE
setString:
'vw_address now points to the qbs struct
set_qbs_size vw_address, LEN(vw_value$)
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
GOTO setAddress
END IF
END IF
END IF
'if it's a UDT, move the pointer to this element's offset
vw_address = vw_address + vw_elementOffset
IF INSTR(vw_varType$, "STRING *") > 0 AND (vw_isArray <> 0 OR vw_isUDT <> 0) THEN
vw_value$ = LEFT$(vw_value$ + SPACE$(vw_varSize), vw_varSize)
ELSEIF INSTR(vw_varType$, "STRING") > 0 THEN
IF vw_isArray <> 0 OR vw_isUDT <> 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
vw_address = _CV(_OFFSET, vw_buf$) 'Pointer to data
GOTO setString
END IF
END IF
'--------
setAddress:
'vw_address now points to the actual data
vw_m = _MEM(vw_address, vw_varSize)
_MEMPUT vw_m, vw_m.OFFSET, vw_value$
CASE "clear last watchpoint"
IF LEFT$(vw_lastWatchpoint$, 1) = "g" THEN
vw_cmd$ = "clear global watchpoint"
ELSE
vw_cmd$ = "clear local watchpoint"
END IF
vw_value$ = MID$(vw_lastWatchpoint$, 2)
vw_getBytesPosition& = 1
GOTO WatchpointCommands
CASE "set global watchpoint", "set local watchpoint", "clear global watchpoint", "clear local watchpoint"
WatchpointCommands:
vw_getBytes& = 4: GOSUB GetBytes: vw_tempIndex = CVL(vw_valueBytes$)
vw_getBytes& = 1: GOSUB GetBytes: vw_isArray = _CV(_BYTE, vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_originalVarLineNumber = CVL(vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_localIndex = CVL(vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_arrayTotalDimensions = CVL(vw_valueBytes$)
vw_getBytes& = vw_arrayTotalDimensions: GOSUB GetBytes: vw_arrayIndexes$ = vw_valueBytes$
vw_temp$ = LEFT$(vw_value$, vw_arrayTotalDimensions + 33)
vw_arrayTotalDimensions = vw_arrayTotalDimensions \ 4
vw_getBytes& = 4: GOSUB GetBytes: vw_arrayElementSize = CVL(vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_isUDT = (CVL(vw_valueBytes$) <> 0)
vw_getBytes& = 4: GOSUB GetBytes: vw_element = CVL(vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_elementOffset = CVL(vw_valueBytes$)
vw_getBytes& = 4: GOSUB GetBytes: vw_varSize = CVL(vw_valueBytes$)
IF vw_varSize = 0 THEN GOTO cmdProcessingDone
vw_getBytes& = 4: GOSUB GetBytes: vw_storage = CVL(vw_valueBytes$)
vw_getBytes& = 2: GOSUB GetBytes: vw_i = CVI(vw_valueBytes$)
IF vw_i THEN
vw_getBytes& = vw_i: GOSUB GetBytes: vw_scope$ = vw_valueBytes$
END IF
vw_getBytes& = 2: GOSUB GetBytes: vw_i = CVI(vw_valueBytes$)
vw_getBytes& = vw_i: GOSUB GetBytes: vw_varType$ = vw_valueBytes$
vw_getBytes& = 2: GOSUB GetBytes: vw_i = CVI(vw_valueBytes$)
vw_getBytes& = vw_i: GOSUB GetBytes: vw_wpExpression$ = vw_valueBytes$
IF INSTR(vw_cmd$, " global ") THEN
vw_buf$ = vw_globalWatchpoints$
ELSE
vw_buf$ = vw_localWatchpoints$
END IF
vw_i = 0
vw_i = INSTR(vw_i + 1, vw_buf$, MKL$(-1))
DO WHILE vw_i
IF MID$(vw_buf$, vw_i + 8, LEN(vw_temp$)) = vw_temp$ THEN EXIT DO
vw_i = INSTR(vw_i + 1, vw_buf$, MKL$(-1))
LOOP
IF vw_i > 0 THEN
'remove existing watchpoint for the same variable/index/element
vw_j = CVL(MID$(vw_buf$, vw_i + 4, 4))
vw_buf$ = LEFT$(vw_buf$, vw_i - 1) + MID$(vw_buf$, vw_i + vw_j + 8)
END IF
IF LEFT$(vw_cmd$, 4) = "set " THEN
vw_value$ = vw_value$ + MKL$(LEN(vw_wpExpression$))
vw_buf$ = vw_buf$ + MKL$(-1) + MKL$(LEN(vw_value$)) + vw_value$
END IF
IF INSTR(vw_cmd$, " global ") THEN
vw_globalWatchpoints$ = vw_buf$
ELSE
vw_localWatchpoints$ = vw_buf$
END IF
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
_KEYCLEAR
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
vw_getBytesPosition& = 1
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
GetBytes:
IF vw_getBytes& = 0 THEN vw_valueBytes$ = "": RETURN
vw_valueBytes$ = MID$(vw_value$, vw_getBytesPosition&, vw_getBytes&)
vw_getBytesPosition& = vw_getBytesPosition& + vw_getBytes&
RETURN
CheckWatchpoints:
FOR vw_wpi = 1 TO 2
IF vw_wpi = 1 AND LEN(vw_globalWatchpoints$) > 0 THEN
vw_wpTemp$ = MID$(vw_globalWatchpoints$, 5)
ELSEIF vw_wpi = 2 AND LEN(vw_localWatchpoints$) > 0 THEN
vw_wpTemp$ = MID$(vw_localWatchpoints$, 5)
ELSE
_CONTINUE
END IF
DO WHILE LEN(vw_wpTemp$)
vw_wpj = CVL(LEFT$(vw_wpTemp$, 4))
vw_value$ = MID$(vw_wpTemp$, 5, vw_wpj)
vw_wpTemp$ = MID$(vw_wpTemp$, 9 + vw_wpj)
IF vw_wpi = 1 THEN vw_cmd$ = "get global var" ELSE vw_cmd$ = "get local var"
vw_i = CVL(RIGHT$(vw_value$, 4))
vw_wpExpression$ = MID$(vw_value$, LEN(vw_value$) - (4 + vw_i) + 1, vw_i)
vw_getBytesPosition& = 1
GOSUB getGlobalLocal
IF vw_varType$ = "" THEN _CONTINUE
IF INSTR(vw_varType$, "STRING") THEN
IF LEFT$(vw_wpExpression$, 1) = "=" THEN
vw_op$ = "="
vw_v1$ = _TRIM$(MID$(vw_wpExpression$, 2))
ELSEIF INSTR("@<=@>=@<>@", "@" + LEFT$(vw_wpExpression$, 2) + "@") > 0 THEN
vw_op$ = LEFT$(vw_wpExpression$, 2)
vw_v1$ = _TRIM$(MID$(vw_wpExpression$, 3))
ELSEIF INSTR("<>", LEFT$(vw_wpExpression$, 1)) > 0 THEN
vw_op$ = LEFT$(vw_wpExpression$, 1)
vw_v1$ = _TRIM$(MID$(vw_wpExpression$, 2))
END IF
IF LEFT$(vw_v1$, 1) = CHR$(34) AND RIGHT$(vw_v1$, 1) = CHR$(34) THEN
vw_v1$ = MID$(vw_v1$, 2, LEN(vw_v1$) - 2) 'remove quotes
vw_v2$ = vw_buf$
ELSE
vw_v1$ = _TRIM$(vw_v1$)
vw_v2$ = _TRIM$(vw_buf$)
END IF
IF vw_op$ = "=" THEN
IF vw_v1$ = vw_v2$ THEN GOTO WatchPointBreak
ELSEIF vw_op$ = "<=" THEN
IF vw_v1$ <= vw_v2$ THEN GOTO WatchPointBreak
ELSEIF vw_op$ = ">=" THEN
IF vw_v1$ >= vw_v2$ THEN GOTO WatchPointBreak
ELSEIF vw_op$ = "<>" THEN
IF vw_v1$ <> vw_v2$ THEN GOTO WatchPointBreak
ELSEIF vw_op$ = "<" THEN
IF vw_v1$ < vw_v2$ THEN GOTO WatchPointBreak
ELSEIF vw_op$ = ">" THEN
IF vw_v1$ > vw_v2$ THEN GOTO WatchPointBreak
END IF
ELSE
IF LEFT$(vw_wpExpression$, 1) = "=" THEN
vw_v1$ = _TRIM$(MID$(vw_wpExpression$, 2))
ELSEIF LEFT$(vw_wpExpression$, 2) = "<=" OR LEFT$(vw_wpExpression$, 2) = ">=" OR LEFT$(vw_wpExpression$, 2) = "<>" THEN
vw_v1$ = _TRIM$(MID$(vw_wpExpression$, 3))
ELSEIF LEFT$(vw_wpExpression$, 1) = "<" OR LEFT$(vw_wpExpression$, 1) = ">" THEN
vw_v1$ = _TRIM$(MID$(vw_wpExpression$, 2))
END IF
GOSUB GetV2
IF LEFT$(vw_wpExpression$, 1) = "=" THEN
IF VAL(vw_v2$) = VAL(vw_v1$) THEN GOTO WatchPointBreak
ELSEIF LEFT$(vw_wpExpression$, 2) = "<=" THEN
IF VAL(vw_v2$) <= VAL(vw_v1$) THEN GOTO WatchPointBreak
ELSEIF LEFT$(vw_wpExpression$, 2) = ">=" THEN
IF VAL(vw_v2$) >= VAL(vw_v1$) THEN GOTO WatchPointBreak
ELSEIF LEFT$(vw_wpExpression$, 2) = "<>" THEN
IF VAL(vw_v2$) <> VAL(vw_v1$) THEN GOTO WatchPointBreak
ELSEIF LEFT$(vw_wpExpression$, 1) = "<" THEN
IF VAL(vw_v2$) < VAL(vw_v1$) THEN GOTO WatchPointBreak
ELSEIF LEFT$(vw_wpExpression$, 1) = ">" THEN
IF VAL(vw_v2$) > VAL(vw_v1$) THEN GOTO WatchPointBreak
END IF
END IF
LOOP
NEXT
RETURN
WatchPointBreak:
'send watchpoint info and pause
IF INSTR(vw_cmd$, "global") THEN
vw_lastWatchpoint$ = "g" + vw_value$
ELSE
vw_lastWatchpoint$ = "l" + vw_value$
END IF
vw_checkingWatchpoints = 2
RETURN
GetV2:
IF INSTR(vw_varType$, "BIT *") THEN
IF VAL(MID$(vw_varType$, _INSTRREV(vw_varType$, " ") + 1)) > 32 THEN
IF INSTR(vw_varType$, "UNSIGNED") THEN
vw_v2$ = STR$(_CV(_UNSIGNED _INTEGER64, vw_buf$))
ELSE
vw_v2$ = STR$(_CV(_INTEGER64, vw_buf$))
END IF
ELSE
IF INSTR(vw_varType$, "UNSIGNED") THEN
vw_v2$ = STR$(_CV(_UNSIGNED LONG, vw_buf$))
ELSE
vw_v2$ = STR$(_CV(LONG, vw_buf$))
END IF
END IF
RETURN
ELSEIF INSTR("@_BIT@BIT@_UNSIGNED _BIT@UNSIGNED BIT@", "@" + vw_varType$ + "@") THEN
IF INSTR(vw_varType$, "UNSIGNED") THEN
vw_v2$ = STR$(_CV(_UNSIGNED LONG, vw_buf$))
ELSE
vw_v2$ = STR$(_CV(LONG, vw_buf$))
END IF
RETURN
END IF
SELECT CASE vw_varType$
CASE "_BYTE", "BYTE": vw_v2$ = STR$(_CV(_BYTE, vw_buf$))
CASE "_UNSIGNED _BYTE", "UNSIGNED BYTE": vw_v2$ = STR$(_CV(_UNSIGNED _BYTE, vw_buf$))
CASE "INTEGER": vw_v2$ = STR$(_CV(INTEGER, vw_buf$))
CASE "_UNSIGNED INTEGER", "UNSIGNED INTEGER": vw_v2$ = STR$(_CV(_UNSIGNED INTEGER, vw_buf$))
CASE "LONG": vw_v2$ = STR$(_CV(LONG, vw_buf$))
CASE "_UNSIGNED LONG", "UNSIGNED LONG": vw_v2$ = STR$(_CV(_UNSIGNED LONG, vw_buf$))
CASE "_INTEGER64", "INTEGER64": vw_v2$ = STR$(_CV(_INTEGER64, vw_buf$))
CASE "_UNSIGNED _INTEGER64", "UNSIGNED INTEGER64": vw_v2$ = STR$(_CV(_UNSIGNED _INTEGER64, vw_buf$))
CASE "SINGLE": vw_v2$ = STR$(CVS(vw_buf$))
CASE "DOUBLE": vw_v2$ = STR$(CVD(vw_buf$))
CASE "_FLOAT", "FLOAT": vw_v2$ = STR$(_CV(_FLOAT, vw_buf$))
CASE "_OFFSET", "OFFSET": vw_v2$ = STR$(_CV(_OFFSET, vw_buf$))
CASE "_UNSIGNED _OFFSET", "UNSIGNED OFFSET": vw_v2$ = STR$(_CV(_UNSIGNED _OFFSET, vw_buf$))
END SELECT
RETURN
END SUB
View git blame Copy permalink