1 | XOBVTLS ;; mjk/alb - VistALink Programmer Mode Support Tools ; 07/27/2002 13:00
|
---|
2 | ;;1.5;VistALink;;Sep 09, 2005
|
---|
3 | ;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
|
---|
4 | ;
|
---|
5 | QUIT
|
---|
6 | ;
|
---|
7 | DEBUG ; -- entry point for debugging
|
---|
8 | NEW XOBDSKT
|
---|
9 | ;
|
---|
10 | WRITE !,"Before running this entry point set your debugger"
|
---|
11 | WRITE !,"to stop at the place you want to debug."
|
---|
12 | WRITE !!,"Some possible spots to use:"
|
---|
13 | WRITE !," o SERV+1^XOBVTLS => where debugging starts"
|
---|
14 | WRITE !," o SPAWN+1^XOBVLL => where VistALink spawn starts"
|
---|
15 | WRITE !," o or location of your choice.",!
|
---|
16 | ;
|
---|
17 | WRITE !,"IP Socket to Listen on ('^' to quit): "
|
---|
18 | READ XOBDSKT:300
|
---|
19 | ;
|
---|
20 | ; -- quit if read timed out or up-arrow or number not entered
|
---|
21 | IF '$TEST!(XOBDSKT["^")!(+XOBDSKT=0) DO GOTO DEBUGQ
|
---|
22 | . WRITE !,"Socket number not entered...debug listener not started.",!
|
---|
23 | ;
|
---|
24 | WRITE !!,"================================================"
|
---|
25 | WRITE !,"Starting listener at port ",XOBDSKT," [Job: ",$JOB,"]..."
|
---|
26 | ;
|
---|
27 | ; -- use %ZISTCP to do a single server
|
---|
28 | DO LISTEN^%ZISTCP(XOBDSKT,"SERV^XOBVTLS")
|
---|
29 | ;
|
---|
30 | USE $PRINCIPAL
|
---|
31 | WRITE !!,"Listener stopped on port ",XOBDSKT,"."
|
---|
32 | WRITE !,"Done."
|
---|
33 | WRITE !,"================================================"
|
---|
34 | DEBUGQ QUIT
|
---|
35 | ;
|
---|
36 | SERV ; -- service debug session
|
---|
37 | NEW XOBDEBUG,XOBEC
|
---|
38 | ;
|
---|
39 | ; -- set a debug mode flag for reference
|
---|
40 | SET XOBDEBUG=1
|
---|
41 | ;
|
---|
42 | USE $PRINCIPAL WRITE !!,"Debug mode started...",!
|
---|
43 | USE IO
|
---|
44 | ;
|
---|
45 | ; -- do basic checks and then real spawn
|
---|
46 | SET XOBEC=$$NEWOK^XOBVTCPL()
|
---|
47 | IF XOBEC DO LOGINERR^XOBVTCPL(XOBEC,IO)
|
---|
48 | IF 'XOBEC DO SPAWN^XOBVLL
|
---|
49 | ;
|
---|
50 | ; -- cause the listener to stop
|
---|
51 | SET IO("C")=1
|
---|
52 | QUIT
|
---|
53 | ;
|
---|