************************************************************                    
*                                                          *                    
*                                                          *                    
*        K E Y - I N  P A R T  T W O                       *                    
*                                                          *                    
*                                                          *                    
************************************************************                    
         PCC      0                                                             
         SPACE    4                                                             
         SYSTEM   SIG5P                                                         
         SYSTEM   OPTIONS                                                       
         DEF      A:KEY2                                                        
         DEF      KEY2EXB                                                       
         DEF      KEY2A04                                                       
OLAYFLAG EQU      'KEY2'                                                        
         SYSTEM   CPRMON                                                        
*                                                                               
*                                                                               
         TITLE    '** KEY2 - CONTROL SECTION **'                                
*                                                                               
*                                                                               
*        ENTERED FROM KEY1                                                      
*        RETURNS TO KEY1 IF ERROR DETECTED                                      
*        RETURNS TO CONTROL TASK (CT1) IF OK                                    
*                                                                               
*        ALL KEY-IN OVERLAYS RUN DIRECLY UNDER CONTROL TASK                     
*                                                                               
*                                                                               
*        AT ENTRY,                                                              
*        R2=KEYIN INDEX                                                         
*        R6=SCAN RETURN CODE FROM FIRST SCAN CALL                               
*        R7=KEYIN TEXT POINTERS AS REQUIRED FOR SCAN ROUTINE                    
*                                                                               
OLAYSIZ  EQU      512                                                           
KEY2     RES      0                                                             
A:KEY2   EQU      KEY2                                                          
*                                   ENTER HERE FOR PART 2 OF KEY-IN OLAY        
A01      RES      0                                                             
         LH,R8    A91,R2            GET ADDRESS TO PROCESS KEYIN                
         B        *R8               GO TO PROPER REGUON                         
*                                                                               
KEY2EXIT RES      0                 NORMAL EXIT                                 
KEY2EXB  B        CT1               EXIT TO CONTROL TASK                        
*                                                                               
A04      RES      0                 ERROR EXIT                                  
KEY2A04  B        KEY1A04           EXIT TO KEY1                                
A91      RES      0                                                             
         DATA,2   G01               DT                                          
         DATA,2   P01               STDLB                                       
         DATA,2   T01               CINT                                        
         DATA,2   U01               DM                                          
         DATA,2   V01               DB                                          
         DATA,2   W01               DF                                          
         DATA,2   X01               DED                                         
         DATA,2   X020              UNDED                                       
         PAGE                                                                   
         BOUND    4                                                             
TIMEC    EQU      X'10'             TIME CAL                                    
CTDRUN   EQU      Y02               FLAG FOR CT DUMP IN K:CTST                  
CTDABT   EQU      X'10000'          FLAG FOR CT DUMP ABORT IN K:PMD1            
*        INDIXES TO SET UP DUMP CONTROL BLOCK                                   
WXDCB    EQU      2                                                             
WXFWA    EQU      3                                                             
WXLWA    EQU      4                                                             
WXBAD    EQU      5                                                             
WXBAL    EQU      6                                                             
BXFLAGS  EQU      4*7                                                           
BXLNP    EQU      4*7+3                                                         
MEBC     EQU      1**7                                                          
M4WD     EQU      1**6                                                          
WXRES    EQU      54                                                            
WXBUF    EQU      14                                                            
WXCTDTO  EQU      WXRES+5                                                       
KEYIN    EQU      Y04               0400 0000                                   
WTKEY    EQU      Y08               0800 0000                                   
KX7F     EQU      M7                0000 007F                                   
KX2      EQU      X2                0000 0002                                   
KXFD     DATA     X'FD'                                                         
KXFFFF   EQU      M16               0000 FFFF                                   
KX1FFF8  DATA     X'1FFF8'                                                      
KL01     EQU      Y01               1000 0000                                   
KL80     EQU      Y8                8000 0000                                   
KL001    EQU      Y001                100000                                    
KBLANKS  EQU      BLANKS            4040 4040                                   
TYPE6    GEN,8,24 2,0               FPT TO TYPE 'IDLE'                          
         GEN,1,31 1,0                                                           
         DATA     K:DPIDLE                                                      
         TITLE    '** KEY2 - DT KEY-IN **'                                      
*                                                                               
*                                   CODE DATE AND TIME HERE                     
*                                   PROCESS 'DAT' KEYIN                         
G01      CI,R6    2                                                             
         BE       G100              'PERSON' WANTS THE TIME                     
         LI,R11   4                 SET FOR DECIMAL INPUT                       
         BAL,R14  SCAN              GO GET MONTH                                
         CI,R6    1                                                             
         BNE      A04               ERROR IF NOT END OF FIELD                   
         LW,R4    R8                                                            
         BEZ      A04               ERROR IF MONTH=0                            
         CI,R4    12                                                            
         BG       A04               ERROR IF MONTH MORE THAN 12                 
         BAL,R14  SCAN              GET DAY                                     
         CI,R6    1                                                             
         BNE      A04                                                           
         LW,R3    R8                R3=DAY                                      
         BEZ      A04               R4=MONTH                                    
         BAL,R14  SCAN              GO GET YEAR                                 
         CI,R6    1                                                             
         BNE      A04               ERROR IF NOT END OF FIELD                   
         CI,R8    99                                                            
         BG       A04               ERROR, YEAR CAN'T EXCEED 99                 
         LW,R2    R8                R2=YEAR                                     
         BAL,R14  SCAN              GO GET HOUR                                 
         CI,R6    1                                                             
         BNE      A04               ERROR IF NOT END OF FIELD                   
         CI,R8    23                                                            
         BG       A04               ERROR IF HOUR MORE THAN 23                  
         LW,R1    R8                                                            
         MI,R1    3600              CHANGE HRS TO SEC.                          
         BAL,R14  SCAN              GET MIN.                                    
         CI,R6    2                                                             
         BNE      A04                                                           
         CI,R8    59                                                            
         BG       A04               ERROR, MIN. TOO BIG                         
         LW,R13   R8                                                            
         MI,R13   60                CHANGE MIN. TO SEC.                         
         AW,R1    R13                                                           
         STW,R1   K:TIME            STORE TIME IN SECONDS                       
         STW,R2   K:DATE1           STORE YEAR                                  
         LW,R0    G90                                                           
         STW,R0   K:MONTH+1         SET FEB TO 28 DAYS                          
         AND,R2   M2                IS IT LEAP YEAR                             
         BNEZ     G03               NO                                          
         MTB,1    K:MONTH+1         YES,SET FEB TO 29 DAYS                      
         LI,R0    366                                                           
         B        %+2                                                           
G03      LI,R0    365                                                           
         STH,R0   K:DATE1           SET MAX. NO. DAYS IN YEAR                   
         LW,R0    K:MONTH-1,R4                                                  
         SLS,R0   -24               GET NO. DAYS IN MONTH                       
         CW,R0    R3                                                            
         BL       A04               ERROR, INPUT DAY TOO BIG                    
G05      BDR,R4   G06                                                           
         STW,R3   K:DATE2           STORE DAY OF YEAR                           
         DO1      #ERRORLOG                                                     
         BAL,R15  INITLOG           GENERATE INIT. LOGS                         
         LI,R0    0                                                             
         LI,R1    X'10'                                                         
         STS,R0   K:JCP1            CLEAR INIT BIT                              
         RD,0     0                 READ SENSE SWITCHES                         
         BCS,1    %+3               SKIP IN CASE RSDFGD                         
         LI,R1    BIT16             RUN PERIODIC SCHEDULER                      
         STS,R1   K:CTST                                                        
         B        KEY2EXIT          EXIT                                        
G06      LW,R0    K:MONTH-1,R4                                                  
         SLS,R0   -24               CHANGE MONTH,DAY TO DAY OF YEAR             
         AW,R3    R0                                                            
         B        G05                                                           
G90      GEN,8,24 28,'FEB'                                                      
*                                                                               
G100     RES      0                 TELL OPERATOR THE TIME                      
         LW,R3    TIMFPT                                                        
         CAL1,8   R3                D&T BLOC IN R9-R12                          
         LW,R8    TIMHDR            SET UP TEXTC FORMAT                         
         LCI      3                                                             
         LM,R3    TYPFPT            TYPE FPT IN R3-R5                           
         CAL1,2   R3                TYPE TIME/DATE                              
         B        KEY2EXIT          DEPART UNCARINGLY                           
*                                                                               
*     FPT'S AND STUFF TO TELL THE TIME                                          
*                                                                               
TIMFPT   GEN,8,24 X'10',R9          PUT TIME/DATE IN REGISTERS 9-12             
TYPFPT   GEN,8,24 2,0               TYPE CODE                                   
         DATA     P1+F3             WAIT FLAG                                   
         DATA     R8                WRITE FROM REGISTERS 8-12                   
TIMHDR   GEN,8,24 19,'   '          BYTE COUNT INC. 3 BLANKS                    
*                                                                               
         TITLE    '** KEY2 - STDLB KEY-IN **'                                   
*                                                                               
*                                                                               
P01      RES      0                 PROCESS STDLB KEYIN                         
         CI,R6    2                                                             
         BE       A04               ERROR IF NO PARAMETERS                      
         PUSH     R7                                                            
         LI,R7    16                                                            
         BAL,R8   GETTEMP           GET TSPACE FOR FPT, ETC.                    
         B        P01ERR1           NO TSPACE RETURN                            
         ENABLE                     TSPACE OBTAINED (RETURNS DISABLED)          
         LW,R3    R7                                                            
         PULL     R7                RECOVER KEYIN SCAN POINTER                  
         PUSH     R3                SAVE TSPACE BLOCK POINTER                   
         LW,R9    R3                CONTROL BLOCK FOR FIRST GETIOID             
         LW,R0    GIOOBIT                                                       
         STW,R0   *R9               SET TO SCAN OPLABEL ONLY                    
         BAL,R8   GETIOID           GET OPLABEL TO REASSIGN                     
         CI,R6    0                                                             
         BL       P01ERR2           B IF GETIOID ERROR                          
         CI,R6    2                                                             
         BGE      P01ERR2           B IF NO ASSIGNMENT SPECIFIED                
         AI,R9    8                 CONTROL BLOCK FOR SECOND GETIOID            
         LW,R0    GIOBITS                                                       
         STW,R0   *R9               SET TO SCAN ANY IO MEDIUM ID                
         BAL,R8   GETIOID           GET NEW ASSIGNMENT FOR OPLABEL              
         CI,R6    2                                                             
         BL       P01ERR2           B IF GETIOID OR SYNTAX ERROR                
         LCI      END-BASE                                                      
         LM,R8    BASE              GET FPT PROTOTYPE IN REGISTERS              
         OR,R8    1,R3              MERGE IN OPLABEL NAME                       
         OR,R8+BITS-BASE  8,R3      MERGE IN P-BITS FOR NEW ASSIGNMENT          
         AW,R8+IDPTR-BASE  R3       BIAS IO ID POINTER INTO TSPACE BLOCK        
         AW,R8+APTR-BASE  R3        BIAS ACNT PTR INTO TSPACE BLOCK             
         CW,R8+BITS-BASE  GIOOBIT                                               
         BAZ      %+2               B IF NEW ASGNMT NOT OPLABEL                 
         OR,R8+IDPTR-BASE  Y8       MERGE INDIRECT BIT INTO PTR                 
         LCI      END-BASE                                                      
         STM,R8   0,R3              STUFF FPT IN TSPACE                         
         CAL1,7   0,R3              DO STDLB CAL                                
         PULL     R7                RECOVER TSPACE POINTER                      
         BAL,R8   RELTEMP           RELEASE TSPACE                              
         B        KEY2EXIT          DONE                                        
*                                                                               
P01ERR1  RES      0                 ERROR EXIT NO TSPACE                        
         PULL     R7                                                            
         B        A04                                                           
*                                                                               
P01ERR2  RES      0                 ERROR EXIT WITH TSPACE                      
         PULL     R7                RECOVER TSPACE POINTER                      
         BAL,R8   RELTEMP           RELEASE TSPACE                              
         B        A04                                                           
*                                                                               
BASE     DATA     X'62800000'       STDLB FPT PROTOTYPE                         
BITS     DATA     X'80000021'       P1, F2, F7                                  
         DATA     P01ERR2           ERROR RETURN                                
IDPTR    DATA     9                 DISPLACEMENT TO IO ID BLOCK                 
APTR     DATA     12                DISPLACEMENT TO ACNT BLOCK                  
END      RES      0                                                             
*                                                                               
GIOBITS  DATA     X'70040000'       GETIOID FLAGS FOR ANY IO ID                 
GIOOBIT  EQU      XBIT1             GETIOID FLAGS FOR OPLABEL                   
*                                                                               
         TITLE    '** KEY2 - CINT KEY-IN **'                                    
*                                                                               
*                                                                               
T01      RES      0                                                             
         CI,R6    2                                                             
         BE       A04               ERROR IF END OF CARD                        
         STW,R7   R1                SAVE R7                                     
         LI,R11   1                 TRY BCD FIRST                               
         BAL,R15  R61               GET LOC,LAB'L(ERR IF END FIELD              
         CI,R10   2                                                             
         BG       T03               IF MORE THAN 2 CHARS. MUST BE LOC           
         BL       A04               IF LESS THAN 2 CHARS. , ERROR               
         LH,R15   R8                                                            
         BAL,R4   CKINTLAB          TEST FOR VALID INTERRUPT LABEL              
         B        T03               NOT                                         
         B        T05               IS                                          
T03      LW,R7    R1                NO, TRY SCAN AGAIN FOR LOC.                 
         LI,R11   2                 SET FOR HEX                                 
         BAL,R15  R61               GET LOC(ERR IF NOT END OF FIELD             
         LW,R15   R8                                                            
         BAL,R4   CKINTADR                                                      
         B        A04               ILLEGAL ADDRESS                             
T05      RES      0                                                             
         LW,R4    R15               SAVE R15                                    
         LI,R11   1                 SET FOR BCD INPUT                           
         BAL,R15  R62               GET D,A,T(ERR IF NOT END OF CARD            
         CI,R10   1                                                             
         BNE      A04               ERROR IF NOT 1 CHAR.                        
         LB,R1    T90                                                           
         LB,R8    R8                                                            
         CB,R8    T90,R1            SEARCH FOR CHAR.                            
         BE       %+3               FOUND IT                                    
         BDR,R1   %-2                                                           
         B        A04               ERROR, INVALID CODE                         
         INT,R15  R4                GET 2ND HW (LEVEL BIT)                      
         LB,R4    R4                GET GROUP CODE                              
         LI,R2    2                 INDEX TO INSERT FUNCTION CODE               
         LB,R0    T91,R1            GET FIRST FUNCTION CODE                     
         STB,R0   R4,R2                                                         
         WD,R15   *R4                                                           
         LB,R8    T92,R1            IS THERE A 2ND FUNCTION CODE                
         BEZ      KEY2EXIT          NO,EXIT                                     
         STB,R8   R4,R2             YES, STORE IT                               
         WD,R15   *R4                                                           
         B        KEY2EXIT                                                      
*                                                                               
T90      DATA,1   3,'D','A','T'                                                 
T91      DATA,1   0,X'11',X'12',X'12'   INT. CONTROL CODES                      
T92      DATA,1   0,0,0,X'17'       TRIGGER CODE                                
         TITLE    '** KEY2 -  DM,DB,DF KEY-INS **'                              
U01      RES      0                 DUMP MONITOR                                
         LI,R2    X'10'             DEFAULT START OF RANGE                      
         LW,R3    K:FGDBG1                                                      
         AI,R3    -1                DEFAULT END OF RANGE                        
         LI,R4    0                 SHIFT FOR FLAG BITS IN K:PMD1               
         BAL,R15  UVW               ANALYZE KEYIN                               
         B        CTDINIT           B TO INITIATE CONTROL TASK DUMP             
*                                                                               
V01      RES      0                 DUMP BACKGROUND                             
         LW,R2    K:BACKBG          DEFAULT START OF RANGE                      
         LW,R3    K:BCKEND          DEFAULT END OF RANGE                        
         LI,R4    3                 SHIFT FOR FLAG BITS IN K:PMD1               
         BAL,R15  UVW               ANALYZE KEYIN                               
         AI,R3    2                 ROUND TO NEXT DW                            
         SLD,R2   -1                WA TO DA                                    
         STH,R2   R3                                                            
         STW,R3   K:PMD+4           SET THE DUMP RANGE                          
         LW,R3    K:CTST                                                        
         CI,R3    1                                                             
         BANZ     KEY2EXIT          B IF PMD RUNNING NOW                        
         CI,R3    X'10000'                                                      
         BAZ      KEY2EXIT          B IF BKG NOT ABORTING NOW                   
         PULL     R15               REMOVE RETURN ADDRESS                       
         LI,R15   PMD               ROUTINE TO START THE DUMP                   
         B        KEY2EXB           B TO LEAVE KEY2                             
*                                                                               
W01      RES      0                 DUMP FOREGROUND PRIMARY                     
         LW,R2    K:FGDBG1          DEFAULT START OF RANGE                      
         LW,R3    K:FGDEND          DEFAULT END OF RANGE                        
         LI,R4    0                 SHIFT FOR FLAG BITS IN K:PMD1               
         BAL,R15  UVW               ANALYZE KEYIN                               
*                                                                               
CTDINIT  RES      0                 INITIATE A CONTROL TASK DUMP                
         LW,R7    CTDRUN                                                        
         CW,R7    K:CTST                                                        
         BANZ     A04               ERROR:  CT DUMP ALREADY RUNNING             
         OR,R7    K:CTST                                                        
         STW,R7   K:CTST            SET FLAG TO RUN CT DUMP                     
         LI,R6    0                                                             
         LI,R7    CTDABT                                                        
         STS,R6   K:PMD1            RESET CT DUMP ABORT FLAG                    
         LI,R7    64                                                            
         BAL,R8   GETTEMP           GET DUMP CONTROL BLOCK                      
         B        NOTS              B IF NOT ENUF TEMP SPACE                    
         ENABLE                                                                 
         AND,R7   XFFFFFF                                                       
         STW,R2   WXFWA,R7                                                      
         STW,R3   WXLWA,R7          SET DUMP RANGE                              
         LW,R6    R7                                                            
         AI,R6    WXRES             SPACE FOR DCB                               
         STW,R6   WXDCB,R7          SET UP DCB POINTER                          
         AI,R6    -1                                                            
         LI,R4    5                                                             
         LW,R5    DODCB-1,R4        SET UP DCB                                  
         STW,R5   *R6,R4                                                        
         BDR,R4   %-2                                                           
         LI,R0    0                                                             
         STW,R0   WXBAD,R7          SET BUFFER-ADDRESS DISPLACEMENT             
         STW,R0   WXCTDTO,R7        SET TIMEOUT FOR LP MANUAL                   
         LI,R6    DFGDBAL                                                       
         STW,R6   WXBAL,R7          SET POST-PRINT ROUTINE ADDR                 
         LW,R6    K:PMD1                                                        
         CI,R6    X'100'                                                        
         BAZ      %+2               B IF NO EBCDIC                              
         AI,R0    MEBC              SET EBCDIC DUMP FLAG                        
         CI,R6    1                                                             
         BAZ      %+2               B IF NOT SHORT-LINE                         
         AI,R0    M4WD              SET 4-WORD LINE FLAG                        
         LI,R1    BXFLAGS                                                       
         STB,R0   *R7,R1            SET FLAGS IN CONTROL BLOCK                  
         LW,R6    R7                                                            
         AI,R6    WXBUF-1           PUT HEADER IN MESSAGE BUFFER                
         LI,R5    CTDHE-CTDH                                                    
         LW,R4    CTDH-1,R5                                                     
         STW,R4   *R6,R5                                                        
         BDR,R5   %-2                                                           
         AI,R6    CTDHE-CTDH                                                    
         LI,R5    32-CTDHE+CTDH                                                 
         LW,R4    BLANKS                                                        
         STW,R4   *R6,R5                                                        
         BDR,R5   %-1                                                           
         LI,R5    TIMEC                                                         
         STB,R5   R6                                                            
         AI,R6    2                                                             
         CAL1,8   R6                PUT DATE/TIME IN MESSAGE                    
         BAL,R8   DUMP              DUMP THE RANGE                              
         B        IOER              I/O ERROR IN DUMP                           
CTD2     LI,R6    64                                                            
         STB,R6   R7                                                            
         BAL,R8   RELTEMP           RELEASE THE DUMP CONTROL BLOCK              
CTD3     LI,R6    0                                                             
         LW,R7    CTDRUN                                                        
         STS,R6   K:CTST            END OF DUMP                                 
         B        KEY2EXIT                                                      
*                                                                               
DODCB    GEN,8,16,4,4  5,1,0,3      LENGTH,VFC,UNSET,OPLABEL CODE               
         GEN,8,16,8    3,0,DO       NRT,UNSET,OPLABEL  INDEX                    
         DATA     0,128**17,0       UNSET,RSZ,UNSET                             
*                                                                               
CTDH     TEXT     '1 CONTROL TASK DUMP'                                         
CTDHE    RES      0                                                             
*                                                                               
NOTS     LCI      NOTSME-NOTSM                                                  
         LM,R8    NOTSM                                                         
         CAL1,2   R8                ERROR MESSAGE:  NO TSPACE                   
         B        CTD3                                                          
*                                                                               
NOTSM    GEN,8,24  2,0              FPT FOR TYPE CAL                            
         GEN,1,31 1,X'10'                                                       
         DATA     R11                                                           
         TEXTC    '!!NO TSPACE'                                                 
NOTSME   RES      0                                                             
*                                                                               
IOER     LCI      IOERME-IOERM                                                  
         LM,R8    IOERM                                                         
         CAL1,2   R8                ERROR MESSAGE: DUMP IO ERROR                
         B        CTD2                                                          
*                                                                               
IOERM    GEN,8,24  2,0              FPT FOR TYPE CAL                            
         GEN,1,31 1,X'10'                                                       
         DATA     R11                                                           
         TEXTC    '!!DUMP IO ERROR'                                             
IOERME   RES      0                                                             
*                                                                               
UVW      LI,R1    0                 EBCDIC AND SHORT-LINE FLAGS OFF             
         CI,R6    2                                                             
         BE       UVW9              B IF END OF KEYIN                           
UVW1     PUSH     R7                SAVE CURRENT KEYIN SCAN POINTER             
         LI,R11   2                 TRY FOR FWA (HEX)                           
         BAL,R14  SCAN                                                          
         CI,R6    0                                                             
         BL       UVW5              B IF NOT HEX                                
         PULL     R9                BALANCE STACK                               
         STW,R8   R2                SET FWA                                     
         STW,R8   R3                (ALSO LWA, FOR NOW)                         
         CI,R6    1                                                             
         BG       UVW9              B IF END OF KEYIN                           
         PUSH     R7                SAVE CURRENT KEYIN SCAN POINTER             
         LI,R11   2                 TRY FOR LWA (HEX)                           
         BAL,R14  SCAN                                                          
         CI,R6    0                                                             
         BL       UVW5              B IF NOT HEX                                
         PULL     R9                BALANCE STACK                               
         STW,R8   R3                SET LWA                                     
         B        UVW7                                                          
UVW5     PULL     R7                RETRY SCAN                                  
         LI,R11   1                 TRY FOR FLAG (EBCDIC)                       
         BAL,R14  SCAN                                                          
         CI,R6    0                                                             
         BL       A04               KEY ERR                                     
         SLS,R8   -16               KEEP FIRST TWO BYTES ONLY                   
         LI,R0    X'100'            EBCDIC FLAG                                 
         CI,R8    'T '                                                          
         BE       UVW6              B IF EBCDIC REQUEST                         
         LI,R0    1                 SHORT-LINE FLAG                             
         CI,R8    'S '                                                          
         BNE      A04               B IF UNRECOGNIZED FLAG                      
UVW6     OR,R1    R0                SAVE FLAG                                   
UVW7     CI,R6    1                                                             
         BLE      UVW1                                                          
UVW9     CW,R3    R2                                                            
         BL       A04               B IF LWA .LT. FWA                           
         CI,R3    X'1FFFF'                                                      
         BG       A04               B IF LWA TOO BIG                            
         LW,R0    R1                                                            
         LI,R1    X'101'                                                        
         SLD,R0   0,R4              SHIFT FLAGS TO NATURAL POSITION             
         STS,R0   K:PMD1            SET THEM                                    
         B        *R15                                                          
         TITLE    '** KEY2 - DED,UND KEY-INS **'                                
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*   DOES STOPIO OR STARTIO OR DEACTV OR ACTV CALL ON THE                        
*    PROPER DEVICE, CONTROLLER OR IOP.                                          
*                                                                               
*                                                                               
*                                                                               
X01      LI,R2    X'E'              SET CODE FOR STOP BCKG I/O                  
X02      RES      0                                                             
         CI,R6    2                                                             
         BE       A04               ERROR IF END OF CARD                        
         LI,R11   1                 SET FOR BCD                                 
         BAL,R14  SCAN              GO GET DEVICE NAME                          
         SLD,R8   -24                                                           
         AW,R8    Y155A5A           MERGE NL,BANG,BANG                          
         LH,R1    DCT1                                                          
         CD,R8    DCT16,R1          SEARCH DCT16 FOR DEVICE                     
         BE       %+3               FOUND IT                                    
         BDR,R1   %-2                                                           
         B        A04               ERROR IN DEV. NAME                          
         CI,R6    2                 IS IT END OF CARD                           
         BE       A04               YES,ERROR                                   
         BAL,R14  SCAN              GET F,X,N,D OR R PARAMETER                  
         CI,R10   1                                                             
         BNE      A04               ERROR IF NOT 1 CHAR. INPUT                  
         LI,R12   0                 INIT. BYTE 1 OF FPT WORD 0                  
         LB,R0    R8                GET CHAR.                                   
         CI,R0    'F'                                                           
         BE       X03               IF F,DON'T CHANGE ORDER                     
         CI,R0    'N'               IS IT STOP ALL I/O WITHOUT ABORT            
         BE       X02A               YES                                        
         CI,R0    'X'               IS IT STOP ALL I/O WITH ABORT               
         BNE      X05                NO                                         
         CI,R2    X'E'              IS THIS A DED KEYIN                         
         BNE      X02A              NO, UND KEYIN                               
         LI,R12   K80               YES, SET P0 BIT IN FPT WORD 0               
X02A     RES      0                                                             
         AI,R2    2                 STEP ORDER TO STOP/START ALL I/O            
X03      CI,R6    2                 IS IT END OF CARD                           
         BNE      %+3               B IF NOT END OF CARD                        
         AI,R12   4                 CONTROLLER; SET DEV,IOP= 0,0                
         B        X04                                                           
         BAL,R15  R62               GO GET 'I'(ERR IF NOT END OF CARD)          
         CI,R10   1                                                             
         BNE      A04               ERROR IF NOT 1 CHAR.                        
         LB,R0    R8                                                            
         CI,R0    'D'               IS IT FOR SINGLE DEVICE                     
         BNE      %+3               NO                                          
         AI,R12   X'24'             YES, SET DEV,IOP= 1,0                       
         B        X04                                                           
         CI,R0    'I'                                                           
         BNE      A04               ERROR IF NOT I (RES. IOP)                   
         AI,R12   X'C'              IOP; SET DEV,IOP= 0,1                       
X04      RES      0                                                             
         LI,R3    1                                                             
         STB,R12  R1,R3             STORE BYTE 1 OF FPT WORD 0                  
         STB,R2   R1                STORE STOP OR START ORDER IN CALL           
         CI,R12   X'80'             IS P0=1 (PREEMPT ADDR PRESENT)              
         BAZ      %+3               NO, BRANCH                                  
         LW,R2    Y008              YES, SET UP WORDS 1 AND 2 OF FPT            
         LI,R3    0                 SET PREEMPT ADDR = 0                        
         CAL1,5   R1                CALL STOP/STRT I/O                          
         B        KEY2EXIT                                                      
X05      CI,R0    'R'                                                           
         BE       X05A              B IF 'R' OPTION                             
         CI,R0    'D'               IS IT THE 'D' OPTION                        
         BNE      A04               NO, ERROR                                   
         AI,R2    8                 YES, MAKE FPT CODE=X'16' OR X'17'           
         B        X03               PROCESS IOP, DEVICE, CONTROLLER OPT.        
X05A     RES      0                                                             
         DO       #PRIV                                                         
X09      B        A04               MUST USE MOU/UNM                            
         ELSE     #PRIV                                                         
         LB,R0    DCT4,R1           CHECK FOR                                   
         CI,R0    DCT4:DP            DISK PACK                                  
         BE       %+3                                                           
         CI,R0    DCT4:DPX          ALSO CHECK FOR 7260 TYPE                    
         BNE      A04                 ERROR IF NOT                              
         WD,R0    DISABLE                                                       
         LB,R0    DCTRBM,R1                                                     
         CI,R2    X'E'               CHECK FOR DED KEYIN                        
         BNE      X09                 BRANCH IF UNDEDICATE                      
         OR,R0    KX2               SET BIT 6                                   
         STB,R0   DCTRBM,R1          OF DCTRBM                                  
         WD,R0    ENABLE                                                        
         LH,R7    RFT4              CHECK ALL RFT ENTRIES                       
X06      LD,R3    RFT1,R7            FOR ANY OPEN                               
         BEZ      X07                 FILES WITH THE                            
         LB,R4    RFT8,R7              SAME DEVICE INDEX                        
         CB,R1    MDDCTI,R4         SAME DEVICE ?                               
         BE       KEY2EXIT          FOUND MATCH, EXIT                           
X07      BDR,R7   X06                                      /SIG7-4791/*C5732 C01
         LCI      3                                                             
         LM,R11   TYPE6             TYPE 'IDLE'                                 
         CAL1,2   R11                                                           
         B        KEY2EXIT              'IDLE'AND RETURN                        
X09      AND,R0   KXFD              FOR UND DPNDD, RESET                        
         STB,R0   DCTRBM,R1          BIT 6 OF DCTRBM                            
         WD,R0    ENABLE                                                        
         B        KEY2EXIT                                                      
         FIN      #PRIV                                                         
*                                   PROCESS UND KEYIN                           
X020     LI,R2    X'F'              SET CODE FOR START BCKG I/O                 
         B        X02                                                           
*                                                                               
         PAGE                                                                   
         SPACE    2                                                             
*                          PARAM PROCESSINS UTILITY ROUTINES*                   
R61      RES      0                 CHECK FOR END OF FIELD                      
         BAL,R14  SCAN                                                          
         CI,R6    1                                                             
         BNE      A04               NOT END OF FIELD                            
         B        *R15                                                          
******************************                                                  
R62      RES      0                 CHECK FOR END OF CARD                       
         BAL,R14  SCAN                                                          
         CI,R6    2                                                             
         BNE      A04                                                           
         B        *R15                                                          
         OLAYEND                                                                
         END                                                                    
