FTN,Q,C 
      SUBROUTINE NUMB(IBUF,IRBUF,IFLG,IERFG),09580-16072 REV.2001 791015
C-------------------------------------------------------------------
C 
C      RELOC.       09580-16072 
C      SOURCE       09580-18072 
C 
C      C. LEATH     REV.A   770504
C 
C      HP 92425A TEST SYSTEM SOFTWARE IS THE PROPRIETARY
C      MATERIAL OF THE HEWLETT-PACKARD COMPANY.  USE AND
C      DISCLOSURE THEREOF ARE RESTRICTED BY WRITTEN AGREEMENT.
C 
C      (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.
C      ALL RIGHTS RESERVED.  NO PART OF THIS PROGRAM
C      MAY BE PHOTOCOPIED, REPRODUCED OR TRANSLATED 
C      TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR
C      WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY.
C 
C-------------------------------------------------------------------
      DIMENSION IBUF(40)
      DIMENSION IRBUF(10) 
      DIMENSION INBUF(2)
      EQUIVALENCE(INBUF,AFLT) 
      DATA IPLUS,MINUS/53B,55B/ 
      DATA IDPT,IEXP/27000B,42400B/ 
C 
C     SUBROUTINE # 9 FOR DBUG 
C 
C     THIS SUBROUTINE IS RESPONSIBLE FOR ANALYSING A
C  NUMERIC FIELD, DETERMINING WHETHER THE NUMBER
C  IS OCTAL, INTEGER OR FLOATING POINT. THE STRING
C  PROCESSING ROUTINES UTILIZED IN THIS ROUTINE 
C  ARE: 
C 
C     INTV:  ASCII TO INTEGER OR OCTAL
C     A2F:   ASCII TO FLOATING POINT
C  AN ILLEGAL NUMERIC IS INDICATED TO THE HIGHER
C  UP ROUTINES BY "IERFG"= -8 
C 
CC*****#1 ASCERTAIN WHETHER A + OR - IS 1ST CHARACTER 
C 
10    CALL DBUG(9,10,IBUF)
      IFLG = 2
      I=1 
      ICHR = 0
      NIN = 0 
      CALL SCAN(IBUF,IRBUF,NIN,Q) 
      ITST = (IAND(IRBUF(2),177400B))/400B
      IF(ITST.NE.IPLUS.AND.ITST.NE.MINUS)GO TO 405
      CALL SCAN(IBUF,IRBUF,NIN,Q) 
405   I= I+1
C 
CC*****#2 NOW SEE IS NUMBER IS FLOATING PT
C 
      IFLT1 = IAND(IRBUF(I),177400B)
      IFLT2 = IAND(IRBUF(I),177B)*400B
      IF(IFLT1.EQ.IDPT.OR.IFLT2.EQ.IDPT)GO TO 460 
      IF(IFLT1.EQ.IEXP.OR.IFLT2.EQ.IEXP)GO TO 460 
      ICHR = ICHR +2
      IF(ICHR.LT.IRBUF(1))GO TO 405 
C 
CC******3 INTEGER OR OCTAL
C 
      IRBUF(2) = INTV(IRBUF,IFL)
      IF(IFL.EQ.-1)GO TO 800
      IRBUF(1) = 1
      IF(ITST.EQ.MINUS)IRBUF(2) = -IRBUF(2) 
      RETURN
C 
CC******4 FLOATING POINT
C 
460   IFLT = A2F(IRBUF,1,IRBUF(1),INBUF(1)) 
      IF(IFLT.LT.0)GO TO 800
      IF(ITST.EQ.MINUS)AFLT = -AFLT 
      DO 475 I = 1,2
475   IRBUF(I+1) = INBUF(I) 
      IRBUF(1) = 2
      RETURN
800   IERFG= -8 
      RETURN
      END 
      SUBROUTINE CNTR(ITOKN,IERFG,IND)
C 
C     SUBROUTINE # 11 FOR DBUG
C 
      DIMENSION ICNT(128) 
      DATA MSK1,MSK2/177400B,377B/
C 
C     THIS SUBROUTINE KEEPS TRACK OF THE UNIT NUMBERS 
C  AND DEVICE TYPE NUMBERS AND REPORTS ANY DUPLICATES 
C  IN IERFG.
C 
C     THE PARAMETERS IN THE CALLING SEQUENCE HAVE THE FOLLOWING 
C  MEANINGS:
C     ITOKN = THE UNIT OR DEVICE TYPE NUMBER
C     IERFG = ERROR FLAG WHERE: -14 = DUPLICATE DEVICE TYPE 
C                               -15 = DUPLICATE UNIT NUMBER 
C     IND = BRANCHING INDICATOR 
C     WHERE IND = 1 MEANS TO CHECK FOR DUPLICATE UNIT #S
C            "  = 2   "    " CHECK FOR DUPLICATE DEVICE TYPE NUMBERS
C 
C     ICNT IS THE BUFFER CONTAINING THE BOOKEEPING INFOR- 
C     MATION WITH EACH WORD LOOKING LIKE :
C            -----------------------------------
C            !IDTN (BITS 8-15) ! UNIT # BITS 0-7! 
C            ------------------------------------ 
C 
C 
10    CALL DBUG(11,10,IND)
      GO TO(200,100),IND
C 
C     NEW RECORD - FIRST CLEAR UNIT COLUMN
C 
100   DO 120 I= 1,128 
120   ICNT(I) = IAND(ICNT(I),MSK1)
C 
C     CHECK FOR DUPLICATE IDTN
C 
      IDCHK = ITOKN * 400B
      DO 140 I = 1,128
      ICHK = IAND(ICNT(I),MSK1) 
      IF(ICHK.EQ.IDCHK)GO TO 150
      IF(ICHK.EQ.0)GO TO 145
140   CONTINUE
145   ICNT(I) = IDCHK 
      RETURN
150   IERFG = -14 
      RETURN
C 
C CHECK FOR DUPLICATE UNIT# 
C 
200   DO 240 I=1,128
      IUCHK = IAND(ICNT(I),MSK2)
      IF(IUCHK.EQ.ITOKN)GO TO 250 
      IF(IUCHK.EQ.0)GO TO 245 
240   CONTINUE
245   ICNT(I) = IOR(ITOKN,ICNT(I))
      RETURN
250   IERFG = -15 
      RETURN
      END 
      END$
                                                                                                                                                                              