         PCC      0                                                             
         SYSTEM SIG9P                                                           
         SYSTEM   OPTIONS                                                       
         DEF      A:STDLB                                                       
         DO       #ECB                                                          
         DEF      STLBCHK           ENTRY                                       
         FIN      #ECB                                                          
         DEF      SCALEXIT,SCALERR,SCALTRPX                                     
         DO1      #ECB                                                          
         DEF      STLBCHKX          EXIT                                        
OLAYFLAG EQU 'STDL'                                                             
         SYSTEM   CPRMON                                                        
         TITLE    '** STDLB - STDLB CAL PROCESSOR **'                           
****************************************************                            
*                                                                               
*    STDLB CAL                                                                  
*          ENTERS WITH FPT ADDRESS IN R3                                        
*                                                                               
*****************************************************                           
STDLB    RES      0                 STDLB CAL ENTRY                             
A:STDLB  EQU      STDLB                                                         
         LW,R1    Y008                                                          
         CW,R1    0,R3              IS P0=1                                     
         BAZ      SCALTRPX          BADCAL, P0 MUST BE 1                        
         LI,R15   10                GET ADDRESS OF P10                          
         BAL,R5   GETFPTN                                                       
         B        %+2                                                           
         STW,R1   *R14              SET BUSY BIT                                
*   CHECK VALIDITY OF WAIT/ENQ BITS                                             
         LW,R15   1,R3              FPT WORD 1                                  
         CI,R15   X'40'             IS ENQ SPECIFIED                            
         BAZ      STDLB1            NO, BRANCH                                  
         CI,R15   X'10'             YES, IS WAIT SPECIFIED                      
         BAZ      STDLB1            NO, BRANCH                                  
         BIFSEC   STDLB1            WAIT OK FOR SECONDARY                       
         LI,R15   TYC69             ERROR, PRIMARY TASKS CANT WAIT              
         B        SFPTERR1                                                      
STDLB1   RES      0                                                             
*   GET OPLB INDEX                                                              
         LI,R15   -1                                                            
         BAL,R5   GETPSI            GET OPLABEL TO REASSIGN                     
         NOP      0                 FPT WORD 0 IS ALWAYS PRESENT                
         LI,R4    1                                                             
         LH,R0    R15,R4            GET SIGN EXTENDED OPLABEL NAME              
         LH,R4    OPLBS1            R4= # OPLB TABLE ENTRIES                    
         CH,R0    OPLBS1,R4                                                     
         BE       STDLB2            FOUND IT, R4=INDEX                          
         BDR,R4   %-2               ELSE LOOP                                   
         LI,R15   X'74'             ERROR, BAD OPLB NAME                        
         B        SFPTERR1          TAKE ERROR EXIT                             
STDLB2   RES      0                                                             
         BAL,R9   STDPRO            DO CAL                                      
         NOP                        ERROR RETURN, R15= TYC                      
*                                                                               
*   DONE WITH STDLB PROCESSING                                                  
*                                                                               
         BAL,R8   STDCUP            GO DO GENERAL CLEANUP                       
*                                                                               
SFPTERR1 RES      0                                                             
         CI,R15   TYCNORM           IS IT NORMAL COMPLETION                     
         BNE      STDLB3            NO, BRANCH                                  
         BAL,R8   TMTYC15           YES, POST IN STATUS WORD                    
         B        SCALEXIT          EXIT                                        
*                                                                               
STDLB3   RES      0                                                             
         CI,R15   TYCIO             TEST TYC                                    
         BLE      %+2               B IF R15 IS AN ERROR CODE (NOT TYC)         
         BAL,R8   TMTYC15           POST TYC IN COMPL STATUS WORD               
         LW,R9    R15               R9= TYC                                     
         LI,R15   FPTERAD                                                       
         BAL,R5   GETFPTN           GET ERROR ADDRESS                           
         NOP                        R15= 0 IF NOT PRESENT                       
         LW,R5    R15               SAVE ERR ADDR IN R5                         
         LW,R15   R9                R15= TYC                                    
         LW,R6    R3                R6 CONTAINS FPT ADDRESS                     
         BAL,R8   TMSETREG          CHANGE R8,R10                               
         LW,R9    R5                R9= ERROR ADDRESS                           
         BAL,R6   TMSETPSD          MODIFY RETURN ADDRESS= ERROR ADDR           
         CI,R15   X'F0'             TEST TYC                                    
         BGE      SCALERR           TAKE CAL ERR EXIT                           
SCALEXIT B        CALEXIT                                                       
SCALERR  B        CALERR                                                        
SCALTRPX B        TRAPX                                                         
         TITLE    '** STDLB - STDPRO SUBROUTINE **'                             
********************************************************                        
*   STDPRO      SUBROUTINE TO PROCESS STDLB CAL                                 
*        RETURN TO CALL+1 IF ERROR, R15=TYC                                     
*        RETURN TO CALL+2 IF OK,    R15=1                                       
*        CALL    BAL,R9   STDPRO                                                
*        ON ENTRY, R3= USER FPT ADDRESS                                         
*                  R4= INDEX OF OPLB TO ASSIGN                                  
*                  R9= LINK                                                     
********************************************************                        
*                                                                               
STDPRO   RES      0                                                             
         LW,R1    R9                SAVE LINK IN R1                             
         BAL,R6   GETSPCE           GET TSPACE FOR OPEN/CLOSE                   
         B        SFPTERR1          ERROR, NO TSPACE AVAILABLE                  
*                                                                               
*                                                                               
*   CHECK IF OPLB IS TO BE ASSIGNED TO ANOTHER OPLB                             
         PUSH     R1                SAVE LINK IN STACK                          
         LI,R1    0                 PRE-SET INDEX= NULL ASSIGNMENT              
         LI,R15   K2                                                            
         BAL,R5   GETFPTN           GET OPLB NAME IN R15                        
         B        SPR2              NOT PRESENT                                 
         BAL,R0   GETEFADR          GET TRUE ADDRESS                            
         LI,R5    1                                                             
         LH,R15   R15,R5            SIGN EXTEND FOR CH                          
         BEZ      SPRP04C           ZERO= NULL ASSIGNMENT                       
         LH,R1    OPLBS1            R1= # OF OPLBS IN TABLE                     
         CH,R15   OPLBS1,R1                                                     
         BE       SPR1A             B IF MATCH FOUND                            
         BDR,R1   %-2                                                           
         B        SPRERR            ERROR, NO SUCH OPLB                         
SPR1A    RES      0                                                             
         LB,R5    TCBPOINT          TASK ID                                     
         LB,R5    STIJID,R5         JOB ID                                      
         LW,R5    SJI1,R5           JCB ADDRESS                                 
         LW,R5    JCBOPL2,R5        R5= OPLB TABLE ADDRESS                      
         DISABLE                                                                
         LB,R1    *R5,R1            R1= DEV/FILE INDEX FOR NEW ASSN.            
         CI,R1    X'80'             IS IT A RAD FILE                            
         BAZ      SPR1B             NO, BRANCH                                  
         LW,R2    R1                                                            
         AND,R2   M7                R2= RFT INDEX                               
         MTB,1    RFT13,R2          INCR OPEN DCB COUNT                         
         BIFFGD   %+2               B IF FOREGROUND                             
         MTB,1    RFT15,R2          INCR BKGD DCB COUNT                         
         LB,R5    TCBPOINT          TASK ID                                     
         LB,R5    STILMID,R5        LM ID                                       
         LW,R5    LMIRFT,R5         ADDR. OF FILE ACTIVITY TABLE                
         BEZ      %+2               B IF NONEXISTENT                            
         MTB,1    *R5,R2            INCREMENT OPEN DCB COUNT                    
SPR1B    ENABLE                                                                 
         B        SPRP04C                                                       
*                                                                               
*                                                                               
*   CHECK IF OPLB IS TO BE ASSIGNED TO A DEVICE                                 
SPR2     RES      0                                                             
         LI,R15   K3                                                            
         BAL,R5   GETPII            GET ADDRESS OF DEVICE NAME                  
         B        SPR3              BRANCH IF NO DEVICE                         
         LW,R6    R14               USE ADDRESS                                 
         LW,R10   0,R6              1ST HALF OF DEVICE NAME                     
         LW,R11   1,R6              2ND HALF OF DEVICE NAME                     
         CD,R10   ZEROS             NULL IF R10,11= 0,0                         
         BE       SPRP04C           NULL, R1 CONTAINS 0                         
         LH,R0    R10                                                           
         SLD,R10  -24               CONVERT TO DCT16 FORMAT                     
         OR,R10   Y155A5A           MERGE WITH 'NL,BANG,BANG'                   
         LH,R1    DCT7              R1= # OF DCT ENTRIES                        
         CD,R10   DCT16,R1          IS IT EQUAL                                 
         BE       SPRP04C           YES, R1= DCT INDEX                          
         BDR,R1   %-2               LOOP                                        
         B        SPRERR            INVALID DEVICE NAME, ERROR                  
*                                                                               
*                                                                               
*   CHECK IF OPLB IS TO BE ASSIGNED TO A RAD FILE                               
SPR3     RES      0                                                             
         LI,R15   K4                                                            
         BAL,R5   GETPII            GET AREA/FILE NAME ADDRESS                  
         B        SPR4              NOT PRESENT                                 
         LW,R6    R14               USE ADDRESS                                 
         LW,R8    0,R6              R8= AREA NAME                               
         LW,R12   1,R6              R12,13= FILE NAME                           
         LW,R13   2,R6                                                          
         CD,R12   ZEROS             IS FILE NAME ZERO                           
         BNE      SPR3A             B IF NOT                                    
         CI,R8    0                 YES, IS AREA NAME ALSO ZERO                 
         BE       SPRP04C           YES, NULL ASSIGNMENT                        
SPR3A    RES      0                                                             
         DO       #DFACNT                                                       
         LI,R15   KE                                                            
         BAL,R5   GETPII            GET ACCNT NAME IF SPECIFIED                 
         LI,R14   BLANKS            DEFAULT IF NOT SPECIFIED                    
         LCI      2                                                             
         LM,R10   *R14              GET ACNT NAME IN R10, R11                   
         FIN                        #DFACNT                                     
         LW,R14   R8                GET AREA NAME IN R8                         
         LI,R8    1                 R8= ASN= 1                                  
         BAL,R6   STDOPEN           OPEN DCB                                    
         B        SPRP801           ERROR                                       
         LW,R1    2,R7              DCB WORD 1                                  
         AND,R1   M7                MASK                                        
         LB,R5    TCBPOINT          TASK ID                                     
         LB,R5    STIJID,R5         JOB ID                                      
         CI,R5    RBMJID            IS IT THE CPR/RBM JOB ID                    
         BNE      SPR3C             NO, BRANCH                                  
         LI,R5    0                 YES, SET JOB# TO ZERO                       
         STB,R5   RFT9,R1                                                       
SPR3C    RES      0                                                             
         OR,R1    X80               R1= RFTX IN OPLB TABLE FORMAT               
         B        SPRP04C                                                       
*                                                                               
*                                                                               
*   NO ASSIGNMENT WAS INDICATED.                                                
SPR4     RES      0                                                             
*                                   R1 = 0, INDEX FOR NULL ASSIGNMENT           
         PAGE                                                                   
*                                                                               
*                                                                               
*   HERE A NEW ASSIGNMENT WILL BE DONE.                                         
*    R1= INDEX OF NEW ASSIGNMENT (0, DCT INDEX, RFT INDEX)                      
*    R3= FPT ADDRESS                                                            
*    R4= OPLB INDEX                                                             
*                                                                               
SPRP04C  CI,R4    OC                IS OP LABEL OC                              
         BNE      SPRP04E           NO                                          
         LB,R5    TCBPOINT          TASK ID                                     
         LB,R6    STIJID,R5         JOB ID                                      
         CI,R6    1                 ONLY JOB 1 CAN CHANGE OC                    
         BNE      SPRERR            NOT JOB 1                                   
         CI,R1    0                 IS IT THE NULL ASSIGNMENT                   
         BE       SPRERR            ERROR, OC CANT BE ASSIGNED TO 0             
         CI,R1    X'80'             IS NEW ASSIGNMENT TO RAD FILE               
         BGE      SPRERR            YES,CANT ASSIGN OC TO RAD FILE              
         LB,R5    DCT4,R1           IS IT A TY DEVICE                           
         CI,R5    DCT4:TY                                                       
         BNE      SPRERR            ERROR, MUST BE TY DEVICE                    
         LB,R5    DCTJID,R1         IS IT A SHARABLE DEVICE                     
         BEZ      SPRP05            YES, BRANCH                                 
         B        SPRERR            NO, ERROR                                   
SPRP04E  RES      0                                                             
         CI,R1    X'80'             IS IT A RAD FILE                            
         BANZ     SPRP05            YES, BRANCH                                 
         CI,R1    0                 IS IT THE NULL ASSN.                        
         BE       SPRP05            B IF YES                                    
         LB,R5    DCTJID,R1         SEE IF DEVICE IS EXCLUSIVE                  
         BEZ      SPRP05            ZERO= SHARABLE                              
         DO       #SYMB                                                         
         BIFFGD   SPRP04G           B IF CALLER IS NOT BACKGROUND               
         LB,R6    DCTSYM1,R1        GET SYMBIONT FLAGS                          
         CI,R6    DCTSYMSM          IS THE DEVICE DED TO SYMB                   
         BANZ     SPRP05            YES, OK IF DEVICE NOT AVAILABLE             
SPRP04G  RES      0                                                             
         FIN      #SYMB                                                         
         LB,R6    TCBPOINT          TASK ID                                     
         LB,R6    STIJID,R6         CALLER'S JOB ID                             
         CI,R5    X'FF'             EXCL.,SEE IF USED                           
         BE       SPRP04F           NOT USED, GO OPEN IT                        
         CW,R6    R5                WAS DEVICE OBTAINED BY CALLER'S JOB         
         BE       SPRP04F           YES, OK TO CONTINUE                         
         DO       #ECB                                                          
         CI,R6    RBMJID            NO, IS CALLER IN CPR JOB                    
         BNE      SPRENQ            NOT CPR JOB SO CHECK FOR ENQ                
         FIN      #ECB                                                          
         B        STDPRE83          ERROR, CPR JOB CAN'T ENQ VIA STDLB          
SPRP04F  RES      0                                                             
         CI,R6    RBMJID            IS THIS THE CPR JOB                         
         BE       SPRP05            YES, DO STDLB BUT DON'T ENQ                 
         LD,R12   DCT16,R1                                                      
         SLD,R12  24                DEVICE NAME LEFT-ALIGNED                    
         LI,R8    3                 R8= ASN= 3 FOR DEVICE                       
         BAL,R6   STDOPEN           GO OPEN DEV OR RAD FILE                     
         B        SPRP802           OPEN ERROR                                  
         B        SPRP05                                                        
         PAGE                                                                   
*                                                                               
*   R1= INDEX OF NEW ASSIGNMENT (0, RFT INDEX, DCT INDEX)                       
*   R3= FPT ADDRESS                                                             
*   R4= OPLB INDEX                                                              
*                                                                               
SPRP05   RES      0                 IF JOB 1, CHANGE ALL JCB ASSIGNMENTS        
*        THAT MATCH THE CPR ASSIGNMENT UNLESS THE NEW                           
*        ASSIGNMENT IS A  NON-SHARABLE DEVICE.  IF                              
*        THE CALLER IS NOT IN THE CPR JOB THEN CHANGE ONLY                      
*        THE OPLB ASSIGNMENT IN THE CALLER'S JOB.  THE PREVIOUS                 
*        DEVICE/FILE ASSIGNMENT WILL BE CLOSED AS REQUIRED.                     
         LW,R0    1,R3              FPT WORD 1                                  
SPR055   RES      0                 AT SPR055 R0=FPT WORD 1                     
         LB,R5    TCBPOINT          TASK ID                                     
         LB,R5    STIJID,R5         JOB ID                                      
         LW,R5    SJI1,R5           R5= JCB ADDRESS                             
         LW,R11   JCBOPL2,R5        R11= OPLB TABLE ADDRESS                     
         LB,R2    *R11,R4           R2= CURRENT ASSIGNMENT                      
         BEZ      SPRP06            B IF NULL ASSIGNMENT                        
         CI,R2    X'80'             IS IT A RAD FILE                            
         BANZ     SPRP06            B IF RAD FILE                               
         LB,R15   DCTJID,R2         GET JOB ID ENTRY                            
         BEZ      SPRP06            SHARABLE DEVICE, BRANCH                     
         LB,R5    TCBPOINT          TASK ID                                     
         LB,R5    STIJID,R5         JOB ID                                      
         CW,R5    R15               COMPARE JOB ID'S                            
         BNE      SPRP06            REASSIGN OPLB WITHOUT CLOSE                 
*   THE PREVIOUS ASSIGNMENT IS AN EXCLUSIVE DEVICE.                             
*   IF THE 'RLS' BIT IS SET IN THE FPT, THE OPEN DCB                            
*   COUNT WILL BE FORCED TO 1 SO THAT THE CLOSE WILL                            
*   GIVE UP THE DEVICE.   IF 'RLS'=0, A CLOSE                                   
*   WILL BE DONE WITHOUT REGARD TO CURRENT COUNT.                               
         CI,R0    K20               JOB ID OK; CHECK RLS IN FPT WORD 1          
         BAZ      SPRP05B           B IF 'RLS' NOT REQUESTED                    
         LI,R13   1                 RLS REQUESTED, SET OPEN COUNT               
         STB,R13  DCTDCB,R2          TO ONE TO FORCE RELEASE.                   
SPRP05B  RES      0                                                             
         LD,R12   ZEROS                                                         
         LB,R14   DCT4,R2           R14= DEVICE TYPE FOR CLOSE DCB              
         SLS,R14  8                 POSTITION TO TYPE FIELD                     
         OR,R14   R2                MERGE DCT INDEX                             
         AI,R14   X'8000'           MERGE DEVF BIT                              
         LI,R8    K3                ASN FIELD= 3 FOR DEVICE                     
         BAL,R6   STDCLOSE          CLOSE THE DEVICE                            
         B        SPRP801           ERROR, TAKE ERROR EXIT TO USER              
*                                                                               
*   R1=  INDEX OF NEW ASSIGNMENT                                                
*   R2=  INDEX OF CURRENT ASSIGNMENT                                            
*   R3=  FPT ADDRESS                                                            
*   R4=  OPLB INDEX                                                             
*   R7=  TSPACE ADDRESS                                                         
*   R11= CURRENT JOB'S OPLB TABLE ADDRESS                                       
*                                                                               
SPRP06   RES      0                                                             
         CI,R1    0                 IS THIS THE NULL ASSIGNMENT                 
         BE       SPRP061B          YES, BRANCH                                 
         CI,R1    K80               IS IT A RAD FILE                            
         BANZ     SPRP061B          YES, BRANCH                                 
*   THE NEW ASSIGNMENT IS A DEVICE.  CHECK TO SEE IF IT IS                      
*   AN EXCLUSIVE DEVICE.                                                        
         LB,R5    DCTJID,R1         GET JOBID FOR NEW ASSIGNMENT                
         BNEZ     SPRP061A          EXCL, CHANGE CALLER'S OPLB ONLY             
SPRP061B RES      0                                                             
         LB,R5    TCBPOINT          TASK ID                                     
         LB,R5    STIJID,R5         JOB ID                                      
         CI,R5    RBMJID            IS IT THE RBM JOB                           
         BE       SPR06A            YES, BRANCH                                 
SPRP061A RES      0                                                             
         STB,R1   *R11,R4           STORE NEW ASSIGNMENT                        
         B        SPR06D                                                        
*                                                                               
SPR06A   RES      0                                                             
         LB,R5    SJI3              R5= # OF JOBS POSSIBLE                      
         DISABLE                                                                
SPR06B   LW,R6    SJI1,R5           R6= 1ST/NEXT JCB ADDRESS                    
         BEZ      SPR06C            NOT USED, GET NEXT                          
         LW,R10   JCBOPL2,R6        R10= OPLB TABLE ADDRESS                     
         CI,R5    BKGJID            YES, IS THIS THE BKGD JOB                   
         BNE      %+3               B IF NOT                                    
         CI,R4    C                 ASSIGNING THE C OPLB                        
         BE       SPR06B1           YES, STORE NEW ASSIGNMENT                   
         CB,R2    *R10,R4           COMPARE WITH RBM ASSIGNMENT                 
         BNE      SPR06C            DIFFERENT, LEAVE IT ALONE                   
SPR06B1  RES      0                                                             
         STB,R1   *R10,R4           SAME AS RBM, CHANGE ASSIGNMENTS             
SPR06C   BDR,R5   SPR06B            LOOP                                        
         ENABLE                                                                 
SPR06D   RES      0                                                             
         CI,R2    X'80'             IS OLD ASSIGNMENT A RAD FILE                
         BAZ      SPREXIT           NO, DONE                                    
         AND,R2   M7                R2= RFT INDEX                               
         MTB,0    RFT13,R2          TEST OPEN DCB COUNT                         
         BNEZ     SPREXIT           NON-ZERO, DONT CLOSE FILE                   
         LD,R12   RFT1,R2           R12,13= FILE NAME                           
         LB,R14   RFT8,R2           R14= AREA INDEX                             
         SLS,R14  8                 SHIFT TO DCB 'TYPE' POSTITION               
         OR,R14   R2                MERGE RFT INDEX                             
         LI,R8    K1                R8= ASN= 1 FOR RAD FILE                     
         BAL,R6   STDCLOSE          CLOSE THE RAD FILE                          
         NOP                        IGNORE CLOSE ERRORS                         
         B        SPREXIT           DONE                                        
         PAGE                                                                   
*                                                                               
*   R1=    DEVICE INDEX OF NEW ASSIGNMENT                                       
*   R3=    FPT ADDRESS                                                          
*   R4=    OPLB INDEX                                                           
*   R7=    TSPACE ADDRESS                                                       
*                                                                               
         DO       #ECB                                                          
SPRENQ   RES      0                 TREATS ENQ REQUESTS                         
         LW,R2    1,R3              FPT WORD 1                                  
         CI,R2    X'40'             IS ENQ SPECIFIED                            
         BAZ      STDPRE83          NO, ERROR 83                                
         PUSH     11,R1                                                         
         LW,R7    R4                R7=OPL INDEX                                
         LB,R4    TCBPOINT          R4=TASK ID                                  
         LW,R10   R1                R10=DCT INDEX                               
         LI,R11   0                                                             
*                                     JOB LEVEL AET                             
*                                     SYSTEM LEVEL EDT                          
*                                     NORMAL                                    
*                                     EXCLUSIVE                                 
*  SET BITS 6-7 OF BYTE 0 SAME AS FPT ENQ-REL BITS. R9 PRESERVED THRO TO CK     
         LW,R9    R2                                                            
         AND,R9   X60               MASK ENQ AND REL BITS                       
         SLS,R9   19                MOVE TO BYTE 0 BITS 6-7                     
         AW,R9    YD                ENQ FLAGS 1101                              
         BAL,R8   TMENQ             ENQUEUE                                     
         B        SPRENQX           ERROR RETURN                                
         PULL     11,R1                                                         
         CI,R15   TYCNORM           NORMAL COMPLETION MEANS                     
*                                     JOB ID IS IN DCT                          
         BG       SPCEXITA          TIMEOUT RETURN                              
         BL       SPREXIT           0=STILL ENQUEUED SO JUST EXIT               
*                                     ;USER MUST DO A CHECK                     
         LD,R12   DCT16,R1                                                      
         SLD,R12  24                DEVICE NAME LEFT-ALIGNED                    
         LI,R8    K3                R8= ASN= 3 FOR DEVICE                       
         BAL,R6   STDOPEN           OPEN THE DEVICE                             
         B        SPRP801           ERROR                                       
         B        SPRP05                                                        
*                                                                               
*                                                                               
SPRENQX  RES      0                                                             
         PULL     11,R1                                                         
         B        SPCEXITA                                                      
         TITLE    '** STDLB - STDLB CHECK SROUTINE **'                          
**********************************************************                      
*        STLBCHK ROUTINE ENTRY                           *                      
*                 BAL,R8            STLBCHK              *                      
*   AT ENTRY:     R1    FPT ADDRESS                                             
*                 R2    ECB ID                                                  
*                 R4    TASK ID                                                 
*                 R8    LINK                                                    
*                                                                               
*   STDLB CHECK RESULTS IN AN ENQ CHECK                                         
*                                                                               
**********************************************************                      
*                                                                               
STLBCHK  RES      0                 STDLB CHECK ROUTINE                         
         PUSH     R8                SAVE RETURN                                 
         BAL,R8   ENQCHK            CHECK                                       
         B        STLBCHK3          TAKE BUSY EXIT                              
         CI,R15   TYCNORM           CHECK FOR NORMAL COMPLETION                 
         BNE      STLBCHK2          ABN                                         
*   HERE WE HAVE THE REQUESTED DEVICE FREE                                      
*        R7=   INDEX OF OPLB TO RE-ASSIGN                                       
*        R9    BIT 6 AND 7 CONTAIN ORIGINAL FPT ENQ,RLS BIT SETTING             
*        R10   DEVICE INDEX OF NEW ASSIGNMENT                                   
*                                                                               
         LW,R2    R9                                                            
         SLS,R2   -19               R2 LOOKS LIKE ORIGINAL FPT WORD 1           
         LW,R4    R7                R4= OPLB INDEX                              
         LW,R1    R10               R1= INDEX OF NEW ASSIGNMENT                 
         BAL,R6   GETSPCE           GET TSPACE FOR CLOSE/OPEN                   
         B        STLBCHK2          ERROR, NONE AVAILABLE                       
         LW,R0    R2                R0 LOOKS LIKE ORIGINAL FPT WORD 1           
         LI,R9    STLBCHK1          RETURN ADDRESS FOR SIMULATED                
         PUSH     R9                 BAL,R9 SPRO55                              
         B        SPR055            B TO FINISH STDLB REQUEST                   
STLBCHK1 NOP                        ERROR RETURN, R15= TYC                      
         BAL,R8   STDCUP            DO CLEANUP                                  
STLBCHK2 BAL,R8   TMSETERR          SET ERROR ADDRESS, REGISTERS                
         PULL     R8                                                            
         AI,R8    1                 TAKE NON-BUSY EXIT(R15=TYC)                 
STLBCHKX B        *R8                                                           
*                                                                               
STLBCHK3 PULL     R8                                                            
         B        STLBCHKX          EXIT +1 (BUSY RETURN)                       
         FIN      #ECB                                                          
         PAGE                                                                   
GETSPCE  RES      0                 ROUTINE TO GET TSPACE                       
         LI,R7    16                                                            
         BAL,R8   GETTEMP                                                       
         B        0,R6              NONE, ERROR                                 
         LB,R5    TCBPOINT                                                      
         LW,R8    STISPCE,R5        LINK TSPACE TO TASK CHAIN                   
         STW,R8   0,R7                                                          
         STW,R7   STISPCE,R5                                                    
         ENABLE                                                                 
         B        1,R6              RETURN                                      
*                                                                               
*                                                                               
*   ROUTINE TO DO GENERAL CLEANUP                                               
*                                                                               
*   R1= INDEX OF NEW ASSIGNMENT                                                 
*   R8= LINK                                                                    
*                                                                               
STDCUP   RES      0                                                             
         PUSH     R8                SAVE LINK TOO CALLER                        
         CI,R15   TYCNORM           IS THE TYC NORMAL                           
         BNE      STDCUP2           NO, BRANCH                                  
         CI,R1    X'80'             IS NEW ASSIGNMENT A RAD FILE                
         BAZ      STDCUP2           NO, BRANCH                                  
         AND,R1   M7                YES, R1= RFT INDEX                          
         DISABLE                                                                
*  ALTER RFT COUNT SO USER CAN OPEN                                             
         BIFFGD   STDCUP1           SKIP RFT15 IF FGD                           
         MTB,-1   RFT15,R1                                                      
STDCUP1  MTB,-1   RFT13,R1                                                      
         LB,R5    TCBPOINT          TASK ID                                     
         LB,R5    STILMID,R5        LOAD MODULE ID                              
         LW,R5    LMIRFT,R5         ADDRESS OF FILE ACTIVITY TABLE              
         BEZ      %+2               B IF NON EXISTENT                           
         MTB,-1   *R5,R1            DECREMENT COUNT FOR THIS FILE               
         ENABLE                                                                 
STDCUP2  RES      0                                                             
         LB,R5    TCBPOINT                                                      
         AI,R5    STISPCE           FORM CHAIN HEADER                           
         DISABLE                                                                
         LW,R6    *R5               GET PTR IN R6                               
STDDECH1 BEZ      STDDECH3          NONE SO RETURN                              
         CW,R6    R7                SEE IF IT IS STDLB TSPACE                   
         BNE      STDDECH2          NO                                          
         LW,R6    *R6               YES, GET NEXT IN CHAIN                      
         STW,R6   *R5               FIX LINK                                    
STDDECH3 ENABLE                                                                 
         B        SFPTERR0                                                      
STDDECH2 STW,R6   R5                SAVE LINK LOC                               
         LW,R6    *R6               GET NEXT PTR                                
         B        STDDECH1          LOOP                                        
SFPTERR0 RES      0                                                             
         BAL,R8   RELTEMP           RELEASE THE TSPACE                          
         PULL     R8                RESTORE LINK                                
         B        *R8               RETURN                                      
         PAGE                                                                   
*                                                                               
*        R10, R11 =  FILE ACCOUNT IF FILE ASSIGNMENT                            
*        R12, R13 =  FILE OR DEVICE NAME LEFT-ALIGNED                           
*        R14      =  DISK AREA NAME IF FILE ASSIGNMENT                          
*   R8=  ASN                                                                    
*   R7=  TSPACE ADDRESS                                                         
*   R6=  LINK                                                                   
*   ROUTINE RETURNS +2 IF NO ERRORS, +1 OTHERWISE                               
*                                                                               
STDOPEN  RES      0                 OPEN DEV OR RAD FILE (BAL,R6)               
         LB,R5    STDODCB           DCB SIZE IN WORDS                           
         LW,R15   STDODCB-1,R5      MOVE OPEN DCB TO TSPACE                     
         STW,R15  *R7,R5                                                        
         BDR,R5   %-2                                                           
         LCI      2                                                             
         STM,R12  6,R7              SET DEV/FILE NAME                           
         DO1      #DFACNT                                                       
         STM,R10  10,R7             SET FILE ACCOUNT NAME                       
         STW,R14  9,R7              SET FILE AREA NAME                          
         LI,R9    KF                MASK FOR ASN                                
         STS,R8   1,R7              STORE ASN                                   
         LCI      4                                                             
         LM,R12   OPENFPT           OPEN FPT TO R12-R15                         
         LW,R9    R7                TSPACE ADDRESS                              
         AND,R9   M24               MASK                                        
         AI,R9    1                 R9= DCB ADDRESS                             
         STS,R9   R12               STORE IN OPEN FPT                           
         CAL1,1   R12               OPEN                                        
         B        1,R6              RETURN +2 (NORMAL)                          
*                                                                               
*                                                                               
STDOPERR RES      0                 ERROR RETURN FROM OPEN CALL                 
         B        0,R6              RETURNS TO CALLING SUBR +1                  
*                                                                               
*   FPT USED TO OPEN                                                            
OPENFPT  RES      0                                                             
         GEN,8,24 X'14',0                                                       
         GEN,2,30 3,0                                                           
         DATA     STDOPERR          ERR                                         
         DATA     STDOPERR          ABN                                         
*                                                                               
*   DCB USED TO OPEN DEVICES/FILES                                              
STDODCB  RES      0                                                             
         DO       #DFACNT                                                       
         DATA     X'0B0000C0'       11 WORDS, DEVICE OR AREA BY NAME            
         ELSE                       #DFACNT                                     
         DATA     X'090000C0'       9 WORDS, DEVICE OR AREA BY NAME             
         FIN                        #DFACNT                                     
         DATA     X'03008000'       3 RETRIES, DEVICE (IF NOT FILE)             
         DATA     0                                                             
         DATA     STDOPERR          ERROR ADDRESS                               
         DATA     STDOPERR          ABNORMAL ADDRESS                            
         DATA     0,0               FILE/DEV NAME                               
         DO       #DFACNT                                                       
         DATA     X'E0000000'       P-BITS FOR AREA AND ACCOUNT                 
*                                   (IGNORED FOR DEVICE)                        
         DATA     0,0,0             DISK AREA NAME, FILE ACCOUNT NAME           
         ELSE                       #DFACNT                                     
         DATA     X'80000000'       P-BIT FOR DISK AREA                         
*                                   (IGNORED FOR DEVICE)                        
         DATA     0                 DISK AREA NAME                              
         FIN                        #DFACNT                                     
         PAGE                                                                   
*                                                                               
*   R12,R13= DCB WORDS 5,6                                                      
*   R14= DEVF,TYPE, INDEX FIELDS                                                
*   R8=  ASN                                                                    
*   R7=  TSPACE ADDRESS                                                         
*   R6=  LINK                                                                   
*   ROUTINE RETURNS +2 IF NO ERRORS, +1 OTHERWISE                               
*                                                                               
STDCLOSE RES      0                 CLOSE DEV OR RAD FILE (BAL,R6)              
         LI,R5    7                                                             
         LW,R15   STDCDCB-1,R5      MOVE CLOSE DCB TO TSPACE                    
*   DCB USED TO CLOSE DEVICES/FILES                                             
         STW,R15  *R7,R5                                                        
         BDR,R5   %-2                                                           
         LW,R15   Y002                                                          
         STS,R15  1,R7              SET OPEN BIT IN DCB                         
         STW,R12  6,R7              STORE DCB WORDS 5,6                         
         STW,R13  7,R7                                                          
         LI,R9    KF                MASK FOR ASN                                
         STS,R8   1,R7              STORE ASN                                   
         LI,R15   KFFFF             MASK FOR DEVF,TYPE,INDEX                    
         STS,R14  2,R7              STORE IN DCB WORD 1                         
         LCI      4                                                             
         LM,R12   CLOSEFPT          OPEN FPT TO R12-R15                         
         LW,R9    R7                TSPACE ADDRESS                              
         AND,R9   M24               MASK                                        
         AI,R9    1                 R9= DCB ADDRESS                             
         STS,R9   R12               STORE IN OPEN FPT                           
         CAL1,1   R12               OPEN                                        
         B        1,R6              RETURN +2 (NORMAL)                          
*                                                                               
*                                                                               
STDCLERR RES      0                 ERROR RETURN FROM OPEN CALL                 
         B        0,R6              RETURNS TO CALLING SUBR +1                  
*                                                                               
*                                                                               
CLOSEFPT RES      0                                                             
         GEN,8,24 X'15',0                                                       
         GEN,2,30 3,0                                                           
         DATA     STDCLERR          ERROR ADDRESS                               
         DATA     STDCLERR          ABNORMAL ADDRESS                            
STDCDCB  RES      0                                                             
         DATA     X'07000000'                                                   
         DATA     X'03000000'                                                   
         DATA     0                                                             
         DATA     STDCLERR                                                      
         DATA     STDCLERR                                                      
         DATA     0,0                                                           
         PAGE                                                                   
STDPRE83 LI,R15   X'83'             IMMED REQUEST CANNOT BE SATISFIED           
         B        SPCEXITA                                                      
STDPRE5B LI,R15   K5B               ILLEGAL JOB ID                              
         B        SPCEXITA                                                      
STDPRE70 LI,R15   K70               INVALID AREA NAME                           
         B        SPCEXITA                                                      
SPRERR   LI,R15   X'8C'                                                         
         B        SPCEXITA                                                      
SPREXIT  LI,R15   1                                                             
         PULL     R9                                                            
         AI,R9    1                                                             
SPCEXIT  B        *R9               NORMAL RETURN                               
*                                                                               
*   ROUTINE HANDLES ERROR RETURNS FROM OPEN,CLOSE                               
SPRP801  RES      0                                                             
         LB,R15   R10               YES GET TYC                                 
         B        SPCEXITA                                                      
SPRP802  LB,R15   R10               FPT ERROR RETURN                            
         DO       #ECB                                                          
         CI,R15   X'83'             SEE IF EXCL. DEV. BUSY RETIRN               
         BE       SPRENQ                                                        
         FIN      #ECB                                                          
SPCEXITA  PULL    R9                RESTORE RETURN REG                          
         B        SPCEXIT           ERROR RETURN                                
         OLAYEND                                                                
         END                                                                    
