Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0141/daloss.for
There are 2 other files named daloss.for in the archive.  Click here to see a list.
      SUBROUTINE DALOSS(LOWWRD,MAXWRD,IWORD ,LOWKNT,MAXKNT,
         1    KNTLTR,IBUFFR,MAXBFR,LOWBFR,KIND  ,MATCH ,LCNWRD,
         2    LCNKNT,LCNBFR,MANY  ,LCNERR)
C     RENBR(/DELIMITER WRAPPER FOR DAVERB)
 C
  C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
  C     DALOSS IDENTIFIES  WORDS  AND  ABBREVIATIONS,  ALLOWS
    C     COMMAS   BETWEEN   WORDS,  IDENTIFIES  MISSING  ITEMS
    C     INDICATED BY EXTRA COMMAS, SKIPS OVER ANY TEXT  WHICH
    C     IS TO RIGHT OF EITHER EXCLAMATION POINT OR AMPERSAND,
    C     AND  REPORTS  ANY  SEMICOLONS  FOUND  IN  TEXT  BEING
                                                 C     EVALUATED.    IN  ADDITION,  DALOSS  REPORTS  WHETHER
    C     CHARACTER TO RIGHT OF WORD  OR  ITS  ABBREVIATION  IS
    C     CHARACTER  OTHER THAN SPACE, TAB CHARACTER OR ALLOWED
    C     PUNCTUATION CHARACTER.
C
  C     ARGUMENT LISTS OF DALOSS  AND  DAVERB  ARE  IDENTICAL
    C     EXCEPT  FOR DALOSS ARGUMENTS MANY AND LCNERR WHICH DO
    C     NOT APPEAR IN DAVERB ARGUMENT LIST, AND  EXCEPT  THAT
    C     DALOSS  CAN  RETURN  ARGUMENT  NAMED  KIND CONTAINING
    C     ADDITIONAL VALUES 6 THROUGH 11.  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  DAMISS,  DANEXT AND DASPAN) WHICH
    C     DEFINE THIS ARGUMENT IN  SIMILAR  MANNER.   ARGUMENTS
    C     NAMED  KIND  AND  LCNERR  ARE USED ONLY FOR OUTPUT TO
    C     CALLING PROGRAM AND THEIR INPUT VALUES  ARE  IGNORED.
    C     THESE  ARGUMENTS  ARE DESCRIBED BELOW.  DOCUMENTATION
    C     OF DAVERB 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  WORDS  ARE  REQUIRED.  LOWBFR IS
    C              RETURNED  POINTING  BEYOND  END  OF  BUFFER.
    C              MANY  IS  RETURNED  SET  TO  ZERO.  MATCH IS
    C              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              DID NOT MATCH FIRST CHARACTER OF ANY WORD IN
    C              DICTIONARY AND  WAS  NOT  COMMA,  SEMICOLON,
    C              AMPERSAND  OR  EXCLAMATION POINT.  LOWBFR IS
    C              RETURNED   POINTING   TO    THIS    PRINTING
    C              CHARACTER.   IT  IS  EXPECTED  THAT  CALLING
    C              PROGRAM WILL OTHERWISE PROCESS THIS PRINTING
    C              CHARACTER  SINCE  DALOSS  WOULD  RETURN SAME
    C              RESULTS IF CALLED AGAIN WITH SAME  VALUE  OF
    C              LOWBFR,  WITH  SAME DICTIONARY AND WITH SAME
                                                           C              BUFFER   CONTENTS.    MANY    IS    RETURNED
    C              CONTAINING   ONE  PLUS  ITS  INPUT  ABSOLUTE
    C              VALUE.  MATCH IS RETURNED UNDEFINED.
  C            = 3 OR 4 OR 5, SAME  AS  WHEN  DAVERB  RETURNS
    C              THESE  VALUES,  EXCEPT  THAT  IF  THERE  ARE
    C              ADDITIONAL CHARACTERS TO RIGHT  OF  WORD  OR
    C              ITS    ABBREVIATION,   THEN   CHARACTER   TO
    C              IMMEDIATE RIGHT OF WORD OR ITS  ABBREVIATION
    C              IS   EITHER  SPACE,  TAB  CHARACTER,  COMMA,
    C              SEMICOLON, EXCLAMATION POINT  OR  AMPERSAND.
    C              MANY  IS  RETURNED  CONTAINING  ONE PLUS ITS
    C              INPUT ABSOLUTE VALUE.   LOWBFR  IS  RETURNED
    C              POINTING  TO  CHARACTER  TO RIGHT OF WORD OR
    C              ITS ABBREVIATION.
 C            = 3, WORD IN IWORD ARRAY WAS MATCHED  EXACTLY.
    C              MATCH IS RETURNED CONTAINING SEQUENCE NUMBER
    C              OF WORD MATCHED IN IWORD ARRAY.
  C            = 4,  NONAMBIGUOUS  ABBREVIATION  OF  WORD  IN
    C              IWORD  ARRAY  WAS  FOUND.  MATCH IS RETURNED
    C              CONTAINING SEQUENCE NUMBER OF WORD IN  IWORD
    C              ARRAY.
            C            = 5, AMBIGUOUS ABBREVIATION OF WORD WAS FOUND.
    C              MATCH IS RETURNED CONTAINING SEQUENCE NUMBER
    C              OF FIRST WORD MATCHED IN IWORD ARRAY.
 C            = 6  OR  7  OR  8,  SAME  AS   KIND   RETURNED
    C              CONTAINING  3 OR 4 OR 5 RESPECTIVELY, EXCEPT
    C              THAT  CHARACTER  OTHER   THAN   SPACE,   TAB
    C              CHARACTER,   COMMA,  SEMICOLON,  EXCLAMATION
    C              POINT OR  AMPERSAND  APPEARED  TO  IMMEDIATE
    C              RIGHT  OF  WORD OR ITS ABBREVIATION.  LCNBFR
    C              IS RETURNED  POINTING  IN  BUFFER  TO  FIRST
    C              CHARACTER   OF  WORD  OR  ITS  ABBREVIATION.
    C              LOWBFR IS RETURNED  POINTING  IN  BUFFER  TO
    C              CHARACTER   TO   RIGHT   OF   WORD   OR  ITS
    C              ABBREVIATION.  LCNERR IS  RETURNED  POINTING
    C              IN  BUFFER  TO  NEXT  SPACE,  TAB CHARACTER,
    C              COMMA,  SEMICOLON,  EXCLAMATION   POINT   OR
    C              AMPERSAND   TO   RIGHT   OF   WORD   OR  ITS
    C              ABBREVIATION, OR IS RETURNED POINTING BEYOND
    C              END  OF  BUFFER  IF NO SPACE, TAB CHARACTER,
                                                           C              COMMA,  SEMICOLON,  EXCLAMATION   POINT   OR
    C              AMPERSAND  IS  FOUND TO RIGHT OF WORD OR ITS
    C              ABBREVIATION.  MANY IS  RETURNED  CONTAINING
    C              ONE PLUS ITS INPUT ABSOLUTE VALUE.
    C            = 9, 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.   MATCH  IS
    C              RETURNED UNDEFINED.
    C            = 10, 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  WORD  IDENTIFICATION
    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  WORD  CANNOT  BE SPLIT ACROSS
    C              LINE BOUNDARY.  MATCH IS RETURNED UNDEFINED.
    C            = 11, WORD WAS NOT FOUND, BUT EXTRA COMMA  WAS
    C              FOUND  INDICATING  MISSING  WORD.   MANY  IS
    C              RETURNED  CONTAINING  ONE  PLUS  ITS   INPUT
    C              ABSOLUTE    VALUE.     MATCH   IS   RETURNED
    C              UNDEFINED.
   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=9) 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 WORD IS FOUND, EACH
    C              TIME UNKNOWN CHARACTER  IS  FOUND,  OR  EACH
    C              TIME  INDICATION  OF  MISSING WORD IS FOUND.
                                                           C              KIND IS RETURNED  CONTAINING  VALUE  10  AND
    C              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
    C              RETURNED=10)  IS   FOUND   INDICATING   THAT
    C              SUBSEQUENT   CALL  TO  THIS  ROUTINE  IS  TO
    C              PROCESS TEXT  WHICH  IS  TO  BE  TREATED  AS
                                                           C              THOUGH IT APPEARED IN PLACE OF AMPERSAND AND
    C              CHARACTERS TO  ITS  RIGHT.   EFFECT  IS  NOT
    C              QUITE  SAME AS IF USER HAD TYPED ALL OF TEXT
    C              ON SINGLE LINE SINCE SINGLE WORD  CANNOT  BE
    C              SPLIT ACROSS LINE 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 WORD.  IF MANY IS
    C              INPUT GREATER THAN ZERO, THEN INITIAL  COMMA
    C              FOLLOWED BY NO OTHER PRINTING CHARACTERS, BY
    C              SEMICOLON, OR BY EXCLAMATION POINT INDICATES
    C              MISSING ITEM.  IF MANY IS INPUT GREATER THAN
    C              ZERO,  THEN  INITIAL   COMMA   FOLLOWED   BY
    C              AMPERSAND WILL CAUSE REMAINING CHARACTERS IN
    C              BUFFER TO  BE  IGNORED,  AND  MANY  WILL  BE
    C              RETURNED  CONTAINING  NEGATIVE  OF ITS INPUT
                                                           C              VALUE.  IF MANY IS INPUT NEGATIVE,  THEN  IT
    C              IS  ASSUMED  THAT CONTENTS OF CURRENT BUFFER
    C              CONTINUE PREVIOUS LINE WHICH TERMINATED WITH
    C              COMMA  FOLLOWED  BY  AMPERSAND,  AND MANY IS
    C              RETURNED GREATER THAN ZERO.
 C
  C     LCNERR = IF KIND  IS  RETURNED  SET  TO  6,  7  OR  8
    C              INDICATING THAT WORD OR ITS ABBREVIATION WAS
    C              FOLLOWED BY PRINTING  CHARACTER  OTHER  THAN
    C              COMMA,   SEMICOLON,   EXCLAMATION  POINT  OR
    C              AMPERSAND, THEN LCNERR CONTAINS SUBSCRIPT IN
         C              IBUFFR ARRAY OF LOCATION WHICH CONTAINS NEXT
    C              SPACE,  TAB  CHARACTER,   COMMA,  SEMICOLON,
    C              EXCLAMATION POINT OR  AMPERSAND OR IS SET TO
    C              MAXBFR+1 IF  NO ALLOWED DELIMITER  CHARACTER
    C              APPEARS TO RIGHT OF WORD OR ITS ABBREVIATION
    C
        DIMENSION IBUFFR(MAXBFR),IWORD(MAXWRD),
        1KNTLTR(MAXKNT)
         DATA KOMENT,IEND,IAND,KOMMA,ISPACE,ITAB/
       11H!,1H;,1H&,1H,,1H ,1H	/
         INIMNY=MANY
       IF(MANY.LT.0)MANY=-MANY
    C
  C     TEST IF CHARACTER STARTS A WORD
                                                       1 CALL DAVERB(LOWWRD,MAXWRD,IWORD ,LOWKNT,MAXKNT,
     1    KNTLTR,IBUFFR,MAXBFR,LOWBFR,KIND  ,MATCH ,LCNWRD,
         2    LCNKNT,LCNBFR)
          LCNERR=LOWBFR
          IF(KIND.GT.2)GO TO 3
        IF(KIND.EQ.1)GO TO 8
        LETTER=IBUFFR(LOWBFR)
       IF(LETTER.EQ.KOMENT)GO TO 7
      IF(LETTER.EQ.IEND)GO TO 5
        IF(LETTER.EQ.KOMMA)GO TO 4
       IF(LETTER.EQ.IAND)GO TO 6
  C
  C     IF MATCH FOUND, CHECK IF FOLLOWING CHARACTER IS LEGAL
        2 LCNERR=LCNERR+1
        IF(KIND.LE.2)GO TO 3
        IF(KIND.LE.5)KIND=KIND+3
       3 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
       GO TO 2
C
  C     TEST IF COMMA CAN PRECEDE A VALUE
        4 IF(INIMNY.LE.0)GO TO 10
          INIMNY=-INIMNY
         LOWBFR=LOWBFR+1
        GO TO 1
C
  C     SEMICOLON FOUND
      5 IF(INIMNY.LT.0)GO TO 10
          LOWBFR=LOWBFR+1
        KIND=9
       GO TO 9
C
  C     AMPERSAND FOUND
      6 IF(INIMNY.LT.0)MANY=INIMNY
       KIND=10
      LOWBFR=MAXBFR+1
        GO TO 12
    C
       C     EXCLAMATION POINT FOUND
        7 IF(INIMNY.LT.0)GO TO 10
          LOWBFR=MAXBFR+1
        KIND=1
       GO TO 9
C
  C     END OF LINE FOUND
    8 IF(INIMNY.LT.0)GO TO 10
    C
  C     RETURN TO CALLING ROUTINE
      9 MANY=0
       GO TO 12
       10 KIND=11
   11 MANY=MANY+1
    12 RETURN
 C408421442172!;&
        END