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