*                                                                               
         SYSTEM   SIG9P                                                         
         SYSTEM   OPTIONS                                                       
         DEF      DEVI                                                          
         DEF      DEVN,DFM,CORRES,DVF                                           
         DEF      DRC                                                           
         DEF      DEVEXIT,DEVERR                                                
         DEF      DEVEX2                                                        
         DEF      PROMPT                                                        
OLAYFLAG EQU      'DEVI'                                                        
         SYSTEM   CPRMON                                                        
         TITLE    'DEVN'                                                        
************                                                                    
*   DEVN   *                                                                    
************                                                                    
*                                                                               
*   ROUTINE DETERMINES THE FILE, DEVICE, OR OPERATIONAL LABEL TO                
*   WHICH A DCB IS ASSIGNED AND RETURNS THE ASSIGNMENT IN EBCDIC.               
*                                                                               
*   AT ENTRY:     R1    FPT CODE                                                
*                 R3    FPT ADDRESS                                             
*                 R4    STI INDEX                                               
*                                                                               
DEVN     RES      0                                                             
DEVI     EQU      DEVN                                                          
         LW,R8    0,R3              FPT WORD 0                                  
         CW,R8    Y008              IS P0=1                                     
         BAZ      DEVEX2            NO, BAD CAL                                 
         BAL,R4   GETDCBAD          GET DCB ADDRESS                             
         BAL,R4   OPENDCB           OPEN THE DCB                                
         B        DEVERR            ERROR, R9= ERROR CODE                       
*                                                                               
         LI,R1    0                 SET ASN TYPE; 0=NULL,1=FILE,2=DEVICE        
         BAL,R5   GETINDEX          GET WHAT TYPE OF ASSIGNMENT                 
         B        DEVERR01            ERROR                                     
         AI,R1    -1                FILE; SET INDEX = 1                         
         AI,R1    2                 DEVICE; SET INDEX = 2                       
*                                                                               
*                                                                               
         LW,R10   DEVNACES,R1       GET ADDRESS OF ACCESS TABLE                 
         LB,R4    R10               SET NUMBER OF OPTIONS TO PROCESS            
         PAGE                                                                   
         SPACE                                                                  
*        REGISTER USAGE IN FPT P-BIT PROCESSING LOOP                            
*                                                                               
*        R1 :     TYPE OF DCB ASSIGNMENT:  0 => NULL                            
*                                          1 => FILE                            
*                                          2 => DEVICE                          
*        R2 :     ADDRESS OF DCB                                                
*        R3 :     ADDRESS OF FPT                                                
*        R4 :     NUMBER OF OPTION TO PROCESS FOR TYPE OF ASSIGNMENT            
*        R5 :     COPY OF R7                                                    
*        R6 :     ADDRESS OF PARAMETER FROM FPT PARAMETER WORD                  
*        R7 :     DCT INDEX FOR DEVICES; RFT INDEX FOR FILES                    
*        R10:     ADDRESS OF DATA ACCESS ROUTINE TABLE (DEVNDEV, ETC)           
*        R11:     1ST WORD OF RETURNED DATA                                     
*        R12:     2ND WORD OF RETURNED DATA                                     
*        R13:     3RD WORD OF RETURNED DATA                                     
*                                                                               
*        R8 & R9: USED FOR TEMP WORK REGISTERS                                  
         PAGE                                                                   
         SPACE    2                                                             
DEVNLOOP RES      0         PROCESS AN FPT P-BIT OPTION                         
         LW,R5    DEVNTAB1,R4       GET P-BIT NUMBER; PARAM FETCH ROUTIN        
         LB,R15   R5                SET P-BIT NUMBER                            
         BAL,R5   *R5               GET OPTION VIA GETPI, GETPII, ETC.          
         B        DEVNNEXT          NOT PRESENT; SKIP OPTION                    
         LW,R6    R14               COPY STORE ADDRESS                          
         LW,R9    R14               COPY AGAIN TO TEST IF OK TO STORE           
         BAL,R8   TMVADR            CHECK IF VALID ADDRESS & NOT PROTECT        
         B        DEVERR8B            NOT LEGAL ADDRESS; GIVE ERROR             
         CI,R0    0                 IS IT WRITE PROTECTED ?                     
         BNE      DEVERR8B            YES, ERROR                                
         LW,R5    R7                COPY DCT/RFT INDEX                          
         B        *R10,R4           GO GET ASSIGNMENT INFO FOR THIS OPT         
*                                                                               
DEVNSTO3 STW,R13  2,R6              STORE 3RD WORD OF DATA                      
DEVNSTO2 STW,R12  1,R6              STORE 2ND WORD OF DATA                      
DEVNSTO1 STW,R11  0,R6              STORE ONE WORD OF DATA                      
*                                                                               
DEVNNEXT RES      0         STEP TO NEXT P-BIT OPTION                           
         BDR,R4   DEVNLOOP          IF NOT ALL DONE, DO ANOTHER                 
         B        DEVEXIT           IF DONE, EXIT                               
         PAGE                                                                   
         SPACE    2                                                             
DEVNACES RES      0         ACCESS TABLE FOR DATA BY TYPE OF ASSIGNMENT         
         GEN,8,24 #DEVNNUL,DEVNNULL   NULL ASSIGNMENT                           
         GEN,8,24 #DEVNFIL,DEVNFILE   FILE ASSIGNMENT                           
         GEN,8,24 #DEVNDEV,DEVNDEV    DEVICE ASSIGNMENT                         
*                                                                               
*                                                                               
DEVNTAB1 EQU      %-1         OPTION PARAMETER ACCESS TABLE                     
         GEN,8,24 K2,GETPI     1    OPLABEL                                     
         GEN,8,24 K3,GETPII    2    DEVICE NAME                                 
         GEN,8,24 KC,GETPI     3    DCT INDEX                                   
         GEN,8,24 K5,GETPII    4    MODEL NUMBER                                
         GEN,8,24 K6,GETPI     5    BOT                                         
         GEN,8,24 K7,GETPI     6    EOT                                         
         GEN,8,24 K10,GETPII   7    DEVICE CONSTANTS                            
         GEN,8,24 KF,GETPI     8    WRITE PROTECT                               
         GEN,8,24 K4,GETPII    9    AREA/FILENAME                               
         GEN,8,24 K8,GETPI    10    ORG                                         
         GEN,8,24 KB,GETPI    11    RSIZE/GSIZE                                 
         GEN,8,24 K9,GETPI    12    ESIZE                                       
         DO1      #DFACNT                                                       
         GEN,8,24 KE,GETPII   13    ACCOUNT                                     
#OPTS    EQU      %-DEVNTAB1-1   NUMBER OF OPTIONS                              
*                                                                               
*                                                                               
DEVNNULL EQU      %-1       OPTIONS MEANINGFUL FOR NULL ASSIGNMENTS             
         B        DNOPLB            OPLABEL                                     
#DEVNNUL EQU      %-DEVNNULL-1                                                  
         PAGE                                                                   
         SPACE    2                                                             
DEVNFILE EQU      %-1       OPTIONS FOR ASSIGNMENTS TO RAD FILES                
         B        DNOPLB       1    OPLABEL                                     
         B        DNDEVF       2    DEVICE NAME                                 
         B        DNDCTXF      3    DCT INDEX                                   
         B        DNMODF       4    MODEL NUMBER                                
         B        DNBOTF       5    BOT                                         
         B        DNEOTF       6    EOT                                         
         B        DNDEVCF      7    DEVICE CONSTANTS                            
         B        DNWPF        8    WRITE PROTECT                               
         B        DNRADF       9    AREA/FILENAME                               
         B        DNORG       10    ORGANIZATION                                
         B        DNRSZ       11    RSIZE/GSIZE                                 
         B        DNESZ       12    ESIZE                                       
         DO1      #DFACNT                                                       
         B        DNACNTF     13    ACCOUNT                                     
#DEVNFIL EQU      %-DEVNFILE-1                                                  
*                                                                               
*                                                                               
*                                                                               
*                                                                               
DEVNDEV  EQU      %-1       OPTIONS FOR ASSIGNMENTS TO DEVICES                  
         B        DNOPLB       1    OPLABEL                                     
         B        DNDEVD       2    DEVICE NAME                                 
         B        DNDCTXD      3    DCT INDEX                                   
         B        DNMODD       4    MODEL NUMBER                                
         B        DNBOTD       5    BOT (IF A DISC DEVICE)                      
         B        DNEOTD       6    EOT (IF A DISC DEVICE)                      
         B        DNDEVCD      7    DEVICE CONSTANTS (IF A DISC DEVICE)         
#DEVNDEV EQU      %-DEVNDEV-1                                                   
         PAGE                                                                   
*                                                                               
*    PROCESS OPLB PARAMETER                                                     
*                                                                               
DNOPLB   RES      0         GET OPLABEL FOR ALL ASSIGNMENT TYPES                
         LW,R5    0,R2              GET DCB WORD WITH 'ASN' FIELD               
         CI,R5    K1                IS THE DCB AGGIGNED TO 'NULL' ?             
         BAZ      DEVNNEXT            YES, NO OPLABEL:  DONE                    
         CI,R5    K2                IS IT ASSIGNED TO A FILE ?                  
         BAZ      DEVNNEXT            YES, NO OPLABEL                           
         LW,R5    1,R2              GET DCB WORD 1                              
         CI,R5    K8000             IS THE 'DEVF' FLAG SET ?                    
         BANZ     DEVNNEXT            YES, DIRECTLY TO A DEVICE; NO OPLB        
         AND,R5   M8                GET 'DEV/OPLB/RFILE' FIELD                  
         BEZ      DEVERR01          ZERO: ILLEGAL INDEX; GIVE ERROR             
         CH,R5    OPLBS1            IS THE INDEX TOO BIG ?                      
         BG       DEVERR01            YES, ERROR                                
         LH,R11   OPLBS1,R5         GET OPLABEL NAME                            
         AND,R11  M16               REMOVE SIGN EXTENSION                       
         B        DEVNSTO1          GO STORE NAME                               
*                                                                               
*                                                                               
*                                                                               
*   PROCESS AREA AND FILE NAME OPTION                                           
*                                                                               
DNRADF   RES      0                                                             
         LD,R12   RFT1,R7           FILE NAME                                   
         CD,R12   BLANKS            IS DCB ASSIGNED TO AREA                     
         BNE      %+2               NO, BRANCH                                  
         LD,R12   ZEROS             YES, SUBSTITUE ZEROS                        
         LB,R5    RFT8,R7           MASTD INDEX                                 
         LH,R11   MDNAME,R5         R11= AREA NAME                              
         AND,R11  M16                                                           
         B        DEVNSTO3          GO STORE AREA/FILENAME                      
         PAGE                                                                   
*                                                                               
*   PROCESS DEVICE NAME OPTION                                                  
*                                                                               
DNDEVF   RES      0         GET DEVICE NAME FOR FILE ASSIGNMENT                 
         LB,R5    RFT8,R7           GET MASTER DICTIONARY INDEX                 
         LB,R5    MDDCTI,R5         SET DEVICE INDEX                            
         AND,R5   M8                GET AS INDEX TO DEVICE TABLES               
*                                                                               
DNDEVD   RES      0         GET DEVICE NAME FOR DEVICE ASSIGNMENT               
         LD,R12   DCT16,R5          GET NAME                                    
         SLD,R12  24                LEFT JUSTIFY 1ST CHAR OF NAME               
         LW,R11   R12               MOVE TO STORE REGISTERS                     
         LW,R12   R13                                                           
         OR,R12   BLANKS            ADD TRAILING BLANKS                         
         B        DEVNSTO2          GO STORE 2 WORDS OF RESULTS                 
*                                                                               
*                                                                               
*   PROCESS DEVICE INDEX PARAMETER                                              
*                                                                               
DNDCTXF  RES      0         GET DCT INDEX FOR FILE ASSIGNMENT                   
         LB,R5    RFT8,R7           GET MASTER DICTIONARY INDEX                 
         LB,R5    MDDCTI,R5         SET DEVICE INDEX                            
         AND,R5   M8                GET DCT INDEX                               
*                                                                               
DNDCTXD  RES      0         GET DCT INDEX FOR DEVICE ASSIGNMENT                 
         LW,R11   R5                SET DEVICE INDEX                            
         B        DEVNSTO1          GO STORE IT                                 
         PAGE                                                                   
*                                                                               
*   PROCESS MODEL NUMBER PARAMETER                                              
*                                                                               
DNMODF   RES      0         GET MODEL NUMBER FOR FILE ASSIGNMENTS               
         LB,R5    RFT8,R7           GET FILES MASTER DICT INDEX                 
         LB,R5    MDDCTI,R5         GET THE DEVICE INDEX                        
*                                                                               
DNMODD   RES      0         GET MODEL NUMBER FOR DEVICE ASSIGNMENTS             
         LW,R11   DCTMOD,R5         GET EBCDIC MODEL NUMBER                     
         B        DEVNSTO1          GO STORE IT                                 
         PAGE                                                                   
*                                                                               
*   PROCESS BOT PARAMETER                                                       
*                                                                               
DNBOTF   RES      0         GET BOT FOR FILE ASSIGNMENTS                        
         LW,R11   RFT2,R7           GET AREA RELATIVE START SECTOR              
*                                                                               
DNBEOTF  RES      0         COMMON BOT/EOT CALCULATIONS FOR FILES               
         LB,R5    RFT8,R7           GET MASTER DICT INDEX FOR THE FILE          
         AW,R11   MDBOA,R5          ADD AREA BASE TO AREA RELATIVE              
         B        DEVNSTO1          AND GO STORE                                
*                                                                               
*                                                                               
DNBOTD   RES      0         GET BOT FOR (DISC) DEVICE ASSIGNMENT                
         LD,R8    DCT16,R7          GET DEVICE NAME                             
         SLD,R8   -24               RIGHT JUSTIFY 'YY' PART OF NAME             
         AND,R9   M16               STRIP OFF PREFIX INFO                       
         CI,R9    C'DP'             IS IT A DISK PACK DEVICE                    
         BE       DNBOTD1             YES                                       
         CI,R9    C'DC'             IS IT A RAD DEVICE ?                        
         BNE      DEVNNEXT            NO, SKIP RETURNING RESULTS                
*                                                                               
DNBOTD1  RES      0         SET BOT FOR ASSIGNMENT TO DISK DEVICE               
         LI,R11   0                 SET TO START AT SECTOR 0                    
         B        DEVNSTO1          GO STORE INFO                               
         PAGE                                                                   
*                                                                               
*   PROCESS EOT PARAMETER                                                       
*                                                                               
DNEOTF   RES      0         GET EOT FOR FILE ASSIGNMENT                         
         LW,R11   RFT3,R7           GET AREA RELATIVE END SECTOR                
         B        DNBEOTF           GO COMPUTE AREA START AND ADD IT            
*                                                                               
*                                                                               
DNEOTD   RES      0         GET EOT FOR (DISK) DEVICE ASSIGNMENT                
         LD,R8    DCT16,R7          GET DEVICE NAME                             
         SLD,R8   -24               RIGHT JUSTIFY 'YY' PART OF NAME             
         AND,R9   M16               STRIP OFF PREFIX INFO                       
         CI,R9    C'DP'             IS IT A DISK PACK DEVICE ?                  
         BE       DNEOTD1             YES, GET EOT                              
         CI,R9    C'DC'             NO, IS IT A RAD DEVICE ?                    
         BNE      DEVNNEXT            NO, SKIP RETURNING RESULTS                
*                                                                               
DNEOTD1  RES      0         SET EOT FOR ASSIGNMENT TO DISK DEVICE               
         LB,R5    DCTDISCI,R7       GET DISC'S DISC INDEX SO TO                 
         LW,R11   DISCMAXS,R5       GET LAST AVAILABLE SECTOR ON DISC           
         B        DEVNSTO1          GO STORE RESULTS                            
         PAGE                                                                   
*                                                                               
*   PROCESS ORG OPTION                                                          
*                                                                               
DNORG    RES      0         GET ORG FOR FILE ASSIGNMENT                         
         LB,R8    RFT7,R7           GET FILE'S FLAG BYTE                        
         LI,R11   2                 GUESS AT COMPRESSED ORG                     
         CI,R8    COMPORG           IS IT MARKED COMPRESSED ?                   
         BANZ     DEVNSTO1            YES, RETURN ORG = COMPRESSED              
         LI,R11   1                 NO, GUESS AS BLOCKED                        
         CI,R8    BLKORG            IS IT MARKED BLOCKED ?                      
         BANZ     DEVNSTO1            YES, RETURN THAT                          
         LI,R11   0                 NO, SET TO UNBLOCKED                        
         B        DEVNSTO1          AND RETURN THAT                             
*                                                                               
*                                                                               
*                                                                               
*   PROCESS ESIZE OPTION                                                        
*                                                                               
DNESZ    RES      0         GET ESIZE FOR FILE ASSIGNMENT                       
         LW,R11   RFTESZ,R7         SET EXTENSION SIZE IN SECTORS               
         B        DEVNSTO1          AND GO STORE IT                             
         PAGE                                                                   
*                                                                               
*   PROCESS RSZ/GSZ PARAMETER                                                   
*                                                                               
DNRSZ    RES      0                                                             
         LB,R5    RFT7,R7           GET FLAGS                                   
         CI,R5    DIRACC            IS IT DIRECT ACCESS                         
         BANZ     DNRSZ2            YES, USE GSIZE                              
         CI,R5    SEQACC            IS IT SEQUENTIAL ACCESS                     
         BANZ     DNRSZ1A           YES, USE RECORD SIZE                        
*   THE FILE HAS NOT BEEN WRITTEN INTO. LOOK AT FORMAT INSTEAD.                 
         CI,R5    BLKORG+COMPORG    IS IT BLOCKED OR COMPRESSED                 
         BAZ      DNRSZ2            NO, USE GSIZE=RSIZE                         
DNRSZ1A  RES      0                                                             
         LH,R11   RFT5,R7           GET AND USE RECORD SIZE (RSIZ)              
         B        DNRSZ3            GO DO FINAL PROCESSING                      
*                                                                               
DNRSZ2   RES      0         FILE IS DIRECT ACCESS: RETURN GSIZE                 
         LH,R11   RFT4,R7           GET GSIZE                                   
*                                                                               
DNRSZ3   RES      0         INSURE A 16 BIT RESULT AND RETURN IT                
         AND,R11  M16               MASK OFF ANY SIGN EXTENTION                 
         B        DEVNSTO1          GO STORE RESULT                             
         PAGE                                                                   
*                                                                               
*   PROCESS WRITE PROTECT                                                       
*                                                                               
DNWPF    RES      0         GET WRITE PROTECT CODE FOR FILE ASSIGNMENT          
         LB,R5    RFT8,R7           GET MASTER DICTIONARY INDEX                 
         LB,R11   MDFLAG,R5         GET DICT WORD WITH PROTECT CODE             
         AND,R11  M3                EXTRACT IT OUT                              
         B        DEVNSTO1          AND GO STORE IT                             
*                                                                               
*                                                                               
*                                                                               
*  PROCESS ACCOUNT NUMBER                                                       
*                                                                               
         DO       #DFACNT                                                       
DNACNTF  RES      0         GET ACCOUNT NUMBER FOR FILE ASSIGNMENT              
         LD,R12   RFTACNT,R7        GET ACCOUNT NUMBER FOR FILE                 
         LW,R11   R12               MOVE TO CORRECT RESULT REGISTERS            
         LW,R12   R13                                                           
         B        DEVNSTO2          AND GO STORE THE NUMBER                     
         FIN                        #DFACNT                                     
         PAGE                                                                   
*                                                                               
*   PROCESS DEVICE CONSTANTS FOR DISK DEVICES                                   
*                                                                               
DNDEVCF  RES      0         GET DEVICE CONSTANTS FOR FILE ASSIGNMENT            
         LB,R5    RFT8,R7           GET MASTER DICTIONARY INDEX                 
         LB,R5    MDDCTI,R5         GET THE DEVICE INDEX                        
*                                                                               
DNDEVCD  RES      0         GET DEVICE CONSTANTS FOR DEVICE ASSIGNMENT          
         LD,R8    DCT16,R5          GET DEVICE NAME                             
         SLD,R8   -24               RIGHT JUSTIFY THE 'YY' PART                 
         AND,R9   M16               AND REMOVE THE PREFIX                       
         CI,R9    C'DP'             IS IT A DISK PACK DEVICE ?                  
         BE       DNDEVCD1            YES, GET INFO                             
         CI,R9    C'DC'             NO, IS IT A RAD ?                           
         BNE      DEVNNEXT            NO, RETURN; SKIP RETURN OF RESULTS        
*                                                                               
DNDEVCD1 RES      0         GET DEVICE CONSTANTS FOR A DISK DEVICE              
         LB,R5    DCTDISCI,R5       GET DISK TABLE INDEX                        
         LH,R11   DISCNTPC,R5       TRACKS   PER  CYLINDER                      
         LB,R12   DISCNSPT,R5       SECTORS  PER  TRACK                         
         LH,R13   DISCNWPS,R5       WORDS    PER  SECTOR                        
         B        DEVNSTO3          AND GO STORE 'EM                            
         PAGE                                                                   
***************                                                                 
*   GETINDEX   *                                                                
***************                                                                 
*   ROUTINE GETS THE DEVICE OR  FILE TO WHICH                                   
*   THE USER DCB IS ASSIGNED.                                                   
*                                                                               
*        RETURNS +0 IF ERROR                                                    
*                 1 IF RAD FILE                                                 
*                 2 IF DEVICE                                                   
*                 3 IF NULL ASSIGNMENT                                          
*                                                                               
*   AT ENTRY:     R2   DCB ADDRESS                                              
*                 R3   FPT ADDRESS                                              
*                 R5   LINK                                                     
*                                                                               
*   AT EXIT:      R7   RFT OR DCT INDEX                                         
*                                                                               
GETINDEX RES      0                                                             
         LW,R8    0,R2              DCB WORD 0                                  
         LW,R7    1,R2              DCB WORD 1                                  
         CI,R8    K1                TEST ASN IN DCB WORD 0                      
         BANZ     %+3               B IF NOT NULL                               
         LI,R7    0                 NULL, R7= NULL INDEX                        
         B        3,R5              RETURN TO NULL ASSIGNMENT EXIT              
         CI,R8    K2                IS IT ASSIGNED TO FILE                      
         BAZ      GETX1             YES, BRANCH                                 
         BAL,R4   GETDCTX           NO, GET DCT INDEX                           
         B        0,R5              ERROR: RETURN TO ERROR EXIT                 
         CI,R7    0                                                             
         BE       3,R5              NULL; SET NULL ASSIGNMENT                   
         CI,R7    X'80'             IS IT AN RFT INDEX                          
         BAZ      2,R5              DEVICE: SET DEVICE RETURN                   
GETX1    RES      0                                                             
         AND,R7   M7                R7= RFT INDEX                               
         B        1,R5              RETURN WITH RFT INDEX                       
         TITLE    'DEVICE AND FILE MODE CAL'                                    
***********                                                                     
*   DFM   *                                                                     
***********                                                                     
*                                                                               
*                                                                               
*                                                                               
DFM      BAL,R6   SETUP                                                         
*        ON RETURN, R7  DCT OR RFT INDEX                                        
*        R1  FPT CODE/ R2  DCB ADDRESS/  R3  FPT ADDRESS                        
         B        DEVEXIT           NULL                                        
         B        DFM0              RAD FILE                                    
         B        DFM1              DEVICE                                      
         B        DEVERR            ERROR IN OPEN                               
DFM0     LI,R15   1                                                             
         BAL,R5   GETPI             GET RSIZE                                   
         B        DFM2              NOT PRESENT                                 
         STH,R15  RFT5,R7           SET IT                                      
         STH,R15  R4                                                            
         SLS,R4   1                                                             
         LW,R5    YFFFE                                                         
         STS,R4   3,R2              SET RSIZE IN DCB                            
DFM2     LI,R15   2                                                             
         BAL,R5   GETPI             GET ORG                                     
         B        DFM3              NOT PRESENT                                 
         LW,R4    R15                                                           
         LB,R15   ORGCODES,R4       CONVERT CODE                                
         STB,R15  RFT7,R7           SET ORG                                     
DFM3     LI,R15   3                                                             
         BAL,R5   GETPI             GET GSIZE                                   
         B        DFM1              NOT PRESENT                                 
         STH,R15  RFT4,R7                                                       
DFM1     LI,R15   4                                                             
         BAL,R5   GETPI             GET NRT                                     
         B        DFM4              NOT PRESENT                                 
         LI,R4    4                                                             
         STB,R15  *R2,R4            SET NRT IN DCB                              
DFM4     LW,R10   1,R3              FPT WORD 1                                  
         AND,R8   FFFDB5FF                                                      
         CI,R10   BIT24             IS F0 SET                                   
         BAZ      %+2               NO                                          
         AI,R8    BIT20             YES, ASCII                                  
*                                                                               
         CI,R10   BIT25             IS F1 SET                                   
         BANZ     %+2               YES, UNPACK/800 BPI 9T TAPE                 
         AI,R8    BIT22             NO, PACK/1600 BPI 9T TAPE                   
*                                                                               
         CI,R10   BIT26             IS F2 SET                                   
         BAZ      %+2               NO                                          
         AI,R8    BIT17             YES, FBCD                                   
*                                                                               
         CI,R10   BIT27             IS F3 SET                                   
         BAZ      %+2               NO                                          
         AI,R8    BIT14             YES, BINARY                                 
         STW,R8   0,R2              STORE BACK                                  
         B        DEVEXIT                                                       
*                                                                               
*                                                                               
ORGCODES GEN,8,8,8,8   UNBORG,BLKORG,COMPORG,0     ORG CODES IN DIRECTORY       
         TITLE    'CORRESPONDENCE'                                              
**********************                                                          
*                    *                                                          
*   CORRESPONDENCE   *                                                          
*                    *                                                          
**********************                                                          
*   THIS ROUTINE PROCESSES ALL CORRESPONDENCE CALS                              
*                                                                               
*   AT ENTRY:     R0   FPT ADR                                                  
*                 R8 IS IN USER TEMP STACK (PSD,15,14,...,8,...)                
*                                                                               
*   AT EXIT:      R8 IN TEMP STACK                                              
*                    =0 IF DCB1 AND DCB2 HAVE DIFFERENT ASSIGNMENTS             
*                          OR IF APPARENT ERRORS ARE FOUND /SIG7-2651/*C5732 C01
*                         OR IF EITHER DCB IS NOT OPEN                          
*                                                                               
*                    =1 IF ASSIGNMENTS ARE EQUAL                                
*                                                                               
*                                                                               
CORRES   RES      0                                                             
         LI,R15   -1                INITIALIZE FLAG                             
         LW,R11   M4                MASK                                        
CORRES1  BAL,R4   GETDCBAD          GET DCB ADDR IN R2                          
         LW,R10   0,R2              WORD ZERO OF DCB TO R10/SIG7-2651/*C5732 C01
         CW,R10   Y002              IS THE DCB OPEN                             
         BAZ      CORRES3           NO, RETURN 0 IN R8                          
         CS,R10   X1                ASN VALUE 1?           /SIG7-2651/*C5732 C01
         BE       CORRES2           YES                    /SIG7-2651/*C5732 C01
         CS,R10   X3                ASN VALUE 3?           /SIG7-2651/*C5732 C01
         BNE      CORRES3           NO-BAD ASN FIELD       /SIG7-2651/*C5732 C01
         LW,R7    1,R2              YES-WORD 1 OF DCB TO R7/SIG7-2651/*C5732 C01
         LW,R8    0,R2              DCB WORD 0                                  
         BAL,R4   GETDCTX           GET DCT INDEX IN R7    /SIG7-2651/*C5732 C01
         B        CORRES3                                  /SIG7-2651/*C5732 C01
CORRES15 AND,R7   XFF               ONLY BYTE 3            /SIG7-2651/*C5732 C01
         CI,R15   -1                IS THIS FOR DCB 1                           
         BNE      CORRES4           NO-DCB2                /SIG7-2651/*C5732 C01
         STW,R7   R15               SAVE INDEX OF DCB1                          
         AI,R3    1                 INCR TO FPT WORD 1     /SIG7-2651/*C5732 C01
         B        CORRES1           GO PROCESS DCB2        /SIG7-2651/*C5732 C01
CORRES2  LW,R7    1,R2              WORD 1 OF DCB TO R7    /SIG7-2651/*C5732 C01
         OR,R7    X80               SET BIT 24 (RFT INDEX) /SIG7-2651/*C5732 C01
         B        CORRES15                                 /SIG7-2651/*C5732 C01
CORRES3  LI,R4    0                 UNEQUAL ASSIGNMENTS OR /SIG7-2651/*C5732 C01
*                                   ERROR FOUND IN A DCB   /SIG7-2651/*C5732 C01
         B        CORRES5           GO STORE R8=0 IN TMPSTK/SIG7-2651/*C5732 C01
CORRES4  RES      0                                                             
         CW,R7    R15               COMPARE INDEX VALUES                        
         BNE      CORRES3           ASSIGNMENTS NE         /SIG7-2651/*C5732 C01
         LI,R4    1                 EQ. ASSIGNMENTS--R8=1  /SIG7-2651/*C5732 C01
CORRES5  LB,R7    TCBPOINT          GET STI INDEX                               
         LD,R7    STIRTSB,R7        GET CAL STACK BASE                          
         STW,R4   -CAL1PUSH+8,R7    STORE NEW R8 IN                             
*                                     USER TEMP STACK      /SIG7-2651/*C5732 C01
         B        DEVEXIT                                                       
         TITLE    'DEVICE VERTICAL FORMAT'                                      
***********                                                                     
*   DVF   *                                                                     
***********                                                                     
*                                                                               
*                                                                               
DVF      RES      0                 R3 CONTAINS FPT ADDR                        
         BAL,R4   GETDCBAD          DCB ADDRESS TO R2                           
         LW,R10   1,R3              FPT WORD 1                                  
         AND,R10  X10               EXTRACT BIT 27                              
         SLS,R10  4                 POSITION AT BIT 23                          
         LI,R11   K100              SET UP STS                                  
         STS,R10  0,R2              STORE THE BIT                               
         B        DEVEXIT           CALEXIT                                     
         TITLE    'DEVICE DIRECT RECORD FORMAT CONTROL'                         
***********                                                                     
*   DRC   *                                                                     
***********                                                                     
*                                                                               
*   ROUTINE SETS OR RESETS THE DIRECT RECORD FORMATTING INDICATOR               
*    IN THE SPECIFIED DCB. (BIT 21, WORD 0)                                     
*                                                                               
*                                                                               
DRC      RES      0                                                             
         BAL,R4   GETDCBAD          GET DCB ADDRESS IN R2                       
         LW,R10   1,R3              R10= FPT WORD 1                             
         SLS,R10  6                 POSTITION DRC (F3) TO BIT 21                
         LI,R11   X'400'            MASK FOR STS                                
         STS,R10  0,R2              SET OR RESET DRC BIT IN DCB OWRD 0          
         B        DEVEXIT                                                       
         TITLE    'PROMPT CAL'                                                  
*                                                                               
* PROMPT CAL                                                                    
*                                                                               
* R3     FPT ADDR                                                               
*                                                                               
PROMPT   RES      0                                                             
         LW,R14   R3                GET FPT POINTER                             
         LW,R15   0,R3              GET WORD 1 OF FPT                           
         BAL,R0   GETEFADR          TEST AND FETCH IF INDIRECT                  
*                                                                               
         LB,R4    TCBPOINT          GET TASK ID                                 
         LB,R5    STIJID,R4         GET JOB ID                                  
         LW,R6    SJI1,R5           GET JCB POINTER                             
         LI,R7    JCBPRMPT          PROMPT INDEX                                
         STB,R15  *R6,R7            PUT PROMPT IN                               
*                                                                               
         LI,R15   1                                                             
         B        DEVEXIT           AND EXIT                                    
         TITLE    ' '                                                           
*                                                                               
*                                                                               
*  EXITS FROM OVERLAY                                                           
DEVERR8B RES      0                                                             
         LI,R15   X'8B'             SET ERROR CODE (PROTECTED MEMORY)           
DEVEXIT  B        CALEXIT           CALEXIT                                     
DEVERR01 LI,R9    1                 BAD DCB PARAMETERS                          
DEVERR   B        DCBERR                                                        
DEVEX1   B        CALERR                                                        
DEVEX2   B        TRAPX                                                         
         OLAYEND                                                                
         END                                                                    
