ASMB
      NAM CATR,7 92069-16170 REV.1912 770601
* 
* 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
* 
* 
*     SOURCE:    92069-18170
*     RELOC:     92069-16170
* 
* 
************************************************************* 
* 
      ENT CATR
      EXT SGET,.PACK,.ENTR
******************************
*                            *
*  ASCII TO REAL CONVERSION  *
*                            *
******************************
* 
* 
*   CALLING SEQUENCE: 
* 
*       A=CATR(IARRY,J,K,ISTAT) 
* 
*         WHERE: IARRY IS SINGLE DIMENSION ARRAY OF CHARACTERS
*                CONTAINING THE NUMBER TO BE CONVERTED. TWO CHARS 
*                PER WORD.
* 
*                J IS THE NUMBER OF THE FIRST CHARACTER IN THE
*                STRING.
* 
*                K IS THE NUMBER OF THE LAST CHARACTER IN THE STRING
* 
*                ISTAT IS SET TO 0 FOR GOOD CONVERSION AND -1 FOR 
*                INVALID CONVERSION.
* 
* 
BUFR  NOP 
J     NOP 
JLAST NOP 
ISTAT NOP 
CATR  NOP 
      JSB .ENTR 
      DEF BUFR
      CLB 
      STB EXP       ZERO
      STB MANT1       ALL 
      STB MANT2         COMPONENTS
      STB EXPON           OF NUMBER 
      STB SIGN
      STB TEMP3     SET 'NUMBER' FLAG FALSE 
      STB ISTAT,I   CLEAR ERROR FLAG
      CCB           SET 'DECIMAL POINT' 
      STB DPFLG       FLAG FALSE
      LDA J,I       SET 
      STA CHRCT       CHAR COUNTER
      JSB GETCR     GET A CHAR
      JMP NUMER 
      CPA .43       (+)?
      JMP NUMC0     YES!
      CPA .45       (-)?
      JMP NUM16     YES!
      JMP NUMC1     NO! 
NUMC0 JSB GETCR     GET A CHAR
      JMP NUMER     NO CHAR ERROR!
NUMC1 CPA .46       DECIMAL POINT?
      ISZ DPFLG     YES, SET FLAG TRUE
      JMP NUMC2     NO
      CLA           INITIALIZE POST-DECIMAL DIGIT 
      STA EXPON       DIGIT COUNTER TO ZERO 
      JMP NUMC3+1   FETCH A CHARACTER 
* 
NUM16 CCB 
      STB SIGN      SET FOR NEGATIVE NUMBER 
      JMP NUMC0 
* 
NUMC2 JSB DIGCK     DIGIT?
      JMP NUMC7     NO
      ISZ EXPON     YES, COUNT DIGIT
      ALF,ALF       LEFT-JUSTIFY
      ALF,RAR         DIGIT AND 
      STA TEMP4         SAVE IT 
      JSB MBY10     MULTIPLY PREVIOUS NUMBER BY 10
      LDB EXP 
      SZB           ZERO EXPONENT?
      JMP NUMC4     NO
      LDA .4        YES, SET
      STA EXP         EXPONENT TO 4 
      LDA TEMP4     LOAD
      CLB             NUMBER
NUMC3 JSB NORML     NORMALIZE THE NUMBER
      ISZ TEMP3     SET 'NUMBER OCCURRED' FLAG
      JSB GETCR     ANOTHER CHARACTER?
      JMP NUM12     NO
      JMP NUMC1     YES 
NUMC4 ADB M4        COMPUTE 
      CMB             EXPONENT
      LDA TEMP4         BIAS AND
      STB TEMP4           SAVE IT 
      CLB 
NUMC5 ISZ TEMP4     DIGIT POSITIONED? 
      JMP NUMC6     NO
      CLE           YES, ADD IN 
      ADB MANT2       LOW PART
      CLO               OF NUMBER 
      SEZ           OVERFLOW? 
      INA           YES, BUMP (A) 
      ADA MANT1     ADD IN HIGH PART OF NUMBER
      SOS           OVERFLOW? 
      JMP NUMC3     NO
      CLE,ERA       YES, ROTATE 
      ERB             DOWN AND
      ISZ EXP           BUMP
      NOP                 EXPONENT
      JMP NUMC3 
NUMC6 CLE,ERA       SHIFT 
      ERB             DIGIT 
      JMP NUMC5         RIGHT 
NUMC7 CLB           DECIMAL POINT 
      STB TEMP4 
      CPB TEMP3       OR DIGIT FOUND? 
      JMP NUMER     NO, EXIT VIA ERROR
      CPA E         YES, 'E' ?
      RSS           YES 
      JMP NUM12     NO, NO EXPONENT PART
      JSB GETCR 
      JMP NUMER 
      CPA .43       '+' ? 
      JMP NUMC8     YES 
      CPA .45       NO, '-' ? 
      CCA,RSS       YES 
      JMP NUMC9     NO
      STA TEMP4     NOTE MINUS SIGN 
NUMC8 JSB GETCR 
      JMP NUMER 
NUMC9 JSB DIGCK     DIGIT?
      JMP NUMER     NO
      STA TEMP3     YES, SAVE IT
      JSB GETCR 
      JMP NUM10     SECOND
      JSB DIGCK       DIGIT?
      JMP NUM10     NO
      LDB TEMP3     YES 
      BLS,BLS       MULTIPLY
      ADB TEMP3       PRIOR DIGIT 
      BLS               BY 10 
      ADA 1         ADD NEW DIGIT 
      STA TEMP3     SAVE EXPONENT 
      JSB GETCR 
      JMP NUM10     THIRD 
      JSB DIGCK       DIGIT?
      RSS           NO
      JMP NUMER     YES 
NUM10 LDA TEMP3     LOAD EXPONENT 
      ISZ TEMP4     POSITIVE? 
      CMA,INA       YES, COMPLEMENT IT
      RSS           NO
NUM12 CLA           CLEAR IF NO EXPONENT PART 
      ISZ DPFLG     DECIMAL POINT?
      ADA EXPON     YES, CORRECT EXPONENT 
      SZA,RSS       ZERO EXPONENT?
      JMP NUM14     YES 
      SKP 
      SSA           NO, NEGATIVE EXPONENT?
      JMP NUM13     NO
      CMA,INA       YES, SET
      STA EXPON       COUNTER 
      JSB DBY10     DIVIDE NUMBER BY 10 
      ISZ EXPON     DONE? 
      JMP *-2       NO
      JMP NUM14     YES 
NUM13 STA EXPON     SET COUNTER 
      JSB MBY10     MULTIPLY BY 10
      ISZ EXPON     DONE? 
      JMP *-2       NO
NUM14 LDA MANT1     YES, LOAD 
      LDB MANT2       NUMBER
      ISZ SIGN      POSITIVE? 
      JMP NUM15     YES 
      CMA           NO, 
      CMB,INB,SZB,RSS   COMPLEMENT
      INA                IT 
NUM15 JSB .PACK     PACK NUMBER INTO (A) AND (B)
EXP   BSS 1           EXPONENT
      JMP CATR,I
* 
NUMER CCB 
      STB ISTAT,I   SET ERROR FLAG
      JMP CATR,I
      SKP 
**********************************
*                                *
* MULTIPLY UNPACKED NUMBER BY 10 *
*                                *
**********************************
MBY10 NOP 
      LDA MANT1     RETURN ON 
      SZA,RSS         ZERO
      JMP MBY10,I       MANTISSA
      LDB EXP       MULTIPLY
      ADB .3          BY
      STB EXP           8 
      LDB MANT2     LOAD MANTISSA 
      CLE,ERA       DIVIDE
      ERB             BY
      CLE,ERA           4 
      ERB,CLE 
      ADB MANT2     DOUBLE
      SEZ             ADD TO
      INA               PRODUCE 
      ADA MANT1           1.25 * MANTISSA 
      SSA,RSS       CORRECT 
      JMP *+5 
      CLE,ERA         ON
      ERB 
      ISZ EXP           OVERFLOW
      NOP 
      STA MANT1 
      STB MANT2 
      JMP MBY10,I 
********************************
*                              *
* DIVIDE UNPACKED NUMBER BY 10 *
*                              *
********************************
DBY10 NOP           MULTIPLY BY DOUBLE-LENGTH TENTH 
      LDA MANT1     RETURN
      SZA,RSS         ON ZERO 
      JMP DBY10,I       MANTISSA
      LDB M2        ADD EXPONENT OF 
      ADB EXP         'TENTH' TO
      STB EXP           MANTISSA EXPONENT 
      LDA MANT2     JUSTIFY 
      CLE,ERA         LOWER MANTISSA
      MPY TENTH     MULITPLY BY ONE-TENTH (63416) 
      CLE,ELA       SHIFT 
      ELB,CLE         BACK
      ADA 1         ADD IN LOWER MANTISSA*
      SEZ             TENTH*(2)-16
      INB               AND ROUND 
      STB MANT2           TO 16 BITS
      LDA MANT1     DO
      MPY TENTH       SAME FOR
      CLE                 HIGH
      ADA 1                 MANTISSA
      ADA MANT2     (EFFECTIVELY) SUM 
      SEZ             DOUBLE-LENGTH 
      INB               PRODUCTS
      STB MANT1     EXCHANGE
      STA 1           (A) AND (B) 
      LDA MANT1         REGISTERS 
      JSB NORML     NORMALIZE RESULT
      JMP DBY10,I 
******************************* 
*                             * 
* NORMALIZE (A), (B) AND EXP  * 
*                             * 
******************************* 
NORML NOP 
      STA TEMP3     SET LEFT-SHIFT
      CLA             COUNTER 
      STA FERR          TO ZERO 
      LDA TEMP3 
      SZA,RSS       ON
      SZB             ZERO
      JMP NORM3         CLEAR 
      STA EXP             EVERYTHING
      STA MANT1     STORE 
NORM1 STB MANT2       MANTISSA
      JMP NORML,I       AND RETURN
NORM2 ISZ FERR      COUNT LEFT SHIFTS 
NORM3 CLE,ELB       ROTATE (A) AND
      ELA             (B) LEFT INTO (E) 
      SEZ,SSA,RSS   TWO HIGHEST BITS 0? 
      JMP NORM2     YES, + UNNORMALIZED 
      SEZ,SSA       NO, TWO HIGHEST BITS 1? 
      JMP NORM2     YES, - UNNORMALIZED 
      ERA           SHIFT TO
      ERB,CLE         NORMALIZE MANTISSA
      STA MANT1     NO, 
      LDA FERR      COMPUTE 
      CMA,INA         CORRECTED 
      ADA EXP           EXPONENT
      STA EXP             VALUE 
      LDA MANT1 
      JMP NORM1 
******************* 
*                 * 
* CHECK FOR DIGIT * 
*                 * 
******************* 
******************************
*                            *
* GET CHAR FROM INPUT BUFFER *
*                            *
******************************
GETCR NOP 
      JSB SGET      GET 
      DEF *+4 
      DEF BUFR,I      A 
      DEF CHRCT         CHAR
      DEF CHAR            FROM BUFFER 
      LDA CHAR
      LDB CHRCT     IS
      ADB M1
      CPB JLAST,I       END OF STRING?
      JMP GETCR,I   YES!
      CPA B40       SPACE?
      JMP GET1      YES!
      ISZ GETCR     NO! 
      ISZ CHRCT 
      JMP GETCR,I   EXIT
* 
GET1  ISZ CHRCT     GET NEXT CHAR 
      JMP GETCR+1 
      SKP 
DIGCK NOP          CHARACTER IN (A) 
      LDB 0 
      ADB D72      ASCII 72B
      SSB,RSS        OR GREATER?
      JMP DIGCK,I  YES, RETURN WITH CHARACTER 
      ADB .10       NO, ASCII 60B 
      SSB            OR GREATER?
      JMP DIGCK,I  NO 
      ISZ DIGCK    YES, SET 'SUCCESS' EXIT, 
      LDA 1          LOAD DIGIT INTO (A), 
      JMP DIGCK,I      AND RETURN 
MANT1 BSS 1 
MANT2 BSS 1 
EXPON BSS 1 
TEMP3 BSS 1 
TEMP4 BSS 1 
CHRCT BSS 1 
FERR  BSS 1 
CHAR  BSS 1 
DPFLG BSS 1 
SIGN  BSS 1 
.3    DEC 3 
.4    DEC 4 
.10   DEC 10
.43   DEC 43
.45   DEC 45
.46   DEC 46
M1    DEC -1
M2    DEC -2
M4    DEC -4
D72   OCT -72 
B40   OCT 40
TENTH OCT 63146 
E     OCT 105 
      END 
                                                                                                                                                                                      