Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0141/dajoin.for
There are 2 other files named dajoin.for in the archive. Click here to see a list.
SUBROUTINE DAJOIN(ITRAIL,IBUFFR,MAXBFR,LOWBFR,KIND ,
1 VALUE ,DIVISR,ISHIFT,JSHIFT)
C RENBR(/EVALUATE FRACTIONS AND MIXED NUMBERS)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C THIS ROUTINE EVALUATES THE WHOLE NUMBERS, FRACTIONS
C AND MIXED NUMBERS CONTAINED IN A LINE OF TEXT READ
C WITH A MULTIPLE OF AN A1 FORMAT. IF THE FRACTION OR
C MIXED NUMBER IS TO BE MULTIPLED BY 10.0 RAISED TO
C SOME POWER, THEN THIS EXPONENT MUST APPEAR TO THE
C IMMEDATE RIGHT OF THE DENOMINATOR OF THE FRACTION.
C THE TEXT CONTENTS 1 1/2K OR 1.5K OR 3/2K WOULD ALL
C REPRESENT THE VALUE 1500.
C
C FOLLOWING ARGUMENTS ARE USED ONLY FOR INPUT AND ARE
C RETURNED UNCHANGED.
C
C ITRAIL = SELECTS WHETHER EXPONENTS ARE TO BE
C RECOGNIZED. IF EXPONENTS ARE NOT TO BE
C RECOGNIZED BUT EXPONENT IS FOUND, THEN
C EVALUATION OF CONTENTS OF INPUT TEXT BUFFER
C WILL BE TERMINATED PRIOR TO EXPONENT AND
C FIRST CHARACTER OF EXPONENT WILL BE TREATED
C SAME AS ANY OTHER UNKNOWN ALPHABETIC
C CHARACTER. WHEN SUCH UNKNOWN CHARACTER IS
C FOUND, KIND IS RETURNED CONTAINING 2 AND
C LOWBFR IS RETURNED POINTING TO UNKNOWN
C CHARACTER.
C = -1, EXPONENTS EXPRESSED IN E NOTATION ARE TO
C BE RECOGNIZED, BUT PERCENT SIGN AND LETTERS
C K AND M ARE TO BE TREATED SAME AS ANY OTHER
C ALPHABETIC CHARACTERS.
C = 0, NO EXPONENTS ARE TO BE RECOGNIZED.
C EVALUATION WILL BE TERMINATED PRIOR TO
C PERCENT SIGNS OR TO LETTERS E OR K OR M.
C = 1, PERCENT SIGNS, LETTERS K AND M, AND
C EXPONENTS EXPRESSED IN E NOTATION ARE ALL TO
C BE RECOGNIZED.
C IBUFFR = INPUT BUFFER ARRAY CONTAINING CHARACTERS OF
C LINE OF TEXT TO BE INTERPRETED, ONE
C CHARACTER PER ARRAY LOCATION, AS READ BY
C MULTIPLE OF A1 FORMAT.
C MAXBFR = SUBSCRIPT OF IBUFFR ARRAY LOCATION
C CONTAINING RIGHTMOST (HIGHEST SUBSCRIPT)
C CHARACTER IN LINE OF TEXT BEING INTERPRETED.
C MAXBFR WOULD NORMALLY BE DIMENSION OF IBUFFR
C ARRAY.
C
C FOLLOWING ARGUMENT IS USED BOTH FOR INPUT TO THIS
C ROUTINE AND FOR OUTPUT TO CALLING PROGRAM.
C
C LOWBFR = INPUT CONTAINING SUBSCRIPT OF IBUFFR ARRAY
C LOCATION WHICH CONTAINS LEFTMOST (LOWEST
C SUBSCRIPT) CHARACTER WHICH IS TO BE
C INTERPRETED BY THIS ROUTINE. LOWBFR IS
C RETURNED POINTING TO LEFTMOST CHARACTER NOT
C YET IDENTIFIED BY THIS ROUTINE. IF KIND IS
C RETURNED CONTAINING 3 OR GREATER, THEN
C LOWBFR IS RETURNED POINTING TO CHARACTER TO
C IMMEDIATE RIGHT OF REPRESENTATION OF NUMBER.
C IF KIND IS RETURNED CONTAINING 2, THEN
C LOWBFR IS RETURNED POINTING TO CHARACTER
C WHICH COULD NOT BE EVALUATED. IF KIND IS
C RETURNED CONTAINING 1, THEN LOWBFR IS
C RETURNED POINTING BEYOND END OF BUFFER.
C
C FOLLOWING ARGUMENTS ARE USED FOR OUTPUT ONLY. THEIR
C INPUT VALUES ARE IGNORED.
C
C KIND = 1, NO PRINTING CHARACTERS APPEARED AT OR TO
C THE RIGHT OF IBUFFR(LOWBFR). LOWBFR IS
C RETURNED POINTING BEYOND END OF BUFFER.
C = 2, UNKNOWN CHARACTER WAS FOUND. LOWBFR IS
C RETURNED CONTAINING SUBSCRIPT OF IBUFFR
C ARRAY LOCATION CONTAINING THIS UNKNOWN
C CHARACTER. LOWBFR MUST BE INCREMENTED BY AT
C LEAST 1 BEFORE THIS ROUTINE IS AGAIN CALLED
C TO CONTINUE PROCESSING OF TEXT.
C = 3, WHOLE NUMBER WAS FOUND. LOWBFR IS
C RETURNED POINTING TO CHARACTER TO IMMEDIATE
C RIGHT OF REPRESENTATION OF WHOLE NUMBER.
C = 4, MIXED NUMBER CONSISTING OF WHOLE NUMBER
C FOLLOWED BY UNSIGNED FRACTION WAS FOUND.
C LOWBFR IS RETURNED POINTING TO CHARACTER TO
C IMMEDIATE RIGHT OF REPRESENTATION OF
C FRACTION.
C = 5, FRACTION WAS FOUND. LOWBFR IS RETURNED
C POINTING TO CHARACTER TO IMMEDIATE RIGHT OF
C REPRESENTATION OF FRACTION.
C = 6, MIXED NUMBER OR FRACTION WAS FOUND IN
C WHICH RIGHTMOST DENOMINATOR WAS MISSING.
C LOWBFR IS RETURNED POINTING TO CHARACTER TO
C RIGHT OF RIGHTMOST SLASH.
C VALUE = RETURNED CONTAINING VALUE OF WHOLE NUMBER,
C OR MIXED NUMBER OR FRACTION IF KIND IS
C RETURNED CONTAINING 3 OR GREATER. VALUE,
C DIVISR, ISHIFT AND JSHIFT ARE RETURNED
C UNDEFINED IF KIND IS RETURNED CONTAINING 1
C OR 2.
C DIVISR = RETURNED CONTAINING VALUE OF DENOMINATOR IF
C FRACTION OR MIXED NUMBER IS FOUND. RETURNED
C SET TO 1 IF WHOLE NUMBER IS FOUND.
C ISHIFT = 0, RETURNED IF NONE OF CHARACTERS E, %, K OR
C M FOLLOW NUMBER
C = 1, PERCENT SIGN FOLLOWS NUMBER
C = 2, K FOLLOWS NUMBER
C = 3, M FOLLOWS NUMBER
C = LESS THAN ZERO, RETURNED IF E FOLLOWS
C NUMBER.
C = -1, E AND POSSIBLY SIGNED NUMBER FOLLOW
C NUMBER.
C = -2, E IS FOLLOWED BY PLUS SIGN NOT IN TURN
C FOLLOWED BY DIGITS.
C = -3, E IS FOLLOWED BY MINUS SIGN NOT IN TURN
C FOLLOWED BY DIGITS.
C = -4, E IS FOLLOWED BY NEITHER SIGN NOR DIGITS
C JSHIFT = EXPONENT INDICATED BY FOLLOWING PERCENT
C SIGN, K, M OR E FOLLOWED BY DIGITS. 12.34K
C OR 12.34E3 OR 12 34/100K OR 12 34/100E3
C WOULD GIVE JSHIFT OF 3. 12% OR 12E-2 WOULD
C GIVE JSHIFT -2.
C
DIMENSION IBUFFR(MAXBFR)
C
C ISPACE CONTAINS SPACE CHARACTER AND ITAB CONTAINS
C TAB CHARACTER. IF TAB CHARACTER IS NOT AVAILABLE,
C ITAB SHOULD INSTEAD CONTAIN A SPACE ALSO.
DATA MINUS,IPLUS,ISLASH,ISPACE,ITAB/
11H-,1H+,1H/,1H ,1H /
C
C INITIALIZE
INITAL=0
LEVEL=0
ISIGN=1
KIND=1
JTRAIL=10
IF(ITRAIL.LT.0)JTRAIL=9
IF(ITRAIL.GT.0)JTRAIL=11
GO TO 3
C
C *********************
C * SCAN FOR NUMBER *
C *********************
C
C LOOP LOOKING AT CHARACTERS IN IBUFFR ARRAY
1 LEVEL=1
2 LOWBFR=LOWBFR+1
3 IF(LOWBFR.GT.MAXBFR)GO TO 12
NOWLTR=IBUFFR(LOWBFR)
C
C LOOK FOR LEADING SPACES, SIGNS OR SLASHES
IF(LEVEL.NE.0)GO TO 5
IF(NOWLTR.EQ.ISPACE)GO TO 2
IF(NOWLTR.EQ.ITAB)GO TO 2
IF(NOWLTR.EQ.ISLASH)GO TO 7
IF(NOWLTR.EQ.IPLUS)GO TO 4
IF(NOWLTR.NE.MINUS)GO TO 6
ISIGN=-1
4 IF(INITAL.NE.0)GO TO 12
GO TO 6
5 IF(NOWLTR.EQ.IPLUS)GO TO 12
IF(NOWLTR.EQ.MINUS)GO TO 12
IF(NOWLTR.EQ.ISPACE)GO TO 12
IF(NOWLTR.EQ.ITAB)GO TO 12
IF(NOWLTR.EQ.ISLASH)GO TO 2
C
C EVALUATE NUMBER
6 CALL DAHEFT(1,JTRAIL,0,IBUFFR,MAXBFR,
1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
2VALUE)
IF(KIND.NE.3)GO TO 12
KSHIFT=KSHIFT-JSHIFT
IF(KSHIFT.NE.0)VALUE=VALUE*(10.0**KSHIFT)
C
C MARK THAT ARE IN FRACTION IF FIND SLASH
IF(ISHIFT.NE.0)GO TO 9
IF(LOWBFR.GT.MAXBFR)GO TO 9
IF(IBUFFR(LOWBFR).NE.ISLASH)GO TO 9
IF(LEVEL.EQ.0)GO TO 8
LEVEL=-1
GO TO 10
7 VALUE=0.0
8 DIVISR=1.0
FRACTN=VALUE
GO TO 1
C
C *******************************
C * NUMBER HAS BEEN EVALUATED *
C *******************************
C
C DIVIDE FRACTION BY NEW DENOMINATOR
9 IF(LEVEL.EQ.0)GO TO 11
10 IF(LSHIFT.LE.0)VALUE=1.0
DIVISR=VALUE
FRACTN=FRACTN/VALUE
IF(LEVEL.GT.0)GO TO 13
GO TO 1
C
C STORE WHOLE NUMBER AND LOOP BACK FOR FRACTION
11 IF(INITAL.NE.0)GO TO 12
IF(ISHIFT.NE.0)GO TO 19
INITAL=ISIGN
LOWSAV=LOWBFR
WHOLE=VALUE
GO TO 3
C
C COMBINE WHOLE NUMBER AND FRACTION
12 ISHIFT=0
JSHIFT=0
IF(LEVEL.EQ.0)GO TO 18
KIND=6
IF(INITAL.EQ.0)GO TO 17
GO TO 14
13 IF(INITAL.EQ.0)GO TO 16
KIND=4
14 IF(INITAL.GT.0)GO TO 15
VALUE=WHOLE-FRACTN
GO TO 20
15 VALUE=WHOLE+FRACTN
GO TO 20
16 KIND=5
17 VALUE=FRACTN
GO TO 20
18 IF(INITAL.EQ.0)GO TO 21
LOWBFR=LOWSAV
VALUE=WHOLE
19 KIND=3
DIVISR=1.0
20 IF(JSHIFT.NE.0)VALUE=VALUE*(10.0**JSHIFT)
GO TO 22
C
C SIMULATE NUMBER IF NONE FOUND
21 VALUE=0.0
DIVISR=1.0
C
C RETURN TO CALLING PROGRAM
22 RETURN
C INITAL = 0, NO WHOLE NUMBER STORED
C = -1, NEGATIVE WHOLE NUMBER STORED
C = 1, POSITIVE WHOLE NUMBER STORED
C ISIGN = -1, MINUS SIGN AT START OF NUMBER
C = 1, NUMBER DOES NOT START WITH MINUS SIGN
C LEVEL = 0, A SLASH HAS NOT BEEN FOUND.
C = 1, THE NUMERATOR OF FRACTION HAS BEEN
C STORED AND NEED TO GET DENOMINATOR.
C = -1, A SLASH APPEARS AT RIGHT OF THE
C DENOMINATOR OF THE FRACTION SO NEED
C TO CALCULATE NEW NUMERATOR AND THEN
C GO BACK TO LEVEL=1 STATE.
C510407084164
END