Trailing-Edge
-
PDP-10 Archives
-
decus_20tap5_198111
-
decus/20-0141/dahest.for
There are 2 other files named dahest.for in the archive. Click here to see a list.
SUBROUTINE DAHEST(KMDTYP,LSTTYP,NAMLOW,NAMMAX,MRKLOW,
1 MRKMAX,NUMLOW,NUMMAX,INTRVL,LOWWRD,MAXWRD,IWORD ,
2 LOWKNT,MAXKNT,KNTLTR,LEGAL ,MAXBFR,IBUFFR,LOWBFR,
3 KIND ,KOMAND,LCNWRD,LCNKNT,INIPRT,MIDPRT,LMTPRT,
4 NAMKNT,NAMLFT,NAMRIT,MRKKNT,MRKLFT,MRKRIT,NUMKNT,
5 NUMSIN,NUMVAL,VALNUM,IFLOAT)
C RENBR(/PARSER OF SIMPLE COMMANDS)
C
C DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C DAHEST AND DAIHST INTERPRET SIMPLE COMMANDS TYPED BY
C THE USER AND READ INTO A BUFFER ARRAY WITH A MULTIPLE
C OF AN A1 FORMAT. THE COMMANDS CONSIST OF A COMMAND
C WORD, OR UNIQUE ABREVIATION THEREOF, FOLLOWED BY AN
C ARGUMENT LIST FORMED OF NUMBERS, ALPHABETIC WORDS AND
C QUOTED TEXT STRINGS. THE LINE OF TEXT BEING
C EVALUATED CAN CONTAIN SEVERAL STATEMENTS IF THESE
C STATEMENTS ARE SEPARATED BY THE SEMICOLON CHARACTER.
C THE BUFFER CAN ALSO CONTAIN A COMMENT INDICATED BY AN
C EXCLAMATION POINT TO THE LEFT OF THE COMMENT.
C
C DAHEST OR DAIHST IS CALLED ONCE TO EVALUATE EACH
C STATEMENT. THE CALLING PROGRAM INDICATES TO THE
C ROUTINE THE POSITION IN THE BUFFER OF THE LEFTMOST
C CHARACTER WHICH HAS NOT YET BEEN EVALUATED. THE
C ROUTINE MOVES THIS POINTER THROUGH THE BUFFER AND
C RETURNS IT TO THE CALLING PROGRAM SPECIFYING THE
C LEFTMOST CHARACTER TO BE EVALUATED BY THE NEXT CALL
C TO THE ROUTINE. AFTER THIS ROUTINE HAS FINALLY
C INDICATED THAT NOTHING MORE REMAINS TO BE PROCESSED
C IN THE LINE OF TEXT CONTAINED IN THE BUFFER, THEN THE
C CALLING PROGRAM MUST READ ANOTHER LINE WHICH IS TO BE
C INTERPRETED, AND MUST RESET THE POINTER TO INDICATE
C THE START OF THE BUFFER BEFORE THE NEXT CALL TO THE
C ROUTINE.
C
C DAHEST CAN EVALUATE BOTH REAL NUMBERS AND INTEGERS.
C EITHER FORM CAN BE SPECIFIED IN FLOATING POINT FORMAT
C WITH FOLLOWING E EXPONENT OR WITH FOLLOWING %, K OR M
C TO INDICATE E-2, E3 AND E6 RESPECTIVELY. IF THE
C PROGRAM WHICH CALLS DAHEST DOES NOT REQUIRE THE
C EVALUATION OF REAL NUMBERS AND DOES NOT OTHERWISE
C CALL DAHEFT, AND IF THE SPECIFICATION OF INTEGERS IN
C EXPONENT FORM IS NOT NECESSARY, THEN THE ROUTINE
C DAIHST SHOULD BE CALLED INSTEAD OF DAHEST. ALTHOUGH
C THE ROUTINES ARE OF APPROXIMATELY THE SAME LENGTH,
C DAIHST DOES NOT CALL DAHEFT FOR NUMERIC EVALUATION.
C NUMBERS EVALUATED BY DAIHST MUST CONSIST ONLY OF
C DIGITS FOLLOWING THE OPTIONAL SIGN. NUMBERS CAN BE
C SEPARATED BY SLASHES (OR BY COLONS, THESE TWO
C CHARACTERS BEING EQUIVALENT) IF THEY ARE TO BE
C ASSOCIATED IN SOME MANNER, SUCH AS SPECIFYING A RANGE
C AND INCREMENT. BOTH THE SIGN AND THE SIGNED VALUE
C ARE RETURNED TO THE CALLING PROGRAM.
C
C TEXT STRINGS ARE PRECEDED AND FOLLOWED BY THE
C APOSTROPHE. IF AN APOSTROPHE MUST APPEAR IN THE TEXT
C STRING ITSELF, THEN AN EXTRA APPEARANCE OF THE
C APOSTROPHE MUST PRECEDE THE ONE WHICH IS TO BE
C TREATED MERELY AS TEXT. THE LOCATIONS OF THE START
C AND END OF THE TEXT INSIDE THE DELIMITING APOSTROPHES
C ARE RETURNED TO THE CALLING PROGRAM, AND THE EXTRA
C APOSTROPHES WITHIN THE TEXT STRING ARE EXPUNGED FROM
C THE INPUT BUFFER.
C
C TEXT STRINGS CAN ALSO BE DELIMITED BY PARENTHESES.
C IF THE TEXT STRING STARTS WITH A LEADING LEFT
C PARENTHESIS, THEN IT WILL BE TERMINATED BY A MATCHING
C TRAILING RIGHT PARENTHESIS. IF THE TEXT STRING
C STARTS WITH A LEADING RIGHT PARENTHESIS, THEN IT WILL
C BE TERMINATED BY A MATCHING TRAILING LEFT
C PARENTHESIS. WITHIN THE PARENTHESES, AN APOSTROPHE
C CAN APPEAR IN FRONT OF ANY CHARACTER, INCLUDING A
C PARENTHESIS OR ANOTHER APOSTROPHE, TO INDICATE THAT
C THIS FOLLOWING CHARACTER IS TO HAVE NO SPECIAL
C MEANING. IF FOUND, THE APOSTROPHE IS LEFT IN THE
C TEXT STRING. IF THE TYPE OF TEXT STRING HAS MEANING
C TO THE PROGRAM, THEN THE PROGRAM SHOULD TEST THE
C CHARACTER WHICH IS IMMEDIATELY TO THE LEFT OF THE
C CONTENTS OF THE TEXT STRING TO DETERIMINE WHETHER
C THIS IS AN APOSTROPHE OR A LEFT OR A RIGHT
C PARENTHESIS.
C
C A WORD APPEARING AS AN ARGUMENT OF A COMMAND MUST
C BEGIN WITH A CHARACTER WHICH CANNOT START A NUMBER
C AND WHICH IS NOT ONE OF THE DELIMITER CHARACTERS SUCH
C AS THE SPACE, TAB, SLASH, COLON, SEMICOLON,
C EXCLAMATION POINT, COMMA OR APOSTROPHE. DIGITS CAN
C APPEAR ANYWHERE TO THE RIGHT OF THE LEADING CHARACTER
C OF THE WORD, BUT THE OTHER PROHIBITED CHARACTERS
C WILL, IF ENCOUNTERED, TERMINATE THE WORD. THE
C LOCATIONS OF THE START AND END OF THE WORD ARE
C RETURNED TO THE CALLING PROGRAM.
C
C ONE, BUT ONLY ONE, OF THE THREE TYPES OF ARGUMENTS
C CAN BE USED MORE THAN ONCE AS AN ARGUMENT. IF THE
C TYPE OF ARGUMENT WHICH CAN BE REPEATED IS SPECIFIED
C BEFORE THE FIRST ARGUMENT IS FOUND, EITHER BEING THE
C SAME FOR ALL COMMANDS, OR ELSE BEING SPECIFIED
C SEPARATELY IN THE DICTIONARY FOR EACH COMMAND, THEN
C ARGUMENTS OF THE OTHER TWO TYPES CAN APPEAR AT MOST
C ONCE IN THE ARGUMENT LIST. IF THE REPEATABLE TYPE IS
C WORD OR TEXT STRING, THEN A SET OF NUMBERS INDICATING
C A RANGE CAN STILL BE SUPPLIED. IF THE REPEATABLE
C TYPE IS NUMERIC, THEN MORE THAN ONE SET OF NUMBERS
C INDICATING RANGES WILL BE ACCEPTED. ALTERNATIVELY,
C THE TYPE OF ARGUMENT WHICH CAN BE REPEATED CAN BE THE
C TYPE OF THE FIRST ARGUMENT ENCOUNTERED, IN WHICH CASE
C ARGUMENTS OF THE OTHER TWO TYPES ARE NOT ALLOWED IN
C THE ARGUMENT LIST.
C
C ANY NUMBER OF SPACES AND/OR TAB CHARACTERS CAN APPEAR
C BEFORE THE COMMAND WORD AND BETWEEN THE COMMAND WORD
C AND ITS FIRST ARGUMENT. SUCCESSIVE ARGUMENTS CAN BE
C SEPARATED BY A SINGLE COMMA AND/OR BY ANY NUMBER OF
C SPACES AND/OR TAB CHARACTERS. NO SEPARATING
C CHARACTERS ARE NECESSARY IF THE LEADING CHARACTER OF
C AN ARGUMENT INDICATES THAT IT CANNOT CONTINUE THE
C PRECEDING COMMAND WORD OR PRECEDING ARGUMENT. A
C SINGLE COMMA APPEARING BETWEEN 2 ARGUMENTS OF EITHER
C THE SAME OR OF DIFFERENT TYPES MERELY INDICATES THE
C SEPARATION BETWEEN THE ARGUMENTS, AND IS ENTIRELY
C EQUIVALENT TO ONE OR MORE SPACES AND/OR TAB
C CHARACTERS. TWO COMMAS, POSSIBLY SEPARATED BY SPACES
C AND/OR BY TAB CHARACTERS, INDICATE A MISSING ARGUMENT
C OF THE REPEATABLE TYPE. A COMMA BETWEEN THE COMMAND
C WORD AND THE FIRST ARGUMENT IS TAKEN TO INDICATE THAT
C THE FIRST ARGUMENT OF THE REPEATABLE TYPE IS MISSING.
C FOR EXAMPLE, IN THE STATEMENTS
C
C OPAQUE'=',,'*';INVISIBLE,'$'
C
C THE QUOTED TEXT CHARACTER * IS THE THIRD ARGUMENT OF
C THE COMMAND WORD OPAQUE, THE SECOND ARGUMENT BEING
C MISSING, AND THE QUOTED TEXT CHARACTER $ IS THE
C SECOND ARGUMENT OF THE COMMAND WORD INVISIBLE, THE
C FIRST ARGUMENT BEING MISSING.
C
C THE ARGUMENTS OF THE REPEATABLE TYPE ARE RETURNED TO
C THE CALLING PROGRAM IN THE ORDER IN WHICH THEY APPEAR
C IN THE STATEMENT, AND, IN PARTICULAR, THE CALLING
C PROGRAM IS ABLE TO DETERMINE WHETHER ANY ARE MISSING.
C NO INFORMATION REGARDING ORDERING BETWEEN ARGUMENTS
C OF DIFFERENT TYPES IS RETURNED TO THE CALLING
C PROGRAM.
C
C FOLLOWING ARGUMENTS ARE USED FOR INPUT ONLY, AND ARE
C RETURNED UNCHANGED.
C
C KMDTYP = 0, STATEMENT MUST START WITH COMMAND WORD.
C = 1, STATEMENT CAN START WITH COMMAND WORD OR
C INTEGER. IF INTEGER IS FOUND, RETURN VALUE
C AS NUMVAL AND LOCATIONS OF LEFT AND RIGHT
C ENDS OF FOLLOWING TEXT AS MIDPRT AND LMTPRT.
C = 2, STATEMENT CAN START WITH COMMAND WORD OR
C REAL NUMBER. IF REAL NUMBER IS FOUND,
C RETURN VALUE AS VALNUM AND LOCATIONS OF LEFT
C AND RIGHT ENDS OF FOLLOWING TEXT AS MIDPRT
C AND LMTPRT.
C = -1, DO NOT LOOK FOR COMMAND WORD. CONTENTS
C OF STATEMENT ARE EVALUATED AS ARGUMENT LIST
C OF TYPE INDICATED BY LSTTYP.
C LSTTYP = SPECIFIES TYPE OF ARGUMENT WHICH CAN APPEAR
C MORE THAN ONCE IN ARGUMENT LIST.
C = -1, TYPE OF ARGUMENT LIST IS SPECIFIED FOR
C EACH COMMAND BY LEGAL ARRAY VALUE PARALLEL
C TO CHARACTER COUNT IN KNTLTR ARRAY.
C = 0, NO ARGUMENTS ARE ALLOWED.
C = 1, TYPE OF ARGUMENT WHICH CAN BE REPEATED IS
C TYPE OF FIRST ARGUMENT ENCOUNTERED, WHETHER
C OR NOT THIS IS PRECEDED BY COMMAS. COMMAS
C DO, HOWEVER, INDICATE MISSING ARGUMENTS OF
C SAME TYPE AS THAT EVENTUALLY FOUND.
C ADDITIONAL ARGUMENTS OF TYPES OTHER THAN
C THAT OF FIRST ARGUMENT ENCOUNTERED ARE NOT
C ALLOWED. IF AN ADDITIONAL ARGUMENT OF
C ANOTHER TYPE IS FOUND, THEN EVALUATION OF
C ARGUMENT LIST WILL BE TERMINATED EXCEPT
C INSOFAR AS IS NECESSARY TO DETECT END OF
C STATEMENT, AND KIND WILL BE RETURNED
C CONTAINING ONE OF VALUES 8, 9 OR 10
C INDICATING TYPE OF ILLEGAL ARGUMENT. IF A
C SET OF NUMBERS IS FOUND, IT IS EVALUATED AS
C A SET OF INTEGERS.
C = 2, ALLOW SERIES OF WORDS. TEXT STRING OR
C SET OF INTEGERS CAN APPEAR AT MOST ONCE.
C = 3, ALLOW SERIES OF SETS OF INTEGERS. TEXT
C STRING OR WORD CAN APPEAR AT MOST ONCE.
C = 4, ALLOW SERIES OF TEXT STRINGS. WORD OR
C SET OF INTEGERS CAN APPEAR AT MOST ONCE.
C = 5, 6, 7 AND 8, SAME AS LSTTYP VALUES OF 1,
C 2, 3 AND 4 RESPECTIVELY, EXCEPT THAT IF A
C NUMBER IS FOUND, IT IS EVALUATED AS REAL
C NUMBER AND ITS VALUE IS RETURNED IN VALNUM
C ARRAY, RATHER THAN IN NUMVAL ARRAY.
C = 9, ONLY TYPE OF ARGUMENT ACCEPTED WILL BE
C PARENTHETICAL TEXT STRINGS, NOT TEXT STRINGS
C DELIMITED BY APOSTROPHES. PRINTING
C CHARACTERS IMMEDIATELY TO LEFT OF
C PARENTHETICAL EXPRESSION WILL BE TAKEN TO BE
C PART OF THAT EXPRESSION, AND MRKLFT WILL
C POINT TO LEFTMOST OF THESE. UNLIKE TEXT
C STRINGS ALLOWED BY ANY OTHER VALUE OF
C LSTTYP, LEADING PARENTHESIS IS POINTED TO BY
C MRKLFT IF NO PRINTING CHARACTERS APPEAR TO
C ITS LEFT. MRKRIT WILL STILL BE RETURNED
C POINTING TO CHARACTER TO LEFT OF TRAILING
C PARENTHESIS.
C NAMLOW = SUBSCRIPT OF NAMLFT AND NAMRIT ARRAY
C LOCATIONS TO BE RETURNED WITH DESCRIPTION OF
C FIRST WORD IN ARGUMENT LIST.
C NAMMAX = MAXIMUM SUBSCRIPT OF NAMLFT AND NAMRIT
C ARRAYS.
C MRKLOW = SUBSCRIPT OF MRKLFT AND MRKRIT ARRAY
C LOCATIONS TO BE RETURNED WITH DESCRIPTION OF
C FIRST TEXT STRING IN ARGUMENT LIST.
C MRKMAX = MAXIMUM SUBSCRIPT OF MRKLFT AND MRKRIT
C ARRAYS.
C NUMLOW = SUBSCRIPT OF NUMSIN, NUMVAL AND VALNUM ARRAY
C LOCATIONS TO BE RETURNED WITH DESCRIPTION OF
C FIRST NUMBER IN ARGUMENT LIST.
C NUMMAX = MAXIMUM SUBSCRIPT OF NUMSIN, NUMVAL AND
C VALNUM ARRAYS.
C INTRVL = MAXIMUM NUMBER OF NUMBERS IN SET OF NUMBERS
C SEPARATED BY SLASHES. IF 2 NUMERIC
C ARGUMENTS ARE SEPARATED BY SOMETHING OTHER
C THAN SLASH, THEN THESE ARGUMENTS ARE PART OF
C SERIES OF SETS OF NUMBERS, AND DESCRIPTION
C OF SECOND NUMBER IS PLACED INTO NUMSIN,
C NUMVAL AND VALNUM ARRAYS AT LOCATION HAVING
C SUBSCRIPT GREATER BY VALUE OF INTRVL THAN
C SUBSCRIPT OF LOCATION INTO WHICH WAS PLACED
C DESCRIPTION OF FIRST NUMBER OF PREVIOUS SET.
C LOWWRD = SUBSCRIPT OF LOCATION IN IWORD ARRAY WHICH
C CONTAINS 1ST LETTER OF 1ST WORD. NOTE THAT
C IF KNTLTR(LOWKNT) IS NEGATIVE, THEN THE 1ST
C LETTER OF 1ST WORD WILL BE FOUND IN ARRAY
C LOCATION IWORD(LOWWRD-KNTLTR(LOWKNT)).
C MAXWRD = DIMENSION OF IWORD ARRAY.
C IWORD = DICTIONARY ARRAY CONTAINING CHARACTERS OF
C COMMAND WORDS WHICH ARE TO BE RECOGNIZED, 1
C CHARACTER PER ARRAY LOCATION AS READ BY A1
C FORMAT OR ELSE DEFINED BY 1H FIELD. COMMAND
C WORD IN INPUT BUFFR ARRAY IBUFFR CAN BE
C SPLIT INTO 2 OR MORE PORTIONS SEPARATED BY
C SPACES AND/OR TABS AND WILL BE MATCHED
C WHETHER OR NOT SPACES OR TABS ARE PRESENT IF
C WORD IN IWORD CONTAINS A SINGLE SPACE AT
C LOCATION AT WHICH SPLIT IS ALLOWED. IN
C ORDER TO OBTAIN A MATCH, CASES OF CHARACTERS
C IN DICTIONARY AND IN INPUT BUFFER MUST BE
C IDENTICAL. NOTE ALSO, THAT LETTERS E, M AND
C K USED WITHIN NUMBERS TO INDICATE EXPONENTS
C MUST BE IN UPPER CASE IN INPUT BUFFER IN
C ORDER TO BE RECOGNIZED.
C LOWKNT = SUBSCRIPT OF KNTLTR ARRAY CONTAINING LENGTH
C OF FIRST WORD WHICH CAN BE MATCHED IN IWORD
C ARRAY. THIS FIRST WORD WILL START AT
C IWORD(LOWWRD).
C MAXKNT = SUBSCRIPT OF KNTLTR ARRAY CONTAINING LENGTH
C OF FINAL WORD WHICH CAN BE MATCHED IN IWORD
C ARRAY.
C KNTLTR = ARRAY CONTAINING NUMBERS OF CHARACTERS IN
C WORDS IN IWORD ARRAY. ZERO OR NEGATIVE
C VALUE IN KNTLTR ARRAY OFFSETS NEXT POSSIBLE
C WORD WHICH CAN BE MATCHED IN IWORD ARRAY BY
C NUMBER OF LETTERS GIVEN BY ABSOLUTE VALUE OF
C NEGATIVE NUMBER IN KNTLTR ARRAY. DIMENSION
C OF KNTLTR MUST BE AT LEAST MAXKNT. FOR
C EXAMPLE TO RECOGNIZE WORDS
C
C YES, NO, MAYBE
C
C CONTENTS OF IWORD ARRAY WOULD BE
C
C 1HY,1HE,1HS,1HN,1HO,1HM,1HA,1HY,1HB,1HE
C
C AND CONTENTS OF KNTLTR ARRAY WOULD BE
C
C 3,2,5
C
C LEGAL = IF LSTTYP=-1, THEN LEGAL IS ARRAY SPECIFYING
C FOR EACH POSSIBLE COMMAND WORD THE TYPE OF
C NUMERIC ARGUMENTS, REAL OR INTEGER, WITH CAN
C BE EVALUATED, AND TYPE OF ARGUMENT, WORD OR
C SET OF NUMBERS OR TEXT STRING, WHICH CAN BE
C PRESENT MORE THAN ONCE IN ARGUMENT LIST.
C TYPE OF ARGUMENT LIST IS AT SAME SUBSCRIPT
C IN LEGAL ARRAY AS CHARACTER COUNT IN KNTLTR
C ARRAY. IF LSTTYP IS GREATER THAN OR EQUAL
C TO ZERO, THEN CONTENTS OF LEGAL ARRAY ARE
C IGNORED.
C = 0, NO ARGUMENTS ARE ALLOWED.
C = 1, TYPE OF ARGUMENT WHICH CAN BE REPEATED IS
C TYPE OF FIRST ARGUMENT ENCOUNTERED, WHETHER
C OR NOT THIS IS PRECEDED BY COMMAS. COMMAS
C DO, HOWEVER, INDICATE MISSING ARGUMENTS OF
C SAME TYPE AS THAT EVENTUALLY FOUND.
C ADDITIONAL ARGUMENTS OF TYPES OTHER THAN
C THAT OF FIRST ARGUMENT ENCOUNTERED ARE NOT
C ALLOWED. IF AN ADDITIONAL ARGUMENT OF
C ANOTHER TYPE IS FOUND, THEN EVALUATION OF
C ARGUMENT LIST WILL BE TERMINATED EXCEPT
C INSOFAR AS IS NECESSARY TO DETECT END OF
C STATEMENT, AND KIND WILL BE RETURNED
C CONTAINING ONE OF VALUES 8, 9 OR 10
C INDICATING TYPE OF ILLEGAL ARGUMENT. IF A
C SET OF NUMBERS IS FOUND, IT IS EVALUATED AS
C A SET OF INTEGERS.
C = 2, ALLOW SERIES OF WORDS. TEXT STRING OR
C SET OF INTEGERS CAN APPEAR AT MOST ONCE.
C = 3, ALLOW SERIES OF SETS OF INTEGERS. TEXT
C STRING OR WORD CAN APPEAR AT MOST ONCE.
C = 4, ALLOW SERIES OF TEXT STRINGS. WORD OR
C SET OF INTEGERS CAN APPEAR AT MOST ONCE.
C = 5, 6, 7 AND 8, SAME AS LEGAL ARRAY VALUES OF
C 1, 2, 3 AND 4 RESPECTIVELY, EXCEPT THAT IF
C NUMBER IS FOUND, IT IS EVALUATED AS REAL
C NUMBER AND ITS VALUE IS RETURNED IN VALNUM
C ARRAY, RATHER THAN IN NUMVAL ARRAY.
C = 9, ONLY TYPE OF ARGUMENT ACCEPTED WILL BE
C PARENTHETICAL TEXT STRINGS, NOT TEXT STRINGS
C DELIMITED BY APOSTROPHES. PRINTING
C CHARACTERS IMMEDIATELY TO LEFT OF
C PARENTHETICAL EXPRESSION WILL BE TAKEN TO BE
C PART OF THAT EXPRESSION, AND MRKLFT WILL
C POINT TO LEFTMOST OF THESE. UNLIKE TEXT
C STRINGS ALLOWED BY ANY OTHER VALUE OF
C LEGAL, LEADING PARENTHESIS IS POINTED TO BY
C MRKLFT IF NO PRINTING CHARACTERS APPEAR TO
C ITS LEFT. MRKRIT WILL STILL BE RETURNED
C POINTING TO CHARACTER TO LEFT OF TRAILING
C PARENTHESIS.
C MAXBFR = SUBSCRIPT OF IBUFFR ARRAY LOCATION
C CONTAINING RIGHTMOST CHARACTER IN CURRENT
C LINE.
C
C FOLLOWING ARGUMENTS ARE USED FOR BOTH INPUT AND
C OUTPUT.
C
C IBUFFR = INPUT BUFFER ARRAY CONTAINING CHARACTERS OF
C LINE BEING INTERPRETED, ONE CHARACTER PER
C ARRAY LOCATION, AS READ BY MULTIPLE OF A1
C FORMAT. IF QUOTED TEXT STRING ITSELF
C CONTAINING APOSTROPHES IS FOUND IN IBUFFR
C ARRAY, THEN EXTRA APOSTROPHES NEEDED TO MARK
C APOSTROPHES TO REMAIN IN TEXT ARE REMOVED BY
C SHIFTING TO LEFT TEXT TO THEIR RIGHT.
C LOWBFR = SUBSCRIPT IN IBUFFR ARRAY OF FIRST CHARACTER
C TO BE INTERPRETED. LOWBFR IS RETURNED
C POINTING TO FIRST CHARACTER BEYOND
C INTERPRETED STATEMENT. IF SEMICOLON APPEARS
C AT END OF STATEMENT, THEN LOWBFR IS RETURNED
C POINTING TO SEMICOLON AND WILL BE ADVANCED
C BEYOND SEMICOLON BY SUBSEQUENT CALL TO THIS
C ROUTINE. IF EXCLAMATION POINT APPEARS AT
C END OF STATEMENT, OR IF THERE ARE NO MORE
C PRINTING CHARACTERS TO RIGHT OF STATEMENT,
C THEN LOWBFR IS RETURNED CONTAINING MAXBFR+1.
C KIND = MUST BE SET TO ZERO BY CALLING PROGRAM
C BEFORE THIS ROUTINE IS FIRST CALLED TO
C EVALUATE LINE OF TEXT. KIND IS THEN
C RETURNED DESCRIBING TYPE OF STATEMENT WHICH
C WAS EVALUATED. CALLING PROGRAM SHOULD RESET
C KIND TO HAVE VALUE ZERO IF EVALUATION OF
C CONTENTS OF LINE OF TEXT IS BEING ABANDONED
C BY CALLING PROGRAM BEFORE THIS ROUTINE HAS
C INDICATED BY RETURNING KIND=1 THAT IT HAS
C COMPLETED EVALUATION OF LINE OF TEXT.
C EXCEPT FOR THIS INSTANCE IN WHICH
C INTERPRETATION IS BEING ABANDONED BY CALLING
C PROGRAM, VALUE OF KIND IS OTHERWISE PASSED
C UNCHANGED TO SUBSEQUENT CALL TO THIS
C ROUTINE.
C = 1, (PROCESSING COMPLETED) RETURNED IF
C PREVIOUS CALLS TO THIS ROUTINE HAVE
C COMPLETED EVALUATION OF CONTENTS OF LINE OF
C TEXT. CALLING PROGRAM SHOULD READ NEW LINE
C OF TEXT AND RESET LOWBFR TO POINT TO FIRST
C CHARACTER IN NEW TEXT.
C = 2, (EMPTY STATEMENT) RETURNED IF ORIGINAL
C LINE OF TEXT CONTAINED NO PRINTING
C CHARACTERS OR CONTAINED LEADING EXCLAMATION
C POINT INDICATING THAT CHARACTERS TO ITS
C RIGHT FORMED COMMENT. KIND IS ALSO RETURNED
C SET TO 2 IF EXTRA SEMICOLON INDICATES
C MISSING STATEMENT.
C = 3, (CORRECT STATEMENT) RETURNED IF STATEMENT
C WAS NOT EMPTY AND WAS EVALUATED WITHOUT
C ERRORS. IF KMDTYP IS GREATER THAN OR EQUAL
C TO ZERO, THEN KNOWN COMMAND WORD, OR ELSE
C NONAMBIGUOUS ABBREVIATION THEREOF, WAS FOUND
C AND SEQUENCE NUMBER OF THIS COMMAND WORD
C WITHIN DICTIONARY IS RETURNED AS VALUE OF
C KOMAND. IF KMDTYP IS LESS THAN ZERO, THEN
C KOMAND IS RETURNED WITH VALUE ZERO, AND
C STATEMENT CONTAINED AT LEAST COMMA, SLASH,
C COLON OR ARGUMENT.
C = 4, (INITIAL NUMBER) RETURNED IF KMDTYP IS
C GREATER THAN ZERO, AND IF NUMBER WAS FOUND
C AT START OF STATEMENT. MIDPRT IS RETURNED
C CONTAINING SUBSCRIPT WITHIN IBUFFR ARRAY OF
C CHARACTER TO IMMEDIATE RIGHT OF NUMBER.
C LMTPRT IS RETURNED CONTAINING SUBSCRIPT
C WITHIN IBUFFR ARRAY OF RIGHTMOST PRINTING
C CHARACTER WITHIN IBUFFR ARRAY.
C = 5, (MISSING COMMAND) RETURNED IF COMMAND
C WORD OR ELSE LEADING NUMBER WAS REQUIRED BUT
C NOT FOUND, BUT STATEMENT IS NOT EMPTY. NO
C ARGUMENT DESCRIPTIONS ARE RETURNED TO
C CALLING PROGRAM.
C = 6, (UNKNOWN COMMAND) RETURNED IF INITIAL
C COMMAND WORD WAS REQUIRED, BUT STATEMENT
C STARTS WITH SEQUENCE OF PRINTING CHARACTERS
C WHICH COULD FORM COMMAND WORD, BUT WHICH DO
C NOT MATCH WORD IN DICTIONARY, OR WHICH FORM
C AMBIGUOUS ABBREVIATION OF 2 OR MORE WORDS IN
C DICTIONARY, OR WHICH DO MATCH SINGLE WORD IN
C DICTIONARY BUT ARE FOLLOWED IMMEDIATELY BY
C ADDITIONAL ALPHABETIC CHARACTERS OR DIGITS.
C INIPRT AND MIDPRT ARE RETURNED POINTING TO
C LEFTMOST AND RIGHTMOST CHARACTERS IN THIS
C UNKNOWN COMMAND WORD. NO ARGUMENT
C DESCRIPTIONS ARE RETURNED TO CALLING
C PROGRAM.
C = 7, 8, 9 OR 10 RETURNED IF MAXIMUM NUMBER OF
C ARGUMENTS OF SINGLE TYPE WAS EXCEEDED IN
C ARGUMENT LIST. DESCRIPTION OF ARGUMENT
C WHICH EXCEEDED LIMIT, AS WELL AS
C DESCRIPTIONS OF ANY ARGUMENTS TO ITS RIGHT,
C ARE NOT RETURNED TO CALLING PROGRAM,
C ALTHOUGH SCANNING OF STATEMENT CONTINUES TO
C DETERMINE ITS RIGHT END.
C = 7, RETURNED IF TOO MANY SLASHES OR COLONS
C WERE ENCOUNTERED IN SET OF NUMBERS.
C = 8, RETURNED IF TOO MANY WORDS WERE FOUND.
C = 9, RETURNED IF TOO MANY SETS OF NUMBERS WERE
C FOUND.
C = 10, RETURNED IF TOO MANY TEXT STRINGS WERE
C FOUND.
C
C FOLLOWING ARGUMENTS ARE USED ONLY FOR OUTPUT. THEIR
C INPUT VALUES ARE IGNORED.
C
C KOMAND = IF KIND IS RETURNED CONTAINING 3 OR RETURNED
C CONTAINING 7 OR GREATER, THEN KOMAND IS
C SEQUENCE NUMBER OF COMMAND WORD MATCHED IN
C IWORD ARRAY. IF SECOND COMMAND WORD IS
C MATCHED, THEN KOMAND IS RETURNED CONTAINING
C 2. SEQUENCE NUMBER DOES NOT INCLUDE LETTERS
C SKIPPED OVER BY VALUE OF LOWWRD, AND DOES
C NOT INCLUDE LETTERS SKIPPED OVER BY NEGATIVE
C VALUES IN KNTLTR ARRAY. IF COMMAND WORD IN
C IWORD ARRAY IS MATCHED, THEN KOMAND IS
C NUMBER OF VALUES IN KNTLTR ARRAY WHICH ARE
C GREATER THAN ZERO STARTING AT KNTLTR(LOWKNT)
C UP TO AND INCLUDING KNTLTR LOCATION WHICH
C CONTAINS NUMBER OF LETTERS IN COMMAND WORD
C WHICH IS SUCCESSFULLY MATCHED.
C = RETURNED CONTAINING ZERO IF A COMMAND WORD
C WAS NOT MATCHED.
C LCNWRD = IF KIND IS RETURNED CONTAINING EITHER 3 OR 7
C OR GREATER AND KOMAND BEING RETURNED GREATER
C THAN ZERO, LCNWRD IS RETURNED CONTAINING
C SUBSCRIPT OF IWORD LOCATION CONTAINING FIRST
C LETTER OF MATCHED WORD. LCNWRD IS UNDEFINED
C IF KOMAND IS RETURNED CONTAINING ZERO.
C LCNKNT = IF KIND IS RETURNED CONTAINING EITHER 3 OR 7
C OR GREATER AND KOMAND BEING RETURNED GREATER
C THAN ZERO, LNCKNT IS RETURNED CONTAINING
C SUBSCRIPT OF KNTLTR LOCATION CONTAINING WORD
C LENGTH. LCNKNT IS UNDEFINED IF KOMAND IS
C RETURNED CONTAINING ZERO.
C INIPRT = RETURNED CONTAINING SUBSCRIPT OF IBUFFR
C ARRAY LOCATION CONTAINING LEFTMOST PRINTING
C CHARACTER IN STATEMENT IF KIND IS RETURNED
C CONTAINING 3 OR GREATER. INIPRT IS RETURNED
C UNDEFINED IF KIND IS RETURNED SET TO EITHER
C 1 OR 2.
C = IF KIND IS RETURNED CONTAINING 6 INDICATING
C THAT UNKNOWN COMMAND WORD WAS FOUND AT START
C OF STATEMENT, THEN INIPRT IS RETURNED
C POINTING TO LEFT CHARACTER OF UNKNOWN
C COMMAND WORD. MIDPRT WILL THEN BE RETURNED
C POINTING TO RIGHT CHARACTER OF UNKNOWN
C COMMAND WORD.
C MIDPRT = RETURNED UNDEFINED IF KIND IS RETURNED
C CONTAINING ANY VALUE OTHER THAN 4 OR 6.
C = IF KMDTYP WAS INPUT GREATER THAN ZERO
C ALLOWING INITIAL NUMBER IN PLACE OF INITIAL
C COMMAND WORD, AND IF SUCH INITIAL NUMBER WAS
C FOUND SO THAT KIND IS RETURNED CONTAINING 4,
C THEN MIDPRT IS RETURNED POINTING TO
C CHARACTER TO IMMEDIATE RIGHT OF NUMBER.
C LMTPRT WILL THEN BE RETURNED POINTING TO
C RIGHTMOST PRINTING CHARACTER ON LINE.
C = IF KIND IS RETURNED CONTAINING 6 INDICATING
C THAT UNKNOWN COMMAND WORD WAS FOUND AT START
C OF STATEMENT, THEN MIDPRT IS RETURNED
C POINTING TO RIGHT CHARACTER OF UNKNOWN
C COMMAND WORD.
C LMTPRT = RETURNED CONTAINING SUBSCRIPT OF IBUFFR
C ARRAY LOCATION CONTAINING RIGHTMOST PRINTING
C CHARACTER IN STATEMENT IF KIND IS RETURNED
C CONTAINING 3 OR GREATER. IF STATEMENT IS
C FOLLOWED BY EITHER SEMICOLON OR EXCLAMATION
C POINT, THEN LMTPRT IS RETURNED POINTING TO
C RIGHTMOST PRINTING CHARACTER TO LEFT OF
C SEMICOLON OR EXCLAMATION POINT. LMTPRT IS
C RETURNED UNDEFINED IF KIND IS RETURNED SET
C TO EITHER 1 OR 2.
C = IF KMDTYP WAS INPUT GREATER THAN ZERO
C ALLOWING INITIAL NUMBER IN PLACE OF INITIAL
C COMMAND WORD, AND IF SUCH INITIAL NUMBER WAS
C FOUND SO THAT KIND IS RETURNED CONTAINING 4,
C THEN LMTPRT IS RETURNED POINTING TO
C RIGHTMOST PRINTING CHARACTER IN BUFFER.
C NAMKNT = RETURNED CONTAINING HIGHEST SUBSCRIPT USED
C IN NAMLFT AND NAMRIT ARRAYS TO STORE
C LOCATIONS IN BUFFER OF ENDS OF WORDS IN
C ARGUMENT LIST. IF NO WORDS ARE FOUND THEN
C NAMKNT IS RETURNED CONTAINING NAMLOW-1.
C NAMLFT = ARRAY RETURNED CONTAINING SUBSCRIPTS IN
C IBUFFR ARRAY OF LOCATIONS CONTAINING LEFT
C CHARACTERS OF WORDS IN ARGUMENT LIST. IF
C SERIES OF WORDS IS ENABLED BUT SOME ARE
C INDICATED AS MISSING BY EXTRA COMMAS IN
C ARGUMENT LIST, THEN FOR THESE MISSING WORDS
C NAMRIT ARRAY WILL CONTAIN VALUES LESS THAN
C THOSE IN NAMLFT ARRAY.
C NAMRIT = ARRAY RETURNED CONTAINING SUBSCRIPTS IN
C IBUFFR ARRAY OF LOCATIONS CONTAINING RIGHT
C CHARACTERS OF WORDS IN ARGUMENT LIST.
C MRKKNT = RETURNED CONTAINING HIGHEST SUBSCRIPT USED
C IN MRKLFT AND MRKRIT ARRAYS TO STORE
C LOCATIONS IN BUFFER OF ENDS OF QUOTED TEXT
C STRINGS IN ARGUMENT LIST. IF NO QUOTED TEXT
C STRINGS ARE FOUND THEN MRKKNT IS RETURNED
C CONTAINING MRKLOW-1.
C MRKLFT = ARRAY RETURNED CONTAINING SUBSCRIPTS IN
C IBUFFR ARRAY OF LOCATIONS CONTAINING LEFT
C CHARACTERS OF QUOTED TEXT STRINGS.
C CHARACTER POINTED TO BY MRKLFT IS CHARACTER
C TO IMMEDIATE RIGHT OF INITIAL APOSTROPHE OR
C OF INITIAL PARENTHESIS. IF LSTTYP=9, OR IF
C LSTTYP=-1 AND LEGAL=9, THEN MRKLFT POINTS TO
C LEFTMOST PRINTING CHARACTER LEFT OF OPENING
C PARENTHESIS OR TO OPENING PARENTHESIS ITSELF
C IF NOT PRECEDED BY ANY OTHER PRINTING
C CHARACTERS. IF SERIES OF TEXT STRINGS IS
C ENABLED BUT SOME ARE INDICATED AS MISSING BY
C EXTRA COMMAS IN ARGUMENT LIST, THEN FOR
C THESE MISSING TEXT STRINGS MRKRIT ARRAY WILL
C CONTAIN VALUES 2 LESS THAN THOSE IN MRKLFT.
C MRKRIT = ARRAY RETURNED CONTAINING SUBSCRIPTS IN
C IBUFFR ARRAY OF LOCATIONS CONTAINING RIGHT
C CHARACTERS OF QUOTED TEXT STRINGS IN
C ARGUMENT LIST. CHARACTER POINTED TO BY
C MRKRIT ARRAY IS CHARACTER TO IMMEDIATE LEFT
C OF FINAL APOSTROPHE OR OF FINAL PARENTHESIS
C AT RIGHT END OF QUOTED TEXT STRING, OR IS
C RIGHTMOST PRINTING CHARACTER ON LINE IF NO
C FINAL APOSTROPHE OR FINAL PARENTHESIS IS
C FOUND.
C NUMKNT = RETURNED CONTAINING HIGHEST SUBSCRIPT USED
C IN NUMSIN, NUMVAL AND VALNUM ARRAYS TO STORE
C DESCRIPTION OF NUMERIC ARGUMENTS FOUND IN
C ARGUMENT LIST. IF NO NUMERIC ARGUMENTS ARE
C FOUND IN ARGUMENT LIST, THEN NUMKNT IS
C RETURNED CONTAINING NUMLOW-1.
C NUMSIN = ARRAY RETURNED INDICATING SIGN, IF ANY,
C WHICH PRECEDED EACH NUMERIC ARGUMENT. VALUE
C OF ARGUMENT IS RETURNED IN NUMVAL OR VALNUM
C ARRAY LOCATION HAVING SAME SUBSCRIPT AS
C NUMSIN ARRAY LOCATION DESCRIBING SIGN.
C = -1, CORRESPONDING NUMERIC ARGUMENT WAS
C INDICATED AS MISSING EITHER BY ABSENCE OF
C NUMBER BEFORE SLASH OR COLON, BY ABSENCE OF
C NUMBER AFTER SLASH OR COLON, OR BY ABSENCE
C OF NUMBER BETWEEN SLASHES OR COLONS.
C CORRESPONDING VALUE IN NUMVAL OR VALNUM
C ARRAY IS RETURNED SET TO ZERO.
C = 0, RETURNED IF CORRESPONDING NUMERIC
C ARGUMENT WAS INDICATED AS MISSING BY LESS
C THAN INTRVL NUMBERS BEING INCLUDED IN SET OF
C NUMBERS, OR BY 2 ADJACENT COMMAS IN ARGUMENT
C LIST.
C = 1, NUMERIC ARGUMENT WAS EVALUATED, BUT NO
C SIGN APPEARED TO ITS LEFT.
C = 2, MINUS SIGN APPEARED TO LEFT OF NUMERIC
C ARGUMENT.
C = 3, PLUS SIGN APPEARED TO LEFT OF NUMERIC
C ARGUMENT.
C NUMVAL = ARRAY RETURNED CONTAINING VALUES OF NUMERIC
C ARGUMENTS EVALUATED AS INTEGERS. IF MINUS
C SIGN PRECEDED NUMBER, THEN VALUE IN NUMVAL
C IS NEGATIVE.
C VALNUM = ARRAY RETURNED CONTAINING VALUES OF NUMERIC
C ARGUMENTS EVALUATED AS REAL NUMBERS. IF
C MINUS SIGN PRECEDED NUMBER, THEN VALUE IN
C VALNUM IS NEGATIVE.
C IFLOAT = RETURNED DESCRIBING WHETHER NUMERIC
C ARGUMENTS WERE EVALUATED AS INTEGERS OR REAL
C NUMBERS.
C = 0, RETURNED IF NUMERIC ARGUMENTS WERE
C EVALUATED AS INTEGERS. VALUES OF NUMERIC
C ARGUMENTS ARE RETURNED IN NUMVAL ARRAY.
C = 1, RETURNED IF NUMERIC ARGUMENTS WERE
C EVALUATED AS REAL NUMBERS. VALUES OF
C NUMERIC ARGUMENTS ARE RETURNED IN VALNUM
C ARRAY.
C
DIMENSION IDIGIT(10),ISEPAR(13),IBUFFR(MAXBFR),
1IWORD(MAXWRD),KNTLTR(MAXKNT),LEGAL(MAXKNT),
2NAMLFT(NAMMAX),NAMRIT(NAMMAX),MRKLFT(MRKMAX),
3MRKRIT(MRKMAX),NUMSIN(NUMMAX),NUMVAL(NUMMAX),
4VALNUM(NUMMAX)
C
EQUIVALENCE(IBLANK,ISEPAR(1)),(ITAB,ISEPAR(2)),
1 (IQUOTE,ISEPAR(6)),(ILEFT,ISEPAR(7)),
2 (IRIGHT,ISEPAR(8)),(ISLASH,ISEPAR(9)),
3 (ICOLON,ISEPAR(10)),(IPLUS,ISEPAR(11)),
4 (IMINUS,ISEPAR(12)),(IDOT,ISEPAR(13))
C
C FIRST CHARACTER IN ISEPAR ARRAY IS SPACE. SECOND
C CHARACTER IS TAB CHARACTER. IF TAB CHARACTER IS NOT
C AVAILABLE, THEN SECOND CHARACTER SHOULD BE SPACE ALSO
DATA ISEPAR/1H ,1H ,
11H!,1H;,1H,,1H',1H(,1H),1H/,1H:,1H+,1H-,1H./
DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
C SET DEFAULT ARGUMENT COUNTS TO ZERO
NUMKNT=NUMLOW-1
MRKKNT=MRKLOW-1
NAMKNT=NAMLOW-1
INIKND=KIND
C
C **********************
C * *
C * SCAN FOR COMMAND *
C * *
C **********************
C
C LOOK FOR FIRST PRINTING CHARACTER
GO TO 3
1 INIKND=0
2 LOWBFR=LOWBFR+1
3 IF(LOWBFR.GT.MAXBFR)GO TO 90
IF(IBUFFR(LOWBFR).EQ.IBLANK)GO TO 2
IF(IBUFFR(LOWBFR).EQ.ITAB)GO TO 2
INIPRT=LOWBFR
MULTPL=LSTTYP
IF(KMDTYP.LT.0)GO TO 6
C
C TEST IF SEQUENCE OF PRINTING CHARACTERS IN DICTIONARY
INILTR=LOWBFR
CALL DAVERB(LOWWRD,MAXWRD,IWORD,LOWKNT,MAXKNT,
1KNTLTR,IBUFFR,MAXBFR,LOWBFR,KIND,KOMAND,LCNWRD,
2LCNKNT,LCNBFR)
LMTPRT=LOWBFR-1
C
C ENTIRE DICTIONARY HAS BEEN SEARCHED
IF(KIND.GE.3)GO TO 4
C NO COMMAND WORD, CHECK FOR LEADING NUMBER
ISTATE=-1
MULTPL=3
IF(KMDTYP.GE.2)MULTPL=7
GO TO 7
C GET ARGUMENT LIST TYPE IF IN LEGAL ARRAY
4 IF(LSTTYP.EQ.-1)MULTPL=LEGAL(LCNKNT)
IF(KIND.LE.4)GO TO 5
C AMBIGUOUS ABREVIATION, CHECK FOR REST OF WORD IF ANY
KIND=-1
GO TO 8
C COMMAND FOUND BUT IS ERROR IF ADDITIONAL CHARACTERS
5 ISTATE=0
GO TO 7
C NO COMMAND WAS TESTED FOR, SIMULATE LEADING SPACE
6 ISTATE=1
KOMAND=0
7 KIND=0
C
C MULTPL = -3, ALLOW NO ARGUMENTS
C = -2, ALLOW MULTIPLE ARGUMENTS OF 1ST TYPE
C FOUND
C = -1, ALLOW MULTIPLE WORDS
C = 0, ALLOW MULTIPLE NUMBERS
C = 1, ALLOW MULTIPLE STRINGS
C
8 JMLTPL=MULTPL-8
LIMIT=13
IF(JMLTPL.GT.0)LIMIT=8
MULTPL=MULTPL-3
IF(MULTPL.LE.1)GO TO 9
MULTPL=MULTPL-4
IFLOAT=1
GO TO 10
9 IFLOAT=0
10 IF(MULTPL.GE.-1)GO TO 11
IF(MULTPL.LE.-3)IFLOAT=1
NUMBLK=0
MRKNXT=MRKKNT
NAMNXT=NAMKNT
NUMNXT=NUMKNT
NOTYET=0
GO TO 12
11 NUMBLK=1
NUMNXT=NUMLOW
MRKNXT=MRKLOW
NAMNXT=NAMLOW
12 NUMNOW=NUMNXT
IF(KIND.LT.0)GO TO 71
GO TO 16
C
C ************************
C * *
C * SCAN FOR ARGUMENTS *
C * *
C ************************
C
C ISTATE = -1, NOTHING OR SPACE FOUND. WILL ACCEPT
C ONLY A LEADING NUMBER.
C = 0, COMMAND FOUND, BUT NOT YET ANYTHING,
C EVEN SPACES, AFTER IT.
C = 1, NO COMMAND WAS LOOKED FOR, ONLY SPACES
C HAVE YET BEEN FOUND, NOTHING ELSE
C = 2, COMMA FOUND ANYWHERE, OR ELSE COMMAND
C FOUND FOLLOWED BY SPACE. ANOTHER COMMA WILL
C INDICATE A MISSING ARGUMENT.
C = 3, TERMINATED SINGLE ITEM
C
C SPACE OR TAB CHARACTER FOUND
13 IF(ISTATE.NE.0)GO TO 15
14 ISTATE=2
C
C TEST IF NEXT CHARACTER BEGINS ARGUMENT OR PUNCTUATION
15 LOWBFR=LOWBFR+1
16 IF(LOWBFR.GT.MAXBFR)GO TO 89
KOMPAR=IBUFFR(LOWBFR)
DO 17 I=1,LIMIT
IF(KOMPAR.NE.ISEPAR(I))GO TO 17
GO TO(13,13,89,91,83,19,31,31,59,59,45,46,47),I
17 CONTINUE
IF(JMLTPL.GT.0)GO TO 70
IF(ISTATE.EQ.0)GO TO 72
DO 18 I=1,10
IF(KOMPAR.EQ.IDIGIT(I))GO TO 47
18 CONTINUE
GO TO 70
C
C ************************
C * *
C * QUOTED TEXT STRING *
C * *
C ************************
C
C APOSTROPHE STARTS TEXT STRING
19 IF(JMLTPL.GT.0)GO TO 26
INILTR=LOWBFR+1
I=LOWBFR
LMTPRT=LOWBFR
20 IF(I.GE.MAXBFR)GO TO 22
I=I+1
LOWBFR=LOWBFR+1
IBUFFR(LOWBFR)=IBUFFR(I)
IF(IBUFFR(I).EQ.IBLANK)GO TO 20
IF(IBUFFR(I).EQ.ITAB)GO TO 20
LMTPRT=LOWBFR
IF(IBUFFR(I).NE.IQUOTE)GO TO 20
IF(I.GE.MAXBFR)GO TO 21
IF(IBUFFR(I+1).NE.IQUOTE)GO TO 21
I=I+1
GO TO 20
21 NONSPC=LMTPRT-1
GO TO 23
22 NONSPC=LMTPRT
23 IF(LOWBFR.EQ.I)GO TO 39
KOPY=LOWBFR
24 IF(KOPY.GE.MAXBFR)GO TO 39
KOPY=KOPY+1
IF(I.GE.MAXBFR)GO TO 25
I=I+1
IBUFFR(KOPY)=IBUFFR(I)
GO TO 24
25 IBUFFR(KOPY)=IBLANK
GO TO 24
C
C SECTION PRIOR TO PARENTHETICAL EXPRESSION
26 INILTR=LOWBFR
27 KOMPAR=IBUFFR(LOWBFR)
DO 28 I=1,8
IF(KOMPAR.NE.ISEPAR(I))GO TO 28
IF(I.LT.6)GO TO 30
IF(I.GT.6)GO TO 32
IF(LOWBFR.LT.MAXBFR)LOWBFR=LOWBFR+1
GO TO 29
28 CONTINUE
29 LMTPRT=LOWBFR
NONSPC=LOWBFR
IF(LOWBFR.GE.MAXBFR)GO TO 39
LOWBFR=LOWBFR+1
GO TO 27
30 LOWBFR=LOWBFR-1
GO TO 39
C
C PARENTHESIS STARTS TEXT STRING
31 INILTR=LOWBFR
IF(JMLTPL.LE.0)INILTR=INILTR+1
32 LEVEL=0
GO TO 34
33 IF(LOWBFR.GE.MAXBFR)GO TO 38
LOWBFR=LOWBFR+1
34 KOMPAR=IBUFFR(LOWBFR)
IF(KOMPAR.EQ.IBLANK)GO TO 33
IF(KOMPAR.EQ.ITAB)GO TO 33
LMTPRT=LOWBFR
IF(KOMPAR.EQ.ILEFT)GO TO 35
IF(KOMPAR.EQ.IRIGHT)GO TO 36
IF(KOMPAR.NE.IQUOTE)GO TO 33
IF(LOWBFR.GE.MAXBFR)GO TO 38
LOWBFR=LOWBFR+1
LMTPRT=LOWBFR
GO TO 33
35 LEVEL=LEVEL+1
GO TO 37
36 LEVEL=LEVEL-1
37 IF(LEVEL.NE.0)GO TO 33
NONSPC=LMTPRT-1
GO TO 39
38 NONSPC=LMTPRT
C
C STORE THE TEXT STRING
39 IF(ISTATE.LT.0)KIND=5
IF(KIND.NE.0)GO TO 44
IF(MULTPL.NE.-2)GO TO 40
MULTPL=1
MRKNXT=MRKLOW+NOTYET
40 IF(MRKKNT.GE.MRKNXT)GO TO 41
IF(MRKNXT.LE.MRKMAX)GO TO 42
41 KIND=10
GO TO 44
42 MRKKNT=MRKKNT+1
IF(MRKKNT.GE.MRKNXT)GO TO 43
MRKLFT(MRKKNT)=1
MRKRIT(MRKKNT)=-1
GO TO 42
43 MRKLFT(MRKKNT)=INILTR
MRKRIT(MRKKNT)=NONSPC
IF(MULTPL.EQ.0)GO TO 44
IF(NUMKNT.GE.NUMLOW)NUMBLK=0
44 ISTATE=3
IF(MULTPL.GT.0)GO TO 86
GO TO 15
C
C ****************************
C * *
C * NUMBER OR NUMBER RANGE *
C * *
C ****************************
C
C PLUS SIGN STARTS NUMBER
45 ISIGN=3
GO TO 48
C
C MINUS SIGN STARTS NUMBER
46 ISIGN=2
GO TO 48
C
C DIGIT OR PERIOD STARTS NUMBER
47 ISIGN=1
C
C EVALUATE NUMBER
48 CALL DAHEFT(IFLOAT,1,0,IBUFFR,MAXBFR,
1LOWBFR,IDUMMY,ISHIFT,JSHIFT,KSHIFT,LSHIFT,IVALUE,
2VALUE)
C
C STORE EVALUATED NUMBER
IF(KIND.NE.0)GO TO 58
IF(ISTATE.GE.0)GO TO 49
IF(KMDTYP.LE.0)GO TO 52
49 IF(MULTPL.NE.-2)GO TO 50
NUMBLK=1
MULTPL=0
NUMNXT=NUMLOW+(NOTYET*INTRVL)
NUMNOW=NUMNXT
50 IF(NUMKNT.GE.NUMNOW)GO TO 51
IF(NUMNOW.LE.NUMMAX)GO TO 53
51 KIND=9
GO TO 58
52 KIND=5
GO TO 58
53 NUMKNT=NUMKNT+1
IF(NUMKNT.GE.NUMNOW)GO TO 55
NUMSIN(NUMKNT)=0
IF(NUMKNT.GE.NUMNXT)NUMSIN(NUMKNT)=-1
IF(IFLOAT.NE.0)GO TO 54
NUMVAL(NUMKNT)=0
GO TO 53
54 VALNUM(NUMKNT)=0.0
GO TO 53
55 NUMSIN(NUMKNT)=ISIGN
IF(IFLOAT.NE.0)GO TO 56
NUMVAL(NUMKNT)=IVALUE
GO TO 57
56 VALNUM(NUMKNT)=VALUE
57 IF(ISTATE.LT.0)GO TO 87
58 IF(LOWBFR.GT.MAXBFR)GO TO 69
KOMPAR=IBUFFR(LOWBFR)
IF(KOMPAR.EQ.ISLASH)GO TO 59
IF(KOMPAR.NE.ICOLON)GO TO 68
C
C SLASH FOUND
59 IF(KIND.NE.0)GO TO 62
IF(ISTATE.GE.0)GO TO 60
KIND=5
GO TO 62
60 IF(MULTPL.NE.-2)GO TO 61
NUMBLK=1
MULTPL=0
NUMNXT=NUMLOW+(NOTYET*INTRVL)
NUMNOW=NUMNXT
61 NUMNOW=NUMNOW+NUMBLK
IF(NUMNOW.GE.(NUMNXT+INTRVL))KIND=7
62 LOWBFR=LOWBFR+1
IF(LOWBFR.GT.MAXBFR)GO TO 69
KOMPAR=IBUFFR(LOWBFR)
IF(KOMPAR.EQ.IPLUS)GO TO 45
IF(KOMPAR.EQ.IMINUS)GO TO 46
IF(KOMPAR.EQ.IDOT)GO TO 47
IF(KOMPAR.EQ.ISLASH)GO TO 59
IF(KOMPAR.EQ.ICOLON)GO TO 59
DO 63 I=1,10
IF(KOMPAR.NE.IDIGIT(I))GO TO 63
NUMBER=I-1
GO TO 47
63 CONTINUE
C
C END OF RANGE SPECIFICATION
IF(KIND.NE.0)GO TO 68
IF(NUMKNT.GE.NUMNOW)GO TO 64
IF(NUMNOW.LE.NUMMAX)GO TO 65
64 KIND=9
GO TO 68
65 NUMKNT=NUMKNT+1
IF(IFLOAT.NE.0)GO TO 66
NUMVAL(NUMKNT)=0
GO TO 67
66 VALNUM(NUMKNT)=0.0
67 NUMSIN(NUMKNT)=0
IF(NUMKNT.GE.NUMNXT)NUMSIN(NUMKNT)=-1
IF(NUMKNT.LT.NUMNOW)GO TO 65
68 IF(MULTPL.NE.0)NUMBLK=0
69 LOWBFR=LOWBFR-1
LMTPRT=LOWBFR
ISTATE=3
IF(MULTPL.EQ.0)GO TO 85
GO TO 15
C
C **********
C * *
C * WORD *
C * *
C **********
C
C SEARCH FOR END OF WORD
70 IF(ISTATE.LE.0)GO TO 72
IF(JMLTPL.GT.0)GO TO 26
INILTR=LOWBFR
GO TO 73
71 LOWBFR=LOWBFR-1
72 KIND=-1
73 IF(LOWBFR.GE.MAXBFR)GO TO 76
LOWBFR=LOWBFR+1
KOMPAR=IBUFFR(LOWBFR)
DO 74 I=1,13
IF(KOMPAR.EQ.ISEPAR(I))GO TO 75
74 CONTINUE
GO TO 73
75 LOWBFR=LOWBFR-1
C
C STORE DESCRIPTION OF WORD
76 LMTPRT=LOWBFR
IF(KIND.EQ.0)GO TO 77
IF(KIND.GT.0)GO TO 82
KIND=6
MIDPRT=LMTPRT
GO TO 82
77 IF(MULTPL.NE.-2)GO TO 78
MULTPL=-1
NAMNXT=NAMLOW+NOTYET
78 IF(NAMKNT.GE.NAMNXT)GO TO 79
IF(NAMNXT.LE.NAMMAX)GO TO 80
79 KIND=8
GO TO 82
80 NAMKNT=NAMKNT+1
IF(NAMKNT.GE.NAMNXT)GO TO 81
NAMLFT(NAMKNT)=1
NAMRIT(NAMKNT)=0
GO TO 80
81 NAMLFT(NAMKNT)=INILTR
NAMRIT(NAMKNT)=LMTPRT
IF(MULTPL.EQ.0)GO TO 82
IF(NUMKNT.GE.NUMLOW)NUMBLK=0
82 ISTATE=3
IF(MULTPL.LT.0)GO TO 84
GO TO 15
C
C ***********************
C * *
C * PUNCTUATION MARKS *
C * *
C ***********************
C
C COMMA FOUND
83 LMTPRT=LOWBFR
IF(ISTATE.LT.0)KIND=5
IF(ISTATE.EQ.3)GO TO 14
ISTATE=2
IF(MULTPL.GT.0)GO TO 86
IF(MULTPL.EQ.0)GO TO 85
IF(MULTPL.EQ.-1)GO TO 84
NOTYET=NOTYET+1
GO TO 15
C
C INCREMENT SEQUENCE NUMBER OF NEXT SERIES ITEM
84 NAMNXT=NAMNXT+1
GO TO 15
85 NUMNXT=NUMNXT+INTRVL
NUMNOW=NUMNXT
GO TO 15
86 MRKNXT=MRKNXT+1
GO TO 15
C
C INITIAL NUMBER FOUND
87 KIND=4
MIDPRT=LOWBFR
LOWBFR=MAXBFR+1
LMTPRT=LOWBFR
88 LMTPRT=LMTPRT-1
IF(LMTPRT.LT.MIDPRT)GO TO 95
IF(IBUFFR(LMTPRT).EQ.IBLANK)GO TO 88
IF(IBUFFR(LMTPRT).EQ.ITAB)GO TO 88
GO TO 95
C
C COMMENT
89 LOWBFR=MAXBFR+1
IF(ISTATE.EQ.-1)GO TO 90
IF(ISTATE.NE.1)GO TO 94
90 IF(INIKND.LE.1)GO TO 93
KIND=1
GO TO 95
C
C SEMICOLON
91 IF(ISTATE.EQ.-1)GO TO 92
IF(ISTATE.NE.1)GO TO 94
92 IF(INIKND.GT.1)GO TO 1
93 KIND=2
GO TO 95
C
C RETURN TO CALLING PROGRAM
94 IF(KIND.GE.7)GO TO 96
IF(KIND.NE.0)GO TO 95
KIND=3
GO TO 96
95 KOMAND=0
96 RETURN
C395642931348!;':
END