[613] | 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 | ;
|
---|