Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0141/damenu.for
There are 2 other files named damenu.for in the archive. Click here to see a list.
C     RENBR(DAMENU/WRITE DATA STATEMENTS DEFINING COMMANDS)
C
C     DONALD BARTH, HARVARD BUSINESS SCHOOL
C
C     THIS PROGRAM CONSTRUCTS DATA STATEMENTS WHICH  DEFINE
C     THE  DICTIONARY  REQUIRED  BY  FASP  ROUTINES SUCH AS
C     DAWORD AND DAHEST FOR WORD IDENTIFICATION.  THE FIRST
C     80  CHARACTERS  ARE  READ FROM EACH LINE OF THE INPUT
C     FILE.   THE FIRST  LINE OF  THE INPUT  FILE IS COPIED
C     INTO THE OUTPUT FILE AS A COMMENT AND SHOULD DESCRIBE
C     THE  CONTENTS OF  THE FILE.   THE SECOND  LINE OF THE
C     INPUT FILE MUST CONTAIN SEPARATED BY SPACES THE NAMES
C     BY WHICH THE FOLLOWING 6  ITEMS ARE TO BE REPRESENTED
C     IN THE DATA STATEMENTS GENERATED BY THIS PROGRAM
C       1 THE VARIABLE WHICH CONTAINS THE TOTAL  NUMBER  OF
C         CHARACTERS IN ALL WORDS IN THE DICTIONARY.
C       2 THE VARIABLE WHICH CONTAINS THE TOTAL  NUMBER  OF
C         WORDS IN THE DICTIONARY.
C       3 THE ARRAY WHICH  CONTAINS  IDENTICAL  VALUES  FOR
C         WORDS  WHICH  ARE  SYNONYMS.   THESE  VALUES  ARE
C         SPECIFIED FOR EACH WORD BY A NUMBER AT  THE  LEFT
C         END  OF  EACH  SUBSEQUENT LINE IN THE FILE.  DATA
C         STATEMENTS DEFINING THIS ARRAY ARE GENERATED ONLY
C         IF SOME  VALUES WITHIN  THE ARRAY  ARE SPECIFIED,
C         BUT THE NAME OF THE ARRAY MUST STILL BE SUPPLIED.
C       4 THE ARRAY WHICH CONTAINS THE  CHARACTERS  FORMING
C         THE WORDS IN THE DICTIONARY.
C       5 THE ARRAY WHICH CONTAINS THE LENGTH OF EACH  WORD
C         IN THE DICTIONARY.
C       6 THE  ARRAY  WHICH  CONTAINS  THE  ARGUMENT   TYPE
C         ASSOCIATED  WITH  EACH  WORD  IN  THE DICTIONARY.
C         THIS IS SPECIFIED FOR EACH WORD BY  A  NUMBER  AT
C         THE  RIGHT  END  OF  EACH  SUBSEQUENT LINE IN THE
C         FILE.  DATA STATEMENTS DEFINING  THIS  ARRAY  ARE
C         GENERATED  ONLY IF  SOME VALUES  WITHIN THE ARRAY
C         ARE  SPECIFIED,  BUT THE  NAME OF  THE ARRAY MUST
C         STILL BE SUPPLIED.
C     IF THE SECOND LINE DOES NOT CONTAIN AT LEAST 6 GROUPS
C     OF  CHARACTERS,  THEN  ADDITIONAL  NAMES WILL BE READ
C     FROM SUBSEQUENT LINES UNTIL 6 HAVE BEEN SPECIFIED.
C
C     EACH SUBSEQUENT LINE CONTAINS A  WORD  IDENTIFICATION
C     NUMBER  FOLLOWED  BY THE SPELLING OF THE WORD.  IF AN
C     ABBREVIATION OF THIS WORD IS TO  BE  RECOGNIZED  EVEN
C     THOUGH IT IS NOT UNIQUE ACROSS THE ENTIRE DICTIONARY,
C     THEN THIS ABBREVIATION OR ABBREVIATIONS SHOULD FOLLOW
C     THE  COMPLETE  SPELLING  SEPARATED  FROM  IT AND EACH
C     OTHER  BY  COMMAS,  WITH  THE  LONGEST  ABBREVIATIONS
C     COMING FIRST.  SPACES ARE IGNORED AT THE START OR END
C     OF THE SPELLING OF A WORD.   IF  TWO  OR  MORE  WORDS
C     APPEAR  ON  A  SINGLE  LINE  BUT ARE NOT SEPARATED BY
C     COMMAS, THEN THE RESULTING  DICTIONARY  WILL  INCLUCE
C     THESE  WORDS  AS  A SINGLE ENTRY IN WHICH THESE WORDS
C     ARE SEPARATED BY SINGLE SPACES.  FOR EXAMPLE, IF  THE
C     FIRST  3  LETTERS OF THE WORD DUPLICATE THOSE OF SOME
C     OTHER WORD, BUT  THE  WORD  BEING  DESCRIBED  ON  THE
C     CURRENT  LINE  IS  TO  BE  SELECTED  BY ITS 1, 2 OR 3
C     LETTER ABBREVIATIONS, THEN THE FULL SPELLING WOULD BE
C     FOLLOWED  BY  A  COMMA AND THE 3 LETTER ABBREVIATION,
C     THEN BY A COMMA AND THE  2  LETTER  ABBREVIATION  AND
C     FINALLY   BY   A   COMMA   AND   THE   SINGLE  LETTER
C     ABBREVIATION.  (ALTERNATIVELY, THE ABBREVIATIONS  CAN
C     BE  ENTERED  IN  SUBSEQUENT LINES, BUT AGAIN THE FULL
C     SPELLING SHOULD APPEAR FIRST AND BE FOLLOWED  BY  ITS
C     LONGEST  ABBREVIATION.)  A  SINGLE DIGIT APPEARING AT
C     THE RIGHT END OF EACH LINE  WOULD  DESCRIBE  FOR  THE
C     ROUTINE  DAHEST  THAT THE WORDS APPEARING TO THE LEFT
C     OF THE DIGIT ARE TO TAKE ARGUMENTS OF  THE  FOLLOWING
C     TYPES
C       0 (OR ABSENT NUMBER) WILL NOT  ALLOW  THE  WORD  TO
C         ACCEPT ANY ARGUMENTS.
C       1 WILL ALLOW THE WORD TO ACCEPT MULTIPLE  ARGUMENTS
C         OF THE SAME TYPE AS ITS FIRST ARGUMENT.
C       2 WILL ALLOW  THE  WORD  TO  ACCEPT  MULTIPLE  WORD
C         ARGUMENTS.
C       3 WILL ALLOW THE WORD TO  ACCEPT  MULTIPLE  NUMERIC
C         ARGUMENTS.
C       4 WILL ALLOW  THE  WORD  TO  ACCEPT  MULTIPLE  TEXT
C         STRING ARGUMENTS.
C       5 6 7 OR 8, SAME AS 1 2 3 OR 4 RESPECTIVELY, EXCEPT
C         THAT  NUMBERS  IF  FOUND  ARE  RETURNED  AS REALS
C         RATHER THAN AS INTEGERS.
C       9 WILL ALLOW  WORD TO ACCEPT  MULTIPLE TEXT STRINGS
C         WHICH  BEGIN WITH  ANY CHARACTER  WHICH IS  NOT A
C         PUNCTUATION MARK.
C     THE INPUT FILE IS TERMINATED BY A BLANK LINE.
C
C     FOR EXAMPLE, IF  THE  DICTIONARY  CONTAINS  THE  WORD
C     EXAMINE WHICH IS TO
C         BE IDENTIFIED BY THE NUMBER 135
C         BE ABBREVIATED AS EITHER EX OR E
C         TAKE MULTIPLE ARGUMENTS OF SAME TYPE AS ITS FIRST
C     AND THE WORD EXCHANGE WHICH IS TO
C         BE IDENTIFIED BY THE NUMBER -8
C         NOT BE ABBREVIATED AS EITHER EX OR E
C         TAKE MULTIPLE NUMERIC ARGUMENTS
C     THEN THE INPUT FILE WOULD CONTAIN
C
C     135 EXAMINE,EX,E 1
C     -8 EXCHANGE 3
C
C     OR
C
C     135 EXAMINE 1
C     135 EX 1
C     135 E 1
C     -8 EXCHANGE 3
C
      DIMENSION IBUFFR(80),KMDLTR(1000),KMDTYP(200),
     1KMDWID(200),KMDARG(200),INAME(6),JNAME(6),KNAME(6),
     2LNAME(6),MNAME(6),NNAME(6),IDIGIT(10)
      DOUBLE PRECISION NAMSRC,NAMOUT
      DATA IDIGIT/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA ISPACE,KOMMA,KLEFT,KRIGHT/1H ,1H,,1H(,1H)/
C
C     MAXBFR = NUMBER OF CHARACTERS READ INTO IBUFFR ARRAY
C              FROM EACH LINE OF INPUT FILE
C     MAXCMD = DIMENSION  OF KMDTYP  AND KMDWID  AND KMDARG
C              ARRAYS,   MAXIMUM   NUMBER   OF   WORDS   IN
C              DICTIONARY
C     MAXLTR = DIMENSION OF KMDLTR ARRAY, MAXIMUM NUMBER OF
C              CHARACTERS IN ALL WORDS IN DICTIONARY
C     IDSK   = UNIT NUMBER CONTAINING INPUT FILE
C     JDSK   = UNIT NUMBER TO WHICH OUTPUT IS WRITTEN
      DATA MAXBFR,MAXLTR,MAXCMD/80,1000,200/
      DATA IDSK,JDSK/1,20/
C
C     ASK USER FOR FILE NAMES AND OPEN FILES
      TYPE 1
    1 FORMAT(19H INPUT FILE NAME = ,$)
      ACCEPT 2,NAMSRC
    2 FORMAT(1A10)
      OPEN(UNIT=IDSK,FILE=NAMSRC,ACCESS='SEQIN')
      TYPE 3
    3 FORMAT(20H OUTPUT FILE NAME = ,$)
      ACCEPT 2,NAMOUT
      OPEN(UNIT=JDSK,FILE=NAMOUT,ACCESS='SEQOUT')
C
C     KNTLTR = NUMBER OF CHARACTERS IN KMDLTR ARRAY
C     KNTCMD = NUMBER OF COMMANDS IN KMDTYP, KMDWID AND
C              KMDARG ARRAYS
      KNTLTR=0
      KNTCMD=0
      IFANY=0
      JFANY=0
C
C     READ FIRST LINE OF FILE CONTAINING COMMENT
      READ(IDSK,19)IBUFFR
      LIMIT=MAXBFR+1
    4 LIMIT=LIMIT-1
      IF(LIMIT.LE.1)GO TO 5
      IF(IBUFFR(LIMIT).EQ.ISPACE)GO TO 4
    5 WRITE(JDSK,6)(IBUFFR(I),I=1,LIMIT)
    6 FORMAT(1HC,80A1)
      WRITE(JDSK,6)
C
C     READ SECOND LINE OF FILE CONTAINING ARRAY NAMES
      DO 7 I=1,6
      INAME(I)=ISPACE
    7 JNAME(I)=ISPACE
      KONTRL=0
    8 READ(IDSK,19)IBUFFR
      LOCAL=0
      DO 17 INDEX=1,MAXBFR
      IF(IBUFFR(INDEX).EQ.ISPACE)GO TO 16
      IF(IBUFFR(INDEX).EQ.KOMMA)GO TO 16
      IF(LOCAL.NE.0)GO TO 9
      KONTRL=KONTRL+1
      IF(KONTRL.GT.6)GO TO 18
    9 LOCAL=LOCAL+1
      IF(LOCAL.GT.6)GO TO 17
      GO TO(10,11,12,13,14,15),KONTRL
   10 ILONG=LOCAL
      INAME(ILONG)=IBUFFR(INDEX)
      GO TO 17
   11 JLONG=LOCAL
      JNAME(JLONG)=IBUFFR(INDEX)
      GO TO 17
   12 KLONG=LOCAL
      KNAME(KLONG)=IBUFFR(INDEX)
      GO TO 17
   13 LLONG=LOCAL
      LNAME(LLONG)=IBUFFR(INDEX)
      GO TO 17
   14 MLONG=LOCAL
      MNAME(MLONG)=IBUFFR(INDEX)
      GO TO 17
   15 NLONG=LOCAL
      NNAME(NLONG)=IBUFFR(INDEX)
      GO TO 17
   16 LOCAL=0
   17 CONTINUE
      IF(KONTRL.LT.6)GO TO 8
C
C     READ THE DESCRIPTIONS OF THE COMMANDS
   18 READ(IDSK,19,END=30)IBUFFR
   19 FORMAT(80A1)
      ITYPE=0
C
C     GET IDENTIFYING NUMBER
      INDEX=1
      CALL DAIHFT(0,1,0,IBUFFR,MAXBFR,
     1INDEX,KIND,ISHIFT,JSHIFT,KSHIFT,LSHIFT,ITYPE)
C
C     GET ARGUMENT TYPE
      LIMIT=MAXBFR+1
   20 LIMIT=LIMIT-1
      IF(LIMIT.LT.INDEX)GO TO 30
      IF(IBUFFR(LIMIT).EQ.ISPACE)GO TO 20
      DO 21 I=1,10
      IF(IBUFFR(LIMIT).NE.IDIGIT(I))GO TO 21
      JTYPE=I-1
      KTYPE=1
      GO TO 22
   21 CONTINUE
      LIMIT=LIMIT+1
      JTYPE=0
      KTYPE=0
C
C     STORE COMMAND NAME OR NAMES
   22 KNTINI=KNTLTR
      JSPACE=0
      KSPACE=0
   23 IF(INDEX.LT.LIMIT)GO TO 24
      IF(JSPACE.EQ.0)GO TO 18
      GO TO 29
   24 IF(IBUFFR(INDEX).EQ.KOMMA)GO TO 28
      IF(IBUFFR(INDEX).EQ.ISPACE)GO TO 26
      IF(JSPACE.LE.0)GO TO 25
      IF(KNTINI.GE.MAXLTR)GO TO 30
      KNTINI=KNTINI+1
      KMDLTR(KNTINI)=ISPACE
      KSPACE=100
   25 IF(KNTINI.GE.MAXLTR)GO TO 30
      KNTINI=KNTINI+1
      KMDLTR(KNTINI)=IBUFFR(INDEX)
      JSPACE=-1
      GO TO 27
   26 IF(JSPACE.LT.0)JSPACE=1
   27 INDEX=INDEX+1
      GO TO 23
   28 INDEX=INDEX+1
      IF(JSPACE.EQ.0)GO TO 23
   29 IF(KNTCMD.GE.MAXCMD)GO TO 30
      KNTCMD=KNTCMD+1
      KMDTYP(KNTCMD)=ITYPE
      KMDWID(KNTCMD)=KNTINI-KNTLTR+KSPACE
      KNTLTR=KNTINI
      KMDARG(KNTCMD)=JTYPE
      IF(KIND.EQ.3)IFANY=1
      IF(KTYPE.NE.0)JFANY=1
      GO TO 22
C
C     PREPARE TO WRITE COMMENT LINES DESCRIBING COMMANDS
   30 IF(JFANY.EQ.0)GO TO 58
      WRITE(JDSK,31)
   31 FORMAT(1HC,5X,25HMULTIPLE  NUMERIC  LENGTH/1HC)
      INDEX=0
      IRIGHT=0
      LAST=KMDTYP(1)+1
C
C     OBTAIN NEXT COMMAND TO BE INCLUDED IN COMMENTS
   32 INDEX=INDEX+1
      IF(INDEX.GT.KNTCMD)GO TO 56
      ILEFT=IRIGHT+1
      I=KMDWID(INDEX)
      IF(I.GE.100)I=I-100
      IRIGHT=IRIGHT+I
C
C     TEST IF COMMAND IS ABBREVIATION OF PREVIOUS COMMAND
      IF(IFANY.EQ.0)GO TO 34
      IF(LAST.NE.KMDTYP(INDEX))GO TO 34
      IF((JRIGHT-JLEFT).LE.(IRIGHT-ILEFT))GO TO 34
      J=JLEFT
      DO 33 I=ILEFT,IRIGHT
      IF(KMDLTR(I).NE.KMDLTR(J))GO TO 34
   33 J=J+1
      J=IRIGHT-ILEFT+1
      K=JLEFT+J
      WRITE(JDSK,45)J,(KMDLTR(I),I=ILEFT,IRIGHT),KLEFT,
     1(KMDLTR(I),I=K,JRIGHT),KRIGHT
      GO TO 32
C
C     COMMENT DESCRIBING COMMAND WHICH IS NOT ABBREVIATED
   34 LAST=KMDTYP(INDEX)
      JLEFT=ILEFT
      JRIGHT=IRIGHT
      JTYPE=KMDARG(INDEX)+1
      J=IRIGHT-ILEFT+1
      GO TO(35,36,37,38,39,40,41,42,43,44),JTYPE
   35 WRITE(JDSK,46)LAST,J,(KMDLTR(I),I=ILEFT,IRIGHT)
      GO TO 32
   36 WRITE(JDSK,47)LAST,J,(KMDLTR(I),I=ILEFT,IRIGHT)
      GO TO 32
   37 WRITE(JDSK,48)LAST,J,(KMDLTR(I),I=ILEFT,IRIGHT)
      GO TO 32
   38 WRITE(JDSK,49)LAST,J,(KMDLTR(I),I=ILEFT,IRIGHT)
      GO TO 32
   39 WRITE(JDSK,50)LAST,J,(KMDLTR(I),I=ILEFT,IRIGHT)
      GO TO 32
   40 WRITE(JDSK,51)LAST,J,(KMDLTR(I),I=ILEFT,IRIGHT)
      GO TO 32
   41 WRITE(JDSK,52)LAST,J,(KMDLTR(I),I=ILEFT,IRIGHT)
      GO TO 32
   42 WRITE(JDSK,53)LAST,J,(KMDLTR(I),I=ILEFT,IRIGHT)
      GO TO 32
   43 WRITE(JDSK,54)LAST,J,(KMDLTR(I),I=ILEFT,IRIGHT)
      GO TO 32
   44 WRITE(JDSK,55)LAST,J,(KMDLTR(I),I=ILEFT,IRIGHT)
      GO TO 32
   45 FORMAT(1HC,23X,1I3,1X,80A1)
   46 FORMAT(1HC,1I7,16H NONE    NONE   ,1I3,1X,80A1)
   47 FORMAT(1HC,1I7,16H DYNAMIC INTEGER,1I3,1X,80A1)
   48 FORMAT(1HC,1I7,16H WORD    INTEGER,1I3,1X,80A1)
   49 FORMAT(1HC,1I7,16H NUMBER  INTEGER,1I3,1X,80A1)
   50 FORMAT(1HC,1I7,16H TEXT    INTEGER,1I3,1X,80A1)
   51 FORMAT(1HC,1I7,16H DYNAMIC REAL   ,1I3,1X,80A1)
   52 FORMAT(1HC,1I7,16H WORD    REAL   ,1I3,1X,80A1)
   53 FORMAT(1HC,1I7,16H NUMBER  REAL   ,1I3,1X,80A1)
   54 FORMAT(1HC,1I7,16H TEXT    REAL   ,1I3,1X,80A1)
   55 FORMAT(1HC,1I7,16H PARENTHETICAL  ,1I3,1X,80A1)
C
C     GENERATE DIMENSION STATEMENTS
   56 WRITE(JDSK,57)
   57 FORMAT(1HC)
   58 IF(IFANY.NE.0)CALL DASAVE(1,3,53,10,KMDTYP,
     1KNTCMD,KMDLTR,KNTLTR,KNAME,KLONG,JDSK,IERR)
      CALL DASAVE(1,-1,53,10,KMDTYP,
     1KNTCMD,KMDLTR,KNTLTR,LNAME,LLONG,JDSK,IERR)
      CALL DASAVE(1,3,53,10,KMDWID,
     1KNTCMD,KMDLTR,KNTLTR,MNAME,MLONG,JDSK,IERR)
      IF(JFANY.NE.0)CALL DASAVE(1,3,53,10,KMDARG,
     1KNTCMD,KMDLTR,KNTLTR,NNAME,NLONG,JDSK,IERR)
C
C     GENERATE EQUIVALENCE STATEMENTS
      WRITE(JDSK,57)
      IF(IFANY.NE.0)CALL DASAVE(2,3,53,10,KMDTYP,
     1KNTCMD,KMDLTR,KNTLTR,KNAME,KLONG,JDSK,IERR)
      CALL DASAVE(2,-1,53,10,KMDTYP,
     1KNTCMD,KMDLTR,KNTLTR,LNAME,LLONG,JDSK,IERR)
      CALL DASAVE(2,3,53,10,KMDWID,
     1KNTCMD,KMDLTR,KNTLTR,MNAME,MLONG,JDSK,IERR)
      IF(JFANY.NE.0)CALL DASAVE(2,3,53,10,KMDARG,
     1KNTCMD,KMDLTR,KNTLTR,NNAME,NLONG,JDSK,IERR)
C
C     GENERATE DATA STATEMENTS
      WRITE(JDSK,59)INAME,JNAME,KNTLTR,KNTCMD
   59 FORMAT(1HC/36HC     NUMBER OF CHARACTERS AND WORDS/
     111H      DATA ,6A1,1H,6A1,1H/,1I4,1H,,1I4,1H/)
      IF(IFANY.EQ.0)GO TO 61
      WRITE(JDSK,60)
   60 FORMAT(1HC/37HC     NUMBER IDENTIFYING EACH COMMAND)
      CALL DASAVE(3,3,53,10,KMDTYP,
     1KNTCMD,KMDLTR,KNTLTR,KNAME,KLONG,JDSK,IERR)
   61 WRITE(JDSK,62)
   62 FORMAT(1HC/34HC     LETTERS FORMING EACH COMMAND)
      CALL DASAVE(3,-1,53,10,KMDTYP,
     1KNTCMD,KMDLTR,KNTLTR,LNAME,LLONG,JDSK,IERR)
      WRITE(JDSK,63)
   63 FORMAT(1HC/28HC     LENGTH OF EACH COMMAND)
      CALL DASAVE(3,3,53,10,KMDWID,
     1KNTCMD,KMDLTR,KNTLTR,MNAME,MLONG,JDSK,IERR)
      IF(JFANY.EQ.0)GO TO 65
      WRITE(JDSK,64)
   64 FORMAT(1HC/27HC     TYPE OF ARGUMENT LIST)
      CALL DASAVE(3,3,53,10,KMDARG,
     1KNTCMD,KMDLTR,KNTLTR,NNAME,NLONG,JDSK,IERR)
   65 STOP
C376787486395$'
      END