         TITLE    '** KEYSCN - KEY-IN SCAN ROUTINES **'                         
*                                                                               
*                                                                               
*                                                                               
         SYSTEM   SIG9P                                                         
         SYSTEM   OPTIONS                                                       
         PCC      0                                                             
*                                                                               
         DEF      KEYSCN                                                        
         DEF      SCAN                                                          
         DEF      GETIOID                                                       
         DEF      SCANEX                                                        
         DEF      GIOEX                                                         
*                                                                               
OLAYFLAG SET      'KEYS'                                                        
*                                                                               
         SYSTEM   CPRMON                                                        
*                                                                               
         PAGE                                                                   
*                                                                               
*        ENVIRONMENT FOR GETIOID                                                
*                                                                               
GIOSCAN  CNAME                                                                  
         PROC                                                                   
         LI,R11   0                 SET TO SCAN POSSIBLE FILE ID                
         BAL,R14  SCAN              GET NEXT SUBFIELD                           
         CI,R6    0                                                             
         BL       GIOEXIT           B IF SCAN ERROR                             
         PEND                                                                   
*                                                                               
GIOBITS  DATA     1**(31-1)+1**(31-2)+1**(31-3)+1**(31-13)  P2+P3+P4+P14        
GIOOBIT  DATA     1**(31-1)         P2 (OPLABEL)                                
GIODBIT  DATA     1**(31-2)         P3 (DEVICE)                                 
GIOFBIT  DATA     1**(31-3)         P4 (FILE ID)                                
GIOABIT  DATA     1**(31-13)        P14 (ACCOUNT NAME)                          
GIODEV0  DATA     '0   '            NULL DEVICE NAME                            
GIOFA    DATA     1**(31-3)+1**(31-13)   P4 AND P14                             
NULLDEV  EQU      ZEROS                                                         
NLBB     DATA     X'155A5A00'       L-ALIGNED NEWLINE, BANG, BANG               
BLBLBL   DATA     X'00404040'       RT-ALIGNED BLANK, BLANK, BLANK              
*                                                                               
         TITLE    '** KEYSCN - GETIOID SUBROUTINE **'                           
*                                                                               
*        NAME:    GETIOID                                                       
*                                                                               
*        PURPOSE: SCAN A DEVICE, OPLABEL, OR FILE IDENTIFIER                    
*                 FROM A COMMAND                                                
*                                                                               
*        CALL:    BAL,R8  GETIOID                                               
*                                                                               
*        INPUT:   R9 = ADDRESS OF A MEMORY AREA, THE FIRST                      
*                      WORD OF WHICH INDICATES PERMISSIBLE FORMS AS             
*                      FOLLOWS:                                                 
*                      BIT 1 SET IF AN OPLABEL NAME IS PERMITTED                
*                      BIT 2 SET IF A DEVICE NAME IS PERMITTED                  
*                      BIT 3 SET IF A FILE AND AREA IS PERMITTED                
*                      BIT 13 SET IF AN ACCOUNT NAME IS PERMITTED               
*                      NOTE THAT THESE ARE THE CORRESPONDING                    
*                      P-BITS FOR AN ASSIGN CAL.                                
*                      FOLLOWING THE FIRST WORD MUST BE ENOUGH                  
*                      SPACE FOR THE RETURN AS INDICATED BELOW                  
*                      (SPACE NEED NOT BE ALLOWED FOR NON-                      
*                      PERMISSIBLE NAME TYPES)                                  
*                 R7 = R7 VALUE FOR SCAN                                        
*                                                                               
*        RETURN:  R6 = -1 IF A NON-ALLOWED OR UNRECOGNIZED FORM                 
*                      IS FOUND.  OTHERWISE, AS RETURNED FROM                   
*                      THE LAST SCAN CALL.                                      
*                 R10,R11 AS RETURNED FROM LAST SCAN CALL                       
*                 OTHER REGISTERS UNCHANGED                                     
*                 AREA POINTED BY R9:                                           
*                   FIRST WORD BITS 1, 2, 3, AND 13 SET TO INDICATE             
*                   THE FORM FOUND. OTHER BITS UNCHANGED.                       
*                   FOLLOWING WORDS AS INDICATED BELOW:                         
*                      OPLABEL:  RIGHT-ALIGNED IN ONE WORD                      
*                      DEVICE:  LEFT-ALIGNED WITH TRAILING BLANKS               
*                      IN TWO WORDS                                             
*                      FILE AND AREA:  AREA NAME IN ONE WORD, RIGHT             
*                      ALIGNED, AND FILE NAME IN FOLLOWING TWO                  
*                      WORDS, LEFT-ALIGNED WITH TRAILING BLANKS                 
*                      ACCOUNT NAME: IN TWO WORDS FOLLOWING THE                 
*                      SPACE FOR FILE AND AREA NAMES (WORDS 4                   
*                      AND 5 FOLLOWING THE P-BIT WORD), LEFT-ALIGNED            
*                      WITH TRAILING BLANKS                                     
*                      THIS FORMAT MAY BE USED IN AN ASSIGN CAL FPT.            
*                                                                               
GETIOID  RES      0                                                             
         PUSH     R8                                                            
         PUSH     4,R0                                                          
*                                                                               
         LW,R1    R9                SAFER AND MORE USABLE PLACE                 
         GIOSCAN                    GET NEXT SUBFIELD                           
*                                                                               
*        CHECK TO SEE IF A DEVICE NAME COULD BE IN R8, R9                       
         LW,R0    GIODBIT                                                       
         CW,R0    *R1                                                           
         BAZ      GIO10             B IF NOT PERMITTED                          
         CI,R6    2                                                             
         BG       GIO10             B IF NEW-FORMAT FILE ID                     
         CW,R8    GIODEV0                                                       
         BNE      GIO01             B IF NOT NULL DEVICE                        
         LD,R8    NULLDEV           GET NULL DEVICE ID                          
         B        GIO05                                                         
*****                                                                           
GIO01    RES      0                                                             
         CI,R10   5                                                             
         BNE      GIO10             B IF WRONG LENGTH                           
         SLD,R8   -24               ADJUST TO DCT16 FORMAT                      
         OR,R8    NLBB                                                          
         LH,R2    *K:DCT1           GET DCT NR OF ENTRIES                       
GIO02    RES      0                 SEARCH FOR NAME IN DCT                      
         CD,R8    *K:DCT16,R2                                                   
         BE       GIO03             B IF FOUND                                  
         BDR,R2   GIO02                                                         
         SLD,R8   24                NOT FOUND.  RESTORE NAME                    
         OR,R9    BLBLBL                                                        
         B        GIO10                                                         
*****                                                                           
GIO03    RES      0                                                             
         SLD,R8   24                NAME FOUND. RESTORE TO INPUT FORMAT         
         OR,R9    BLBLBL                                                        
GIO05    RES      0                                                             
*                                                                               
*        DEVICE ID SCANNED. PACK IT AWAY.                                       
         STW,R8   1,R1                                                          
         STW,R9   2,R1                                                          
         LW,R3    GIODBIT                                                       
         B        GIOOKEX           SPLIT                                       
*****                                                                           
GIO10    RES      0                                                             
*                                                                               
*        CHECK TO SEE IF AN OPLABEL NAME COULD BE IN R8                         
         LW,R0    GIOOBIT                                                       
         CW,R0    *R1                                                           
         BAZ      GIO20             B IF NOT PERMITTED                          
         CI,R6    2                                                             
         BG       GIO20             B IF NEW-FORMAT FILE ID                     
         CI,R10   2                                                             
         BG       GIO20             B IF NAME IS TOO LONG                       
         LH,R2    *K:OPLBS1         GET OPLBS1 NR OF ENTRIES                    
         LH,R0    R8                                                            
GIO15    RES      0                 SEARCH FOR NAME IN OPLB                     
         CH,R0    *K:OPLBS1,R2                                                  
         BE       GIO17             B IF FOUND                                  
         BDR,R2   GIO15                                                         
         B        GIO20             B IF NOT FOUND                              
*****                                                                           
GIO17    RES      0                                                             
*                                                                               
*        OPLABEL NAME SCANNED. PACK IT AWAY.                                    
         SLS,R8   -16                                                           
         STW,R8   1,R1                                                          
         LW,R3    GIOOBIT                                                       
         B        GIOOKEX                                                       
*****                                                                           
GIO20    RES      0                                                             
*                                                                               
*        CHECK TO SEE IF AN OLD-FORMAT AREA NAME COULD BE IN R8, R9             
         LW,R0    GIOFBIT                                                       
         CW,R0    *R1                                                           
         BAZ      GIO30             B IF NOT PERMITTED                          
         CI,R6    0                                                             
         BG       GIO30             B IF NEW-FORMAT FILE ID                     
         CI,R10   2                                                             
         BNE      GIO30             B IF WRONG LENGTH                           
*                                                                               
*        OLD FORMAT AREA NAME FOUND. PACK IT AWAY.                              
*                                                                               
         SLS,R8   -16                                                           
         STW,R8   1,R1                                                          
         LW,R3    GIOFBIT           FLAG FOR FILE ID FOUND                      
*                                                                               
*        FILE NAME FOLLOWS AREA NAME                                            
         GIOSCAN                    GET NEXT SUBFIELD                           
         CI,R6    2                                                             
         BG       GIOEREX           B IF A NEW-FORMAT TERMINATOR                
*                                                                               
*        FILE NAME FOUND. PACK IT AWAY.                                         
         STW,R8   2,R1                                                          
         STW,R9   3,R1                                                          
*                                                                               
         LW,R0    GIOABIT                                                       
         CW,R0    *R1               IS AN ACCOUNT NAME REQUESTED                
         BAZ      GIOOKEX           NO, SKIP THIS                               
*                                   YES                                         
         LI,R0    0                                                             
         STW,R0   4,R1                                                          
         STW,R0   5,R1              ZERO IS THE DEFAULT ACCOUNT NAME            
         B        GIOOKEX           DONE.                                       
*****                                                                           
*        ASSUME SCANNED FIELD IS A NEW-FORMAT FILE NAME                         
GIO30    RES      0                                                             
         LW,R3    GIOFBIT                                                       
         CW,R3    *R1                                                           
         BAZ      GIOEREX           B IF FILE ID NOT PERMITTED                  
         STW,R8   2,R1                                                          
         STW,R9   3,R1              SET FILE NAME                               
         LI,R0    0                                                             
         STW,R0   1,R1              SET AREA NAME UNSPECIFIED FOR NOW.          
*                                                                               
         LW,R0    GIOABIT                                                       
         CW,R0    *R1               IS AN ACCOUNT NAME REQUESTED                
         BAZ      GIO31             NO, SKIP THIS                               
*                                   YES                                         
         LI,R0    0                                                             
         STW,R0   4,R1                                                          
         STW,R0   5,R1              ZERO IS THE DEFAULT ACCOUNT NAME            
*                                                                               
GIO31    RES      0                                                             
         CI,R6    3                                                             
         BNE      GIOOKEX           B IF NO MORE FILE ID FIELDS                 
         GIOSCAN                    GET NEXT SUBFIELD                           
*                                                                               
*        CHECK TO SEE IF A NEW-FORMAT AREA NAME COULD BE IN R8, R9              
         CI,R10   0                                                             
         BE       GIO34             B IF NULL (DEFAULT) AREA                    
         CI,R10   2                                                             
         BNE      GIO35             B IF WRONG LENGTH                           
         LB,R2    K:MDNAME          NR OF AREA NAMES                            
GIO33    RES      0                                                             
         AI,R2    -1                                                            
         BLZ      GIO35             B IF NOT AN AREA NAME                       
         LH,R0    *K:MDNAME,R2      GET NEXT NAME FROM TABLE                    
         CH,R0    R8                                                            
         BNE      GIO33             B IF NOT MATCHED                            
*                                                                               
*        AREA NAME FOUND. SET IT.                                               
         SLS,R8   -16                                                           
         STW,R8   1,R1                                                          
*                                                                               
GIO34    RES      0                                                             
         CI,R6    3                                                             
         BNE      GIOOKEX           B IF NO MORE FILE ID FIELDS                 
         GIOSCAN                    GET NEXT SUBFIELD                           
*                                                                               
GIO35    RES      0                                                             
*                                                                               
*        CHECK TO SEE IF AN ACCOUNT NAME COULD BE IN R8, R9                     
         LW,R0    GIOABIT                                                       
         CW,R0    *R1                                                           
         BAZ      GIOEREX           B IF NOT PERMITTED                          
*                                                                               
*        ACCOUNT NAME FOUND. SET IT                                             
         STW,R8   4,R1                                                          
         STW,R9   5,R1                                                          
         OR,R3    GIOABIT           SET ACCOUNT NAME BIT.                       
         CI,R6    3                                                             
         BNE      GIOOKEX           B IF END OF FILE ID                         
*        OTHERWISE, TOO MANY FILE ID FIELDS                                     
*                                                                               
*        NON-SCAN ERROR ENCOUNTERED. SET R6 AND EXIT.                           
GIOEREX  RES      0                                                             
         LI,R6    -1                                                            
         B        GIOEXIT                                                       
*****                                                                           
*        NORMAL EXIT                                                            
*        R1 IS PARAM TABLE POINTER                                              
*        R2 IS P-BITS FOR TYPE OF I/O STREAM NAME FOUND                         
GIOOKEX  RES      0                                                             
         LW,R9    R1                RESTORE R9                                  
         LW,R0    R3                GET NEW P-BIT SETTING                       
         LW,R1    GIOBITS                                                       
         STS,R0   *R9               SET EM                                      
*                                                                               
*        ALL EXIT PATHS MEET HERE                                               
GIOEXIT  RES      0                                                             
         PULL     4,R0              RESTORE OTHER STUFF                         
         PULL     R8                RESTORE LINK                                
GIOEX    B        *R8               RETURN                                      
*****                                                                           
*****                                                                           
         TITLE    '** KEYSCN  - SCAN ROUTINE **'                                
*                                                                               
*                                   SCANS ONE FIELD AT A TIME                   
*                                   CALL IS  BAL,R14  SCAN                      
*                                     WHERE R7, BITS 0-7 =                      
*                                               INDEX FROM BUFFER               
*                                               LAST BYTE +1 TO                 
*                                               CURRENT CHARACTER               
*                                           R7, BIT 8 IS SET IF                 
*                                               SCAN IS WITHIN A                
*                                               PAREN FIELD,                    
*                                               OTHERWISE RESET                 
*                                           R7, BITS 9-31 =                     
*                                               BUFFER LAST BYTE+1              
*                                               ADDRESS                         
*                                           R11=0, SCAN FILE ID FIELD           
*                                              =1, LEAVE IN BCD                 
*                                              =2, CONVERT TO HEX               
*                                              =4, CONVERT TO DECIMAL           
*                                   EXITS WITH                                  
*                                     R8,R9= VALUE                              
*                                     R6=-1, ERROR IN INPUT                     
*                                       = 0, END OF SUBFIELD                    
*                                       = 1, END OF FIELD                       
*                                       = 2, END OF COMMAND                     
*                                       = 3, END OF FILE ID FIELD               
*                                    R10=NO. CHARS. SCANNED                     
*                                   USES REGS R0,R5-R11                         
*                                                                               
         PAGE                                                                   
SCAN     RES      0                                                             
KEYSCN   RES      0                                                             
         LW,R0    R7                GET BUFFER PTR AND PAREN FLAG               
         SAS,R7   -24               RT-JUSTIFY CHARACTER PTR                    
         AW,R7    R0                GET BYTE PTR                                
         LI,R5    0                 RESET INDEX FOR R8,R9                       
         LD,R8    BLANKS                                                        
         LI,R10   0                                                             
         CI,R11   1                                                             
         BLE      SCAN4B                                                        
         LD,R8    ZEROS             PRESET TO 0 FOR DEC. OR HEX                 
         B        SCAN4B                                                        
         PAGE                                                                   
SCAN3    LI,R6    -1                ERROR IF MORE THAN 8 CHARS.                 
         B        SCAN5X                                                        
SCAN4    RES      0                                                             
         AI,R5    1                 INCR CHAR COUNT                             
SCAN4A   RES      0                                                             
         AI,R7    1                 INCREMENT CHARACTER POINTER                 
         MTB,1    R7                BUMP COUNT                                  
SCAN4B   RES      0                 INITIAL ENTRY                               
         MTB,0    R7                ANY MORE CHARACTERS                         
         BEZ      SCAN5A            NO                                          
*                                   YES                                         
         LB,R10   0,R7              GET NEXT CHAR                               
         CI,R10   ','                                                           
         BE       SCAN5B            B IF END OF ITEM                            
         CI,R10   '-'                                                           
         BE       SCAN5B            B IF END OF ITEM                            
         CI,R10   ' '                                                           
         BE       SCAN5F            B IF END OF CMND                            
         CI,R6    X'FF'                                                         
         BE       SCAN3             B IF JUST PAST ')'                          
         CI,R10   '('                                                           
         BE       SCAN5C            B IF START OF PAREN FIELD                   
         CI,R10   ')'                                                           
         BE       SCAN5D            B IF END OF PAREN FIELD                     
         CI,R10   '.'                                                           
         BE       SCAN5E            B IF END OF FILE ID FIELD                   
         B        SCAN8             B IF NONTERMINATOR                          
         PAGE                                                                   
SCAN5A   RES      0                 END OF CMND                                 
         LI,R6    2                                                             
         B        SCAN5X                                                        
*                                                                               
SCAN5B   RES      0                 END OF ITEM                                 
         LI,R6    0                 END OF SUBFIELD                             
         CW,R0    PARENBIT                                                      
         BANZ     %+2               B IF IN PAREN FIELD                         
         LI,R6    1                                                             
SCAN5X   RES      0                 COMMON EXIT PATH                            
         MTB,0    R7                ANY MORE CHARACTERS                         
         BEZ      %+2               NO, SKIP                                    
         AI,R7    1                 SKIP TERMINATOR                             
         SW,R7    R0                GET BYTE DISPLACEMENT                       
         STB,R7   R0                PUT BYTE INDEX BACK WITH                    
         LW,R7    R0                PAREN FLAG AND BUFFER PTR                   
         LW,R10   R5                PICK UP NR OF CHARS SCANNED                 
SCANEX   B        *R14                                                          
*                                                                               
SCAN5C   RES      0                 START OF PAREN FIELD                        
         CW,R0    PARENBIT                                                      
         BANZ     SCAN3             B IF ALREADY IN PAREN FIELD                 
         CI,R5    0                                                             
         BG       SCAN3             B IF IN MIDDLE OF ITEM                      
         OR,R0    PARENBIT          SET PAREN FIELD FLAG                        
         B        SCAN4A            CONTINUE SCAN                               
         PAGE                                                                   
SCAN5D   RES      0                 END OF PAREN FIELD                          
         CW,R0    PARENBIT                                                      
         BAZ      SCAN3             B IF NOT IN PAREN FIELD                     
         EOR,R0   PARENBIT          RESET PAREN FIELD FLAG                      
         LI,R6    X'FF'             FLAG: END OF ITEM OR CMND NEXT              
         B        SCAN4A            CONTINUE SCAN                               
*                                                                               
SCAN5E   RES      0                                                             
         CI,R11   0                                                             
         BNE      SCAN5A            B IF NOT FILE ID SCAN                       
         LI,R6    3                                                             
         B        SCAN5X                                                        
*                                                                               
SCAN5F   RES      0                                                             
         AI,R7    1                 SCAN OFF BLANK STRING                       
         MTB,1    R7                BUMP COUNT                                  
         BEZ      SCAN5A            B IF END OF INPUT LINE                      
         LB,R10   0,R7              GET NEXT CHARACTER                          
         CI,R10   ' '                                                           
         BE       SCAN5F            B IF BLANK                                  
         AI,R7    -1                BACK TO LAST BLANK                          
         CI,R5    0                                                             
         BE       SCAN4A            B IF LEADING BLANKS (IGNORE)                
         B        SCAN5B            TREAT TRAILING BLANKS AS ITEM END           
         PAGE                                                                   
SCAN8    RES      0                                                             
         CI,R5    8                                                             
         BGE      SCAN3             B IF TOO BIG                                
         CI,R11   2                 CHECK CONVERSION TYPE                       
         BE       SCAN9             HEX                                         
         BG       SCAN11            DECIMAL                                     
         STB,R10  R8,R5             BCD, STORE CHAR.                            
         B        SCAN4                                                         
SCAN9    CI,R10   X'F0'             HEX CONVERSION                              
         BGE      %+2                                                           
         AI,R10   X'39'                                                         
         AI,R10   -X'F0'                                                        
         BLZ      SCAN3             ERROR IF NOT 0-9, A-F                       
         CI,R10   15                                                            
         BG       SCAN3                                                         
         SLS,R8   4                                                             
         AW,R8    R10               STORE NEXT CHAR.                            
         B        SCAN4                                                         
SCAN11   AI,R10   -X'F0'            DECIMAL CONVERSION                          
         BLZ      SCAN3                                                         
         CI,R10   9                 ERROR IF NOT 0-9                            
         BG       SCAN3                                                         
         XW,R9    R8                                                            
         MI,R9    10                CHANGE TO DECIMAL                           
         XW,R8    R9                                                            
         AW,R8    R10               ADD INTO ACC. SUM                           
         B        SCAN4             GO BACK FOR NEXT CHAR.                      
*                                                                               
PARENBIT EQU      BITABLE+8         PAREN FIELD FLAG                            
         PAGE                                                                   
         OLAYEND                                                                
*                                                                               
         END                                                                    
