diff --git a/internal/c/libqb.cpp b/internal/c/libqb.cpp index e30da1491..50a7ed15b 100644 --- a/internal/c/libqb.cpp +++ b/internal/c/libqb.cpp @@ -5397,6 +5397,14 @@ extern uint32 error_retry; void sub__echo(qbs *message); +void unlockvWatchHandle() { + if (vwatch>0) vwatch=-1; +} + +int32 vWatchHandle() { + return vwatch; +} + void sub__assert(int32 expression, qbs *assert_message, int32 passed) { if (asserts==0) return; if (expression==0) { @@ -13096,7 +13104,11 @@ void sub_close(int32 i2,int32 passed){ for (i=1;i<=special_handles->indexes;i++){ - sub_close(-i-1,1); + if (vwatch>0 && vwatch==i) { + //keep connection to the IDE open for $DEBUG mode + } else { + sub_close(-i-1,1); + } } @@ -21892,7 +21904,11 @@ void sub_put2(int32 i,int64 offset,void *element,int32 passed){ if ((method==0)||(method==1)){ if (parts<2) return -1; - if (qbs_equal(qbs_ucase(info_part[1]),qbs_new_txt("TCP/IP"))==0) return -1; + if (qbs_equal(qbs_ucase(info_part[1]),qbs_new_txt("TCP/IP"))==0) { + if (qbs_equal(qbs_ucase(info_part[1]),qbs_new_txt("QB64IDE"))==0 || vwatch!=-1) { + return -1; + } + } d=func_val(info_part[2]); port=qbr_double_to_long(d);//***assume*** port number is within valid range @@ -21923,6 +21939,7 @@ void sub_put2(int32 i,int64 offset,void *element,int32 passed){ //init stream my_stream_struct->in=NULL; my_stream_struct->in_size=0; my_stream_struct->in_limit=0; + if (vwatch==-1) vwatch=my_handle; return my_handle; }//client diff --git a/internal/c/qbx.cpp b/internal/c/qbx.cpp index 15cf2e41d..be453c5e6 100755 --- a/internal/c/qbx.cpp +++ b/internal/c/qbx.cpp @@ -12,6 +12,9 @@ extern void sub__consolefont(qbs* FontName, int FontSize); extern void sub__console_cursor(int32 visible, int32 cursorsize, int32 passed); extern int32 func__getconsoleinput(); +extern void unlockvWatchHandle(); +extern int32 vWatchHandle(); + #ifdef DEPENDENCY_ZLIB #include qbs *func__deflate(qbs *text); diff --git a/source/ide/ide_methods.bas b/source/ide/ide_methods.bas index 075d8cb96..9ab42b8ea 100644 --- a/source/ide/ide_methods.bas +++ b/source/ide/ide_methods.bas @@ -6410,6 +6410,8 @@ SUB DebugMode noFocusMessage = -1 DO 'main loop + IF _EXIT THEN ideexit = 1: GOTO requestQuit + bkpidecy = idecy WHILE _MOUSEINPUT: idecy = idecy + _MOUSEWHEEL * 3: WEND @@ -6656,6 +6658,7 @@ SUB DebugMode r$ = idesubs PCOPY 3, 0: SCREEN , , 3, 0 GOSUB UpdateDisplay + WHILE _MOUSEINPUT: WEND CASE 15872 'F4 IF PauseMode THEN requestCallStack: @@ -6668,9 +6671,13 @@ SUB DebugMode setStatusMessage 1, "Requesting call stack...", 7 start! = TIMER + callStackLength = -1 DO GOSUB GetCommand - IF cmd$ = "call stack size" THEN callStackLength = CVL(value$) + IF cmd$ = "call stack size" THEN + callStackLength = CVL(value$) + IF callStackLength = 0 THEN EXIT DO + END IF _LIMIT 100 LOOP UNTIL cmd$ = "call stack" OR TIMER - start! > timeout @@ -6678,13 +6685,20 @@ SUB DebugMode 'display call stack callstacklist$ = value$ ShowCallStack: - retval = idecallstackbox - PCOPY 3, 0: SCREEN , , 3, 0 clearStatusWindow 0 setStatusMessage 1, "Paused.", 2 + retval = idecallstackbox + PCOPY 3, 0: SCREEN , , 3, 0 + WHILE _MOUSEINPUT: WEND ELSE - clearStatusWindow 0 - setStatusMessage 1, "Error retrieving call stack.", 2 + IF callStackLength = -1 THEN + callStackLength = 0 + clearStatusWindow 0 + setStatusMessage 1, "Error retrieving call stack.", 2 + ELSEIF callStackLength = 0 THEN + clearStatusWindow 0 + setStatusMessage 1, "No call stack log available.", 2 + END IF END IF noFocusMessage = NOT noFocusMessage END IF @@ -6757,8 +6771,9 @@ SUB DebugMode IF _KEYDOWN(100304) OR _KEYDOWN(100303) THEN result = idegetlinenumberbox("Run To Line", idecy) PCOPY 3, 0: SCREEN , , 3, 0 + WHILE _MOUSEINPUT: WEND requestRunToThisLine: - IF result > 0 AND result < iden THEN + IF result > 0 AND result <= iden THEN PauseMode = 0 debugnextline = 0 cmd$ = "run to line:" + MKL$(result) @@ -6771,8 +6786,9 @@ SUB DebugMode ELSE result = idegetlinenumberbox("Set Next Line", idecy) PCOPY 3, 0: SCREEN , , 3, 0 + WHILE _MOUSEINPUT: WEND requestSetNextLine: - IF result > 0 AND result < iden THEN + IF result > 0 AND result <= iden THEN cmd$ = "set next line:" + MKL$(result) GOSUB SendCommand END IF @@ -6782,6 +6798,7 @@ SUB DebugMode IF _KEYDOWN(100306) OR _KEYDOWN(100305) THEN result = idegetlinenumberbox("Skip Line", idecy) PCOPY 3, 0: SCREEN , , 3, 0 + WHILE _MOUSEINPUT: WEND requestToggleSkipLine: IF result > 0 AND result <= iden THEN IdeSkipLines(result) = NOT IdeSkipLines(result) @@ -6838,15 +6855,19 @@ SUB DebugMode 'requested when the program is about to quit or 'when an error just occurred callStackLength = CVL(value$) - start! = TIMER - DO - GOSUB GetCommand - _LIMIT 100 - LOOP UNTIL cmd$ = "call stack" OR TIMER - start! > timeout + IF callStackLength THEN + start! = TIMER + DO + GOSUB GetCommand + _LIMIT 100 + LOOP UNTIL cmd$ = "call stack" OR TIMER - start! > timeout - IF cmd$ = "call stack" THEN - 'store call stack - callstacklist$ = value$ + IF cmd$ = "call stack" THEN + 'store call stack + callstacklist$ = value$ + END IF + ELSE + callstacklist$ = "" END IF END SELECT @@ -6906,19 +6927,25 @@ FUNCTION idecallstackbox '-------- init -------- i = 0 - idepar p, idewx - 8, idewy + idesubwindow - 6, "$DEBUG MODE" + + dialogHeight = callStackLength + 4 + IF dialogHeight > idewy + idesubwindow - 6 THEN + dialogHeight = idewy + idesubwindow - 6 + END IF + + idepar p, idewx - 8, dialogHeight, "$DEBUG MODE" i = i + 1 o(i).typ = 2 o(i).y = 2 - o(i).w = idewx - 12: o(i).h = idewy + idesubwindow - 10 + o(i).w = idewx - 12: o(i).h = dialogHeight - 4 o(i).txt = idenewtxt(callstacklist$) o(i).sel = callStackLength o(i).nam = idenewtxt("Call Stack") i = i + 1 o(i).typ = 3 - o(i).y = idewy + idesubwindow - 6 + o(i).y = dialogHeight o(i).txt = idenewtxt("#Close") o(i).dft = 1 @@ -8270,6 +8297,7 @@ FUNCTION idegetline$ (i) END FUNCTION SUB idecentercurrentline + IF iden <= idewy - 8 THEN EXIT SUB idesy = idecy - (idewy - 8) \ 2 IF idesy < 1 THEN idesy = 1 END SUB @@ -8748,6 +8776,7 @@ FUNCTION idefiledialog$(programname$, mode AS _BYTE) '-------- custom display changes -------- COLOR 0, 7: _PRINTSTRING (p.x + 2, p.y + 4), "Path: " a$ = path$ + IF LEN(a$) = 2 AND RIGHT$(a$, 1) = ":" THEN a$ = a$ + "\" w = p.w - 8 IF LEN(a$) > w - 3 THEN a$ = STRING$(3, 250) + RIGHT$(a$, w - 3) _PRINTSTRING (p.x + 2 + 6, p.y + 4), a$ @@ -10074,13 +10103,17 @@ FUNCTION idesubs$ '72,19 i = 0 - idepar p, idewx - 8, idewy + idesubwindow - 6, "SUBs" + dialogHeight = TotalSUBs + 4 + IF dialogHeight > idewy + idesubwindow - 6 THEN + dialogHeight = idewy + idesubwindow - 6 + END IF + idepar p, idewx - 8, dialogHeight, "SUBs" i = i + 1 o(i).typ = 2 o(i).y = 1 '68 - o(i).w = idewx - 12: o(i).h = idewy + idesubwindow - 9 + o(i).w = idewx - 12: o(i).h = dialogHeight - 3 IF SortedSubsFlag = 0 THEN IF IDESubsLength THEN o(i).txt = idenewtxt(lSized$) @@ -10121,14 +10154,14 @@ FUNCTION idesubs$ i = i + 1 o(i).typ = 4 'check box o(i).x = 2 - o(i).y = idewy + idesubwindow - 6 + o(i).y = dialogHeight o(i).nam = idenewtxt("#Line Count") o(i).sel = IDESubsLength i = i + 1 o(i).typ = 4 'check box o(i).x = 18 - o(i).y = idewy + idesubwindow - 6 + o(i).y = dialogHeight o(i).nam = idenewtxt("#Sort") o(i).sel = SortedSubsFlag @@ -10136,8 +10169,12 @@ FUNCTION idesubs$ o(i).typ = 3 o(i).x = p.x + p.w - 26 o(i).w = 26 - o(i).y = idewy + idesubwindow - 6 - o(i).txt = idenewtxt("#Edit" + sep + "#Cancel") + o(i).y = dialogHeight + IF IdeDebugMode = 0 THEN + o(i).txt = idenewtxt("#Edit" + sep + "#Cancel") + ELSE + o(i).txt = idenewtxt("#View" + sep + "#Cancel") + END IF o(i).dft = 1 @@ -10358,19 +10395,23 @@ FUNCTION idelanguagebox l$ = UCASE$(l$) i = 0 - idepar p, idewx - 8, idewy + idesubwindow - 6, "Language" + dialogHeight = idecpnum + 4 + IF dialogHeight > idewy + idesubwindow - 6 THEN + dialogHeight = idewy + idesubwindow - 6 + END IF + idepar p, idewx - 8, dialogHeight, "Language" i = i + 1 o(i).typ = 2 o(i).y = 2 - o(i).w = idewx - 12: o(i).h = idewy + idesubwindow - 10 + o(i).w = idewx - 12: o(i).h = dialogheight - 4 o(i).txt = idenewtxt(l$) o(i).sel = 1: IF idecpindex THEN o(i).sel = idecpindex o(i).nam = idenewtxt("Code Pages") i = i + 1 o(i).typ = 3 - o(i).y = idewy + idesubwindow - 6 + o(i).y = dialogheight o(i).txt = idenewtxt("#OK" + sep + "#Cancel") o(i).dft = 1 @@ -11293,7 +11334,7 @@ FUNCTION idezchangepath$ (path$, newpath$) END IF 'change drive IF LEN(newpath$) = 2 AND RIGHT$(newpath$, 1) = ":" THEN - idezchangepath$ = newpath$ + "\" + idezchangepath$ = newpath$ EXIT FUNCTION END IF idezchangepath$ = path$ + "\" + newpath$ diff --git a/source/qb64.bas b/source/qb64.bas index 97eea292f..12277c429 100644 --- a/source/qb64.bas +++ b/source/qb64.bas @@ -27,8 +27,11 @@ 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$ +DIM SHARED vWatchNewVariable$, vWatchVariableExclusions$ 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;};" +vWatchVariableExclusions$ = "@__LONG_VWATCH_LINENUMBER@__LONG_VWATCH_SUBLEVEL@__LONG_VWATCH_GOTO@" + _ + "@__STRING_VWATCH_SUBNAME@__STRING_VWATCH_CALLSTACK@__ARRAY_BYTE_VWATCH_BREAKPOINTS" + _ + "@__ARRAY_BYTE_VWATCH_SKIPLINES@" DIM SHARED qb64prefix_set_recompileAttempts, qb64prefix_set_desiredState DIM SHARED opex_recompileAttempts, opex_desiredState @@ -8765,7 +8768,16 @@ DO END IF END IF + IF firstelement$ = "CHAIN" THEN + IF vWatchOn THEN + addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "Feature incompatible with $DEBUG MODE", "CHAIN" + END IF + END IF + IF firstelement$ = "RUN" THEN 'RUN + IF vWatchOn THEN + addWarning linenumber, inclevel, inclinenumber(inclevel), incname$(inclevel), "Feature incompatible with $DEBUG MODE", "RUN" + END IF l$ = SCase$("Run") IF n = 1 THEN 'no parameters @@ -11395,6 +11407,9 @@ FOR i = 1 TO idn getid i IF Error_Happened THEN GOTO errmes IF id.arrayelements = -1 THEN GOTO clearerasereturned 'cannot erase non-existant array + IF INSTR(vWatchVariableExclusions$, "@" + RTRIM$(id.callname) + "@") > 0 THEN + GOTO clearerasereturned + END IF clearerasereturn = 1: GOTO clearerase END IF 'array @@ -11417,14 +11432,18 @@ FOR i = 1 TO idn PRINT #12, "memset((void*)(" + e$ + "->chr),0," + bytes$ + ");" GOTO cleared ELSE - PRINT #12, e$ + "->len=0;" + IF INSTR(vWatchVariableExclusions$, "@" + e$ + "@") = 0 AND LEFT$(e$, 12) <> "_SUB_VWATCH_" THEN + PRINT #12, e$ + "->len=0;" + END IF GOTO cleared END IF END IF IF typ AND ISUDT THEN PRINT #12, "memset((void*)" + e$ + ",0," + bytes$ + ");" ELSE - PRINT #12, "*" + e$ + "=0;" + IF INSTR(vWatchVariableExclusions$, "@" + e$ + "@") = 0 AND LEFT$(e$, 12) <> "_SUB_VWATCH_" THEN + PRINT #12, "*" + e$ + "=0;" + END IF END IF GOTO cleared END IF 'non-array variable @@ -11695,7 +11714,7 @@ ELSE END IF IF vWatchOn THEN - PRINT #18, "int32 vwatch=1;" + PRINT #18, "int32 vwatch=-1;" ELSE PRINT #18, "int32 vwatch=0;" END IF @@ -14197,17 +14216,10 @@ 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 + IF INSTR(vWatchVariableExclusions$, "@" + this$ + "@") > 0 OR LEFT$(this$, 12) = "_SUB_VWATCH_" THEN EXIT SUB END IF diff --git a/source/utilities/vwatch/vwatch.bm b/source/utilities/vwatch/vwatch.bm index 4e2fbfd35..59dc05577 100644 --- a/source/utilities/vwatch/vwatch.bm +++ b/source/utilities/vwatch/vwatch.bm @@ -13,6 +13,7 @@ SUB vwatch (localVariables AS _OFFSET) DECLARE LIBRARY SUB vwatch_stoptimers ALIAS stop_timers SUB vwatch_starttimers ALIAS start_timers + SUB unlockvWatchHandle END DECLARE IF bypass THEN EXIT SUB @@ -35,7 +36,7 @@ SUB vwatch (localVariables AS _OFFSET) SELECT CASE cmd$ CASE "vwatch" IF value$ <> "ok" THEN - CLOSE #ideHost + unlockvWatchHandle: CLOSE #ideHost bypass = -1 EXIT SUB END IF @@ -48,7 +49,7 @@ SUB vwatch (localVariables AS _OFFSET) IF LEN(value$) \ 4 <> breakpointCount THEN cmd$ = "quit:Communication error." GOSUB SendCommand - CLOSE #ideHost + unlockvWatchHandle: CLOSE #ideHost bypass = -1 EXIT SUB END IF @@ -62,7 +63,7 @@ SUB vwatch (localVariables AS _OFFSET) IF LEN(value$) \ 4 <> skipCount THEN cmd$ = "quit:Communication error." GOSUB SendCommand - CLOSE #ideHost + unlockvWatchHandle: CLOSE #ideHost bypass = -1 EXIT SUB END IF @@ -85,7 +86,7 @@ SUB vwatch (localVariables AS _OFFSET) GOSUB SendCallStack cmd$ = "quit:Program ended." GOSUB SendCommand - CLOSE #ideHost + unlockvWatchHandle: CLOSE #ideHost bypass = -1 ideHost = 0 EXIT SUB @@ -193,7 +194,7 @@ SUB vwatch (localVariables AS _OFFSET) vwatch_starttimers EXIT SUB CASE "free" - CLOSE #ideHost + unlockvWatchHandle: CLOSE #ideHost ideHost = 0 bypass = -1 vwatch_starttimers @@ -240,7 +241,7 @@ SUB vwatch (localVariables AS _OFFSET) start! = TIMER DO k& = _KEYHIT - ideHost = _OPENCLIENT("TCP/IP:" + ideport$ + ":localhost") + ideHost = _OPENCLIENT("QB64IDE:" + ideport$ + ":localhost") _LIMIT 30 LOOP UNTIL k& = 27 OR ideHost <> 0 OR TIMER - start! > timeout IF ideHost = 0 THEN bypass = -1: EXIT SUB