QB64/qb64
QB64/qb64
1
1
Fork 0
mirror of https://github.com/QB64Official/qb64.git synced 2024-07-07 15:40:24 +00:00
Code Releases Wiki Activity

Merge branch 'var-export' into development

Browse source
This commit is contained in:
Fellippe Heitor 2021-07-22 03:11:16 -03:00
parent fba3aaa920 4efd95201d
commit 151d9c544e
5 changed files with 122 additions and 48 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
internal/c/libqb.cpp
View file

@ -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

3
internal/c/qbx.cpp
View file

@ -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 <zlib.h>
qbs *func__deflate(qbs *text);

97
source/ide/ide_methods.bas
View file

@ -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$

36
source/qb64.bas
View file

@ -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

13
source/utilities/vwatch/vwatch.bm
View file

@ -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