*DECK C$NUMRA 
          IDENT  C$NUMRA
          TITLE  C$NUMRA - IF NUMERIC WHEN USING A-OPTION 
          MACHINE   ANY,I 
  
          SST 
          COMMENT   IF NUMERIC WITH A-OPTION
  
 C.NUMRA  SPACE  4
**        C.NUMERA - IF NUMERIC FOR USE WITH THE A-OPTION (LDZ ON 
*                CONTROL CARD)
* 
*         CALLING SEQUENCE: 
*         SB4    CHAR OFFSET
*         SB5    BASE ADDR
*         SB6    ITEM LENGTH
*         SB7    0  - FIELD UNSIGNED
*                1          SIGNED WITH TRAILING OVERPUNCH
*                2                 WITH TRAILING SEP CHAR 
*                3                 WITH LEADING OVERPUNCH 
*                4                 WITH LEADING SEP CHAR
*         RJ     =XC.NUMRA
* 
* 
*         RETURNS:  
*         B7 =   0 - TRUE 
*                1 - FALSE
* 
*         THIS ROUTINE SIMPLY CHECKS EACH CHARACTER IN THE ITEM TO SEE
*         IF IT IS NUMERIC.  IF IT IS SIGNED, EITHER THE FIRST OR 
*         LAST CHARACTER IS CHECKED FOR A PROPER SIGN.
* 
*         SPACES, IF PRESENT, ARE SKIPED EXCEPT FOR LEADING OVERPUNCH 
*         FIELDS IN WHICH CASE THEY ARE ILLEGAL.
* 
*         ITEMS WITH OVERPUNCHED SIGNS MAY HAVE A SIGN PRESENT OR 
*         NOT.  IF IT IS NOT PRESENT, THE NUMER IS ASSUMED POSITIVE.
*         ITEMS WITH SEPERATE CHARACTER SIGNS MUST ALWAYS HAVE THE
*         SIGN CHARACTER PRESENT. 
* 
*         REGISTERS USED: 
*                X  - 1 2 3 4 5 - - 
*                A  - - - 3 - 5 - - 
*                B  - - - 3 4 5 6 7 
* 
*         ENTRY POINTS: 
          ENTRY  C.NUMRA
* 
*         EXTERNAL REFS:  
*         NONE
* 
* 
 C.NUMRA  SPACE  4
 C.NUMRA  DATA   0
          SX2    10 
          SX5    B4 
          IX4    X5-X2       C.F. INDEXING
          NG     X4,NUMR1 
          SX4    52429       =2**19/10
          IX4    X4*X5
          AX4    19          DIVIDE BY 10 
          SB5    B5+X4       UP ADDR
 IFA      IFEQ   OP.MODEL,OP.6400 
          LX3    X4,B1       X4*2 
          LX4    3           X4*8 
          IX3    X3+X4       X4*10
 IFA      ELSE
          IX3    X4*X2
 IFA      ENDIF 
          IX5    X5-X3       BUILD BCP
          SB4    X5          SAVE BCP 
  
 NUMR1    SX4    X5          BCP TO X4
          SX5    B7-3 
          SA3    B5          FETCH FIRST WORD 
          SB7    X2 
 IFB      IFEQ   OP.MODEL,OP.6400 
          LX2    X4,B1       X4*2 
          LX4    2           X4*4 
          IX4    X4+X2       X4*6 
 IFB      ELSE
          SX2    6
          IX4    X4*X2
 IFB      ENDIF 
          SB5    X4          SHIFT COUNT
          LX3    X3,B5       L. JUST WORD 
          SX2    X5+3 
          SB4    B7-B4       NR CHARS IN THIS WORD
          LT     B4,B6,NUMR1A 
          SB4    B6 
 NUMR1A   SB6    B6-B4
          SB3    1R0
          MX4    54 
          SB5    1R9
          NG     X5,NUMR4    NOT LEAD SIGN
          LX3    6
          MX2    0           SET NO SIGN
          BX1    -X4*X3 
          SB4    B4-B1
 NUMR1B   ZR     X5,NUMR3    LEAD OVERPUNCH 
          SX5    X1-1R+ 
          ZR     X5,NUMR4    OK 
          SX5    X1-1R- 
          ZR     X5,NUMR4 
          SX5    X1-1R       SPACE IS OK
          ZR     X5,NUMR4 
  
 NUMR2    SB7    B1 
          EQ     C.NUMRA     SET FALSE AND EXIT 
  
 NUMR3    SX5    X1-1R
          ZR     X5,NUMR4    JP IF BLANK - IS OK
          SA5    X1+=XC.STRP
          LX5    59-35
          NG     X5,NUMR2    JP IF NOT NUMERIC CHARACTER
  
 NUMR4    NZ     B4,NUMRA2   GOT A CHAR 
          SB7    10 
          LT     B6,B7,NUMRA1      SHORT WORD LEFT
          SB4    B7 
          SA3    A3+B1
          SB6    B6-B7
          EQ     NUMRA2 
  
 NUMRA1   ZR     B6,NUMR7    ALL BLANK - TREAT AS ZERO
          SA3    A3+1 
          SB4    B6+0 
          SB6    0
  
 NUMRA2   LX3    6
          BX1    -X4*X3 
          SX5    X1-1R
          NZ     X5,NUMRA3   DONE SET UP FOR REST OF CHECK
          SB4    B4-1 
          NZ     B4,NUMRA2   SHORT LOOP 
          EQ     NUMR4       LOOP 
  
 NUMRA3   LX3    54          RESYNC 
          EQ     B4,B1,NUMR6       C.F. LAST CHAR OF WORD 
  
 NUMR5    LX3    6           CHECK CHAR LOOP
          BX1    -X4*X3      GET NEXT CHAR
          SB7    X1+0 
          LT     B7,B3,NUMR2 BAD
          SB4    B4-1 
          LT     B5,B7,NUMR2
          GE     B1,B4,NUMR6
          EQ     NUMR5
  
*      HANDLE LAST CHAR IN WORD..C.F. LAST CHAR IN ITEM 
  
 NUMR6    ZR     B4,NUMR9 
          ZR     X2,NUMR5    UNSIGNED 
          NZ     B6,NUMR5    NOT LAST WORD
          SX5    X2-1 
          LX3    6
          SB4    B0 
          BX1    -X4*X3 
          SB7    X1 
          NZ     X5,NUMR1B   SEP CHAR 
          SA5    X1+=XC.STRP
          LX5    59-35
          NG     X5,NUMR2    JP IF NOT NUMERIC CHARACTER
  
*      SET OK AND SPLIT 
  
 NUMR7    SB7    B0 
          EQ     C.NUMRA
  
 NUMR8    SX5    X1-1R+      SEP CHARS
          SX1    X1-1R- 
          ZR     X5,NUMR7    SET OK 
          NZ     X1,NUMR2 
          EQ     NUMR7
  
 NUMR9    ZR     B6,NUMR7    ALL DONE SET OK AND EXIT 
          SB7    10          PICK UP NEXT WORD
          LT     B6,B7,NUMR10 
          SA3    A3+B1
          SB4    B7 
          SB6    B6-B7
          EQ     NUMR5
  
 NUMR10   SB4    B6          SHORT WORD 
          SB6    B0 
          SA3    A3+1 
          LT     B1,B4,NUMR5
          EQ     NUMR6
  
          END 
