************************************************************                    
*                                                          *                    
*                                                          *                    
*        K E Y - 6    K E Y - I N  P R O C E S S O R       *                    
*                                                          *                    
*                                                          *                    
************************************************************                    
         PCC      0                                                             
         SPACE    2                                                             
         SYSTEM   SIG5P                                                         
         SYSTEM   OPTIONS                                                       
         SPACE    2                                                             
         DEF      A:KEY6                                                        
         DEF      KEY6              ENTRY POINT FROM KEY1                       
         DEF      KEY6EXB                                                       
         DEF      KEY6A04                                                       
         SPACE    2                                                             
OLAYSIZ  EQU      512                                                           
         SPACE    1                                                             
OLAYFLAG EQU      'KEY6'                                                        
         SYSTEM   CPRMON                                                        
         TITLE    '** KEY6 - CONTROL SECTION **'                                
*                                   RUNS UNDER RBM CONTROL TASK AS AN           
*                                   OVERLAY. PROCESSES KEY-INS AS AN            
*                                   EXTENSION OF THE KEY1 OVERLAY.              
KEY6     RES      0                                                             
A:KEY6   EQU      KEY6                                                          
KEYIN    EQU      Y04               KEYIN CONTROL BIT                           
*                                   ENTER HERE FOR PART 6 OF KEY-IN OLAY        
*                                                                               
*                                                                               
*        AT ENTRY,                                                              
*        R2=KEYIN INDEX                                                         
*        R6=SCAN RETURN CODE FROM FIRST SCAN CALL                               
*        R7=KEYIN TEXT POINTERS AS REQUIRED FOR SCAN ROUTINE                    
*        R15=ADDRESS TO RETURN INTO CONTROL TASK                                
*                                                                               
*                                                                               
A01      RES      0                 ENTRY FOR THIS OVERLAY                      
         PUSH     R7                SAVE INDEX INTO KEYIN BUFFER                
         LI,R7    31                GET TSPACE FOR FPTS                         
         BAL,R8   GETTEMP                                                       
         B        KEY6NOTS          NO TSPACE. ERROR.                           
         ENABLE                     SPACE FOUND                                 
         LW,R3    R7                KEEP TSACE PTR IN R3                        
         PULL     R7                RESTORE INDEX INTO KEYIN BUFFER             
         PUSH     R3                SAVE TEMP SPACE POINTER FOR EXIT            
         LW,R4    A92,R2            MOVE FPT FOR INDICATED KEYIN                
         BEZ      A01A              NO SPACE TO MOVE                            
         LI,R5    31                NUMBER OF WORDS TO MOVE (WAS 20)            
MOVFPT   LW,R8    *R4,R5                                                        
         STW,R8   *R3,R5                                                        
         BDR,R5   MOVFPT                                                        
         LW,R8    *R4               GET LAST DW                                 
         STW,R8   *R3               PUT IN TEMP SPACE                           
A01A     LH,R8    A91,R2            GET ADDRESS TO PROCESS KEYIN                
         B        *R8               GO TO PROPER ROUTINE                        
*                                                                               
*                                                                               
*                                                                               
KEY6NOTS PULL     R7                ERROR EXIT: NO TSPACE                       
         B        KEY6A04                                                       
A04P2    RES      0                                                             
         PULL     2,R4              BALANCE STACK                               
KEY6ERR  RES      0                 ERROR ENTRY, TYPE 'KEY ERROR'               
A04      EQU      KEY6ERR           OLD NAME FOR ERROR EXIT                     
         PULL     R7                                                            
         BAL,R8   RELTEMP                                                       
KEY6A04  B        KEY1A04           RET TO KEY1 TO TYPE ERR MSG                 
*                                                                               
KEY6EXIT RES      0                                                             
         PULL     R7                                                            
         BAL,R8   RELTEMP                                                       
KEY6EXB  B        CT1                                                           
*                                                                               
         PAGE                                                                   
         SPACE    2                                                             
*                                                                               
A91      EQU      %                                                             
*                                                                               
*        DATA,2   HALF-WORD START ADDRESSES    OF KEY-IN                        
*                 PROCESSING ROUTINES                                           
*                                                                               
*                                                                               
         DATA,2   SNAPKEY           SNAP KEY-IN PROCESSOR                       
         DO       #ERRORLOG                                                     
         DATA,2   ERRSKEY           ERRSEND KEY-IN PROCESSOR  I                 
         DATA,2   ERRSKEY           ERRSEND KEY-IN PROCESSOR II                 
         DATA,2   ELOGKEY           ELOG KEY-IN                                 
         FIN                                                                    
         DATA,2   ALARMKEY          ALARM KEY-IN PROCESSOR                      
         DATA,2   REBKEY            REBOOT KEY-IN PROCESSOR                     
         DO1      #TSLICE                                                       
         DATA,2   QKEY              Q KEY-IN                                    
         DO       #550                                                          
         DATA,2   Q30                                                           
         DATA,2   Q31                                                           
         FIN      #550                                                          
*                                                                               
*                                                                               
         BOUND    4                                                             
A92      EQU      %                                                             
*        DATA     ADDRESSES OF FPT'S FOR THE PROCESSORS                         
*                                                                               
*                 SHOULD BE ON A DOUBLE WORD BOUNDARY (BOUND 8)                 
*                    ( BUT MOVE CODE DOESN'T MAKE USE OF THIS. )                
*                                                                               
*                                                                               
*                 MUST BE IN SAME ORDER AS ABOVE TABLE                          
*                  IF NO FPT EXISTS, THE CORRESPONDING WORDS IS                 
*                  SET TO ZERO TO INDICATE NO MOVE                              
*                                                                               
*                                                                               
         DATA     SNAPFPT           SNAP'S FPT                                  
         DO       #ERRORLOG                                                     
         DATA     ERRSFPT           ERRSEND  I                                  
         DATA     ERRSFPT           ERRSEND II                                  
         DATA     0                 ERRLOG (ELOG)                               
         FIN                                                                    
         DATA     0                 ALARM                                       
         DATA     0                 REBOOT                                      
         DO1      #TSLICE                                                       
         DATA     QFPT              QKEY                                        
         DO       #550                                                          
         DATA     0                                                             
         DATA     0                                                             
         FIN      #550                                                          
*                                                                               
*                                                                               
#KEYINS  EQU      %-A92             NUMBER OF KEYINS IN THIS OVERLAY            
         PAGE                                                                   
*        SUBROUTINE  TO CONVERT BINARY TO HEX EBCDIC                            
*        CALL IS  BAL,R8  HEXBCD                                                
*        WHERE    R11=VALUE TO  CONVERT                                         
*        EXITS    R10,R11=VALUE IN BCD RT. JUST.                                
*        USES     R0,R5,R6,R10,R11                                              
*                                                                               
HEXBCD   LI,R5    -28                                                           
         LI,R6    0                                                             
         LW,R9    R11                                                           
HEXBCD1  LW,R0    R9                                                            
         SLS,R0   0,R5                                                          
         AND,R0   M4                                                            
         AI,R0    X'F0'                                                         
         CI,R0    X'FA'                                                         
         BL       %+2                                                           
         AI,R0    -X'39'                                                        
         STB,R0   R10,R6                                                        
         AI,R6    1                                                             
         AI,R5    4                                                             
         BLEZ     HEXBCD1                                                       
         B        *R8                                                           
         TITLE    '** KEY6 - GET OPTION SUBROUTINE **'                          
*        ROUTINE TO FETCH NEXT OPTION FOR A KEYIN                               
*        CALL IS                                                                
*                                                                               
*        BAL,R13  GETOPT                                                        
*        GEN,8,24 #OPT,OPTIONLIST   WHERE #OPT IS THE NUMBER OF OPTIONS         
*                                   AVAILABLE FOR THE KEYIN.                    
*                                   OPTIONLIST IS THE ADDRESS OF A              
*                                   DOUBLE WORD TABLE THAT HAS ONE              
*                                   ENTRY PER OPTION AS FOLLOWS:                
*                                                                               
*                                     FIRST WORD:  THE OPTION KEYWORD           
*                                                  IDENTIFIER  IN EBCDIC        
*                                                  LEFT   JUSTIFIED BLANK       
*                                                  FILLED                       
*                                                                               
*                                     SECOND WORD: PARAMETER CONTROL            
*                                     BITS 0-7                                  
*                                        00  NO PARAMETER ALLOWED               
*                                            ON RETURN R8 WILL HAVE             
*                                            THE CONTENTS OF THIS WORD          
*                                                                               
*                                        01  CONVERT TO EBCDIC                  
*                                        02  CONVERT  TO HEX                    
*                                        04  CONVERT  TO DECIMAL                
*                                                                               
*                                        8X  IF  NO PARAMETER - RETURN          
*                                            CONTENTS  OF THIS WORD IN          
*                                            R8.   IF PARAMETER IS PRESENT      
*                                            CONVERT  ACCORDING TO X AND        
*                                            AND  RETURN IT IN R8.  X           
*                                            IS  DESCRIBED ABOVE.               
*        RETURN IS TO CALL LOCATION +(N+2)                                      
*                 WHERE N IS 0 IF ANY ERRORS ARE DETECTED                       
*                 IF NO ERRORS N WILL BE THE INDEX                              
*                 INTO THE OPTION LIST TABLE CORRESPONDING                      
*                 TO THE OPTION BEING PROCESSED.                                
*                                                                               
*        USES REGISTERS:                                                        
*                                                                               
*        R0,R5-R11                                                              
*                                                                               
*        USES SCAN ROUTINE                                                      
*                                                                               
*                                                                               
GETOPT   EQU      %                                                             
         PUSH     4,R1              SAVE R1-R4                                  
         LI,R11   1                                                             
         BAL,R14  SCAN              NEXT CHAR SHOULD BE '('                     
         CI,R6    0                                                             
         BGE      GO02              B IF NO SCAN ERROR                          
GO01     EQU      %                                                             
         AI,R13   1                 TAKE ERROR EXIT                             
         PULL     4,R1                                                          
         B        *R13                                                          
GO02     EQU      %                                                             
         LI,R1    0                 OPTION SEARCH INDEX                         
         LW,R0    *R13              GET ADDRESS OF OPTION LIST                  
GO03     EQU      %                                                             
         LD,R2    *R0,R1            GET OPTION DESCRIPTOR                       
         CW,R8    R2                IS IT THIS OPTION                           
         BE       GO04              B IF YES                                    
         AI,R1    1                 MOVE TO NEXT OPTION                         
         CB,R1    *R13              REACHED LIMIT YET                           
         BL       GO03              B IF NO                                     
         B        GO01              YES -TAKE ERROR EXIT                        
GO04     EQU      %                                                             
         LB,R11   R3                GET CONVERT TYPE                            
         BEZ      GO09              B IF NO PARAMETER                           
         CI,R11   X'80'             IS IT NO PRAMETER OPTION                    
         BANZ     GO010             B IF YES                                    
GO05     RES      0                                                             
         AND,R11  M7                                                            
         BAL,R14  SCAN              GET PARAMETER                               
         CI,R6    0                                                             
         BL       GO01              B IF SCAN ERROR                             
GO07     AI,R13   2                 POINT TO FIRST EXIT                         
         AW,R13   R1                NOW POINT TO CORRECT OPTION EXIT            
         PULL     4,R1                                                          
         B        *R13              RETURN                                      
*                                                                               
GO09     EQU      %                                                             
         LW,R8    R3                GET RETURN PARAMETER                        
         B        GO07                                                          
GO010    EQU      %                                                             
         LW,R8    R3                GET DUMMY PARAMETER                         
         CI,R6    0                                                             
         BG       GO07              B IF END OF PAREN FIELD                     
         B        GO05              PROCESS FIRST OPTION                        
*                                                                               
         TITLE    '** KEY6 - SNAP KEY-IN **'                                    
         SPACE    2                                                             
*************************************************************                   
*                                                                               
*                                                                               
*                                                                               
*                S N A P    K E Y - IN    P R O C E S S O R                     
*                                                                               
*                                                                               
*                                                                               
************************************************************************        
*                                                                               
*                                                                               
*        INPUTS:  R3 = ADDRESS OF FPT IN TEMPSPACE                              
*                 R7 = NEG INDEX TO INPUT CHARS IN INPUT BUFFER                 
*                                                                               
*                                                                               
*        CALLS:   GETOPT TO GET OPTIONS AND PARAMETERS                          
*                 SCAN   TO GET AREA AND FILE NAME                              
*                 SNAP   TO COPY CORE TO SE OPLABEL                             
*                                                                               
*                                                                               
*        REGISTER USAGE:                                                        
*                                                                               
*                 R3 = ADDRESS OF FPT IN TEMP SPACE                             
*                 R7 = ADDRESS OF KEY-IN MESSAGE                                
*                 R13= LINK TO GETOPT                                           
*                 R14= LINK TO SCAN                                             
*                                                                               
*        NOTE:   REGISTERS R5 - R11 USED AS SET BY GETOPT, SCAN                 
*                                                                               
*        IF FILE IS SPECIFIED, OPLBS3 ENTRY FOR SE IS TEMPORARILY               
*          MODIFIED TO INDICATE THAT FILE BEFORE BAL TO SNAP OVERLAY            
*                                                                               
*        AFTER SNAP, SE IS RE-SET TO ORIGINAL ASSIGNMENT                        
*                                                                               
*****************************************************************************   
         PAGE                                                                   
         SPACE    2                                                             
SNAPKEY  EQU      %                                                             
         CI,R6    2                 IF FILE IS SPECIFIED                        
         BNE      SNP01               SET SE TO IT                              
*                                                                               
         BAL,R15  SNAP              ELSE, USE CURRENT SE ASSIGNMENT             
         B        KEY6EXIT                                                      
*                                                                               
SNP01    RES      0                                                             
         BAL,R13  GETOPT            SCAN FOR KEYWORD 'FILE'                     
         GEN,8,24 #SNPLST,SNPLST                                                
         B        A04                                                           
*                                                                               
         LW,R9    R3                                                            
         AI,R9    16                GETIOID CONTROL BLOCK POINTER               
         LW,R0    GIOFA                                                         
         STW,R0   *R9               SET FLAGS FOR FILE NAME SCAN                
         BAL,R8   GETIOID           GET SNAP FILE ID                            
         CI,R6    2                                                             
         BL       A04               B IF GETIOID OR SYNTAX ERROR                
         AWM,R3   SNAPPTR-SNAPFPT,R3  BIAS FILE ID PTR INTO TSPACE BLOCK        
*                                                                               
         LI,R4    'SE'+X'F0000'     FIND OPLBS                                  
         LH,R5    OPLBS1             ENTRY FOR                                  
         CH,R4    OPLBS1,R5          SE                                         
         BE       %+3                                                           
         BDR,R5   %-2                                                           
         B        A04                                                           
*                                                                               
         LB,R4    OPLBS3,R5         GET CURRENT ASSIGNMENT                      
         PUSH     2,R4              SAVE OPLBS3 AND INDEX                       
         CAL1,7   *R3               RE-ASSIGN SE TO FILE IN R11-R13             
         BAL,R15  SNAP              WRITE CORE TO SE                            
*                                                                               
         PULL     2,R4              RESTORE OPLBS3                              
         STB,R4   OPLBS3,R5            TO   ORIGNAL SE ASSIGNMENT               
         B        KEY6EXIT                                                      
*                                                                               
*                                                                               
         BOUND    8                                                             
SNPLST   TEXT     'FILE'            LIST FOR GETOPT                             
         GEN,8,24 0,0                                                           
*                                                                               
#SNPLST  EQU      (%-SNPLST)/2                                                  
*                                                                               
SNAPFPT  GEN,8,1,23  X'62',1,'SE'   STDLB CAL FPT                               
         DATA     P1+P4+F3                                                      
         DATA     A04P2             ERROR                                       
SNAPPTR  DATA     17                DISPLACEMENT TO IO ID BLOCK                 
*                                                                               
GIOFA    DATA     X'10040000'       GETIOID FLAGS FOR FILE, ACNT                
         TITLE    '** KEY6 - ERRSEND KEY-IN **'                                 
         SPACE    2                                                             
********************************************************************            
*                                                                               
*        E R R S E N D     K E Y - I N P R O C E S S O R                        
*                                                                               
*******************************************************************             
ERRSKEY  RES      0                                                             
         DO       #ERRORLOG                                                     
         MTW,0    LOGFLAG           IF NO ERROR                                 
         BEZ      A04                 LOGGING, ERROR                            
*                                                                               
         SAS,R7   -24               GET INDEX TO NEXT CHAR                      
         LI,R5    0                                                             
ERRS01   AI,R5    -1                SCAN BUFFER                                 
         LB,R1    *K:KEYIN,R5       BACKWARDS FOR                               
         CI,R1    X'40'             FIRST NON-BLANK                             
         BE       ERRS01            CHARACTER                                   
*                                                                               
         SW,R5    R7                                                            
         AI,R5    1                 R5=BYTE COUNT                               
*                                                                               
         LW,R2    K:KEYIN                                                       
         AI,R2    -1                R2 WILL = MESSAGE BUFFER                    
         AI,R7    4                 R7 WILL = BTD                               
         BLZ      %-2                                                           
*                                                                               
ERRS02   CAL1,7   0,R3              PLACE TEXT IN ERROR LOG                     
*                                                                               
         B        KEY6EXIT                                                      
*                                                                               
*                                                                               
ERRSFPT  GEN,8,1,23  X'66',1,0      ERRSEND FPT                                 
         DATA     P1+P3+P4+P6+P10+F7                                            
         DATA     A04               ERROR ADDRESS                               
         GEN,1,31 1,R2              BUFFER                                      
         GEN,1,31 1,R5              BYTE COUNT                                  
         GEN,1,31 1,R7              BTD                                         
         DATA     0                 TYC                                         
*                                                                               
         FIN                                                                    
         TITLE    '** KEY6 - ELOG KEY-IN **'                                    
         SPACE    2                                                             
********************************************************************            
*                                                                               
*        E L O G           K E Y - I N P R O C E S S O R                        
*                                                                               
*******************************************************************             
         DO       #ERRORLOG                                                     
ELOGKEY  RES      0                 ELOG KEY-IN                                 
         BAL,R13  GETOPT                                                        
         GEN,8,24 #ELOGLST,ELOGLST  SCAN INPUT                                  
         B        A04               ERROR                                       
         B        ELOGON              'ON'                                      
         B        ELOGPURG                                                      
         LI,R1    0                   'OFF'                                     
         B        %+2                                                           
ELOGON   LI,R1    -1                                                            
         STW,R1   LOGFLAG           SET RUN-TIME SWITCH                         
         B        KEY6EXIT                                                      
*                                                                               
ELOGPURG RES      0                                                             
         BAL,R15  LOGPURGE                                                      
         B        KEY6EXIT                                                      
*                                                                               
         BOUND    8                                                             
ELOGLST  TEXT     'ON'                                                          
         DATA     0                                                             
         TEXT     'PURG'                                                        
         DATA     0                                                             
         TEXT     'OFF'                                                         
         DATA     0                                                             
#ELOGLST EQU      (%-ELOGLST)/2                                                 
         FIN                                                                    
         TITLE    '** KEY6 - REBOOT/ALARM KEY-INS **'                           
         SPACE    2                                                             
********************************************************************            
*                                                                               
*        R E B O O T    A N D    A L A R M    K E Y - I N    P R O C E S S O R  
*                                                                               
*******************************************************************             
REBKEY   RES      0                                                             
         LI,R3    -1                SET ALARMREC                                
         STW,R3   ALARMREC            FOR REBOOTING                             
ALARMKEY RES      0                                                             
         B        X'26'             DO CRASH                                    
         TITLE    '** KEY6 - Q30 KEY-IN **'                                     
*                                                                               
*                                                                               
        DO       #550                                                           
*                                                                               
* KEYIN TO MODIFY THE Q30 REGISTER ON A 550                                     
*                                                                               
Q30      RES      0                                                             
         RD,R1    X'31E'            READ OLD Q30                                
*                                                                               
Q30LOOP  BAL,R13  GETOPT            GET OPTIONS                                 
         GEN,8,24 (Q30LAST-Q30LIST)/2,Q30LIST                                   
*                                                                               
         B        A04               ERROR                                       
         B        NORETRY                                                       
         B        RETRY                                                         
         B        NOPARITY                                                      
         B        PARITY                                                        
         B        WDTON                                                         
         B        WDTOFF                                                        
         PAGE                                                                   
NORETRY  RES      0                                                             
         OR,R1    XBIT0                                                         
         B        NEXTQ30                                                       
*                                                                               
RETRY    RES      0                                                             
         OR,R1    XBIT0                                                         
         EOR,R1   XBIT0                                                         
         B        NEXTQ30                                                       
*                                                                               
NOPARITY RES      0                                                             
         OR,R1    XBIT1                                                         
         B        NEXTQ30                                                       
*                                                                               
PARITY   RES      0                                                             
         OR,R1    XBIT1                                                         
         EOR,R1   XBIT1                                                         
         B        NEXTQ30                                                       
*                                                                               
WDTOFF   RES      0                                                             
         OR,R1    XBIT2                                                         
         B        NEXTQ30                                                       
*                                                                               
WDTON    RES      0                                                             
         OR,R1    XBIT2                                                         
         EOR,R1   XBIT2                                                         
         B        NEXTQ30                                                       
*                                                                               
NEXTQ30  RES      0                                                             
         CI,R6    2                 ARE THERE ANY MORE OPTIONS                  
         BNE      Q30LOOP                                                       
*                                                                               
         WD,R1    X'31E'            WRITE Q30 REGISTER                          
         B        KEY6EXIT                                                      
         PAGE                                                                   
         BOUND    8                                                             
Q30LIST  RES      0                                                             
         DATA     'NORE',0                                                      
         DATA     'RETR',0                                                      
         DATA     'NOPA',0                                                      
         DATA     'PARI',0                                                      
         DATA     'WDT ',0                                                      
         DATA     'NOWD',0                                                      
Q30LAST  RES      0                                                             
         FIN      #550                                                          
         TITLE    '** KEY6 - Q31 KEY-IN **'                                     
         DO       #550                                                          
*                                                                               
* KEYIN TO MODIFY Q31 REGISTER IN A 550 (Q31 = ADDRESS HALT WORD)               
*                                                                               
Q31      RES      0                                                             
         RD,R1    X'31F'            READ OLD VALUE                              
         CI,R6    2                 ANY OPTIONS                                 
         BE       Q31MSG            NO                                          
*                                   YES                                         
         LI,R6    1                 FAKE FOR NEXT TEST                          
*                                                                               
Q31LOOP  CI,R6    2                 IS IT END OF PARAMETERS                     
         BE       Q31DONE           YES                                         
*                                   NO                                          
         BAL,R13  GETOPT            GET PARAMETERS                              
         GEN,8,24 (Q31LAST-Q31LIST)/2,Q31LIST                                   
*                                                                               
         B        SYMBOLCK                                                      
         B        ADDROPT                                                       
         B        INST                                                          
         B        WRONLY                                                        
         B        REAL                                                          
         B        VIRTUAL                                                       
         B        HALT                                                          
         B        HALT                                                          
         B        BEEP                                                          
         B        WORD                                                          
         B        PAGE                                                          
         B        ANY                                                           
         B        ALL                                                           
         B        CLEAR                                                         
         B        STMOPT                                                        
         B        ROOTOPT                                                       
         B        PLUSOPT                                                       
         PAGE                                                                   
PLUSOPT  RES      0                                                             
         AW,R1    R8                ADD IN BIAS                                 
         B        Q31LOOP           AND LOOP                                    
*                                                                               
ADDROPT  RES      0                                                             
         LB,R0    R1                                                            
         LW,R1    R8                                                            
         STB,R0   R1                                                            
         B        Q31LOOP                                                       
*                                                                               
STMOPT   RES      0                                                             
         AW,R8    STVM                                                          
         B        ADDROPT                                                       
*                                                                               
ROOTOPT  RES      0                                                             
         AW,R8    STVM                                                          
         AI,R8    X'E'                                                          
         B        ADDROPT                                                       
*                                                                               
Q31DONE  RES      0                                                             
         WD,R1    X'31F'            WRITE TO Q31                                
Q31MSG   RES      0                                                             
         LCI      7                                                             
         LM,R9    Q31FPT                                                        
*                                                                               
         LI,R3    -8                                                            
Q31MSGLP RES      0                                                             
         LI,R0    0                                                             
         SLD,R0   4                                                             
         AI,R0    '0'                                                           
         CI,R0    '9'                                                           
         BLE      %+2                                                           
         AI,R0    'A'-'0'-10                                                    
         STB,R0   X'10',R3                                                      
         BIR,R3   Q31MSGLP                                                      
*                                                                               
         CAL1,2   R9                TYPE MESSAGE                                
         B        KEY6EXIT          AND EXIT                                    
*                                                                               
Q31FPT   DATA     X'02000000'                                                   
         DATA     X'80000010'                                                   
         DATA     R12                                                           
         TEXTC    'Q31 IS XXXXXXXX'                                             
*                                                                               
INST     RES      0                                                             
         OR,R1    XBIT1                                                         
         OR,R1    XBIT2                                                         
         EOR,R1   XBIT2                                                         
         B        Q31LOOP                                                       
*                                                                               
WRONLY   RES      0                                                             
         OR,R1    XBIT2                                                         
         OR,R1    XBIT1                                                         
         EOR,R1   XBIT1                                                         
         B        Q31LOOP                                                       
*                                                                               
REAL     RES      0                                                             
         OR,R1    XBIT0                                                         
         B        Q31LOOP                                                       
*                                                                               
VIRTUAL  RES      0                                                             
         OR,R1    XBIT0                                                         
         EOR,R1   XBIT0                                                         
         B        Q31LOOP                                                       
*                                                                               
HALT     RES      0                                                             
         OR,R1    XBIT5                                                         
         OR,R1    XBIT4                                                         
         EOR,R1   XBIT4                                                         
         B        Q31LOOP                                                       
*                                                                               
BEEP     RES      0                                                             
         OR,R1    XBIT4                                                         
         OR,R1    XBIT5                                                         
         EOR,R1   XBIT5                                                         
         B        Q31LOOP                                                       
*                                                                               
WORD     RES      0                                                             
         OR,R1    XBIT3                                                         
         EOR,R1   XBIT3                                                         
         B        Q31LOOP                                                       
*                                                                               
PAGE     RES      0                                                             
         OR,R1    XBIT3                                                         
         B        Q31LOOP                                                       
*                                                                               
ANY      RES      0                                                             
ALL      RES      0                                                             
         OR,R1    XBIT2                                                         
         OR,R1    XBIT1                                                         
         EOR,R1   XBIT2                                                         
         EOR,R1   XBIT1                                                         
         B        Q31LOOP                                                       
*                                                                               
CLEAR    RES      0                                                             
         LI,R2    0                                                             
         STB,R2   R1                CLEAR ALL FLAGS                             
         B        Q31LOOP                                                       
SYMBOLCK RES      0                                                             
         LW,R2    R7                SAVE KEYIN SCAN POINTER                     
         BAL,R7   CPRSYMBL          GO LOOK UP SYMBOL NAME                      
         B        A04               CANT FIND, ERROR                            
*                                   CAN FIND                                    
         LW,R7    R2                RESTORE KEYIN SCAN POINTER                  
         LB,R0    R1                                                            
         LW,R1    R8                                                            
         STB,R0   R1                                                            
*                                                                               
         CI,R6    0                                                             
         BL       A04               ERROR IF ERROR IN SYNTAX                    
         BG       Q31LOOP           B IF NO SUB-FIELD                           
         LI,R11   2                                                             
         BAL,R14  SCAN              GET SUB-FIELD                               
*                                                                               
         CI,R6    1                                                             
         BL       A04               ERROR IF NOT EOF OR BETTER                  
*                                                                               
         AW,R1    R8                ADD IN DISPLACEMENT FIELD                   
         B        Q31LOOP                                                       
*                                                                               
         PAGE                                                                   
         BOUND    8                                                             
Q31LIST  RES      0                                                             
         DATA     'ADDR',X'02000000'                                            
         DATA     'INST',0                                                      
         DATA     'WRIT',0                                                      
         DATA     'REAL',0                                                      
         DATA     'VIRT',0                                                      
         DATA     'STOP',0                                                      
         DATA     'HALT',0                                                      
         DATA     'BEEP',0                                                      
         DATA     'WORD',0                                                      
         DATA     'PAGE',0                                                      
         DATA     'ANY ',0                                                      
         DATA     'ALL ',0                                                      
         DATA     'CLEA',0                                                      
         DATA     'STM ',X'02000000'                                            
         DATA     'ROOT',X'02000000'                                            
         DATA     'PLUS',X'02000000'                                            
Q31LAST  RES      0                                                             
         FIN      #550                                                          
         TITLE    '** KEY6 - TIME SLICING CONTROL KEY-IN **'                    
         DO       #TSLICE                                                       
*                                                                               
*        KEYIN TO CHANGE  TIME SLICING PARAMETERS                               
*                                                                               
*                                                                               
*                                                                               
*                                                                               
*        OFFSETS  INTO  TSPACE                                                  
QFPTMAD  EQU      2                 MESSAGE ADDRESS                             
QXSL     EQU      6                 SLICE                                       
QXMIN    EQU      7                 QMIN                                        
QXSWAP   EQU      8                 QSWAP                                       
QXMAX    EQU      9                 QMAX                                        
QM       EQU      12                MESSAGE                                     
*                                                                               
QKEY     EQU      %                                                             
         CI,R6    2                 ANY OPTIONS                                 
         BNEZ     QKEY01            B IF YES                                    
QKEY00   EQU      %                                                             
         LW,R11   TS1STICK          # OF SLICES IN ONE SECOND                   
         BAL,R8   DEC               CONVERT TO DECIMAL                          
         STW,R11  QM+2,R3                                                       
         LI,R11   1000                                                          
         DW,R11   TS1STICK          YEILDS PERIOD IN MIKLISECONDS               
         BAL,R8   DEC               CONVERT  TO  DECIMAL                        
         STW,R11  QM+5,R3                                                       
         LW,R11   QMIN                                                          
         BAL,R8   CTMS              CONVERT TO MILLISECONDS                     
         BAL,R8   DEC               CONVERT TO DECIMAL                          
         STW,R11  QM+8,R3                                                       
         LW,R11   QSWAP                                                         
         BAL,R8   CTMS              CONVERT TO MILLISECONDS                     
         BAL,R8   DEC               CONVERT  TO DECIMAL                         
         STW,R11  QM+11,R3                                                      
         LW,R11   QMAX                                                          
         BAL,R8   CTMS              CONVERT TO MILLISECONDS                     
         BAL,R8   DEC               CONVERT TO DECIMAL                          
         STW,R11  QM+14,R3                                                      
         LI,R0    QM                                                            
         AW,R0    R3                SET BUFFER ADDRESS                          
         STW,R0   QFPTMAD,R3                                                    
         CAL1,2   0,R3              OUTPUT MESSAGE                              
         B        KEY6EXIT                                                      
*                                                                               
QKEY01   EQU      %                                                             
         LW,R11   TS1STICK          SETUP TO PRESERVE CURRENT                   
         STW,11   QXSL,R3           VALUES OF SLICE, QMIN                       
         LW,R11   QMIN              QSWAP AND QMAX AS THEY WILL                 
         BAL,R8   CTMS                                                          
         STW,R11  QXMIN,R3          BE RECOMPUTED BASED ON                      
         LW,R11   QSWAP             ANY CHANGES IN SLICE                        
         BAL,R8   CTMS                                                          
         STW,R11  QXSWAP,R3         PARAMETER                                   
         LW,R11   QMAX                                                          
         BAL,R8   CTMS                                                          
         STW,R11  QXMAX,R3                                                      
*                                                                               
QKEY02   EQU      %                                                             
         BAL,R13  GETOPT            GET OPTION                                  
         GEN,8,24 #QOPT,QOPT                                                    
         B        A04               ERROR                                       
         B        QKEY04            SLICE                                       
         B        QKEY05            QMIN                                        
         B        QKEY06            QSWAP                                       
         B        QKEY07            QMAX                                        
*                                                                               
QKEY03   EQU      %                                                             
         CI,R6    2                 ANY MORE OPTIONS                            
         BNE      QKEY02            B IF YES                                    
*                                   NOW RECOMPUTE ALL VALUES BASED ON           
*                                   ANY CHANGES IN SLICE                        
*                                                                               
         LI,R9    1000                                                          
         DW,R9    QXSL,R3           YEILDS PERIOD IN MILLISECONDS               
         LW,R15   QXMIN,R3                                                      
         DW,R15   R9                YEILDS TIME TICK VALUE                      
*                                   R15 HAS QMIN VALUE                          
         LW,R11   QXSWAP,R3                                                     
         DW,R11   R9                                                            
         STW,R11  R14               R14 HAS QSWAP VALUE                         
         LW,R13   QXMAX,R3                                                      
         DW,R13   R9                R13 HAS QMAX VALUE                          
         LW,R12   QXSL,R3           R12 HAS SLICE VALUE                         
         LI,R11   1000                                                          
         DW,R11   R12                                                           
         SLS,R11  -1                GIVES # OF TICKS IN 1 SLICE                 
*                                   NOW WAIT FOR 1SEC CLOCK PASS                
         LW,R0    TS1STICK                                                      
         CW,R0    TS1SEC                                                        
         BNE      %-1               B IF NOT JUST REFRESHED                     
         DISABLE                                                                
         STW,R11  TSTICK                                                        
         STW,R12  TS1STICK          SET ALL NEW VALUES                          
         STW,R12  TS1SEC                                                        
         STW,R13  QMAX                                                          
         STW,R14  QSWAP                                                         
         STW,R15  QMIN                                                          
         ENABLE                     DONE                                        
         B        QKEY00            OUTPUT ALL NEW VALUES                       
*                                                                               
QKEY04   EQU      %                 PROCESS SLICE OPTION                        
         LW,R9    R8                                                            
         CI,R9    500                                                           
         BG       A04               CANNOT BE LARGER THAN 500                   
         CI,R9    1                                                             
         BL       A04               CANNOT BE SMALLER THAN 1                    
         LI,R4    0                                                             
         LI,R5    500               DOES IT DEVIDE EVENLY INTO                  
         DW,R4    R9                500                                         
         CI,R4    0                 IF NOT THEN REJECT IT                       
         BNE      A04               ERROR                                       
         STW,R9   QXSL,R3           ITS OK SAVE IT                              
         B        QKEY03            GO FOR NEXT OPTION                          
*                                                                               
QKEY05   EQU      %                 PROCESS Q MIN                               
         LI,R1    QXMIN                                                         
QKEY05A  LW,R9    R8                COMMON FOR QMIN, QMAX, QSWAP                
         CI,R9    1                                                             
         BL       A04               CANNOT BE LESS THAN ONE                     
         STW,R9   *R3,R1            SAVE IT                                     
         B        QKEY03            GO FOR NEXT OPTION                          
*                                                                               
QKEY06   EQU      %                 PROCESS Q SWAP                              
         LI,R1    QXSWAP                                                        
         B        QKEY05A                                                       
*                                                                               
QKEY07   EQU      %                 PROCESS QMAX                                
         LI,R1    QXMAX                                                         
         B        QKEY05A                                                       
*                                                                               
         BOUND    8                                                             
QOPT     EQU      %                                                             
         TEXT     'SLIC'                                                        
         GEN,8,24 4,0               DECIMAL PARAMETER                           
         TEXT     'QMIN'                                                        
         GEN,8,24 4,0                                                           
         TEXT     'QSWA'                                                        
         GEN,8,24 4,0                                                           
         TEXT     'QMAX'                                                        
         GEN,8,24 4,0                                                           
#QOPT    EQU      (%-QOPT)/2                                                    
*        SUBROUTINE TO CONVERT BINARY VALUE                                     
*        IN R11 TO DECIMAL AND RETURN                                           
*        VALUE IN EBCDIC IN R11                                                 
*        USES R0 AND R1                                                         
DEC      EQU      %                                                             
         LI,R10   0                                                             
         LI,R1    3                                                             
DEC01    DW,R10   XA                =10                                         
         AI,R10   X'F0'                                                         
         STB,R10  R0,R1                                                         
         LI,R10   0                                                             
         BDR,R1   DEC01                                                         
         DW,R10   XA                                                            
         AI,R10   X'F0'                                                         
         STB,R10  R0                                                            
         STW,R0   R11                                                           
         B        *R8                                                           
*                                                                               
*        SUBROUTINE TO CONVERT A VALUE IN  CURRENT                              
*        TIME TICKS TO A VALUE      IN MILLISECONDS                             
*                 R11 VALUE IN                                                  
*                 R11 VALUE OUT                                                 
*                                                                               
CTMS     EQU      %                                                             
         LW,R0    TSTICK            # OF TICKS IN SLICE                         
         SLS,R0   1                 TIMES 2 GIVES MILLISECONDS                  
*                                   IN ONE SLICE                                
         MW,R11   R0                TIMES VALUE GIVES MILLISECONDS              
         B        *R8               RETURN                                      
*                                                                               
QFPT     EQU      %                                                             
         DATA     X'02000000'       TYPE CAL                                    
         DATA     P1+F3                                                         
         DATA     0                 ADDRESS OF BUFFER                           
         DATA     0,0,0             RESERVED                                    
         DATA     50                SLICE                                       
         DATA     5                 QMIN                                        
         DATA     18                QSWAP                                       
         DATA     20                QMAX                                        
         DATA     0,0               SPARE                                       
         DATA,1   59,'S','L','I'                                                
         TEXT     'CE.=XXXX'                                                    
         DATA,1   21,'P','E','R'                                                
         TEXT     'IOD=XXXX'                                                    
         DATA,1   21,'Q','M','I'                                                
         TEXT     'N..=XXXX'                                                    
         DATA,1   21,'Q','S','W'                                                
         TEXT     'AP.=XXXX'                                                    
         DATA,1   21,'Q','M','A'                                                
         TEXT     'X..=XXXX'                                                    
*                                                                               
         FIN      #TSLICE                                                       
*                                                                               
*                                                                               
         OLAYEND                                                                
         END                                                                    
