ZUGTM.m

ZU ;SF/JLI,RWF - For GT.M, TIE ALL TERMINALS TO THIS ROUTINE!! ;11/24/2003  11:34

 ;;8.0;KERNEL;**275,419**;Jul 10, 1995;Build 5

 ; for GT.M for VMS & Unix, version 4.3

 ;

 ;The env var ZINTRRUPT should be set to catch all interrupts.

EN ;See that escape processing is off, Conflict with Screenman

 U $P:(NOCENABLE:NOESCAPE)

 N $ESTACK,$ETRAP S $ETRAP="D ERR^ZU Q:$QUIT -9 Q"

 S $ZINTERRUPT="I $$JOBEXAM^ZU($ZPOSITION)"

 D:+$G(^%ZTSCH("LOGRSRC")) LOGRSRC^%ZOSV("$LOGIN$")

 D COUNT^XUSCNT(1)

 G ^XUS

 ;

 ;

ERR ;Come here on error

 ; handle stack overflow errors specifically

 I $P($ZS,",",3)["STACKCRIT"!("STACKOFLOW"[$P($ZS,",",3)) S $ET="Q:$ST>"_($ST-8)_"  G ERR2^ZU" Q

 ;

ERR2 ;

 S $ETRAP="D UNWIND^ZU" L  ;Backup Trap

 U $P:NOCENABLE

 Q:$ECODE["<PROG>"

 I $P($ZS,",",2,3)["^XUS1A:2, %GTM-E-IOWRITERR" G HALT

 ;

 D ^%ZTER K %ZT ; Capture symbol table first!

 ;

 I $G(IO)]"",$D(IO(1,IO)),$E($G(IOST))="P" D

 . U IO

 . W @$S($D(IOF):IOF,1:"#")

 I $G(IO(0))]"" D

 . U IO(0)

 . W !!,"RECORDING THAT AN ERROR OCCURRED ---"

 . W !!?15,"Sorry 'bout that"

 . W !,*7

 . W !?10,"$STACK=",$STACK,"  $ECODE=",$ECODE

 . W !?10,"$ZSTATUS=",$ZSTATUS

 ;

 ;

 I $G(DUZ)'>0 G HALT

 S $ET="D HALT^ZU"

 ;

 I $P($ZS,",",3)'["-CTRLC" S XUERF="" G ^XUSCLEAN ;419

CTRLC U $P

 W !,"--Interrupt Acknowledged",!

 D KILL1^XUSCLEAN ;Clean up symbol table

 S $ECODE=",<<POP>>,"

 Q

 ;

UNWIND ;Unwind the stack

 Q:$ESTACK>1  G CTRLC2:$ECODE["<<POP>>"

 S $ECODE=""

 Q

 ;

CTRLC2 S $ECODE="" G:$G(^XUTL("XQ",$J,"T"))<2 ^XUSCLEAN

 S ^XUTL("XQ",$J,"T")=1,XQY=$G(^(1)),XQY0=$P(XQY,"^",2,99)

 G:$P(XQY0,"^",4)'="M" HALT

 S XQPSM=$P(XQY,"^",1),XQY=+XQPSM,XQPSM=$P(XQPSM,XQY,2,3)

 G:'XQY ^XUSCLEAN

 S $ECODE="",$ETRAP="D ERR^ZU Q:$QUIT 0 Q"

 U $P:NOESCAPE

 G M1^XQ

 ;

HALT I $D(^XUTL("XQ",$J)) D:$G(DUZ)>0 BYE^XUSCLEAN

 D COUNT^XUSCNT(-1)

 D:+$G(^%ZTSCH("LOGRSRC")) LOGRSRC^%ZOSV("$LOGOUT$")

 HALT

 ;

JOBEXAM(%ZPOS) ;

 N %reference S %reference=$REFERENCE

 S ^XUTL("XUSYS",$J,0)=$H,^XUTL("XUSYS",$J,"INTERRUPT")=$G(%ZPOS)

 I %ZPOS["^" S ^XUTL("XUSYS",$J,"codeline")=$T(@%ZPOS)

 K ^XUTL("XUSYS",$J,"JE")

 I $G(^XUTL("XUSYS","COMMAND"))'="EXAM" ZSHOW "SD":^XUTL("XUSYS",$J,"JE")

 I $G(^XUTL("XUSYS","COMMAND"))="EXAM" ZSHOW "*":^XUTL("XUSYS",$J,"JE")

 I $G(^XUTL("XUSYS",$J,"CMD"))="HALT" ;To do.

 Q 1

 ;

ZU        ;SF/JLI,RWF - For GT.M, TIE ALL TERMINALS TO THIS ROUTINE!! ;11/24/2003  11:34

 +1       ;;8.0;KERNEL;**275,419**;Jul 10, 1995;Build 5

 +2       ; for GT.M for VMS & Unix, version 4.3

 +3       ;

 +4       ;The env var ZINTRRUPT should be set to catch all interrupts.

EN        ;See that escape processing is off, Conflict with Screenman

 +1        USE $PRINCIPAL:(NOCENABLE:NOESCAPE)

 +2        NEW $ESTACK,$ETRAP

           SET $ETRAP="D ERR^ZU Q:$QUIT -9 Q"

 +3        SET $ZINTERRUPT="I $$JOBEXAM^ZU($ZPOSITION)"

 +4        IF +$GET(^%ZTSCH("LOGRSRC"))

               DO LOGRSRC^%ZOSV("$LOGIN$")

 +5        DO COUNT^XUSCNT(1)

 +6        GOTO ^XUS

 +7       ;

 +8       ;

ERR       ;Come here on error

 +1       ; handle stack overflow errors specifically

 +2        IF $PIECE($ZS,",",3)["STACKCRIT"!("STACKOFLOW"[$PIECE($ZS,",",3))

               SET $ETRAP="Q:$ST>"_($STACK-8)_"  G ERR2^ZU"

               QUIT 

 +3       ;

ERR2      ;

 +1       ;Backup Trap

           SET $ETRAP="D UNWIND^ZU"

           LOCK 

 +2        USE $PRINCIPAL:NOCENABLE

 +3        IF $ECODE["<PROG>"

               QUIT 

 +4        IF $PIECE($ZS,",",2,3)["^XUS1A:2, %GTM-E-IOWRITERR"

               GOTO HALT

 +5       ;

 +6       ; Capture symbol table first!

           DO ^%ZTER

           KILL %ZT

 +7       ;

 +8        IF $GET(IO)]""

               IF $DATA(IO(1,IO))

                   IF $EXTRACT($GET(IOST))="P"

                       Begin DoDot:1

 +9                        USE IO

 +10                       WRITE @$SELECT($DATA(IOF):IOF,1:"#")

                       End DoDot:1

 +11       IF $GET(IO(0))]""

               Begin DoDot:1

 +12               USE IO(0)

 +13               WRITE !!,"RECORDING THAT AN ERROR OCCURRED ---"

 +14               WRITE !!?15,"Sorry 'bout that"

 +15               WRITE !,*7

 +16               WRITE !?10,"$STACK=",$STACK,"  $ECODE=",$ECODE

 +17               WRITE !?10,"$ZSTATUS=",$ZSTATUS

               End DoDot:1

 +18      ;

 +19      ;

 +20       IF $GET(DUZ)'>0

               GOTO HALT

 +21       SET $ETRAP="D HALT^ZU"

 +22      ;

 +23      ;419

           IF $PIECE($ZS,",",3)'["-CTRLC"

               SET XUERF=""

               GOTO ^XUSCLEAN

CTRLC      USE $PRINCIPAL

 +1        WRITE !,"--Interrupt Acknowledged",!

 +2       ;Clean up symbol table

           DO KILL1^XUSCLEAN

 +3        SET $ECODE=",<<POP>>,"

 +4        QUIT 

 +5       ;

UNWIND    ;Unwind the stack

 +1        IF $ESTACK>1

               QUIT 

           IF $ECODE["<<POP>>"

               GOTO CTRLC2

 +2        SET $ECODE=""

 +3        QUIT 

 +4       ;

CTRLC2     SET $ECODE=""

           IF $GET(^XUTL("XQ",$JOB,"T"))<2

               GOTO ^XUSCLEAN

 +1        SET ^XUTL("XQ",$JOB,"T")=1

           SET XQY=$GET(^(1))

           SET XQY0=$PIECE(XQY,"^",2,99)

 +2        IF $PIECE(XQY0,"^",4)'="M"

               GOTO HALT

 +3        SET XQPSM=$PIECE(XQY,"^",1)

           SET XQY=+XQPSM

           SET XQPSM=$PIECE(XQPSM,XQY,2,3)

 +4        IF 'XQY

               GOTO ^XUSCLEAN

 +5        SET $ECODE=""

           SET $ETRAP="D ERR^ZU Q:$QUIT 0 Q"

 +6        USE $PRINCIPAL:NOESCAPE

 +7        GOTO M1^XQ

 +8       ;

HALT       IF $DATA(^XUTL("XQ",$JOB))

               IF $GET(DUZ)>0

                   DO BYE^XUSCLEAN

 +1        DO COUNT^XUSCNT(-1)

 +2        IF +$GET(^%ZTSCH("LOGRSRC"))

               DO LOGRSRC^%ZOSV("$LOGOUT$")

 +3        HALT 

 +4       ;

JOBEXAM(%ZPOS) ;

 +1        NEW %reference