************************************************************                    
*                                                          *                    
*                                                                               
*        K E Y - I N  P A R T   T H R E E                *                      
*                                                          *                    
*                                                          *                    
         PCC      0                                                             
         SPACE    3                                                             
************************************************************                    
         SYSTEM   SIG5P                                                         
         SYSTEM   OPTIONS                                                       
         DEF      KEY3                                                          
         DEF      KEY3EXB                                                       
         DEF      CRSHEX                                                        
         DEF      KEY3A04                                                       
OLAYFLAG EQU      'KEY3'                                                        
         SYSTEM   CPRMON                                                        
         TITLE    '** KEY3 - CONTROL SECTION **'                                
*                                                                               
*        AT ENTRY,                                                              
*        R2=KEYIN INDEX                                                         
*        R6=SCAN RETURN CODE FROM FIRST SCAN CALL                               
*        R7=KEYIN TEXT POINTERS AS REQUIRED FOR SCAN ROUTINE                    
*                                                                               
KEY3     RES      0                 KEY PROCESSOR #3                            
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        KEY3NOTS          NO TEMP SPACE.  ERROR.                      
         ENABLE                     SPACE FOUND                                 
         LW,R3    R7                KEEP TSACE PTR IN R3                        
         PULL     R7                RESTORE INDEX INTO DEYIN BUFFER             
         PUSH     R3                SAVE TEMP SPACE POINTER FOR EXIT            
         AI,R3    2                 START AT FIRST DW OF T-SPACE                
         LW,R4    A92,R2            MOVE FPT FOR INDICATED KEYIN                
         BEZ      A01A              NO SPACE TO MOVE                            
         LI,R5   20                 NUMBER OF DW TO MOVE                        
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 REGUON                         
*                                                                               
* NO TEMP SPACE EXIT                                                            
*                                                                               
KEY3NOTS PULL      R7               NO TSPACE ERR EXIT                          
         B        KEY3A04                                                       
*                                                                               
* KEY ERROR EXIT                                                                
*                                                                               
A04      RES      0                 ERROR ENTRY, TYPE 'KEY ERROR'               
         PULL     R7                                                            
         BAL,R8   RELTEMP                                                       
KEY3A04  B        KEY1A04                                                       
*                                                                               
KEY3EXIT RES      0                 NORMAL EXIT                                 
         PULL     R7                RELEASE TSPACE                              
         BAL,R8   RELTEMP                                                       
KEY3EXB  B        CT1               RETURN TO CONTROL TASK                      
         PAGE                                                                   
*                                                                               
* THESE TABLES ARE PARALLEL TO KEYWORD TABLES IN KEY1                           
*                                                                               
* THESE ARE THE PROPER ENTRY POINTS FOR THOSE KEYWORDS                          
*                                                                               
A91      DATA,2   Q01               INTLB                                       
         DO1      #ECB                                                          
         DATA,2   INITK                                                         
         DATA,2   TASKCNT           EXTM                                        
         DATA,2   TASKCNT           STRT                                        
         DATA,2   TASKCNT           STP                                         
         DO1      #DEBUG                                                        
         DATA,2   TASKCNT           DEBUG                                       
         DATA,2   STAT                                                          
         DO1      #ECB                                                          
         DATA,2   SJOBK                                                         
         DO1      #ECB                                                          
         DATA,2   KJOBK                                                         
         DATA,2   CRASHDMP                                                      
         DO1      #CRASH                                                        
A91A     DATA,2   CRASHDMP          CKD                                         
         DATA,2   SCHEDK                                                        
         BOUND    4                                                             
*                                                                               
* THESE ARE POINTERS TO FPT BLOCKS FOR THOSE KEYWORDS                           
*                                                                               
A92      EQU      %                                                             
         DATA     0                 INTLB      NO, FPTS                         
         DO1      #ECB                                                          
         DATA     INITFPT                                                       
         DATA     EXTMFPT                                                       
         DATA     STRTFPT           STRT                                        
         DATA     STPFPT            STP                                         
         DO1      #DEBUG                                                        
         DATA     DEBUGFPT          DEBUG                                       
         DATA     STATFPT                                                       
         DO1      #ECB                                                          
         DATA     SJOBFPT                                                       
         DO1      #ECB                                                          
         DATA     KJOBFPT                                                       
         DATA     0                                                             
         DO1      #CRASH                                                        
         DATA     0                                                             
         DATA     SCHEDFPT                                                      
         PAGE                                                                   
         BOUND    4                                                             
GIOFA    DATA     X'10040000'       GETIOID FLAGS FOR FILE, ACCOUNT             
KXF      EQU      M4                                                            
         BOUND    8                                                             
TYPE2    GEN,8,24 2,0               FPT TO TYPE 'BANG BANG KEY ERR'             
         GEN,1,31 1,0                                                           
         DATA     K:MSG2                                                        
         TITLE    '**KEY3 - INIT/SCHED KEY-INS **'                              
SCHEDK   EQU      %                                                             
INITK    EQU      %                                                             
         CI,R6    2                                                             
         BNE      INITK1            MORE PARAMETERS                             
         LW,R8    *R3                                                           
         CI,R8    X'68'             SCHED KEYIN                                 
         BNE      A04               NO,TREAT AS ERROR                           
         LI,R9    BIT16             KICK OF PERIODIC SCHEDULER                  
         STS,R9   K:CTST                                                        
         B        KEY3EXIT          NO CAL                                      
INITK1   LW,R9    R3                                                            
         AI,R9    16                CONTROL BLOCK FOR GETIOID                   
         LW,R8    BLANKS                                                        
         STW,R8   20,R3             SET ACCOUNT                                 
         STW,R8   21,R3             TO BLANKS AS DEFAULT                        
         LW,R0    GIOFA                                                         
         STW,R0   *R9               SET TO SCAN FILE ID                         
         BAL,R8   GETIOID           GET FILE ID TO INIT                         
         CI,R6    1                                                             
         BL       A04               B IF GETIOID OR SYNTAX ERROR                
         LCI      2                                                             
         LM,R8    18,R3                                                         
         STM,R8   2,R3              MOVE FILE NAME INTO INIT FPT                
         LI,R9    X'FFFF'                                                       
         LW,R8    17,R3             GET FILE AREA NAME                          
         BEZ      %+2               B IF NOT SPECIFIED                          
         STS,R8   0,R3              PUT FILE AREA NAME IN INIT FPT              
*                                   SET ACCOUNT & STRT POINTERS                 
         LB,R8    *R3                                                           
         CI,R8    X'68'                                                         
         BE       SCHED01           B IF DOING A SCHED                          
*                                                                               
         LW,R8    R3                TEMP FPT ADDR                               
         AI,R8    8                 OFFSET TO ACCOUNT SLOTS                     
         STW,R8   7,R3              INTO FPT SLOT                               
         B        INIT025                                                       
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
SCHED01  EQU      %                                                             
         LW,R8    R3                TS FPT ADDRESS                              
         AI,R8    12                OFFSET OF START TIME BUFFER                 
         STW,R8   9,R3              INTO FPT SLOT                               
*                                                                               
         LW,R8    R3                TEMP SPC FPT ADDR                           
         AI,R8    10                OFFSET TO ACCOUNT SLOTS                     
         STW,R8   8,R3              INTO FPT SLOT                               
*                                                                               
INIT025  LCI      2                 MOVE ACCOUNT IN                             
         LM,R9    20,R3                                                         
         STM,R9   *R8                                                           
*                                                                               
INIT02   RES      0                                                             
         CI,R6    2                                                             
         BE       INIT03            B IF NO OPTIONAL FIELDS                     
INIT01   BAL,R13  GETOPT            GET NEXT OPTION                             
         GEN,8,24 11,INITOPT        POINTER TO OPTIONS LIST                     
         B        A04               ERROR                                       
         B        INIT05            JOB                                         
         B        INIT06            PRI                                         
         B        INIT08            PRIO                                        
         B        INIT09            STOP                                        
         B        INIT10            DBUG                                        
         B        INIT11            TS  -- TIME SLICE OPTION                    
         B        INIT12            SEC  --  SECONDARY TASK OPTION              
         B        SCHED14           SCHED START TIME                            
         B        SCHED15           SCHED INTERVAL                              
         B        SCHED16           SCHED DELETE OPTION                         
         PAGE                                                                   
*                                                                               
INIT03   EQU      %                                                             
         CAL1,7   0,R3              INIT THE TASK                               
         B        KEY3EXIT                                                      
INIT05   EQU      %                 PROCESS JOB OPTION                          
         LCI      2                                                             
         STM,R8   5,R3                                                          
         B        INIT02                                                        
*                                                                               
INIT06   EQU      %                 PROCESS PRI OPTION                          
         LI,R9    F2                                                            
         STS,R8   1,R3              SET F2 TO ZERO                              
         B        INIT02                                                        
*                                                                               
INIT08   EQU      %                 PROCESS PRIO OPTION                         
         LI,R9    X'FFFF'                                                       
         STS,R8   4,R3                                                          
         B        INIT02                                                        
*                                                                               
INIT09   EQU      %                 PROCESS STOP                                
         LB,R9    *R3               GET FPT CODE                                
         CI,R9    X'68'             CHECK FOR SCHED                             
         BE       A04               ERROR IF SCHED                              
         LI,R9    F1                                                            
         STS,R8   1,R3              SET STOP BIT IN FPT                         
         B        INIT02                                                        
         PAGE                                                                   
*                                                                               
* DEBUG                                                                         
*                                                                               
INIT10   EQU      %                                                             
         LB,R9    *R3               GET FPT CODE                                
         CI,R9    X'68'             CHECK FOR SCHED                             
         BE       A04               ERROR IF SCHED                              
         LI,R9    F4                DEBUG BIT (FLAG)                            
         STS,R9   1,R3              SET IN DEBUG FPT                            
         B        INIT02            GO FOR NEXT PARAM                           
*                                                                               
INIT11   EQU      %                 PROCESS  TS  -- TIME SLICE OPTION           
         LI,R9    F5                TS BIT                                      
         STS,R8   1,R3              SET TS BIT IN FPT                           
         B        INIT02            GO FOR NEXT PARAM                           
*                                                                               
INIT12   EQU      %                 PROCESS SEC  --  SEC TASK OPTION            
         LI,R9    F2                SET F2 TO 1                                 
         STS,R9   1,R3                                                          
         B        INIT02            GET NEXT PARAMETER                          
         PAGE                                                                   
*                                                                               
* START TIME                                                                    
*                                                                               
SCHED14  EQU      %                 START TIME                                  
         LB,R9    *R3                                                           
         CI,R9    X'68'             SCHED                                       
         BNE      A04               ERROR                                       
         LI,R9    -1                SET TO DEFAULT                              
         STW,R9   12,R3                                                         
         STW,R9   13,R3                                                         
         CI,R6    1                 ARE THERE ANY FURTHER VALUES ?              
         BGE      INIT02            NO, GO DO NEXT OPTION                       
SCHED14A EQU      %                                                             
         LI,R11   4                 INPUT IS IN DECIMAL                         
         BAL,R14  SCAN              GET NEXT VALUE                              
         CI,R6    0                                                             
         BL       A04               SCAN ERROR                                  
         LCI      2                                                             
         LM,R4    12,R3             RETRIEVE START TIME                         
         SLD,R4   8                 MOVE WHAT WE HAVE SO FAR                    
         LI,R9    X'FF'             JUST BYTE 3                                 
         STS,R8   R5                MERGE IN NEW VALUE                          
         LCI      2                                                             
         STM,R4   12,R3             STUFF IT BACK                               
         CI,R6    1                 ANY MORE START VALUES ?                     
         BL       SCHED14A          YES                                         
         LW,R9    R4                GET YEAR                                    
         AND,R9   M16                                                           
         SLS,R9   -8                                                            
         CI,R9    X'FF'             WAS IT INPUT                                
         BE       INIT02            NO                                          
         AND,R4   M16               CALCULATE WHOLE YEAR                        
         AI,R4    1900**8                                                       
         STM,R4   12,R3             STORE IT                                    
         B        INIT02            NEXT OPTION                                 
*                                                                               
* PROCESS INTERVAL                                                              
*                                                                               
SCHED15  EQU      %                 PROCESS INTERVAL                            
         LB,R9    *R3                                                           
         CI,R9    X'68'                                                         
         BNE      A04               ERROR IF INIT                               
         STW,R8   7,R3              TUCK IT AWAY                                
         B        INIT02            NEXT OPTION                                 
*                                                                               
SCHED16  EQU      %                 DELETE OPTION                               
         LB,R9    *R3                                                           
         CI,R9    X'68'                                                         
         BNE      A04               ERROR IF INIT                               
         LI,R9    F6                                                            
         STS,R9   SFPTFLGS,R3       SET DELETE BIT IN FPT                       
         B        INIT02                                                        
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
INITFPT  EQU      %                                                             
         GEN,8,1,23  X'48',1,0                                                  
FPTFLAGS EQU      %                                                             
         DATA     P3+P4+P8+P11+P12+P14+F8+F7+F2                                 
TASKNAME DATA     0,0                                                           
PRIO     DATA     X'FFFF'           DEFAULT PRIORITY                            
JOBNAME  RES      0                                                             
         DATA,8   'CPR     '                                                    
         DATA     0                 ADDR OF ACCOUNT FIELD                       
         DATA     0,0               ACCOUNT FIELD                               
SCHEDFPT EQU      %                                                             
         GEN,8,1,23 X'68',1,0                                                   
SFPTFLGS EQU      %-SCHEDFPT           OFFSET TO WORD 1                         
         DATA    P3+P4+P8+P11+P12+P13+P14+P15+F7+F2                             
         DATA     0,0               TASK NAME                                   
         DATA     0                 PRIORITY                                    
         DATA,8   'CPR     '                                                    
         DATA     0                 INTERVAL                                    
         DATA     0                 ADDR OF ACCOUNT FIELD                       
         DATA     0                 ADDR OF STRT FIELD                          
         DATA     0,0               ACCOUNT FIELD                               
         DATA     0,0               STRT TIME FIELD                             
         PAGE                                                                   
         BOUND    8                                                             
INITOPT  EQU      %                                                             
         TEXT     'JOB'                                                         
         GEN,8,24 1,0               EBCDIC CONVERT                              
         TEXT     'PRI'                                                         
         DATA     0                 NO PARAMETER                                
         TEXT     'PRIO'                                                        
         GEN,8,24 2,0               HEX                                         
         TEXT     'STOP'                                                        
         GEN,8,24 0,F1              NO PARAMETER                                
         TEXT     'DEBU'            DEBUG OPTION                                
         GEN,8,24 0,0               EBCDIC                                      
         TEXT     'TS  '            TIME SLICE OPTION                           
         GEN,8,24 0,F5                                                          
         TEXT     'SEC'             SECONDARY TASK OPTION                       
         DATA     0                  NO PARAMETERS                              
         TEXT     'STRT'            START TIME OPTION--SCHED                    
         GEN,8,24 0,0               SET FOR NO PARAM.                           
         TEXT     'INTV'            INTERVAL--SCHED                             
         GEN,8,24 4,0               DECIMAL INPUT                               
         TEXT     'DELE'            DELETE OPTION--SCHED                        
         GEN,8,24 0,F6              NO PARAMETERS                               
*                                                                               
         TITLE    '** KEY3 - EXTM,DEBUG,STOP,START KEY-INS **'                  
*                                                                               
*                                                                               
*        EXTM, DEBUG, START AND STOP ALL ARE OF THE FORM                        
*                                                                               
*        KEYWORD TASKNAME,(JOB,JOBNAME)                                         
*                                                                               
*                                                                               
TASKCNT  RES      0                 TASK CONTROL FUNCTIONS                      
         CI,R6    2                                                             
         BE       A04               ERROR IF NO PARAMETERS                      
         LI,R11   1                 SET FOR EBCDIC                              
         BAL,R14  SCAN              GET TASK NAME                               
         LD,R14   ZEROS                                                         
         LCI      2                                                             
         STM,R8   3,R3              STORE TASK NAME                             
         STM,R14  5,R3              STORE DEFAULT JOB NAME                      
         CI,R6    0                                                             
         BL       A04               B IF SCAN ERROR                             
         CI,R6    2                 IS IT END OF FIELD OR END OF CARD           
         BG       A04               NO - ERROR                                  
         BE       EXTM01            B IF END OF CARD                            
         BAL,R13  GETOPT            GET JOB NAME                                
         GEN,8,24 1,EXTOPT                                                      
         B        A04               ERROR                                       
         LCI      2                                                             
         STM,R8   5,R3              STORE JOB NAME                              
         CI,R6    2                 IS IT END OF CARD                           
         BNE      A04               NO ERROR                                    
EXTM01   EQU      %                                                             
         CAL1,7   0,R3              EXTM  THE TASK                              
         B        KEY3EXIT          RETURN                                      
*                                                                               
*                                                                               
*                                                                               
         BOUND    8                                                             
EXTMFPT  DATA     X'49800000'                                                   
         DATA     P1+P3+P4+P11+P12+F1                                           
         DATA     KEY3EXIT                                                      
*                                                                               
STRTFPT  DATA     X'4A800000'                                                   
         DATA     P1+P3+P4+P11+P12                                              
         DATA     KEY3EXIT                                                      
*                                                                               
STPFPT   DATA     X'4B800000'                                                   
         DATA     P1+P3+P4+P11+P12+F0                                           
         DATA     KEY3EXIT                                                      
*                                                                               
DEBUGFPT DATA     X'65800000'                                                   
         DATA     P1+P3+P4+P11+P12                                              
         DATA     KEY3EXIT                                                      
*                                                                               
         BOUND    8                                                             
EXTOPT   EQU      %                                                             
         TEXT     'JOB'                                                         
         GEN,8,24 1,0                                                           
         TITLE    '** KEY3 - STAT KEY-IN **'                                    
STAT     EQU      %                                                             
         CI,R6    2                                                             
         BE       A04               ERROR IF NO PARAMETERS                      
         LI,R11   1                 SET FOR EBCDIC                              
         BAL,R14  SCAN              GET TASK NAME                               
         LCI      2                                                             
         STM,R8   2,R3              STORE TASK NAME                             
         CI,R6    0                                                             
         BL       A04               B IF SCAN ERROR                             
         CI,R6    2                 IS IT END OF FIELD OR END OF CARD           
         BG       A04               NO ERROR                                    
         BE       STAT01            B IF END OF CARD                            
         BAL,R13  GETOPT            GET JOB  OPTION                             
         GEN,8,24 1,STATOPT                                                     
         B        A04               B IF ERROR                                  
         LCI      2                                                             
         STM,R8   6,R3              STORE JOB NAME                              
         CI,R6    2                 IS IT END OF CARD                           
         BNE      A04               NO - ERROR                                  
STAT01   EQU      %                                                             
         CAL1,7   0,R3                                                          
         LW,R0    5,R3              GET TYC                                     
         LB,R0    R0                                                            
         CI,R0    1                 IS IT NORMAL COMP                           
         BNE      A04               B IF NO --ERROR                             
         LI,R1    11                NUMBER OF WORDS                             
         LW,R0    STATMESS-1,R1                                                 
         STW,R0   IMAGE-1,R1        STORE MESSAGE IN BUFFER                     
         BDR,R1   %-2                                                           
         LW,R2    4,R3              GET STATUS FLAGS                            
         LH,R2    R2                                                            
         AND,R2   M16                                                           
         LI,R1    15                INDEX                                       
         STW,R3   R7                SAVE TSPACE ADDRESS                         
         LI,R3    1                 MASK                                        
STAT02   LB,R4    IMAGE+3,R1                                                    
         STS,R2   R4                SET ONE OR ZERO                             
         STB,R4   IMAGE+3,R1                                                    
         SLS,R2   -1                NEXT STATUS FLAG                            
         AI,R1    -1                                                            
         BGEZ     STAT02                                                        
         LW,R11   4,R7              GET PRIORITY FIELD                          
         BAL,R8   HEXBCD            CONVERT                                     
         STW,R11  IMAGE+10          SET PRIORITY MESSAGE                        
         CAL1,2   8,R7              OUTPUT MESSAGE                              
         B        KEY3EXIT                                                      
         PAGE                                                                   
*                                                                               
*                                                                               
*                                                                               
STATMESS EQU      %                                                             
         TEXTC    '   STATUS =0000000000000000  PRIORITY =0000'                 
STATFPT  EQU      %                                                             
         DATA     X'4E800000'                                                   
         DATA     P3+P4+P8+P10+P11+P12+F7                                       
STATTSK  DATA,8   0                                                             
STATFLG  DATA,8   0                                                             
STATJB   DATA,8   0                                                             
STATYPE  EQU      %                                                             
         DATA     X'02000000'                                                   
         DATA     P1+F3             ADDRESS AND WAIT                            
         DATA     IMAGE             MESSAGE BUFFER                              
         DATA     P1                                                            
*                                                                               
         BOUND    8                                                             
STATOPT  EQU      %                                                             
         TEXT     'JOB'                                                         
         GEN,8,24 1,0               EBCDIC CONVERT                              
         TITLE    '** KEY3 - SJOB KEY-IN **'                                    
SJOBK    EQU      %                                                             
         CI,R6    2                                                             
         BE       A04               ERROR IF NO PARAMETERS                      
         AWM,R3   5,R3              BIAS ACCOUNT POINTER                        
         MTW,6    5,R3              POINT TO NEXT CELL IN FPT                   
         LI,R11   1                 SET FOR EBCDIC                              
         BAL,R14  SCAN                                                          
         LCI      2                                                             
         STM,R8   3,R3              SET NAME IN FPT                             
         CI,R6    2                                                             
         BNE      SJOB01            B IF NOT END  OF CARD                       
         CAL1,7   0,R3                                                          
         B        KEY3EXIT                                                      
SJOB01   EQU      %                                                             
         CI,R6    1                 IS IT END OF FIELD                          
         BNE      A04               B IF NO                                     
         LI,R1    0                 SWITCH FOR DIBUG                            
SJOB02   EQU      %                                                             
         BAL,R13  GETOPT            GET DI OPTION                               
         GEN,8,24 2,SJOBOPT                                                     
         B        A04               ERROR                                       
         B        SJOB03            DEBUG OPTION                                
*                                   ACCT OPTION HERE                            
         LCI      2                                                             
         STM,R8   6,R3              STORE ACCOUNT NAME                          
         CI,R6    2                 END OF INPUT                                
         BNE      SJOB02            B IF NO                                     
         CI,R1    0                 DEBUG INPUT                                 
         BNE      SJOB04            B IF YES                                    
         CAL1,7   0,R3              DO SJOB CAL                                 
         B        KEY3EXIT                                                      
*                                                                               
*                                                                               
*                                                                               
SJOB03   EQU      %                                                             
         AI,R1    1                 SET DEBUG SWITCH                            
         CI,R6    2                 END OF INPUT                                
         BNE      SJOB02            B IF NO                                     
SJOB04   EQU      %                                                             
         CAL1,7   0,R3              SJOB CAL                                    
         LCI      2                                                             
         LM,R10   2,R3              GET JOB NAME                                
         STD,R8   R12               SAVE TTYASSIGNMENT                          
         BAL,R8   TMFINDJ           GET JOB IDS                                 
         B        A04               ERROR                                       
         LCI      2                                                             
         STM,R12  JCBDBUG,R7        SET TTYASSIGNMENT FOR DEBUG                 
         B        KEY3EXIT                                                      
*                                                                               
SJOBEXIT B        KEY3EXIT          RETURN TO CONTROL TASK                      
         LCI      2                                                             
*                                                                               
         TITLE    '** KEY3 - KJOB KEY-IN **'                                    
*                                                                               
KJOBK    EQU      %                                                             
         CI,R6    2                                                             
         BE       A04               ERROR IF NO PARAMETERS                      
         LI,R11   1                 SET FOR EBCDIC                              
         BAL,R14  SCAN                                                          
        LCI       2                                                             
         STM,R8   2,R3              SET NAME                                    
         CI,R6    2                                                             
         BNE      A04               B IF NOT END OF CARD                        
         CAL1,7   0,R3                                                          
         B        KEY3EXIT                                                      
*                                                                               
*                                                                               
*                                                                               
SJOBFPT  EQU      %                                                             
         DATA     X'63800000'                                                   
         DATA     P1+P11+P12+P14+F7                                             
         DATA     A04               ERROR                                       
SJOBNAM  DATA,8   0                                                             
         DATA     0,0,0,0,0,0                                                   
         BOUND    8                                                             
SJOBOPT  TEXT     'DEBU'            DEBUG OPTION                                
         GEN,8,24 1,0                                                           
*                                                                               
         TEXT     'ACCT'                                                        
         GEN,8,24 1,0                                                           
*                                                                               
         BOUND    8                                                             
KJOBFPT  EQU      %                                                             
         DATA     X'64800000'                                                   
         DATA     P11+P12+F7                                                    
KJOBNAM  DATA,8   0                 JOB NAME                                    
*                                                                               
         TITLE    '** KEY3 - CRD,CRS,ESUM KEY-INS **'                           
CRASHDMP EQU      %                                                             
         LI,R3    0                 DEFAULT LOW ADDRESS                         
         LW,R4    K:UNAVBG          DEFAULT HIGH ADDRESS                        
         LI,R11   2                 HEX CONVERT                                 
         BAL,R14  SCAN                                                          
         CI,R10   1                                                             
         BL       CRSH00            B IF NO PARAMETER                           
         LW,R3    R8                GET LOW OPTION                              
         CI,R6    2                 END OF CARD                                 
         BE       CRSH00            B IF YES ONLY LOW ADD INPUT                 
         CI,R6    1                 END OF FIELD                                
         BNE      A04               ERROR                                       
         BAL,R14  SCAN                                                          
         CI,R6    2                 END OF CARD                                 
         BNE      A04               B IF NO  --  ERROR                          
         LW,R4    R8                HIGH PARAMETER                              
CRSH00   RES      0                                                             
         DO       #CRASH                                                        
         CI,R2    HA(A91A)-HA(A91)  IS IT A CK DUMP                             
         BE       CKDUMP            YES                                         
         FIN      #CRASH            NO                                          
         LW,R0    CRSHTX1                                                       
CRSH01   RES      0                                                             
         PULL     R7                RELEASE T-SPACE                             
         PUSH     0                 SAVE TEXT MESSAGE IN 0                      
         BAL,R8   RELTEMP                                                       
         PULL     R0                RESTORE OVERLAY NAME                        
         LI,R15   CT1               FORCE CKD,CRD TO RETURN TO CT               
CRSHEX   B        *R0               GO TO NEXT OLAY                             
CRSHTX1  DATA     CRD               CRASH DUMP OVERLAY                          
         DO       #CRASH                                                        
CKDUMP   LW,R0    CRSHTX2                                                       
         B        CRSH01                                                        
         FIN      #CRASH                                                        
CRSHTX2  DATA     CKD               CHECKPOINT AREA DUM                         
         PAGE                                                                   
*        SUBROUTINE  TO CONVERT BINARY TO HEX GBCDIC                            
*        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   KXF                                                           
         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    '** KEY3 - INTLB KEY-IN **'                                   
*                                                                               
*                                                                               
Q01      EQU      %                                                             
         CI,R6    2                                                             
         BE       A04                 ERROR                                     
         LI,R11   1                 SCAN LABEL AS CHARACTERS                    
         BAL,R14  SCAN                                                          
         CI,R6    1                 END OF FIELD, AND ANOTHER FOLLOWS?          
         BNE      A04                 NO, ERROR                                 
         CI,R10   2                 EXACTLY 2 CHARACTERS IN INPUT?              
         BNE      A04                 NO, ERROR                                 
         LH,R1    INTLB1            LOOK UP INPUT NAME                          
         LH,R8    R8                TO INSURE IT IS A VALID NAME                
         CH,R8    INTLB1,R1                                                     
         BE       %+3               FOUND, SAVE INDEX                           
         BDR,R1   %-2               LOOP LOOKING FURTHER                        
         B        A04                 NOT FOUND; ERROR                          
*                                                                               
         LI,R11   2                 GET HEX ADDRESS OF LABEL                    
         BAL,R14  SCAN                                                          
         CI,R6    2                 AT END OF INPUT?                            
         BNE      A04                 NO, ERROR                                 
         LW,R15   R8                                                            
         BAL,R4   CKINTADR                                                      
         B        A04               ILLEGAL ADDRESS                             
         STH,R8   INTLB2,R1                                                     
         B        KEY3EXIT          EXIT OK                                     
         TITLE    '** KEY3 - GET OPTION SUBROTUTINE **'                         
*                                                                               
* 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 DW TABLE WITH                           
*        ONE DW ENTRY/OPTION AS FOLLOWS:                                        
*                                                                               
*        WORD 1: OPTION KEYWORD IN EBCDIC                                       
*                 (LEFT JUSTIFIED - BLANK FILLED)                               
*                                                                               
*        WORD 2: PARAMATER CONTROL WORD AS FOLLOWS:                             
*                 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 TETURN                                   
*                      CONTENTS OF THIS WORD IN R8                              
*                      IF PARAMETER IS PRESET,                                  
*                      CONVERT ACCORDING TO X AND RETURN IT                     
*                      IN R8. (X AS ABOVE)                                      
*                                                                               
* RETURN IS TO CALL LOCATION+(N+2)                                              
*        WHERE N IS 0 IF ANY ERRORS ARE DETECTED                                
*        OTHERWIZE, N WILL BE THE INDEX INTO THE OPTION LIST                    
*        TABLE CORRESPONDING TO THE OPTION BEING PROCESSED.                     
*                                                                               
* UESE REGISTRS R0,R5-R11                                                       
* USES SCAN ROUTINE                                                             
* NOTE: CAN'T BE MOVED TO KEYSCN BECAUSE OF PARAMETER LIST IN CORE              
*                                                                               
GETOPT   PUSH     4,R1              SAVE R1-R4                                  
         LI,R11   1                                                             
         BAL,R14  SCAN              GET KEYWORD                                 
         CI,R6    0                                                             
         BGE      GO02              B IF NO SCAN ERROR                          
GO01     AI,R13   1                 TAKE ERROR EXIT                             
         PULL     4,R1                                                          
         B        GETOPTX                                                       
GO02     LI,R1    0                 OPTION SEARCH INDEX                         
         LW,R0    *R13              GET ADDRES OF OPTION LIST                   
GO03     LD,R2    *R0,R1            R2 = OPTION DESCRIPTOR                      
         CW,R8    R2                IS IT THIS OPTION                           
         BE       GO04              B IF YES                                    
         AI,R1    1                 MOVE TO NEXT OPTION                         
         CB,R1    *R13              LIMIT REACHED YET                           
         BL       GO03              B IF NO                                     
         B        GO01              YES, TAKE ERROR EXIT                        
GO04     LB,R11   R3                GET CONVERT TYPE                            
         BEZ      GO09              B IF NO PARAMETER                           
         CI,R11   X'80'             IS IT A NO PARAMETR OPTION                  
         BANZ     GO010             B IF YES                                    
GO05     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                                                          
GETOPTX  B        *R13              RETURN                                      
GO09     LW,R8    R3                GET RETURN PARAMETER                        
         B        GO07                                                          
GO010    LW,R8    R3                GET DUMMY PARAMETER                         
         CI,R6    0                                                             
         BG       GO07              B IF END OF PAREN FIELD                     
         B        GO05              PROCESS FIRST OPTION                        
         OLAYEND                                                                
         END                                                                    
