Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0141/dainxt.for
There are 2 other files named dainxt.for in the archive. Click here to see a list.
SUBROUTINE DAINXT (IBUFFR,MAXBFR,LOWBFR,
1 MANY ,KIND ,NEWVAL,INCVAL,LMTVAL)
C RENBR(/RETURNS NEXT NUMBER IN SERIES)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C DANEXT RETURNS TO THE CALLING PROGRAM THE NEXT NUMBER
C REPRESENTED BY THE CHARACTERS IN AN INPUT BUFFER READ
C BY THE CALLING PROGRAM WITH A MULTIPLE OF AN A1
C FORMAT. IF A SERIES SPECIFICATION IS ENCOUNTERED IN
C THE INPUT BUFFER, THEN THE INDIVIDUAL NUMBERS OF THE
C SERIES ARE RETURNED BY THE CALLS TO THIS ROUTINE.
C WHEN ALL OF THE NUMBERS FORMING THE SERIES HAVE BEEN
C RETURNED, THEN THE SUBSEQUENT NUMBER OR SERIES OF
C NUMBERS SPECIFIED BY THE CONTENTS OF THE BUFFER ARE
C EVALUATED.
C
C A SERIES EVALUATED BY THIS ROUTINE CAN BE WRITTEN AS
C A LOWER BOUND, INCREMENT AND UPPER BOUND SEPARATED BY
C SLASHES. IF THE INCREMENT IS TO BE ONE, THEN THE
C LOWER AND UPPER BOUNDS NEED BE SEPARATED ONLY BY A
C SINGLE SLASH. IF EITHER BOUND IS MISSING, IT IS
C ASSUMED TO BE ZERO. THE LOWER BOUND IS THE FIRST
C NUMBER OF THE SERIES REPORTED TO THE CALLING PROGRAM.
C THE SERIES CAN THEN EITHER INCREASE OR DECREASE
C DEPENDING UPON WHETHER THE UPPER BOUND IS LESS THAN,
C EQUAL TO, OR GREATER THAN THE LOWER BOUND. THE SIGN
C OF THE INCREMENT IS CHANGED IF IT DOES NOT CONFORM TO
C THE RELATIVE VALUES OF THE BOUNDS.
C
C IF THE SERIES IS TO CONSIST OF SEVERAL REPETITIONS OF
C THE SAME VALUE, THEN THE SERIES IS INSTEAD WRITTEN AS
C THE NUMBER OF TIMES THE VALUE IS TO BE USED FOLLOWED
C IMMEDIATELY BY AN ASTERISK AND THE VALUE ITSELF. THE
C VALUE TO BE REPEATED IS ASSUMED TO BE NULL IF IT IS
C MISSING.
C
C TWO VERSIONS OF THE ROUTINE ARE SUPPLIED. DANEXT CAN
C EVALUATE REAL NUMBERS AS WELL AS INTEGERS INCLUDING
C E, K AND M NOTATIONS FOR SPECIFYING EITHER OF THESE.
C IF THE CALLING PROGRAM DOES NOT OTHERWISE REFERENCE
C THE FREE FORMAT INPUT ROUTINE DAREAD, IF THE
C EVALUATION OF REAL NUMBERS IS NOT NEEDED, AND IF
C INTEGERS CAN BE SPECIFIED WITHOUT RESORTING TO THE E,
C K AND M NOTATIONS, THEN THE ROUTINE DAINXT SHOULD BE
C USED INSTEAD OF DANEXT. NUMBERS EVALUATED BY DAINXT
C MUST CONSIST ONLY OF DIGITS FOLLOWING THE OPTIONAL
C SIGN. DAINXT TREATS THE CHARACTERS ., %, K AND M THE
C SAME AS ANY OTHER DELIMITER CHARACTER.
C
C FOLLOWING ARGUMENTS ARE USED FOR INPUT ONLY AND ARE
C RETURNED UNCHANGED.
C
C IBUFFR = INPUT BUFFER ARRAY CONTAINING CHARACTERS
C TYPED BY USER, READ BY A MULTIPLE OF AN A1
C FORMAT, WHICH IS TO BE SEARCHED FOR SERIES
C SPECIFICATIONS. IBUFFR THEN CONTAINS ONE
C CHARACTER PER COMPUTER STORAGE LOCATION.
C MAXBFR = MAXIMUM SUBSCRIPT OF IBUFFR ARRAY TO BE
C SEARCHED
C
C FOLLOWING ARGUMENTS ARE USED AS BOTH INPUT AND OUTPUT
C
C LOWBFR = INPUT CONTAINING THE SUBSCRIPT WITHIN THE
C IBUFFR ARRAY OF THE FIRST (LEFTMOST)
C CHARACTER WHICH CAN BE SCANNED FOR A SERIES
C SPECIFICATION. LOWBFR IS RETURNED UNCHANGED
C IF THIS CALL TO THIS ROUTINE MERELY
C GENERATES THE NEXT MEMBER OF A SERIES BEGUN
C BY A PREVIOUS CALL. IF A NEW SERIES
C SPECIFICATION IS EVALUATED BY THIS CALL TO
C THIS ROUTINE, THEN LOWBFR WILL BE RETURNED
C POINTING TO THE NEXT CHARACTER BEYOND THE
C SERIES SPECIFICATION. IF A SECOND NUMBER
C IMMEDIATELY FOLLOWS A FIRST WITHOUT A
C SEPARATING SLASH OR ASTERISK, THEN LOWBFR
C WILL BE RETURNED POINTING TO THE FIRST
C CHARACTER OF THE SECOND NUMBER. IF EITHER A
C SPACE OR A TAB CHARACTER FOLLOWS A SERIES
C SPECIFICATION, THEN LOWBFR WILL BE RETURNED
C POINTING TO THE SPACE OR TAB CHARACTER. IF
C THERE IS NOTHING AT OR TO RIGHT OF LOWBFR,
C THEN LOWBFR WILL BE LEFT POINTING AT
C MAXBFR+1 AND KIND WILL BE RETURNED
C CONTAINING ONE. LOWBFR AND MANY MUST BE SET
C BY THE CALLING PROGRAM BEFORE ANYTHING IS
C PROCESSED IN THE CURRENT CONTENTS OF THE
C IBUFFR ARRAY, BUT THEN SHOULD NOT BE
C MODIFIED BY THE CALLING PROGRAM UNTIL THE
C ENTIRE CONTENTS OF THE IBUFFR ARRAY HAS BEEN
C PROCESSED.
C MANY = SHOULD BE INPUT CONTAINING ZERO EACH TIME
C THIS ROUTINE IS CALLED TO BEGIN PROCESSING
C OF A NEW LOGICAL SECTION OF TEXT, AS FOR
C EXAMPLE WHEN BEGINNING PROCESSING OF A LINE
C OF TEXT NOT TIED TO THE PREVIOUS LINE BY AN
C AMPERSAND AT THE END OF THE PREVIOUS LINE,
C OR WHEN PROCESSING THE TEXT TO THE RIGHT OF
C A SEMICOLON. MANY IS RETURNED SET TO ZERO
C WHENEVER AN END OF LINE (KIND=1) IS FOUND
C WHICH IS NOT TIED TO THE FOLLOWING LINE BY
C AN AMPERSAND, AND WHENEVER A SEMICOLON IS
C FOUND (KIND=2). MANY IS RETURNED INCREMENTED
C BY 1 EACH TIME A NEW SPECIFICATION OF EITHER
C A SINGLE NUMBER OR OF A SERIES IS FOUND,
C EACH TIME AN ERRONEOUS SERIES SPECIFICATION
C IS FOUND, OR EACH TIME AN INDICATION OF A
C MISSING SERIES SPECIFICATION IS FOUND. MANY
C IS RETURNED UNCHANGED IF THIS CALL TO THIS
C ROUTINE MERELY GENERATES THE NEXT MEMBER OF
C A SERIES ALREADY BEGUN BY A PREVIOUS CALL TO
C THIS ROUTINE. KIND IS RETURNED CONTAINING
C THE VALUE 3 AND MANY IS RETURNED CONTAINING
C THE NEGATIVE OF THE NUMBER OF ITEMS FOUND IF
C THE NEXT PRINTING CHARACTER FOLLOWING A
C COMMA IS AN AMPERSAND. MANY SHOULD NOT BE
C CHANGED BY THE CALLING PROGRAM IF AN
C AMPERSAND (KIND BEING RETURNED=3) IS FOUND
C INDICATING THAT THE SUBSEQUENT CALL TO THIS
C ROUTINE IS TO PROCESS TEXT WHICH IS TO BE
C TREATED AS THOUGH IT APPEARED IN PLACE OF
C THE AMPERSAND AND THE CHARACTERS TO ITS
C RIGHT. THE EFFECT IS NOT QUITE THE SAME AS
C IF THE USER HAD TYPED ALL OF THE TEXT ON A
C SINGLE LINE SINCE A SINGLE SERIES
C SPECIFICATION CANNOT BE SPLIT ACROSS THE
C LINE BOUNDARY.
C
C IF MANY IS INPUT CONTAINING ZERO, THEN AN
C INITIAL COMMA IN THE INPUT TEXT BUFFER IS
C TAKEN TO INDICATE AN INITIAL MISSING ITEM,
C AND MANY IS THEN RETURNED CONTAINING 1. IF
C MANY IS INPUT GREATER THAN ZERO, THEN AN
C INITIAL COMMA IS IGNORED IF FOLLOWED BY A
C SERIES SPECIFICATION. IF MANY IS INPUT
C GREATER THAN ZERO, THEN AN INITIAL COMMA
C FOLLOWED BY NO OTHER PRINTING CHARACTERS, BY
C A SEMICOLON, OR BY AN EXCLAMATION POINT
C INDICATES A MISSING ITEM. IF MANY IS INPUT
C GREATER THAN ZERO, THEN AN INITIAL COMMA
C FOLLOWED BY AN AMPERSAND WILL CAUSE THE
C REMAINING CHARACTERS IN THE BUFFER TO BE
C IGNORED, AND MANY WILL BE RETURNED
C CONTAINING THE NEGATIVE OF ITS INPUT VALUE.
C IF MANY IS INPUT NEGATIVE, THEN IT IS
C ASSUMED THAT THE CONTENTS OF THE CURRENT
C BUFFER CONTINUE A PREVIOUS LINE WHICH
C TERMINATED WITH A COMMA FOLLOWED BY AN
C AMPERSAND, AND MANY IS RETURNED GREATER THAN
C ZERO.
C KIND = SHOULD BE INPUT CONTAINING ZERO THE FIRST
C TIME THIS ROUTINE IS CALLED, OR TO ABANDON
C GENERATATION OF VALUES WITHIN A PARTICULAR
C SERIES. KIND IS RETURNED DESCRIBING THE
C KIND OF ITEM LOCATED IN THE IBUFFR ARRAY.
C = 1, NOTHING, EXCEPT PERHAPS COMMENT INDICATED
C BY A LEADING EXCLAMATION POINT, WAS FOUND AT
C OR TO RIGHT OF LOWBFR. THE CALLING PROGRAM
C SHOULD READ A NEW LINE INTO IBUFFR. MANY IS
C RETURNED SET TO ZERO.
C = 2, A SEMICOLON WAS FOUND AS THE FIRST
C PRINTING CHARACTER AT OR TO THE RIGHT OF
C LOWBFR. LOWBFR IS RETURNED POINTING TO THE
C NEXT CHARACTER BEYOND THE LOCATION OF THE
C SEMICOLON. IT IS ASSUMED THE CALLING
C PROGRAM WILL TREAT THE APPEARANCE OF THE
C SEMICOLON AS MARKING THE END OF A STATEMENT.
C MANY IS RETURNED SET TO ZERO.
C = 3, AN AMPERSAND WAS FOUND AS THE FIRST
C PRINTING CHARACTER AT OR TO THE RIGHT OF
C LOWBFR. THE TEXT TO THE RIGHT OF THE
C AMPERSAND IS TAKEN AS A COMMENT SO LOWBFR IS
C RETURNED POINTING BEYOND THE RIGHT END OF
C THE BUFFER. IT IS ASSUMED THAT THE CALLING
C PROGRAM WILL READ IN THE CONTENTS OF A NEW
C BUFFER, THEN AGAIN REQUEST A NEW SERIES
C EVALUATION FROM THIS ROUTINE. THE VALUE OF
C MANY MUST NOT BE CHANGED BY CALLING PROGRAM
C PRIOR TO THIS FOLLOWING CALL. THE EFFECT IS
C NOT QUITE THE SAME AS IF THE USER HAD TYPED
C ALL OF THE TEXT ON A SINGLE LINE SINCE A
C SERIES SPECIFICATION CANNOT BE SPLIT ACROSS
C A LINE BOUNDARY.
C = 4, A NUMBER OR SERIES SPECIFICATION WAS NOT
C FOUND, BUT A COMMA WAS FOUND INDICATING
C A MISSING SERIES SPECIFICATION. NEWVAL IS
C SET TO ZERO SO KIND=4 CAN BE CONSIDERED
C EQUIVALENT TO KIND=5 IF SUCH IS APPROPRIATE
C TO THE APPLICATION FOR WHICH THIS ROUTINE IS
C BEING USED.
C = 5, THE NEXT NUMBER SPECIFIED BY THE CONTENTS
C OF THE INPUT BUFFER IS BEING RETURNED AS THE
C VALUE OF NEWVAL.
C = 6, A SERIES WAS SPECIFIED IN ASTERISK
C NOTATION, BUT NO NUMBER APPEARED TO RIGHT OF
C ASTERISK. NEWVAL IS RETURNED SET TO ZERO.
C NOTE THAT IF A NUMBER DOES NOT PRECEDE THE
C ASTERISK, THEN KIND IS RETURNED WITH THE
C VALUE 7 WHETHER OR NOT A NUMBER FOLLOWS THE
C ASTERISK.
C = 7, A SERIES WAS SPECIFIED IN ASTERISK
C NOTATION, BUT NO NUMBER APPEARED TO THE LEFT
C OF THE ASTERISK OR THE NUMBER TO LEFT OF THE
C ASTERISK WAS LESS THAN 1. A NUMBER MAY OR
C MAY NOT HAVE APPEARED TO RIGHT OF ASTERISK.
C = 8, A SERIES SPECIFICATION WAS FOUND WHICH
C CONTAINED TOO MANY NUMBERS, TOO MANY
C ASTERISKS OR TOO MANY SLASHES.
C = 9, FIRST PRINTING CHARACTER IN OR TO RIGHT
C OF LOWBFR WAS NOT A CHARACTER WHICH COULD
C APPEAR IN A NUMBER OR NUMBER RANGE, AND WAS
C NOT A COMMA, SEMICOLON OR EXCLAMATION POINT.
C LOWBFR IS RETURNED POINTING TO THE NEXT
C CHARACTER BEYOND THIS CHARACTER.
C
C FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT
C
C NEWVAL = RETURNED CONTAINING NEXT NUMBER SPECIFIED
C BY INPUT BUFFER.
C
C INCVAL AND LMTVAL MUST BE PRESERVED FROM ONE CALL TO
C NEXT BUT NOT USED BY CALLING PROGRAM
C
DIMENSION IBUFFR(MAXBFR)
C
IF(KIND.EQ.6)GO TO 2
IF(KIND.NE.5)GO TO 3
IF(INCVAL.EQ.0)GO TO 2
C
C GET NEXT NUMBER EXPRESSED IN SLASH NOTATION
NEWVAL=NEWVAL+INCVAL
IF(INCVAL.GT.0)GO TO 1
IF(NEWVAL.GE.LMTVAL)GO TO 11
GO TO 3
1 IF(NEWVAL.LE.LMTVAL)GO TO 11
GO TO 3
C
C GET NEXT NUMBER EXPRESSED IN ASTERISK NOTATION
2 LMTVAL=LMTVAL-1
IF(LMTVAL.GT.0)GO TO 11
C
C GET NEW RANGE SPECIFICATION
3 CALL DAISPN(-1,IBUFFR,MAXBFR,LOWBFR,
1MANY,KIND,INIGOT,INCGOT,LMTGOT,NEWVAL,INCVAL,
2LMTVAL)
GO TO(5,5,5,5,6,6,7,10,4,4),KIND
C
C INCORRECT SPECIFICATION
4 KIND=KIND-1
C
C SINGLE NUMBER WITHOUT SLASH OR ASTERISK
5 NEWVAL=0
6 INCVAL=0
LMTVAL=0
GO TO 11
C
C SERIES CONTAINING SLASH
7 KIND=5
IF(INIGOT.LE.0)NEWVAL=0
IF(INCGOT.LE.0)INCVAL=1
IF(INCVAL.EQ.0)INCVAL=1
IF(LMTGOT.LE.0)LMTVAL=0
IF(NEWVAL.GT.LMTVAL)GO TO 8
IF(INCVAL.GT.0)GO TO 11
GO TO 9
8 IF(INCVAL.LT.0)GO TO 11
9 INCVAL=-INCVAL
GO TO 11
C
C SERIES CONTAINING ASTERISK
10 KIND=5
IF(LMTGOT.LE.0)KIND=6
IF(INIGOT.LE.0)NEWVAL=0
IF(NEWVAL.LE.0)KIND=7
IF(LMTGOT.LE.0)LMTVAL=0
INCVAL=NEWVAL
NEWVAL=LMTVAL
LMTVAL=INCVAL
INCVAL=0
C
C RETURN TO CALLING PROGRAM
11 RETURN
C287488307054
END