Retro1.org codex

*DECK     SSSPAT
          IDENT  SSSPAT 
          ENTRY  SSSPAT 
          ENTRY  PAT1 
          B1=1
          TITLE  SSSPAT - PROCESS ABNORMAL TERMINATION. 
          COMMENT  BUILT"DATE""TIME"
          SPACE  4,10 
***       SSSPAT - PROCESS ABNORMAL TERMINATION.
* 
*         D. G. DEPEW        81/12/01.
          SPACE  4,10 
***       SSSPAT PERFORMS ALL THE STEPS NECESSARY TO FLUSH THE AIP TRACE
*         FILE (*ZZZZZDN*) WHEN THE PROGRAM TERMINATES ABNORMALLY.
          SPACE  4,10 
***       IDENT  SSSPAT 
* 
*         ENTRY  NONE.
* 
*         EXIT   INITIALIZATION CALL: 
*                  *RPV*  HAS BEEN SET UP TO REPRIEVE ALL CONDITIONS
*                  EXCEPT NORMAL TERMINATION AND TERMINAL INTERRUPTS. 
*                ABNORMAL TERMINATION TRANSFER: 
*                  THE AIP TRACE FILE HAS BEEN FLUSHED, AND THE ERROR 
*                  CONDITION HAS BEEN RESET SO THAT THE OPERATING SYSTEM
*                  CAN PROCESS THE ERROR IN ITS INDUBITABLE FASHION.
* 
*         MACROS NETSTC, REPRIEVE, WRITER.
          SPACE  4,10 
          USE    /TPOINT/    GLOBAL POINTER TABLE FOR DEBUG PURPOSES
          VFD    42/7HREPRIEV,18/RPVPARM
 DNPT     VFD    42/7HZZZZZDN,18/0
          BSSZ   14D
          USE    *
 
 
          USE    /CCARD/     COMMON SERVICES AND SCHEDULING ITEMS 
 NET$ONF  VFD    60/0 
          BSSZ   1
          USE    *
 
 
 SSSPAT   EQ     *+1S17D     ENTRY/EXIT 
 SSSPATX  EQU    *
          SB1    1
          MESSAGE   BLDMSG,0,R
          REPRIEVE  RPVPARM,SET,77B     SET REPRIEVE CONDITIONS 
          JP     SSSPATX
 
 
          USE    /SSBUILD/
 BLDMSG   DIS    ,*    BUILT"DATE""TIME"* 
          USE    *
 
          USE    /RPVCOM/ 
 RPVPARM  VFD    48/25,12/0  REPRIEVE PARAMETER BLOCK 
          VFD    60/PAT1     TRANSFER ADDRESS 
          BSSZ   23 
          USE    *
 
*         CONTENTS OF SYS EQUALS
 
 SYS$EQ   BSS    1
 
 
*         PARAMETERS FOR NETSETF AND NETSTC MACROS. 
 
 GETFET   DATA   0
 DNFETADR BSS    1
 STATOFF  DATA   1
 STATFLAG BSS    1
 
 
 PAT1     BSS    0           REPRIEVE TRANSFER ADDRESS
          SA1    =XSYS= 
          BX6    X1          SAVE LAST CALL TO SYS EQUALS 
          SA6    SYS$EQ 
          SYSTEM DMB,R,0,037B  NEED TO MERGE IN NIN 
          SA2    NET$ONF
          ZR     X2,PAT2     DO NOT FLUSH IF APPL DID NOT NET ON
          RJ     =XSSSPSI 
          NETSTC    STATOFF,STATFLAG     FLUSH *ZZZZZSN* IF PRESENT 
 PAT2     BSS       0 
          SB1    1
          SA1    DNPT        GET *ZZZZZDN* FET ADDRESS
          SX2    X1 
          ZR     X2,PAT3     DON'T FLUSH IF *ZZZZZDN* DOESN'T EXIST 
          WRITER X2,RCL      FLUSH THE BUFFER 
 PAT3     BSS    0
          REPRIEVE  RPVPARM,RESET,77B   RESET ERROR CONDITION 
                                        NO RETURN FROM REPRIEVE,RESET 
 
          END