-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathcode_dbg.prg
1403 lines (1345 loc) · 40.4 KB
/
code_dbg.prg
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
// DO NOT REMOVE THIS PRAGMA
// if the debugger code has DEBUGINFO the program will crash for stack overflow
#pragma -B-
#ifndef DBG_PORT
#define DBG_PORT 6110
#endif
#include <hbdebug.ch>
#include <hbmemvar.ch>
#include <hboo.ch>
#include <hbclass.ch>
#ifdef __XHARBOUR__
#include <hbcompat.ch>
#define __dbgInvokeDebug hb_dbg_InvokeDEBUG
#define __dbgProcLevel hb_dbg_ProcLevel
#define __dbgVMVarLGet hb_dbg_vmVarLGet
#define __dbgVMVarSGet hb_dbg_vmVarSGet
#endif
//#define _DEBUGDEBUG
#ifdef _DEBUGDEBUG
#command ? [<explist,...>] => dbgQOut( <explist> )
#else
#command ? [<explist,...>] =>
#endif
#ifndef HB_DBG_CS_LEN
#define HB_DBG_CS_MODULE 1 /* module name (.prg file) */
#define HB_DBG_CS_FUNCTION 2 /* function name */
#define HB_DBG_CS_LINE 3 /* start line */
#define HB_DBG_CS_LEVEL 4 /* eval stack level of the function */
#define HB_DBG_CS_LOCALS 5 /* an array with local variables */
#define HB_DBG_CS_STATICS 6 /* an array with static variables */
#define HB_DBG_CS_LEN 6
#endif
#ifndef HB_DBG_VAR_LEN
#define HB_DBG_VAR_NAME 1 /* variable name */
#define HB_DBG_VAR_INDEX 2 /* index */
#define HB_DBG_VAR_TYPE 3 /* type of variable: "L", "S", "G" */
#define HB_DBG_VAR_FRAME 4 /* eval stack level of the function or static frame */
#define HB_DBG_VAR_LEN 4
#endif
#define CRLF e"\r\n"
// returns .T. if need step
static procedure CheckSocket(lStopSent)
LOCAL tmp, lNeedExit := .F.
LOCAL t_oDebugInfo := __DEBUGITEM()
lStopSent := iif(empty(lStopSent),.F.,lStopSent)
// if no server then search it.
// 140+130+120+110+100+90+80+70+60+50+40+30+20+10=1050 wait 1sec at start, then 0
do while (empty(t_oDebugInfo['socket']) .and. t_oDebugInfo['timeCheckForDebug']<=14)
//QOut("try to connect to debug server",t_oDebugInfo['timeCheckForDebug'], seconds()," timeout:",140-t_oDebugInfo['timeCheckForDebug']*10)
hb_inetInit()
t_oDebugInfo['socket'] := hb_inetCreate(140-t_oDebugInfo['timeCheckForDebug']*10)
hb_inetConnect("127.0.0.1",DBG_PORT,t_oDebugInfo['socket'])
if hb_inetErrorCode(t_oDebugInfo['socket']) <> 0
//QOut("failed") // no server found
tmp := "NO"
else
//QOut("connected") //server found, send my exeName and my processId
hb_inetSend(t_oDebugInfo['socket'],HB_ARGV(0)+CRLF+str(__PIDNum())+CRLF)
do while hb_inetDataReady(t_oDebugInfo['socket']) != 1 //waiting for response
hb_idleSleep(0.2)
end do
tmp := hb_inetRecvLine(t_oDebugInfo['socket']) // if the server does not respond "NO" it is ok
//QOut("returned ",tmp)
// End of handshake
endif
if tmp="NO" //server not found or handshake failed
t_oDebugInfo['socket'] := nil
t_oDebugInfo['timeCheckForDebug']+=1
endif
end do
if empty(t_oDebugInfo['socket'])
// no debug server
t_oDebugInfo['timeCheckForDebug']-=1
return
endif
do while .T.
if hb_inetErrorCode(t_oDebugInfo['socket']) <> 0
// disconected?
//QOut("socket error",hb_inetErrorDesc( t_oDebugInfo['socket'] ))
t_oDebugInfo['socket'] := nil
t_oDebugInfo['lRunning'] := .T.
t_oDebugInfo['aBreaks'] := {=>}
t_oDebugInfo['maxLevel'] := nil
return
endif
do while hb_inetDataReady(t_oDebugInfo['socket']) = 1
tmp := hb_inetRecvLine(t_oDebugInfo['socket'])
if .not. empty(tmp)
//? "<<", tmp
if subStr(tmp,4,1)==":"
sendCoumpoundVar(tmp, hb_inetRecvLine(t_oDebugInfo['socket']))
loop
endif
#ifndef __XHARBOUR__
#define BEGIN_C switch tmp
#define COMMAND case
#define END_COM exit
#define END_C endswitch
#else
#define BEGIN_C do case
#define COMMAND case tmp=
#define END_COM
#define END_C endcase
#endif
BEGIN_C
COMMAND "PAUSE"
t_oDebugInfo['lRunning'] := .F.
//? "StopRun on pause"
if .not. lStopSent
hb_inetSend(t_oDebugInfo['socket'],"STOP:pause"+CRLF)
lStopSent := .T.
endif
END_COM
COMMAND "GO"
t_oDebugInfo['lRunning'] := .T.
t_oDebugInfo['maxLevel'] := nil
t_oDebugInfo['inError'] := .F. // If it was on error, now it doesn't
lNeedExit := .T.
END_COM
COMMAND "STEP" // go to next line of code even if is in another procedure
t_oDebugInfo['lRunning'] := .F.
t_oDebugInfo['inError'] := .F. // If it was on error, now it doesn't
//? "StopRun on step"
lNeedExit := .T.
END_COM
COMMAND "NEXT" // go to next line of same procedure
t_oDebugInfo['lRunning'] := .T.
t_oDebugInfo['maxLevel'] := t_oDebugInfo['__dbgEntryLevel']
t_oDebugInfo['inError'] := .F. // If it was on error, now it doesn't
lNeedExit := .T.
END_COM
COMMAND "EXIT" // go to callee procedure
t_oDebugInfo['lRunning'] := .T.
t_oDebugInfo['maxLevel'] := t_oDebugInfo['__dbgEntryLevel']-1
t_oDebugInfo['inError'] := .F. // If it was on error, now it doesn't
lNeedExit := .T.
END_COM
COMMAND "STACK"
sendStack()
END_COM
COMMAND "BREAKPOINT"
setBreakpoint(hb_inetRecvLine(t_oDebugInfo['socket']))
END_COM
COMMAND "LOCALS"
sendLocals(hb_inetRecvLine(t_oDebugInfo['socket']),tmp)
END_COM
COMMAND "STATICS"
sendStatics(hb_inetRecvLine(t_oDebugInfo['socket']),tmp)
END_COM
COMMAND "PRIVATES"
sendFromInfo(tmp,hb_inetRecvLine(t_oDebugInfo['socket']),HB_MV_PRIVATE, .T.)
END_COM
COMMAND "PRIVATE_CALLEE"
sendFromInfo(tmp,hb_inetRecvLine(t_oDebugInfo['socket']),HB_MV_PRIVATE, .F.)
END_COM
COMMAND "PUBLICS"
sendFromInfo(tmp,hb_inetRecvLine(t_oDebugInfo['socket']),HB_MV_PUBLIC)
END_COM
//COMMAND "GLOBALS"
// sendVariables(HB_MV_PUBLIC,.F.)
// END_COM
//COMMAND "EXTERNALS"
// sendVariables(HB_MV_PUBLIC,.F.)
// END_COM
COMMAND "EXPRESSION"
sendExpression(hb_inetRecvLine(t_oDebugInfo['socket']))
END_COM
COMMAND "INERROR"
//? "INERROR",t_oDebugInfo['inError']
if t_oDebugInfo['inError']
hb_inetSend(t_oDebugInfo['socket'],"INERROR:True"+CRLF)
else
hb_inetSend(t_oDebugInfo['socket'],"INERROR:False"+CRLF)
endif
END_COM
COMMAND "ERROR_VAR"
hb_inetRecvLine(t_oDebugInfo['socket'])
hb_inetSend(t_oDebugInfo['socket'],"ERROR_VAR 0"+CRLF)
if t_oDebugInfo['inError']
hb_inetSend(t_oDebugInfo['socket'],"ERR:0:0::Error:O:" + format(t_oDebugInfo['error'])+CRLF)
endif
hb_inetSend(t_oDebugInfo['socket'],"END"+CRLF)
END_COM
COMMAND "ERRORTYPE"
SetErrorType(hb_inetRecvLine(t_oDebugInfo['socket']))
END_COM
COMMAND "COMPLETITION"
sendCompletition(hb_inetRecvLine(t_oDebugInfo['socket']))
END_COM
COMMAND "DISCONNECT"
t_oDebugInfo['socket'] := nil
t_oDebugInfo['lRunning'] := .T.
t_oDebugInfo['aBreaks'] := {=>}
t_oDebugInfo['maxLevel'] := nil
return
END_C
#undef BEGIN_C
#undef COMMAND
#undef END_COM
#undef END_C
endif
enddo
if lNeedExit
return
endif
if t_oDebugInfo['lRunning']
if inBreakpoint()
t_oDebugInfo['lRunning'] := .F.
//? "StopRun on break"
if .not. lStopSent
hb_inetSend(t_oDebugInfo['socket'],"STOP:break"+CRLF)
lStopSent := .T.
endif
endif
if __dbgInvokeDebug(.F.)
t_oDebugInfo['lRunning'] := .F.
//? "StopRun on AltD"
if .not. lStopSent
hb_inetSend(t_oDebugInfo['socket'],"STOP:AltD"+CRLF)
lStopSent := .T.
endif
endif
if .not. empty(t_oDebugInfo['maxLevel'])
//? "maxLevel",t_oDebugInfo['maxLevel'], t_oDebugInfo['__dbgEntryLevel']
if t_oDebugInfo['maxLevel'] < t_oDebugInfo['__dbgEntryLevel']
// we are not in the same procedure
return
endif
t_oDebugInfo['maxLevel'] := nil
t_oDebugInfo['lRunning'] := .F.
//? "StopRun on level"
if .not. lStopSent
hb_inetSend(t_oDebugInfo['socket'],"STOP:next"+CRLF)
lStopSent := .T.
endif
endif
endif
if t_oDebugInfo['lRunning']
return
else
t_oDebugInfo['lInternalRun'] := .T.
hb_idleSleep(0.1)
t_oDebugInfo['lInternalRun'] := .F.
if .not. lStopSent
hb_inetSend(t_oDebugInfo['socket'],"STOP:step"+CRLF)
lStopSent := .T.
endif
endif
enddo
// unreachable code
return
static procedure sendStack()
local i,d, line, module, functionName, start := 3
LOCAL t_oDebugInfo := __DEBUGITEM()
#ifdef _DEBUGDEBUG
local aStack := t_oDebugInfo['aStack']
#endif
if t_oDebugInfo['inError']
start := 4
endif
//start := 0
d := __dbgProcLevel()-1
//? "send stack---", start,d, t_oDebugInfo['__dbgEntryLevel']
hb_inetSend(t_oDebugInfo['socket'],"STACK " + alltrim(str(d-start+1))+CRLF)
for i:=start to d
line := procLine(i)
module := strTran(procFile(i),":",";")
functionName := strTran(ProcName(i),":",";")
hb_inetSend(t_oDebugInfo['socket'], module+":"+alltrim(str(line))+":"+functionName+CRLF)
next
//? "---"
#ifdef _DEBUGDEBUG
for i:=1 to len(aStack)
line := aStack[i,HB_DBG_CS_LINE]
module := aStack[i,HB_DBG_CS_MODULE]
functionName := aStack[i,HB_DBG_CS_FUNCTION]
? i," DEBUG ", module,":",alltrim(str(line)),":",functionName,aStack[i,HB_DBG_CS_LEVEL],len(aStack[i,HB_DBG_CS_LOCALS]),len(aStack[i,HB_DBG_CS_LOCALS])
next
#endif
return
static function format(value)
switch valtype(value)
case "U"
return "nil"
case "C"
case "M"
value=StrTran(value,e"\n","\$\n")
value=StrTran(value,e"\r","\$\r")
if at('"',value)==0
return '"'+value+'"'
elseif at("'",value)==0
return "'"+value+"'"
else
return "["+value+"]" //i don't like it decontexted
endif
case "N"
return alltrim(str(value))
case "L"
return iif(value,".T.",".F.")
#ifdef __XHARBOUR__
case "D"
return '{^ '+strTran(left(hb_TsToStr(value),10),"-","/")+' }'
case "T"
return '{^ '+strTran(hb_TsToStr(value),"-","/")+' }'
#else
case "D"
return 'd"'+left(hb_TsToStr(value),10)+'"'
case "T"
return 't"'+hb_TsToStr(value)+'"'
#endif
case "A"
case "H"
return alltrim(str(len(value)))
case "B"
return "{|| ...}"
case "O"
//return value:ClassName()+" "+alltrim(str(len(value)))
return value:ClassName()+" "+alltrim(str(len(__objGetMsgList(value,.T.,HB_MSGLISTALL))))
case "P"
return "Pointer"
case "S"
RETURN "@" + value:name + "()"
endswitch
return ""
static function GetStackId(level,aStack)
local l := __DEBUGITEM()['__dbgEntryLevel'] - level
if __DEBUGITEM()['inError']
l -= 1
endif
if empty(aStack)
aStack := __DEBUGITEM()['aStack']
endif
return AScan( aStack, {| a | a[ HB_DBG_CS_LEVEL ] == l } )
static function GetStackAndParams(cParams, aStack)
local aParams := hb_aTokens(cParams,":")
local iStack
local iStart := val(aParams[2])
local iCount := val(aParams[3])
local idx := val(aParams[1])
local l := __DEBUGITEM()['__dbgEntryLevel'] - idx
iStack := GetStackId(idx,aStack)
return {iStack, iStart, iCount,l,idx} //l and idx used by sendFromInfo
static procedure sendLocals(cParams,prefix)
LOCAL t_oDebugInfo := __DEBUGITEM()
local aStack := t_oDebugInfo['aStack']
local aParams := GetStackAndParams(cParams,aStack)
local iStack := aParams[1]
local iStart := aParams[2]
local iCount := aParams[3]
local iLevel := __dbgProcLevel()
local i, aInfo, value, cLine
//? "sendLocals ", cParams, alltrim(str(aParams[5])), iStack, iLevel, t_oDebugInfo['__dbgEntryLevel']
hb_inetSend(t_oDebugInfo['socket'],prefix+" "+alltrim(str(aParams[5]))+CRLF)
if iStack>0
if iCount=0
iCount := len(aStack[iStack,HB_DBG_CS_LOCALS])
endif
for i:=iStart to iStart+iCount
if(i>len(aStack[iStack,HB_DBG_CS_LOCALS]))
exit
endif
aInfo := aStack[iStack,HB_DBG_CS_LOCALS,i]
value := __dbgVMVarLGet( iLevel-aInfo[ HB_DBG_VAR_FRAME ], aInfo[ HB_DBG_VAR_INDEX ] )
// LOC:LEVEL:IDX::
cLine := left(prefix,3) + ":" + alltrim(str(aInfo[ HB_DBG_VAR_FRAME ])) + ":" + ;
alltrim(str(aInfo[ HB_DBG_VAR_INDEX ])) + "::" + ;
aInfo[HB_DBG_VAR_NAME] + ":" + valtype(value) + ":" + format(value)
hb_inetSend(t_oDebugInfo['socket'],cLine + CRLF )
next
endif
hb_inetSend(t_oDebugInfo['socket'],"END"+CRLF)
return
static procedure sendStatics(cParams,prefix)
LOCAL t_oDebugInfo := __DEBUGITEM()
local aStack := t_oDebugInfo['aStack']
local aModules := t_oDebugInfo['aModules']
local cModule, idxModule, nVarMod, nVarStack
local aParams := GetStackAndParams(cParams,aStack)
local iStack := aParams[1]
local iStart := aParams[2]
local iCount := aParams[3]
local i, aInfo, value, cLine
if iStack>0
cModule := lower(allTrim(aStack[iStack,HB_DBG_CS_MODULE]))
idxModule := aScan(aModules, {|v| v[1]=cModule})
else
idxModule := 0
endif
if idxModule>0
nVarMod:=len(aModules[idxModule,4])
else
nVarMod:=0
endif
nVarStack := iif(iStack>0,len(aStack[iStack,HB_DBG_CS_STATICS]),0)
iStart:= iif(iStart>nVarMod+nVarStack , nVarMod+nVarStack , iStart )
iStart:= iif(iStart<1 , 1 , iStart )
iCount:= iif(iCount<1 , nVarMod+nVarStack , iCount )
hb_inetSend(t_oDebugInfo['socket'],prefix+" "+alltrim(str(aParams[5]))+CRLF)
for i:=iStart to iStart+iCount
if i<=nVarMod
aInfo := aModules[idxModule,4,i]
elseif i<=nVarMod+nVarStack
aInfo := aStack[iStack,HB_DBG_CS_STATICS,i-nVarMod]
else
exit
endif
value := __dbgVMVarSGet( aInfo[ HB_DBG_VAR_FRAME ], aInfo[ HB_DBG_VAR_INDEX ] )
// LOC:LEVEL:IDX::
cLine := left(prefix,3) + ":"+alltrim(str(iStack))+":" + alltrim(str(i)) + "::" + ;
aInfo[HB_DBG_VAR_NAME] + ":" + valtype(value) + ":" + format(value)
hb_inetSend(t_oDebugInfo['socket'],cLine + CRLF )
next
hb_inetSend(t_oDebugInfo['socket'],"END"+CRLF)
return
static function MyGetSta(iStack,varIndex)
LOCAL t_oDebugInfo := __DEBUGITEM()
local aStack := t_oDebugInfo['aStack']
local aModules := t_oDebugInfo['aModules']
LOCAL cModule, idxModule
local nVarMod, aInfo, nVarStack := iif(iStack>0,len(aStack[iStack,HB_DBG_CS_STATICS]),0)
if iStack>0
cModule := lower(allTrim(aStack[iStack,HB_DBG_CS_MODULE]))
idxModule := aScan(aModules, {|v| v[1]=cModule})
else
idxModule := 0
endif
if idxModule>0
nVarMod:=len(aModules[idxModule,4])
else
nVarMod:=0
endif
if varIndex<=nVarMod
aInfo := aModules[idxModule,4,varIndex]
elseif varIndex<=nVarMod+nVarStack
aInfo := aStack[iStack,HB_DBG_CS_STATICS,varIndex-nVarMod]
else
return nil
endif
return __dbgVMVarSGet( aInfo[ HB_DBG_VAR_FRAME ], aInfo[ HB_DBG_VAR_INDEX ] )
static procedure sendFromInfo(prefix, cParams, HB_MV, lLocal)
LOCAL t_oDebugInfo := __DEBUGITEM()
local aStack := t_oDebugInfo['aStack']
local nVars := __mvDbgInfo( HB_MV )
local aParams := GetStackAndParams(cParams,aStack)
//local iStack := aParams[1]
local iStart := aParams[2]
local iCount := aParams[3]
local iLevel := aParams[4]
local i, cLine, cName, value
#ifdef __XHARBOUR__
local nLocal := nVars
#else
local nLocal := __mvDbgInfo( HB_MV_PRIVATE_LOCAL, iLevel )
#endif
hb_inetSend(t_oDebugInfo['socket'],prefix+" "+alltrim(str(aParams[5]))+CRLF)
if iCount=0
iCount := nVars
endif
//? "send From Info", cParams, alltrim(str(aParams[5])), nVars, HB_MV, iLevel
for i:=iStart to iStart+iCount
//for i:=1 to nVars
if i > nVars
loop
endif
if HB_MV = HB_MV_PRIVATE
if lLocal .and. i>nLocal
loop
endif
if .not. lLocal .and. i<=nLocal
loop
endif
endif
value := __mvDbgInfo( HB_MV, i, @cName )
// PRI::i:
cLine := left(prefix,3) + "::" + alltrim(str(i)) + "::" +;
cName + ":" + valtype(value) + ":" + format(value)
hb_inetSend(t_oDebugInfo['socket'],cLine + CRLF )
next
hb_inetSend(t_oDebugInfo['socket'],"END"+CRLF)
return
static function getValue(req)
local aInfos := hb_aTokens(req,":")
local v, i, aIndices, cName
//? "getValue", req
#ifndef __XHARBOUR__
#define BEGIN_T switch aInfos[1]
#define TYPE case
#define ENDTYPE exit
#define END_T endswitch
#else
#define BEGIN_T do case
#define TYPE case aInfos[1]=
#define ENDTYPE
#define END_T endcase
#endif
BEGIN_T
TYPE "ERR"
v := __DEBUGITEM()["error"]
ENDTYPE
TYPE "LOC"
v := __dbgVMVarLGet(__dbgProcLevel()-val(aInfos[2]),val(aInfos[3]))
ENDTYPE
TYPE "STA"
v := MyGetSta(val(aInfos[2]),val(aInfos[3]))
ENDTYPE
TYPE "GLO"
v := __dbgVMVarSGet(val(aInfos[2]),val(aInfos[3]))
ENDTYPE
TYPE "EXT"
v := __dbgVMVarSGet(val(aInfos[2]),val(aInfos[3]))
ENDTYPE
TYPE "PRI"
v := __mvDbgInfo(HB_MV_PRIVATE,val(aInfos[3]), @cName)
ENDTYPE
TYPE "PUB"
v := __mvDbgInfo(HB_MV_PUBLIC,val(aInfos[3]), @cName)
ENDTYPE
TYPE "EXP"
v := evalExpression( aInfos[3], val(aInfos[2]))
END_T
#undef BEGIN_T
#undef TYPE
#undef END_T
// some variable changes its type during execution. mha
req := aInfos[1]+":"+aInfos[2]+":"+aInfos[3]+":"+aInfos[4]
if !empty(aInfos[4])
aIndices := hb_aTokens(aInfos[4],",")
for i:=1 to len(aIndices)
if at(valtype(v),"AHO") == 0
return {}
endif
switch(valtype(v))
case "A"
if val(aIndices[i])>len(v)
v := {}
else
v:=v[val(aIndices[i])]
endif
exit
case "H"
if val(aIndices[i])>len(v)
v := {}
else
#ifdef __XHARBOUR__
v := HGetValueAt(v,val(aIndices[i]))
#else
v := hb_HValueAt(v,val(aIndices[i]))
#endif
endif
exit
case "O"
v := __dbgObjGetValue(val(aInfos[2]),v,aIndices[i])
endswitch
next
endif
if at(valtype(v),"AHO") == 0
return {}
endif
return v
STATIC FUNCTION __dbgObjGetValue( nProcLevel, oObject, cVar )
LOCAL xResult
LOCAL oErr
LOCAL t_oDebugInfo := __DEBUGITEM()
#ifdef __XHARBOUR__
LOCAL i
#endif
t_oDebugInfo['lInternalRun'] := .T.
#ifdef __XHARBOUR__
TRY
//xResult := __objSendMsg( oObject, cVar )
xResult := __objGetValueList( oObject )
cVar := upper(cVar)
i:=aScan(xResult,{|x| upper(x[1])=cVar})
if i>0
xResult := xResult[i,2]
else
xResult := nil
endif
CATCH oErr
xResult := oErr
END
#else
BEGIN SEQUENCE WITH {|| Break() }
xResult := __dbgSENDMSG( nProcLevel, oObject, cVar )
RECOVER
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
/* Try to access variables using class code level */
xResult := __dbgSENDMSG( 0, oObject, cVar )
RECOVER USING oErr
xResult := oErr
END SEQUENCE
END SEQUENCE
#endif
t_oDebugInfo['lInternalRun'] := .F.
RETURN xResult
static procedure sendCoumpoundVar(req, cParams )
local value := getValue(@req)
local aInfos := hb_aTokens(req,":")
local aParams := GetStackAndParams(cParams)
local iStart := aParams[2]
local iCount := aParams[3], nMax := len(value)
local i, idx,vSend, cLine, aData, idx2
LOCAL t_oDebugInfo := __DEBUGITEM()
if valtype(value) == "O"
#ifdef __XHARBOUR__
aData := __objGetValueList(value) // , value:aExcept())
#else
aData := __objGetMsgList( value )
#endif
nMax := len(aData)
endif
hb_inetSend(t_oDebugInfo['socket'],req+CRLF)
if right(req,1)<>":"
req+=","
endif
if iCount=0
iCount := nMax
endif
for i:=iStart to iStart+iCount
if i > nMax
loop
endif
switch(valtype(value))
case "A"
idx2 := idx := alltrim(str(i))
vSend:=value[i]
exit
case "H"
#ifdef __XHARBOUR__
vSend:=HGetValueAt(value,i)
idx2 := format(HGetKeyAt(value,i))
#else
vSend:=hb_HValueAt(value,i)
idx2 := format(hb_HKeyAt(value,i))
#endif
idx := alltrim(str(i))
exit
case "O"
#ifdef __XHARBOUR__
idx2 := idx := aData[i,1]
vSend := aData[i,2] //__dbgObjGetValue(VAL(aInfos[2]),value, aData[i])
#else
idx2 := idx := aData[i]
vSend := __dbgObjGetValue(VAL(aInfos[2]),value, aData[i])
#endif
exit
endswitch
cLine := req + idx + ":" + idx2 + ":" + valtype(vSend) + ":" + format(vSend)
hb_inetSend(t_oDebugInfo['socket'],cLine + CRLF )
next
hb_inetSend(t_oDebugInfo['socket'],"END"+CRLF)
return
// returns -1 if the module is not valid, 0 if the line is not valid, 1 in case of valid line
static function IsValidStopLine(cModule,nLine)
LOCAL iModule
LOCAL t_oDebugInfo := __DEBUGITEM()
local nIdx, nInfo, tmp
cModule := lower(alltrim(cModule))
iModule := aScan(t_oDebugInfo['aModules'],{|v| v[1]=cModule})
if iModule=0
return -1
endif
if nLine<t_oDebugInfo['aModules'][iModule,2]
return 0
endif
nIdx := nLine - t_oDebugInfo['aModules'][iModule,2]
tmp := Int(nIdx/8)
if tmp>=len(t_oDebugInfo['aModules'][iModule,3])
return 0
endif
nInfo = Asc(SubStr(t_oDebugInfo['aModules'][iModule,3],tmp+1,1))
return HB_BITAND(HB_BITSHIFT(nInfo, -(nIdx-tmp*8)),1)
static procedure setBreakpoint(cInfo)
LOCAL aInfos := hb_aTokens(cInfo,":"), idLine
local nReq, nLine, nReason, nExtra
LOCAL t_oDebugInfo := __DEBUGITEM()
//? " BRAEK - ", cInfo
nReq := val(aInfos[3])
aInfos[2] := lower(aInfos[2])
if aInfos[1]=="-"
// remove
if hb_HHasKey(t_oDebugInfo['aBreaks'],aInfos[2])
idLine := aScan(t_oDebugInfo['aBreaks'][aInfos[2]], {|v| v[1]=nReq })
if idLine>0
aDel(t_oDebugInfo['aBreaks'][aInfos[2]],idLine)
aSize(t_oDebugInfo['aBreaks'][aInfos[2]],len(t_oDebugInfo['aBreaks'][aInfos[2]])-1)
endif
endif
hb_inetSend(t_oDebugInfo['socket'],"BREAK:"+aInfos[2]+":"+aInfos[3]+":-1:request"+CRLF)
//? "BREAK:"+aInfos[2]+":"+aInfos[3]+":-1:request"
return
endif
if aInfos[1]<>"+"
hb_inetSend(t_oDebugInfo['socket'],"BREAK:"+aInfos[2]+":"+aInfos[3]+":-1:invalid request"+CRLF)
//? "BREAK:"+aInfos[2]+":"+aInfos[3]+":-1:invalid request"
return
endif
nLine := nReq
while (nReason:=IsValidStopLine(aInfos[2],nLine))!=1
nLine++
if (nLine-nReq)>2
exit
endif
enddo
if nReason!=1
nLine := nReq - 1
while (nReason:=IsValidStopLine(aInfos[2],nLine))!=1
nLine--
if (nReq-nLine)>2
exit
endif
enddo
endif
if nReason!=1
if nReason==0
hb_inetSend(t_oDebugInfo['socket'],"BREAK:"+aInfos[2]+":"+aInfos[3]+":-1:invalid"+CRLF)
//? "BREAK:"+aInfos[2]+":"+aInfos[3]+":-1:invalid"
else
hb_inetSend(t_oDebugInfo['socket'],"BREAK:"+aInfos[2]+":"+aInfos[3]+":-1:not found"+CRLF)
//? "BREAK:"+aInfos[2]+":"+aInfos[3]+":-1:not found"
endif
return
endif
if .not. hb_HHasKey(t_oDebugInfo['aBreaks'],aInfos[2])
t_oDebugInfo['aBreaks'][aInfos[2]] := {}
endif
idLine := aScan(t_oDebugInfo['aBreaks'][aInfos[2]], {|v| v[1]=nLine })
if idLine=0
aAdd(t_oDebugInfo['aBreaks'][aInfos[2]],{nLine})
idLine = len(t_oDebugInfo['aBreaks'][aInfos[2]])
endif
nExtra := 4
do While len(aInfos) >= nExtra
if .not. (aInfos[nExtra] $ "?CL")
hb_inetSend(t_oDebugInfo['socket'],"BREAK:"+aInfos[2]+":"+aInfos[3]+":-1:invalid request "+ aInfos[nExtra]+CRLF)
//? "BREAK:"+aInfos[2]+":"+aInfos[3]+":-1:invalid request "+ aInfos[nExtra]
return
endif
if aInfos[nExtra]='C' //count
aInfos[nExtra+1] := Val(aInfos[nExtra+1])
endif
aAdd(t_oDebugInfo['aBreaks'][aInfos[2]][idLine],aInfos[nExtra])
aAdd(t_oDebugInfo['aBreaks'][aInfos[2]][idLine],aInfos[nExtra+1])
aAdd(t_oDebugInfo['aBreaks'][aInfos[2]][idLine],0)
nExtra += 2
enddo
hb_inetSend(t_oDebugInfo['socket'],"BREAK:"+aInfos[2]+":"+aInfos[3]+":"+alltrim(str(nLine))+CRLF)
//? "BREAK:"+aInfos[2]+":"+aInfos[3]+":"+alltrim(str(nLine))
return
static function inBreakpoint()
LOCAL aBreaks := __DEBUGITEM()['aBreaks']
LOCAL nLine := procLine(3), aBreakInfo
local idLine, cFile := lower(procFile(3)), nExtra := 2
LOCAL ck
if .not. hb_HHasKey(aBreaks,cFile)
return .F.
endif
idLine := aScan(aBreaks[cFile], {|v| iif(!empty(v),(aBreakInfo:=v, v[1]=nLine),.F.) })
if idLine = 0
return .F.
endif
//? "BRK in line " + str(nLine)
do while len(aBreakInfo) >= nExtra
switch aBreakInfo[nExtra]
case '?'
#ifndef __XHARBOUR__
BEGIN SEQUENCE WITH {|| Break() }
ck:=evalExpression(aBreakInfo[nExtra+1],1)
END SEQUENCE
#else
TRY
ck:=evalExpression(aBreakInfo[nExtra+1],1)
catch
END
#endif
if valtype(ck)<>'L' .or. ck=.F.
return .F.
endif
exit
case 'C'
aBreakInfo[nExtra+2]+=1
if aBreakInfo[nExtra+2] < aBreakInfo[nExtra+1]
return .F.
endif
exit
case 'L'
BreakLog(aBreakInfo[nExtra+1])
return .F.
endswitch
nExtra +=3
end if
return .T.
static procedure BreakLog(cMessage)
LOCAL cResponse := "", cCur, cExpr
LOCAL nCurly:=0, i
for i:=1 to len(cMessage)
cCur := subStr(cMessage,i,1)
if nCurly=0
if cCur = "{"
nCurly := 1
cExpr := ""
else
cResponse+=cCur
endif
else
if cCur = "{"
nCurly+=1
cExpr+=cCur
elseif cCur = "}"
nCurly-=1
if nCurly=0
cResponse+=format(evalExpression(cExpr,1))
endif
else
cExpr+=cCur
endif
endif
next
hb_inetSend(__DEBUGITEM()['socket'],"LOG:"+cResponse+CRLF)
return
//#define SAVEMODULES
static procedure AddModule(aInfo)
LOCAL t_oDebugInfo := __DEBUGITEM()
local i, idx
#ifdef SAVEMODULES
local j, tmp, cc,fFileModules
fFileModules := fopen("modules.dbg",1+64)
fSeek(fFileModules,0,2)
#endif
for i:=1 to len(aInfo)
aInfo[i,1] := lower(alltrim(aInfo[i,1]))
if len(aInfo[i,1])=0
loop
endif
idx := aScan(t_oDebugInfo['aModules'], {|v| aInfo[i,1]=v[1]})
if idx=0
aAdd(aInfo[i],{}) //statics
aadd(t_oDebugInfo['aModules'],aInfo[i])
else
aAdd(aInfo[i],t_oDebugInfo['aModules'][idx,4])
t_oDebugInfo['aModules'][idx] := aInfo[i]
endif
#ifdef SAVEMODULES
fWrite(fFileModules,aInfo[i,1]+str(aInfo[i,2])+e"\r\n")
for j:=1 to len(aInfo[i,3])*8
tmp := Int(j/8)
cc := asc(substr(aInfo[i,3],tmp+1,1))
fWrite(fFileModules,str(j+aInfo[i,2])+str(HB_BITAND(HB_BITSHIFT(cc, -(j-tmp*8)),1))+str(cc)+e"\r\n")
//? j, HB_BITAND(HB_BITSHIFT(cc, -(j-tmp*8)),1), cc
next
#endif
next
#ifdef SAVEMODULES
fclose(fFileModules)
#endif
return
static procedure AddStaticModule(idx,name,frame)
LOCAL t_oDebugInfo := __DEBUGITEM()
local currModule := t_oDebugInfo['aStack'][len(t_oDebugInfo['aStack']),HB_DBG_CS_MODULE]
local idxModule
currModule := lower(alltrim(currModule))
idxModule := aScan(t_oDebugInfo['aModules'], {|v| v[1]==currModule})
if idxModule=0
aadd(t_oDebugInfo['aModules'],{currModule,0,{},{}})
idxModule := len(t_oDebugInfo['aModules'])
endif
aAdd(t_oDebugInfo['aModules'][idxModule,4],{name,idx,"S",frame})
return
static function replaceExpression(xExpr, __dbg, name, value)
local aMatches := HB_REGEXALL("\b"+name+"\b",xExpr,.F./*CASE*/,/*line*/,/*nMat*/,/*nGet*/,.F.)
local i, cVal
if empty(aMatches)
return xExpr
endif
aadd(__dbg, value )
cVal := "__dbg[" + allTrim(str(len(__dbg))) +"]"
for i:=len(aMatches) to 1 step -1
xExpr := left(xExpr,aMatches[i,1,2]-1) + cVal + substr(xExpr,aMatches[i,1,3]+1)
next
return xExpr
static function evalExpression( xExpr, level )
local oErr, xResult, __dbg := {}
local i, cName, v
LOCAL t_oDebugInfo := __DEBUGITEM()
local aStack := t_oDebugInfo['aStack']
LOCAL iStack := GetStackId(level,aStack)
local aModules := t_oDebugInfo['aModules']
LOCAL cModule, idxModule := 0
if iStack>0
cModule := lower(aStack[iStack,HB_DBG_CS_MODULE])
idxModule := aScan(aModules, {|v| v[1]=cModule})
endif
xExpr := strTran(xExpr,";",":")
xExpr := strTran(xExpr,"::","self:")
if iStack>0
// replace all locals
for i:=1 to len(aStack[iStack,HB_DBG_CS_LOCALS])
xExpr := replaceExpression(xExpr, @__dbg, aStack[iStack,HB_DBG_CS_LOCALS,i,HB_DBG_VAR_NAME], ;
__dbgVMVarLGet(__dbgProcLevel()-aStack[iStack,HB_DBG_CS_LOCALS, i, HB_DBG_VAR_FRAME], aStack[iStack,HB_DBG_CS_LOCALS, i, HB_DBG_VAR_INDEX]))
next
// replace all proc statics
for i:=1 to len(aStack[iStack,HB_DBG_CS_STATICS])
xExpr := replaceExpression(xExpr, @__dbg, aStack[iStack,HB_DBG_CS_STATICS,i,HB_DBG_VAR_NAME], ;
__dbgVMVarSGet(aStack[iStack,HB_DBG_CS_STATICS, i, HB_DBG_VAR_FRAME],aStack[iStack,HB_DBG_CS_STATICS,i,HB_DBG_VAR_INDEX]))
next
endif
// replace all public
for i:=1 to __mvDbgInfo( HB_MV_PUBLIC )
v:=__mvDbgInfo( HB_MV_PUBLIC, i, @cName )
xExpr := replaceExpression(xExpr, @__dbg, cName, v)
next
// replace all private
for i:=1 to __mvDbgInfo( HB_MV_PRIVATE )
v:=__mvDbgInfo( HB_MV_PRIVATE, i, @cName )
xExpr := replaceExpression(xExpr, @__dbg, cName, v)
next
// replace all module statics
if idxModule>0
for i:=1 to len(aModules[idxModule,4])
xExpr := replaceExpression(xExpr, @__dbg, aModules[idxModule,4,i,HB_DBG_VAR_NAME], ;
__dbgVMVarSGet(aModules[idxModule,4,i,HB_DBG_VAR_FRAME],aModules[idxModule,4,i,HB_DBG_VAR_INDEX]))
next
endif
// ******
t_oDebugInfo['lInternalRun'] := .T.
#ifndef __XHARBOUR__
BEGIN SEQUENCE WITH {|oErr| BREAK( oErr ) }
xResult := Eval(&("{|__dbg| "+xExpr+"}"),__dbg)
RECOVER USING oErr
xResult := oErr
END SEQUENCE
#else
TRY
xResult := Eval(&("{|__dbg| "+xExpr+"}"),__dbg)
CATCH oErr
xResult := oErr
END
#endif
t_oDebugInfo['lInternalRun'] := .F.
return xResult
static procedure sendExpression( xExpr )
LOCAL xResult
LOCAL cType, level, iDots := at(":",xExpr)
LOCAL t_oDebugInfo := __DEBUGITEM()
level := val(left(xExpr,iDots))
xResult := evalExpression( substr(xExpr,iDots+1), level)
if valtype(xResult)="O" .and. xResult:ClassName() == "ERROR"
cType := "E"
xResult := xResult:description
else
cType := valtype(xResult)
xResult := format(xResult)
ENDIF
hb_inetSend(t_oDebugInfo['socket'],"EXPRESSION:"+alltrim(str(level))+":"+cType+":"+xResult+CRLF)
return
static procedure sendCompletition( cLine )
LOCAL iDots := at(":",cLine), cResult:="COMPLETITION"+CRLF
LOCAL level := val(left(cLine,iDots-1))
LOCAL t_oDebugInfo := __DEBUGITEM()
cLine := substr(cLine,iDots+1)