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