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