         PCC      0                                                             
          SYSTEM   SIG5P                                                        
         SYSTEM   OPTIONS                                                       
          DEF      A:CRS,CRSXIT                                                 
         DEF      SNAP                                                          
         DEF      RECALARM                                                      
         DEF      REX1,REX2                                                     
OLAYFLAG EQU      'CRS'                                                         
         TITLE    '** CRS - CRS/SNAP **'                                        
         TITLE    '** CRS - PROCS AND STUFF **'                                 
*                                                                               
*                                                                               
STDLB    CNAME    7                                                             
OPENIT   CNAME    1                                                             
WRITE    CNAME    1                                                             
SETINDEX CNAME    1                                                             
WEOFF    CNAME    1                                                             
REWINDE  CNAME    1                                                             
READ     CNAME    1                                                             
CLOSEIT  CNAME    1                                                             
GETNAME  CNAME    1                                                             
BKSP     CNAME    1                                                             
         PROC                                                                   
*                                                                               
* AF(1) IS THE FPT ADDRESS; AF(2) IS THE ERROR/ABNORMAL ADDRESS                 
*                                                                               
LF       RES      0                                                             
         LCI      4                 LOAD FPT                                    
         LM,R8    AF(1)             INTO R8-R11                                 
         DO1      NAME=1            IF AN IO CAL                                
         AW,R8    R14               ADD ID BIAS FOR DCB ADDRESS                 
         DO       NUM(AF)>1         IF THERE IS AN ERROR ADDRESS                
         LI,R15   AF(2)             PLACE IN R15                                
         ELSE                                                                   
         LI,R15   %+3               ELSE, FALL THRU                             
         FIN                                                                    
         DO       NUM(AF)>2         IF ERR MESSAGE IS TO BE PRINTED             
         LI,R1    -1                SET R1                                      
         ELSE                                                                   
         LI,R1    0                 ELSE, RESET R1                              
         FIN                                                                    
         CAL1,NAME  R8              DO CAL                                      
         PEND                                                                   
*                                                                               
*                                                                               
* PROC TO SIMPLIFY TYPE  OPERATIONS                                             
*                                                                               
TYPE     CNAME                                                                  
         PROC                                                                   
LF       LD,R8    FPT9              FPT IN R8-R10                               
         LI,R10   AF(1)-TTTT        ADD IN BIAS                                 
         AW,R10   R14               FOR ADDRESS OF MESSAGE                      
         CAL1,2   R8                DO CAL                                      
         PEND                                                                   
*PROCS FOR SNAP AND CRS BRANCHES                                                
*                                                                               
* AF(1) IS THE ADDRESS TO BRANCH TO                                             
*                                                                               
BIFSNAP  CNAME    1                                                             
BIFCRS   CNAME    0                                                             
         PROC                                                                   
LF       RES      0                                                             
         CI,R2    0                                                             
         DO       NAME                                                          
         BNEZ     AF                                                            
         ELSE                                                                   
         BEZ      AF                                                            
         FIN                                                                    
         PEND                                                                   
         SYSTEM   CPRMON                                                        
         TITLE    '** CRS - CRS/SNAP KEY-IN PROCESSING **'                      
****************************************************************                
*THIS WRITES 0 THRU RBMEND TO SE OPLABEL                                        
*  IF A FILE IS SPECIFIED, THE SE OPLABEL IS SET TO IT                          
*  IN KEY6 BEFORE BAL TO HERE                                                   
*                                                                               
*                                                                               
SNAP     RES      0                                                             
         MTB,8    R15               FLAG SNAP ENTRY                             
*******************************************************************             
*                                                                               
* THIS WRITES THE CRASH DUMP FROM THE CK AREA TO THE SE OPLABEL.                
* THE DUMP IS PRECEDED BY A SYMBOL TABLE RECORD.  ALL RECORDS ARE               
* WRITTEN IN 1024 BYTE BLOCKS.  THE LAST IS FOLLOWED BY AN EOF.                 
*                                                                               
CRS      RES      0                                                             
A:CRS    EQU      CRS                                                           
         LI,R0    0                                                             
         XW,R0    S:TRACES          TURN TRACE OFF                              
         PUSH     R0                SAVE OLD TRACE STATUS                       
         PUSH     R15                                                           
*                                                                               
         LI,R7    TEMPEND-TTTT      GET SPACE FOR FPT'S                         
         BAL,R8   GETTEMP           RETURN PTR IN R7                            
         B        NOTS              CANT GET SPACE                              
*               (R1-R6, R15 ARE PRESERVED)                                      
         ENABLE                                                                 
         LI,R6    TEMPEND-TTTT-1    MOVE FPT'S TO TEMP SPACE                    
         LW,R0    TTTT,R6                                                       
         STW,R0   *R7,R6                                                        
         BDR,R6   %-2                                                           
*                                                                               
         LW,R14   R7                                                            
         STB,R6   R14               R14=JUST TEMP SPACE ADDRESS                 
         LB,R2    R15               =0 FOR CRS; =1 FOR SNAP                     
*                                                                               
         SETINDEX FPT1,FREE,MSG     POINT DCB TO SE OP LABEL                    
OPENSE  RES       0                                                             
         OPENIT   FPT2,FREE,MSG     OPEN SE DCB TO SE OP LABEL                  
*                                                                               
         LI,R1    0                                                             
         BAL,R5   FINDBB            GET PTR TO BB PTR IN R15                    
         B        NOBB              CANT GET A BB                               
*                                                                               
         PUSH     R15               SAVE BB ADDRESS                             
         LW,R12   *R15                                                          
         AND,R12  M24                                                           
         BAL,R5   CRS2              MOVE SYMBOL TABLE TO BB                     
*                                                                               
         WRITE    FPT3,ITSAFILE,MSG R12=BUFPTR=BB ADDRESS                       
         PUSH     R12               SAVE R12                                    
         BIFCRS   OPENCK            B IF CRS                                    
         LI,R12   0                 HERE FOR SNAP; R12=BUFPTR=BB ADDRESS        
SNAPIT   WRITE    FPT3,WEOFF1,MSG   WRITE 0 THRU                                
         AI,R12   256                                                           
         CW,R12   STVM                                                          
         BL       SNAPIT                                                        
         B        WEOFF                                                         
********************************************************                        
OPENCK   OPENIT   FPT2A,WEOFF1,MSG  OPEN CK DCB                                 
         LI,R6    CKINDEX           CK AREA INDEX                               
         LB,R4    MDDISCI,R6        GET DISC INDEX, AND THEN                    
         LH,R4    DISCNWPS,R4       WORDS PER SECTOR                            
         LI,R5    255                                                           
         AW,R5    R4                                                            
         DW,R5    R4                R5=SECTORS/BLOCK                            
*                                                                               
         DO       #VDUMP                                                        
         LI,R6    512               # OF 1024 BYTE GLOPS                        
         ELSE                                                                   
         LW,R6    K:UNAVBG          FIRST MISSING MEMORY LOC                    
         DO       #PATCH                                                        
         STW,R5   R15               SAVE R5                                     
         LI,R5    1                                                             
         LI,R13   0                                                             
         LW,R13   *S:TRACE          GET TOP OF TRACE STACK (OR 0)               
         LW,R5    *S:TRACE,R5       GET STACK SIZE                              
         SLS,R5   -16               SHIFT TO GET SPACE COUNT                    
         AND,R5   M15               MASK OFF COUNT                              
         AW,R13   R5                ADD IT TO STACK PTR                         
         CW,R13   R6                IS IT BIGGER                                
         BLE      %+2               NO                                          
         LW,R6    R13               YES, READ TO END OF TRACE                   
         LW,R5    R15               RESTORE R5                                  
         FIN                                                                    
         SLS,R6   -8                R6=# OF 1024 BYTE GLOPS TO TRANSFER         
         FIN      #VDUMP                                                        
*                                                                               
         LI,R13   0                 R13=KEY                                     
*                                   R12=BUFPTR=BB ADDRESS                       
WRITE    RES      0                                                             
         READ     FPT4,WEOFF                                                    
*                                                                               
*                                                                               
         WRITE    FPT3,WEOFF2,MSG                                               
         AW,R13   R5                BUMP KEY                                    
         BDR,R6   WRITE             AND WRITE IT OUT                            
************************************                                            
WEOFF    RES      0                                                             
         TYPE     CORESAVE                                                      
         BIFSNAP  WEOFF1                                                        
WEOFF2   CLOSEIT  FPT8              CLOSE CK DCB                                
WEOFF1   RES      0                                                             
         WEOFF    FPT5              WRITE EOF                                   
         PULL     R12                                                           
TESTFILE LI,R5    0                 TEST FOR A FILE                             
         GETNAME  FPT10,ITSAFILE      ASSIGNMENT                                
         CI,R5    0                 WAS IT A FILE                               
         BNE      ITSAFILE          YES, DONT SAVE MAP AND CPR                  
*                                                                               
         LCI      3                 R3/R4/R5=                                   
         LM,R3    MAPNAME             CPRMAP FILE NAME                          
         SETINDEX FPT11,NOCPR       ASSIGN CK DCB TO CPR MAP FILE               
         OPENIT   FPT2A,NOCPR       OPEN IT                                     
READMAP  READ     FPT12,CLOSEMAP    READ MAP                                    
         LI,R5    X'FFFE0000'                                                   
         LS,R4    CKDCB+4-TTTT,R7   GET ARS FROM CK DCB                         
         STS,R4   SEDCB+3-TTTT,R7   SET RSIZE IN SEDCB                          
*                                                                               
         WRITE    FPT3,NOCPR        WRITE IT OUT                                
         B        READMAP           LOOP                                        
********                                                                        
CLOSEMAP WEOFF    FPT5              WRITE AN EOF                                
         TYPE     MAPSAVE                                                       
         CLOSEIT  FPT8              CLOSE MAP                                   
         LCI      3                 R3/R4/R5=                                   
         LM,R3    CPRNAME             CPRFILE FILE NAME                         
         SETINDEX  FPT11,ITSAFILE   ASSIGN CK DCB TO CPR FILE                   
         OPENIT   FPT2A,ITSAFILE    OPEN IT (CK)                                
READCPR  READ     FPT12,CLOSECPR    READ                                        
         LI,R5    X'FFFE0000'                                                   
         LS,R4    CKDCB+4-TTTT,R7   GET ARS FROM CK DCB                         
         STS,R4   SEDCB+3-TTTT,R7   SET RSIZE IN SEDCB                          
*                                                                               
         WRITE    FPT3,NOCPR        WRITE                                       
         B        READCPR                                                       
********                                                                        
CLOSECPR WEOFF    FPT5              WRITE EOF                                   
         TYPE     CPRSAVE                                                       
NOCPR    RES      0                                                             
         CLOSEIT  FPT8              CLOSE IT                                    
ITSAFILE RES      0                                                             
         WEOFF    FPT5              WRITE FINAL EOF                             
         BKSP     FPT19             AND BACK UP ONE                             
CLOSE1   PULL     R6                                                            
          BAL,R11  RELADBUF                                                     
*                                                                               
CLOSE2   CLOSEIT  FPT7,FREE         CLOSE SE                                    
*                                                                               
*FORCE MD UPDATE                                                                
         LI,R2    'SE'+X'F0000'     SEARCH FOR SE OP-LABEL                      
         LH,R3    OPLBS1            GET LENGTH                                  
OPLBLOOP CH,R2    OPLBS1,R3                                                     
         BE       GOTOPLB                                                       
         BDR,R3   OPLBLOOP                                                      
         CRASH    'IN LOG'                                                      
***********************                                                         
GOTOPLB  LB,R4    OPLBS3,R3         GET ASSIGNMENT                              
         CI,R4    BIT24             IS IT A DEVICE OR FILE                      
         BAZ      STDLB3            DEVICE, DONT NEED TO FUDGE STDLB            
*                                   FILE, SWITCH AWAY AND BACK AGAIN            
         AND,R4   M7                MASK RFT INDEX                              
         LB,R3    RFT8,R4           GET MASTER DIRECTORY INDEX                  
*                                                                               
         LW,R3    MDNAME,R3         GET AREA NAME                               
         LD,R4    RFT1,R4           GET FILENAME                                
         LCI      3                                                             
         STM,R3   *R14              STORE PTR, AREA, AND NAME IN TEMP           
*                                                                               
         STDLB    STDLB0            SET ER OP-LABEL TO ZERO                     
STDLB1   STDLB    STDLB2            AND SWITCH IT BACK                          
STDLB3   RES      0                                                             
*                                                                               
FREE     RES      0                                                             
RELEASE  BAL,R8   RELTEMP           RELEASE TEMP SPACE                          
*                                                                               
STOPP    PULL     R15                                                           
         PULL     R0                GET TRACE STATUS                            
         STW,R0   S:TRACES          RESTORE TRACE SWITCH                        
CRSXIT    B        *R15              AND EXIT                                   
         PAGE                                                                   
*                                                                               
NOTS     LCI      6                 NO TEMP SPACE                               
         LM,R1    SAVEFAIL          R1-R6=ERROR MESSAGE                         
         LD,R8    FPT9              R8-R10=FPT FOR TYPE                         
         LI,R10   R1                                                            
         CAL1,2   R8                TYPE MESSAGE                                
         B        STOPP                                                         
*                                                                               
NOBB     TYPE     SAVEFAIL          NO BLOCKING BUFFER                          
         B        CLOSE2                                                        
         PAGE                                                                   
*                                                                               
* ERROR/ABNORMAL HANDLER                                                        
*                                                                               
ABNERR   RES      0                                                             
         CI,R1    0                 IF ERROR MESSAGE                            
         BEZ      *R15                IS NOT TO BE PRINTED, GO TO *R15          
         TYPE     SAVEFAIL            ELSE, PRINT MESSAGE FIRST                 
         B        *R15              ERROR ADDRESS IN R15                        
**************************************                                          
*                                                                               
FPT      COM,8,24 AF(1),AF(2)                                                   
*                                                                               
BINARY   EQU      X'20000'                                                      
OPLBL    EQU      3                                                             
FILE     EQU      1                                                             
         TITLE    '** CRS - FPTS **'                                            
*                                                                               
*                                                                               
FPT1     GEN,8,1,23 8,1,SEDCB-TTTT  SET INDEX TO SEDCB                          
         DATA     P2                                                            
         DATA     '  SE'                                                        
*                                                                               
FPT2     FPT      X'14',SEDCB-TTTT  OPEN SEDCB                                  
         DATA     P1+P2                                                         
         DATA     ABNERR            ERROR                                       
         DATA     ABNERR            ABNORMAL                                    
*                                                                               
FPT2A    FPT      X'14',CKDCB-TTTT  OPEN CK DCB                                 
         DATA     P1+P2                                                         
         DATA     ABNERR,ABNERR                                                 
*                                                                               
FPT3     FPT      X'11',SEDCB-TTTT  WRITE TO SE OPLABEL                         
         DATA     P1+P2+P3+F3                                                   
         DATA     ABNERR            ERROR                                       
         DATA     ABNERR            ABNORMAL                                    
*BUFPTR  DATA     BB                AT CAL, R12=BUFFER                          
*                                                                               
FPT4     FPT      X'10',CKDCB-TTTT  READ CK AREA                                
         DATA     P1+P2+P3+P8+F3                                                
         DATA     ABNERR            ERROR                                       
         DATA     ABNERR            ABNORMAL                                    
*BUFPTR  DATA     BB                AT CAL, R12=BUFFER                          
*KEY     DATA     0                         R13=KEY                             
*                                                                               
FPT5     FPT      2,SEDCB-TTTT+BIT8 WRITE END OF FILE                           
         DATA     F3                                                            
*                                                                               
FPT6     FPT      1,SEDCB-TTTT+BIT8 REWIND                                      
         DATA     F3                                                            
*                                                                               
FPT7     FPT      X'15',SEDCB-TTTT  CLOSE SE OPLABEL                            
         DATA     P1+P2                                                         
         DATA     ABNERR            ERROR                                       
         DATA     ABNERR            ABNORMAL                                    
*                                                                               
FPT8     FPT      X'15',CKDCB-TTTT  CLOSE CK AREA                               
         DATA     P1+P2                                                         
         DATA     ABNERR            ERROR                                       
         DATA     ABNERR            ABNORMAL                                    
*                                                                               
         BOUND    8                                                             
FPT9     FPT      2,0               FPT TO TYPE  MESSAGES                       
         DATA     P1+F3                                                         
*MSGPTR           AT CAL, R10=ADDRESS OF MESSAGE                                
*                                                                               
FPT10    FPT      9,SEDCB-TTTT+BIT8 TEST FOR FILE ASSIGNMENT                    
         DATA     P1+P4                                                         
         DATA     ABNERR                                                        
         DATA     R3                PUT AREA/NAME IN R3-R5                      
*                                                                               
FPT11    FPT      8,CKDCB-TTTT+BIT8 ASSIGN CKDCB TO FILE                        
         DATA     P1+P4                                                         
         DATA     ABNERR                                                        
         DATA     R3                R3/R4/R5=AREA/FILENAME                      
*                                                                               
*                                                                               
MAPNAME  TEXT     '  SPCPRMAP'                                                  
CPRNAME  TEXT     '  SPCPRFILE'                                                 
*                                                                               
*                                                                               
*                                                                               
FPT12    FPT      X'10',CKDCB-TTTT  READ MAP FROM CK DCB                        
         DATA     P1+P2+P3+F3                                                   
         DATA     ABNERR,ABNERR                                                 
*BUFPTR  DATA     BB                AT CAL, R12=BUFFER                          
*                                                                               
FPT19    FPT      X'1D',BIT8+SEDCB-TTTT BACKSPACE SE TAPE                       
         DATA     P2+BIT27+BIT28    WAIT AND BACKWARD                           
         DATA     ABNERR                                                        
*                                                                               
*                                                                               
*                                                                               
*                                                                               
STDLB0   FPT      X'62',BIT8+'SE'   ZERO SE OP-LABEL                            
         DATA     P1+P2+F2+F3+F7                                                
         DATA     STDLB1                                                        
         DATA     0                                                             
*                                                                               
STDLB2   FPT      X'62',BIT8+'SE'   SET IT BACK                                 
         DATA     P1+P4+F2+F3+F7                                                
         DATA     STDLB3                                                        
         GEN,1,31 1,R14             INDIRECT R14                                
*                                                                               
*                                                                               
         TITLE    '** CRS - DCBS **'                                            
*                                                                               
TTTT     RES      1                 SPARE ONE FOR MOVE                          
SEDCB    FPT      5,BINARY+OPLBL                                                
         FPT      10,13             NRT,SE OPLABEL INDEX                        
         DATA     0                                                             
         GEN,15,17 1024,ABNERR                                                  
         DATA     ABNERR                                                        
*                                                                               
CKDCB    FPT      7,BINARY+FILE                                                 
         FPT      10,CKINDEX**8     NRT,TYPE                                    
         DATA     0                                                             
         GEN,15,17 1024,ABNERR                                                  
         DATA     ABNERR                                                        
         DATA     0,0               NAME                                        
*                                                                               
CORESAVE TEXTC    'CORE SAVED ON SE FILE OR DEVICE'                             
SAVEFAIL TEXTC    'CORE SAVE NOT COMPLETED'                                     
*                                                                               
*                                                                               
MAPSAVE  TEXTC    'FILE CPRMAP SAVED ON SE DEVICE'                              
CPRSAVE  TEXTC    'FILE CPRFILE SAVED ON SE DEVICE'                             
*                                                                               
*                                                                               
*                                                                               
TEMPEND  RES      0                                                             
*                                                                               
         TITLE    '** CRS - ALARM RECEIVER CAL **'                              
         SPACE    2                                                             
****************************************************                            
*        ALARM RECEIVER CAL                                                     
*                 ENTER W/                                                      
*                 R3 = FPT ADDRESS                                              
*                                                                               
*  WORD 0 OF FPT---BIT 0:       1 IF ADDRESS IS INDIRECT                        
*                      1-7:     CODE = X'69'                                    
*                      8:       P0 INDICATOR                                    
*                      9:       1 FOR AUTOMATIC REBOOTING                       
*                      10-31:   RECEIVER ADDRESS                                
*                                                                               
******************************************************                          
RECALARM RES      0                 ALARM RECEIVER CAL                          
         BIFBKG   RECERR1           NOT ALLOWED FROM BACKGROUND                 
         LW,R14   0,R3              R14=WORD 0 OF FPT                           
         CW,R14   Y004              IS REB SET                                  
         BAZ      %+3               NO--SKIP                                    
*                                                                               
         LW,R14   -1                YES--SET                                    
         B        REC01                FOR AUTOMATIC REBOOT                     
*                                                                               
         CW,R14   Y8                IS ADDRESS INDIRECT                         
         BAZ      %+2               NO                                          
         LW,R14   *R14              YES, GET IT                                 
         AND,R14  M17               MASKK ADDRESS                               
*                                                                               
         BEZ      REC01             IF 0, USE IT                                
*                                   ELSE, VERIFY ADDRESS                        
         BAL,R8   MMFMP             FIND PARTITION                              
         B        RECERR              ERROR EXIT                                
         LW,R1    PPT,R7            SEE IF PARTITION IS                         
         LB,R1    R1                  PRIVATE PARTITION                         
         AND,R1   XPPTTYPE          MASK FOR PPT TYPE                           
         CI,R1    PPTTYPE1          IS NOT PRIVATE                              
         BNE      RECERR              PARTITION, CANT DO IT                     
*                                                                               
*                                                                               
*                                                                               
*                                                                               
REC01    STW,R14  ALARMREC          PLACE IN ALARMREC                           
REX1     B        CALEXIT                                                       
*                                                                               
*                                                                               
RECERR   RES      0                 CANT DO IT                                  
         LI,R15   TYC8B             TYC                                         
REX2     B        TMX1              TAKE CARE OF ERROR EXIT                     
*                                                                               
RECERR1  RES      0                 BACKGROUND REQUESTING                       
         LI,R15   TYC6A             NOT ALLOWED                                 
         B        REX2                                                          
*                                                                               
         SPACE    5                                                             
         OLAYEND                                                                
*                                                                               
         END                                                                    
