*DECK SNAP
          IDENT  SNAP 
          SST    A
  
          TITLE  SNAP  TEST MODE SNAP PACKAGE.
          LIST   F,X
  
          NOREF  A
  
 B=SNAP   RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
 #SNAP    IFNE   TEST,0 
  
          EXT    FRA=,F.OUT 
 F.BDO    SPACE  4,8
 F.BDO    =      F.OUT       DEFINE BATCH DEBUG OUTPUT FILE TO BE SAME
*                              AS NORMAL OUTPUT FILE AS DEFINED BY
*                              *L=* CC PARAMETER
 PRBDO    SPACE  4,8
**        DEFINE BATCH DEBUG OUTPUT MACRO -- *PRBDO*. 
  
          PURGMAC PRBDO 
  
 PRBDO    OPSYN  LISTL
 FAA=     SPACE  4,8
**        FAA - FIND ABSOLUTE ADDRESS.
* 
* 
*         ENTRY  (X0) = MX0 7*CHAR
*                (X1) = 42/0LNAME, 18/0 
* 
*         EXIT   (X6) .PL. IF ADBS ADDRESS ASSOCIATED WITH NAME 
*                     .MI. IF NO ADDR KNOWN FOR *NAME* (I.E. NO FIND) 
* 
*         USES   X - 2,3,6,7
*                A - 2
*                B - 6,7
* 
*         CALLS  /DBG=IDP/SKT 
  
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
  
 FAA=     SUBR               ** ENTRY/EXIT ** 
          SB6    =XFWA2.0    (B6) = FWA OF (2,0) *RPV* TABLE
          RJ     /DBG=IDP/SKT  SEARCH FOR *NAME*
          SX6    X2+
          NZ     X2,EXIT.    IF A FIND
          SB6    =XLWA2.0+1+LDR.NN  (B6) = FWA OF (2,N) *RPV* TABLE 
          RJ     /DBG=IDP/SKT  SEARCH FOR *NAME*
          SX6    X2 
          NZ     X2,EXIT.    IF A FIND
          MX6    1           SET TO *NO FIND* 
          EQ     EXIT.
 #OS      ENDIF 
 UIO=     SPACE  4,8
**        UIO= - USER IDP OWNCODE.
* 
* 
*         ENTRY  (RA.ORG) =  12/LAST OVERLAY LOADED (0P0S FMT),48/OTHER 
*                (UIOA)   =  48/0,12/LAST OVERLAY LOADED ON PREVIOUS
*                              IDP CALL (0P0S FMT)
* 
*         EXIT   (X1)     =  .MI., I.E. HONOR BREAK 
* 
*                WARNING -- IF THE USER HAS NOT ALLOTTED ENOUGH SPACE 
*                  FOR THE USER *SET* NAME TABLE *IDPSET* TO CONTAIN
*                  ALL THE DEFAULT *SET* NMAES, THEN *ADZ* (CALLED BY 
*                  *IST*) WILL SENSE TABLE OVERFLOW AND XIT TO *IDP=ER*.
*                  THIS CONDITION SHOULD BE AVOIDED.
* 
*         USES   X - 0,1,2,3,6,7   (INCLUDES ALL CALLS) 
*                A - 1,2,6
*                B - 6,7
* 
*         CALLS  CLZ,IST
  
 #OS      IFNE   .OS,2
  
 UIO=     SUBR               ** ENTRY/EXIT ** 
          SA2    RA.ORG 
          SA3    UIOA 
          MX1    1           SET TO *HONOR BREAK* 
          AX2    48-0 
          IX7    X2-X3
          BX6    X2 
          ZR     X7,EXIT.    IF WE ARE STILL IN THE SAME OVERLAY
          SA6    A3 
          SB6    IDPBA
          RJ     CLZ         CLEAR IDP TABLE -- BREAK ADDRESSES 
          SB6    IDPSET 
          RJ     CLZ         CLEAR IDP TABLE -- SET NAMES 
          RJ     IST         (RE)INITIALIZE DEFAULT *SET* NAMES 
          MX1    1           SET TO *HONOR BREAK* 
          EQ     EXIT.
  
  
 UIOA     BSSZ   1           USED TO TELL WHETHER OR NOT A NEW OVERLAY
*                              HAS BEEN LOADED SINCE THE LAST *IDP* 
*                              CALL-- CONTAINS THE MOST RECENT OVERLAY
*                              LOADED NR FROM *RA.ORG* -- 48/0,12/0P0S
 #OS      ENDIF 
 URO=     SPACE  4,8
**        URO= - USER REG= OWNCODE. 
* 
*         ENTRY  NONE 
* 
*         EXIT   (X1) = .MI. IF SNAP TO BE HONORED, ELSE .PL. 
* 
*         USES   X - 1
*                A - 1
* 
*         CALLS  NONE 
  
  
 URO=     SUBR               ** ENTRY/EXIT ** 
          SA1    =XCO.SNAP
          LX1    1RG
          BX1    -X1
          EQ     EXIT.
  
  
 USO=     =      URO= 
 UFT=     SPACE  4,8
**        UFT= - USER FILE NAME TABLE.
  
 #OS      IFNE   .OS,2       IF NOT SCOPE 2 
  
 UFT=     BSS    0
          VFD    42/0LF.OUT,18/=XF.OUT
          VFD    42/0LOUTPUT,18/=XF.OUT 
          DATA   0           END OF TABLE MARK
 #OS      ENDIF 
*CALL DBG=IDP 
 DBG=IDP  SPACE  4,8
          ENTRY  DCM= 
          ENTRY  IDP= 
          ENTRY  IDPFLG 
          ENTRY  REG= 
          ENTRY  SOB
          ENTRY  SNP= 
  
 CHAR     =      /DBG=IDP/CHAR
          IFNE   .OS,2,1     IF NOT SCOPE 2 
 CLZ      =      /DBG=IDP/CLZ 
 DAR      =      /DBG=IDP/DAR 
 DCM      =      /DBG=IDP/DCM 
 DCM=     =      /DBG=IDP/DCM 
          IFNE   .OS,2,1     IF NOT SCOPE 2 
 IDPBA    =      /DBG=IDP/IDPBA 
 IDPFLG   =      /DBG=IDP/IDPFLG
          IFNE   .OS,2,1     IF NOT SCOPE 2 
 IDPSET   =      /DBG=IDP/IDPSET
          IFNE   .OS,2,1     IF NOT SCOPE 2 
 IST      =      /DBG=IDP/IST 
 ROL      =      /DBG=IDP/ROL 
 SNAPLNE  =      /DBG=IDP/SNAPLNE 
 SOB      =      /DBG=IDP/SOB 
 DXP=     SPACE  4,8
**        DXP= - DUMP EXCHANGE PACKAGE. 
* 
* 
*                BECAUSE SCOPE 2 REPRIEVE HAS NO RESET, THE SYSTEM DUMPS
*         ALL REGISTERS AS THEY WERE DURING REPRIEVE PROCESSING; AND
*         BECAUSE THIS IS NOT USEFUL, THIS ROUTINE DUMPS ALL REGISTERS
*         AS THEY WERE WHEN REPRIEVE WAS CALLED. IT ALSO DUMPS 100
*         WORDS EITHER SIDE OF WHAT THE -P- REGISTER WAS WHEN REPRIEVE
*         WAS CALLED. 
* 
*         ENTRY  (A1,X1) = A + C OF 1ST WORD OF EXCHANGE PACKAGE
* 
*         EXIT   NONE 
* 
*         USES   ALL BUT A0,A5,X5 
* 
*         CALLS  COD,DAR,DCM,PRIDP,TEX
  
 .OS      IFEQ   .OS,2       IF SCOPE 2 
  
 DXP=     SUBR   =           ** ENTRY/EXIT ** 
          RJ     TEX         TRANSFER EXCHANGE PACKAGE REGISTERS
  
*         DUMP P,RA,FL,EM,RE,FE, AND MA.
  
 DXP2     SA3    DXPB 
          SX6    X3-6 
          ZR     X6,DXP3     IF DONE
          SX6    X3+B1
          SA6    A3 
          SA2    DXPA+X3     (X2) = .......XX.   (.=BLANK(55B)) 
          SA1    HARDREG+X3  (X1) = SAVED CONTENTS OF HARDWARE REGISTER 
          BX6    X2 
          SA6    =XSNAPLNE
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          LX6    3*CHAR      (X6) = .NNNNNN...
          SA6    A6+B1
          MX7    0
          SA7    A6+B1       MARK EOL 
          PRIDP  SNAPLNE,3
          EQ     DXP2 
  
*         HERE TO DUMP ALL REGISTERS. 
  
 DXP3     RJ     DAR         DUMP ALL REGISTERS 
  
*         HERE TO DUMP 100B WORDS EITHER SIDE OF -P- REGISTER 
  
          SA1    HARDREG     (X1) = -P- REGISTER
          SX4    200B        (X4) = NR OF WORDS TO DUMP (LEN) 
          NZ     X1,DXP4     IF -P- REGISTER NONZERO
          SA1    B0          EXTRACT -P- FROM RA+0
          LX1    59-47+18 
  
 DXP4     MX0    -18
          BX1    -X0*X1 
          SX2    X1-100B     (X2) = FWA TO DUMP 
          RJ     DCM         DUMP CENTRAL MEMORY
          EQ     EXIT.
  
  
 DXPA     DATA   10H1       P  NNNNNN 
          DATA   10H       RA  NNNNNN 
          DATA   10H       FL  NNNNNN 
          DATA   10H       EM  NNNNNN 
          DATA   10H       RE  NNNNNN 
          DATA   10H       FE  NNNNNN 
          DATA   10H       MA  NNNNNN 
  
 DXPB     BSSZ   1
 .OS      ENDIF 
 TEX      SPACE  4,8
**        TEX - TRANSFER EXCHANGE PACKAGE REGISTERS.
* 
* 
*                THIS ROUTINE WILL TRANSFER THE CONTENTS OF THE 
*         REGISTERS IN THE SAVED EXCHANGE PACKAGE TO THE REGISTER SAVE
*         AREA (SVB,SVA,SVX -- AS SET UP BY *COMCSVR*). A SUBSEQUENT
*         CALL TO *RSR=* WOULD RESTORE ALL REGISTERS TO THEIR VALUES
*         AT THE TIME OF THE EXCHANGE.
* 
*         ENTRY  (A1,X1) = A + C OF 1ST WORD OF EXCHANGE PACKAGE
* 
*         EXIT   NONE 
* 
*         USES   X - 0,1,6,7
*                A - 1,6,7
*                B - 2,3,4,5,7
* 
*         CALLS  NONE 
  
  
 TEX      SUBR               ** ENTRY/EXIT ** 
          SA1    A1+16-1     (X1) = LAST WORD OF 16 WORD EXCHANGE PKG 
          SB2    =XSVB
          SB3    =XSVA
          SB4    =XSVX
          SB5    HARDREG
          SB7    7           (B7) = LOOP COUNT -N-
          MX0    -18
  
*         RESTORE -X- REGISTERS.
  
 TEX2     BX6    X1 
          SA6    B4+B7
          SB7    B7-B1       N-1
          SA1    A1-B1
          GE     B7,B0,TEX2  IF MORE -X- REGS TO GO 
  
*         RESTORE -B- AND -A- REGS, AND SAVE P,RA,FL,EM,RE,FE,MA. 
  
          SB7    7           (B7) = LOOP COUNT -N-
  
 TEX3     BX6    -X0*X1      (X6) = (B-N-)
          LX1    -18
          BX7    -X0*X1      (X7) = (A-N-)
          SA6    B2+B7
          SA7    B3+B7
          LX1    -18
          BX6    -X0*X1      (X6) = P,RA,FL,EM,RE,FE,OR MA
          SA6    B5+B7
          SB7    B7-B1       N-1
          SA1    A1-B1
          GE     B7,B0,TEX3  IF NOT DONE
          EQ     EXIT.
  
  
 HARDREG  BSSZ   8           SAVED HARDWARE REGISTERS 
*         BSSZ   1           SAVED P
*         BSSZ   1           SAVED RA 
*         BSSZ   1           SAVED FL 
*         BSSZ   1           SAVED EM 
*         BSSZ   1           SAVED RE 
*         BSSZ   1           SAVED FE 
*         BSSZ   1           SAVED MA 
*         BSSZ   1           DUMMY FOR CONSISTENCY
*CALL COMCSFN 
*CALL COMCSVR 
 SVR=     SPACE  4,8
          ENTRY  SVR=,RSR=
 SVR      =      SVR= 
 RSR      =      RSR= 
  
 #SVR     IF     -DEF,#SVR   IF LOCAL REGISTER SAVE AREA
          ECHO   4,R=(B,A,X)
 SV_R     =      /COMCSVR/SVREG+/COMCSVR/SV_R 
 SAV.R    =      SV_R 
          ENTRY  SV_R,SAV.R 
          ENTRY  SV=R 
 #SVR     ENDIF 
  
          ENTRY  SAVE=,RESET= 
 SAVE=    =      SVR= 
 RESET=   =      RSR= 
  
 #SNAP    ENDIF 
  
          USE    OVLEND 
          ENTRY  LWA2.0 
 LWA2.0   DATA   0           DEFINE LWA (2,0) OVERLAY FOR LOADER CALL 
  
          LIST   D
          END 
