Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0141/damiss.for
There are 2 other files named damiss.for in the archive. Click here to see a list.
SUBROUTINE DAMISS(KONTRL,ITRAIL,IEXTRA,IBUFFR,MAXBFR,
1 LOWBFR,KIND ,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
2 VALUE ,MANY ,LCNBFR,LCNERR)
C RENBR(/DELIMITER WRAPPER FOR DAHEFT)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C DAMISS EVALUATES NUMBERS, ALLOWS COMMAS BETWEEN
C NUMBERS, IDENTIFIES MISSING ITEMS INDICATED BY EXTRA
C COMMAS, SKIPS OVER ANY TEXT WHICH IS TO RIGHT OF
C EITHER EXCLAMATION POINT OR AMPERSAND, AND REPORTS
C ANY SEMICOLONS FOUND IN TEXT BEING EVALUATED.
C
C ARGUMENT LISTS OF DAMISS AND DAHEFT ARE IDENTICAL
C EXCEPT FOR ARGUMENTS MANY, LCNBFR AND LCNERR WHICH DO
C NOT APPEAR IN DAHEFT ARGUMENT LIST, AND EXCEPT THAT
C DAMISS CAN RETURN ARGUMENT NAMED KIND CONTAINING
C ADDITIONAL VALUES 4, 5, 6 AND 7. ARGUMENT NAMED MANY
C MUST BE SET TO ZERO BY CALLING PROGRAM BEFORE CALLING
C EITHER THIS ROUTINE OR ANY OF OTHER ROUTINES IN FASP
C PACKAGE (SUCH AS DANEXT, DASPAN AND DATEST) WHICH
C DEFINE THIS ARGUMENT IN SIMILAR MANNER. ARGUMENTS
C NAMED KIND AND LCNBFR ARE USED ONLY FOR OUTPUT TO
C CALLING PROGRAM AND THEIR INPUT VALUES ARE IGNORED.
C THESE ARGUMENTS ARE DESCRIBED BELOW. DOCUMENTATION
C OF DAHEFT SHOULD BE CONSULTED FOR DESCRIPTIONS OF
C REMAINING ARGUMENTS.
C
C KIND = 1, NOTHING, EXCEPT PERHAPS COMMENT INDICATED
C BY LEADING EXCLAMATION POINT, WAS FOUND AT
C OR TO RIGHT OF IBUFFR(LOWBFR). CALLING
C PROGRAM SHOULD READ NEW LINE INTO IBUFFR
C ARRAY BEFORE AGAIN CALLING THIS ROUTINE IF
C ADDITIONAL VALUES ARE REQUIRED. LOWBFR IS
C RETURNED POINTING BEYOND END OF BUFFER.
C MANY IS RETURNED SET TO ZERO. IVALUE AND
C VALUE ARE RETURNED UNDEFINED.
C = 2, FIRST PRINTING CHARACTER (OTHER THAN
C POSSIBLE COMMA IF MANY WAS INPUT GREATER
C THAN ZERO) IN OR TO RIGHT OF IBUFFR(LOWBFR)
C WAS NOT CHARACTER WHICH COULD BEGIN
C REPRESENTATION OF NUMBER AND WAS NOT COMMA,
C SEMICOLON, AMPERSAND OR EXCLAMATION POINT.
C LOWBFR IS RETURNED POINTING TO THIS PRINTING
C CHARACTER. IT IS EXPECTED THAT CALLING
C PROGRAM WILL OTHERWISE PROCESS THIS PRINTING
C CHARACTER SINCE DAMISS WOULD RETURN SAME
C RESULTS IF CALLED AGAIN WITH SAME VALUE OF
C LOWBFR AND WITH SAME BUFFER CONTENTS. MANY
C IS RETURNED CONTAINING ONE PLUS ITS INPUT
C ABSOLUTE VALUE. IVALUE AND VALUE ARE
C RETURNED UNDEFINED.
C = 3, NUMBER WAS FOUND WHICH WAS FOLLOWED BY A
C SPACE, TAB CHARACTER, COMMA, SEMICOLON,
C EXCLAMATION POINT OR AMPERSAND. MANY IS
C RETURNED CONTAINING ONE PLUS ITS INPUT
C ABSOLUTE VALUE. LOWBFR IS RETURNED POINTING
C TO CHARACTER TO RIGHT OF NUMBER
C REPRESENTATION.
C = 4, NUMBER WAS FOUND WHICH WAS FOLLOWED BY
C CHARACTER OTHER THAN SPACE, TAB CHARACTER,
C COMMA, SEMICOLON, EXCLAMATION POINT OR
C AMPERSAND. LCNBFR IS RETURNED POINTING IN
C BUFFER TO FIRST CHARACTER OF NUMBER. LOWBFR
C IS RETURNED POINTING IN BUFFER TO CHARACTER
C TO RIGHT OF NUMBER. LCNERR IS RETURNED
C POINTING IN BUFFER TO NEXT SPACE, TAB
C CHARACTER, COMMA, SEMICOLON, EXCLAMATION
C POINT OR AMPERSAND TO RIGHT OF NUMBER, OR IS
C RETURNED POINTING BEYOND END OF BUFFER IF NO
C SPACE, TAB CHARACTER, COMMA, SEMICOLON,
C EXCLAMATION POINT OR AMPERSAND IS FOUND TO
C RIGHT OF NUMBER. MANY IS RETURNED
C CONTAINING ONE PLUS ITS INPUT ABSOLUTE
C VALUE.
C = 5, SEMICOLON WAS FOUND AS FIRST PRINTING
C CHARACTER AT OR TO RIGHT OF IBUFFR(LOWBFR).
C LOWBFR IS RETURNED POINTING TO NEXT
C CHARACTER BEYOND SEMICOLON. IT IS ASSUMED
C THAT CALLING PROGRAM WILL TREAT APPEARANCE
C OF SEMICOLON AS MARKING END OF STATEMENT.
C MANY IS RETURNED SET TO ZERO. IVALUE AND
C VALUE ARE RETURNED UNDEFINED.
C = 6, AMPERSAND WAS FOUND AS FIRST PRINTING
C CHARACTER AT OR TO RIGHT OF LOWBFR. TEXT TO
C RIGHT OF AMPERSAND IS TAKEN AS COMMENT SO
C LOWBFR IS RETURNED POINTING BEYOND RIGHT END
C OF BUFFER. IT IS ASSUMED THAT CALLING
C PROGRAM WILL READ IN CONTENTS OF NEW BUFFER,
C THEN AGAIN REQUEST NEW NUMBER EVALUATION
C FROM THIS ROUTINE. VALUE OF MANY MUST NOT
C BE CHANGED BY CALLING PROGRAM PRIOR TO THIS
C FOLLOWING CALL. EFFECT IS NOT QUITE SAME AS
C IF USER HAD TYPED ALL OF TEXT ON SINGLE LINE
C SINCE SINGLE NUMBER CANNOT BE SPLIT ACROSS
C LINE BOUNDARY. IVALUE AND VALUE ARE RETURNED
C UNDEFINED.
C = 7, NUMBER WAS NOT FOUND, BUT EXTRA COMMA WAS
C FOUND INDICATING MISSING NUMBER. MANY IS
C RETURNED CONTAINING ONE PLUS ITS INPUT
C ABSOLUTE VALUE. IVALUE OR VALUE, WHICHEVER
C IS APPROPRIATE, IS RETURNED SET TO ZERO.
C
C MANY = SHOULD BE INPUT CONTAINING ZERO EACH TIME
C THIS ROUTINE IS CALLED TO BEGIN PROCESSING
C OF NEW LOGICAL SECTION OF TEXT, AS FOR
C EXAMPLE WHEN BEGINNING PROCESSING OF LINE OF
C TEXT NOT TIED TO PREVIOUS LINE BY AMPERSAND
C AT END OF PREVIOUS LINE, OR WHEN PROCESSING
C TEXT TO RIGHT OF SEMICOLON. INITIAL ZEROING
C OF THIS ARGUMENT MUST BE DONE BY CALLING
C PROGRAM, BUT THEREAFTER VALUE RETURNED BY
C PREVIOUS CALL TO THIS ROUTINE CAN USUALLY BE
C USED. MANY IS RETURNED SET TO ZERO EACH
C TIME SEMICOLON (KIND=5) IS FOUND, AND EACH
C TIME END OF LINE NOT TIED TO FOLLOWING LINE
C BY AMPERSAND (KIND=1) IS FOUND. MANY IS
C RETURNED CONTAINING ONE PLUS ITS INPUT
C ABSOLUTE VALUE EACH TIME NUMBER IS FOUND,
C EACH TIME UNKNOWN CHARACTER IS FOUND, OR
C EACH TIME INDICATION OF MISSING NUMBER IS
C FOUND. KIND IS RETURNED CONTAINING VALUE 6
C AND MANY IS RETURNED CONTAINING NEGATIVE OF
C NUMBER OF ITEMS FOUND IF NEXT PRINTING
C CHARACTER FOLLOWING COMMA IS AMPERSAND.
C MANY SHOULD NOT BE CHANGED BY CALLING
C PROGRAM IF AMPERSAND (KIND BEING RETURNED=6)
C IS FOUND INDICATING THAT SUBSEQUENT CALL TO
C THIS ROUTINE IS TO PROCESS TEXT WHICH IS TO
C BE TREATED AS THOUGH IT APPEARED IN PLACE OF
C AMPERSAND AND CHARACTERS TO ITS RIGHT.
C EFFECT IS NOT QUITE SAME AS IF USER HAD
C TYPED ALL OF TEXT ON SINGLE LINE SINCE
C SINGLE NUMBER CANNOT BE SPLIT ACROSS LINE
C BOUNDARY.
C
C IF MANY IS INPUT CONTAINING ZERO, THEN
C INITIAL COMMA IN INPUT TEXT BUFFER IS TAKEN
C TO INDICATE INITIAL MISSING ITEM, AND MANY
C IS THEN RETURNED CONTAINING 1. IF MANY IS
C INPUT GREATER THAN ZERO, THEN INITIAL COMMA
C IS IGNORED IF FOLLOWED BY NUMBER. IF MANY
C IS INPUT GREATER THAN ZERO, THEN INITIAL
C COMMA FOLLOWED BY NO OTHER PRINTING
C CHARACTERS, BY SEMICOLON, OR BY EXCLAMATION
C POINT INDICATES MISSING ITEM. IF MANY IS
C INPUT GREATER THAN ZERO, THEN INITIAL COMMA
C FOLLOWED BY AMPERSAND WILL CAUSE REMAINING
C CHARACTERS IN BUFFER TO BE IGNORED, AND MANY
C WILL BE RETURNED CONTAINING NEGATIVE OF ITS
C INPUT VALUE. IF MANY IS INPUT NEGATIVE,
C THEN IT IS ASSUMED THAT CONTENTS OF CURRENT
C BUFFER CONTINUE PREVIOUS LINE WHICH
C TERMINATED WITH COMMA FOLLOWED BY AMPERSAND,
C AND MANY IS RETURNED GREATER THAN ZERO.
C
C LCNBFR = IF NUMBER REPRESENTATION IS FOUND, KIND
C BEING RETURNED CONTAINING EITHER 3 OR 4,
C THEN LCNBFR IS RETURNED CONTAINING SUBSCRIPT
C OF IBUFFR ARRAY LOCATION WHICH CONTAINS
C FIRST (LEFTMOST) CHARACTER OF NUMBER
C REPRESENTATION. LCNBFR IS RETURNED UNDEFINED
C IF NUMBER REPRESENTATION IS NOT FOUND.
C
C LCNERR = IF KIND IS RETURNED SET TO 4 INDICATING THAT
C NUMBER WAS FOLLOWED BY PRINTING CHARACTER
C OTHER THAN COMMA, SEMICOLON, EXCLAMATION
C POINT OR AMPERSAND, THEN LCNERR CONTAINS
C SUBSCRIPT IN IBUFFR ARRAY OF LOCATION WHICH
C CONTAINS NEXT SPACE, TAB CHARACTER, COMMA,
C SEMICOLON, EXCLAMATION POINT OR AMPERSAND OR
C IS SET TO MAXBFR+1 IF NO ALLOWED DELIMITER
C CHARACTERS APPEARS TO RIGHT OF NUMBER.
C
DIMENSION IBUFFR(MAXBFR)
DATA KOMENT,IEND,IAND,KOMMA,ISPACE,ITAB/
11H!,1H;,1H&,1H,,1H ,1H /
KIND=1
IF(MANY.GE.0)GO TO 1
KIND=7
MANY=-MANY
1 IF(KONTRL.LE.0)IVALUE=0
IF(KONTRL.GT.0)VALUE=0.0
GO TO 3
C
C IDENTIFY NEXT CHARACTER
2 LOWBFR=LOWBFR+1
3 IF(LOWBFR.GT.MAXBFR)GO TO 9
LETTER=IBUFFR(LOWBFR)
IF(LETTER.EQ.ISPACE)GO TO 2
IF(LETTER.EQ.ITAB)GO TO 2
IF(LETTER.EQ.KOMENT)GO TO 8
IF(LETTER.EQ.IEND)GO TO 6
IF(LETTER.EQ.KOMMA)GO TO 5
IF(LETTER.EQ.IAND)GO TO 7
C
C TEST IF CHARACTER STARTS A NUMBER
LCNBFR=LOWBFR
CALL DAHEFT(KONTRL,ITRAIL,IEXTRA,IBUFFR,MAXBFR,
1LOWBFR,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
2VALUE)
LCNERR=LOWBFR
4 IF(LCNERR.GT.MAXBFR)GO TO 11
LETTER=IBUFFR(LCNERR)
IF(LETTER.EQ.ISPACE)GO TO 11
IF(LETTER.EQ.ITAB)GO TO 11
IF(LETTER.EQ.KOMENT)GO TO 11
IF(LETTER.EQ.IEND)GO TO 11
IF(LETTER.EQ.KOMMA)GO TO 11
IF(LETTER.EQ.IAND)GO TO 11
LCNERR=LCNERR+1
IF(KIND.EQ.3)KIND=4
GO TO 4
C
C TEST IF COMMA CAN PRECEDE A VALUE
5 IF(KIND.NE.1)GO TO 11
KIND=7
IF(MANY.EQ.0)GO TO 11
GO TO 2
C
C SEMICOLON FOUND
6 IF(KIND.NE.1)GO TO 11
LOWBFR=LOWBFR+1
KIND=5
GO TO 10
C
C AMPERSAND FOUND
7 IF(KIND.NE.1)MANY=-MANY
KIND=6
LOWBFR=MAXBFR+1
GO TO 12
C
C EXCLAMATION POINT FOUND
8 IF(KIND.NE.1)GO TO 11
LOWBFR=MAXBFR+1
GO TO 10
C
C END OF LINE FOUND
9 IF(KIND.NE.1)GO TO 11
C
C RETURN TO CALLING ROUTINE
10 MANY=0
GO TO 12
11 MANY=MANY+1
12 RETURN
C404203515168!;&
END