TITLE   ESCAPE to intercept escape conditions
;LOGICAL FUNCTION ESCAPE(IND)
; IND = +1 : initialization call - returns .FALSE.
; IND =  0 : simulates pressing <escape> (does not return, see below)
; IND = -1 : resets <escape> to standard conditions - returns .TRUE.
;    After initialization, pressing <escape> causes control to jump back to
;the return from ESCAPE(+1), but now it returns .TRUE.
;    ESCAPE(+1) may be called many times from different parts of the program;
;previous calls are then ignored.
;    The escape procedure can only jump backwards. Any attempt to jump
;forwards will be ignored; the program will just continue as if nothing had
;happened.
      MODULE  F77_ESCAPE
      EXPORTC ESCAPE
      IMPORTC Remove='Handler'.'XRemoveEventHandler'
      IMPORTC Declare='Handler'.'XDeclareEventHandler'
      IMPORTC Set    ='Handler'.'XSetEventStatus'
      AREADEF DATA,[PIC],DOUBLE
      AREADEF PROG,[PIC,READ,CODE,SHARED],BYTE
      DEFSB   DATA
      AREA    DATA
state ALLOCD  1
stack ALLOCD  1
frame ALLOCD  1
stc   ALLOCD  2
ostak ALLOCD  1
true  DCB     1
false DCD     0
init  DCB     0
      AREA    PROG
;         control comes here when ESCAPE pressed
      MOVD    24(SP),R0   ;address of environment record
      CMPD    ostak,8(R0) ;check for backwards jump
      BLT     wrong
;         OK, so fix up environment record
      MOVD    stc,4(R0)   ;Program Counter from return sequence
      MOVD    ostak,8(R0) ;Stack Pointer for calling program
      MOVD    frame,12(R0);Frame pointer
      MOVW    stc+4,20(R0);MOD register for calling program
      ADDR    true,24(R0) ;R0 points to .TRUE.
                          ;rest of the registers don't matter
      INSSD   =-1,0(R0),0,22;set validity bits
wrong RXP     20          ;return to event processor
ESCAPE
      TBITB   =0,init     ;F set if initialised
      MOVD    0(8(SP)),R0 ;address of argument
      CMPQB   0,0(R0)     ;test argument for +1
      BGE     escp2
      BFS     escp1       ;escape event has been setup
      MOVQB   1,init      ;set initialization flag
;        declare event handler to PANOS
      MOVQD   -6,TOS      ;handle
      MOVQD   2,TOS       ;only action
      MOVQD   6,TOS       ;ESCAPE condition code
      SPRD    MOD,TOS     ;re-construct code descriptor for this module
      CXP     Declare
;        enable ESCAPE condition
      MOVQD   1,TOS       ;enable
      MOVQD   6,TOS       ;ESCAPE condition code
      CXP     Set
      MOVD    R0,state
escp1 SPRD    SP,stack    ;save stack pointer
      ADDR    12(SP),ostak;stack pointer of calling routine
      SPRD    FP,frame    ;save frame pointer
      MOVMD   TOS,stc,2   ;save stack contents     
;        return .FALSE.
      ADDR    false,R0
      RXP     4
escp2 BFC     retn        ;escape not initialized
      BGT     escp3       ;call to reset escape
      LPRD    SP,stack    ;return to previous escape call
      LPRD    FP,frame
      MOVMD   stc,TOS,2
retn  ADDR    true,R0     ;return .TRUE
      RXP     4
escp3 MOVQB   0,init      ;reset initialization flag
;        resume old ESCAPE condition
      MOVD    state,TOS   ;old state
      MOVQD   6,TOS       ;ESCAPE event code
      CXP     Set
;        remove event handler
      MOVQD   -6,TOS      ;handle
      MOVQD   6,TOS       ;ESCAPE condition code
      SPRD    MOD,TOS     ;re-construct code descriptor for this module
      CXP     Remove
      BR      retn
      END