      SUBROUTINE GRAMAR
C     READ AND INTERPRETE THE META-GRAMMAR
C     2022-02-07: no XML
C     GF 01.08.1980: ']' TERMINATES 'RULE' TOO
C     GF 27.07.1980: WITH 'EOSTMT,AXIOM'
C     GF 19.07.1980: WITHOUT 'SETS', 'GRASYB', 'FMEM'-CHECK FOR 'SEMWRI'
C           PARAMETER 'GRANOU' SETS NO 'UNCH'
C     GF 12.07.1980 : INT PARASK, TEST,MEMHIB=... DELETED
C
      INCLUDE 'PARS.f'
      INCLUDE 'MEMS.f'
      INCLUDE 'PROS.f'
      INCLUDE 'SEMS.f'
      INCLUDE 'STRS.f'
      INCLUDE 'SYMS.f'
      INTEGER*2 PARASK
      INTEGER*2 I
     = ,ADDSUB   ! = 1(0) : ADD (SUBTRACT) A PRODUCTION
     = ,ENTITY   ! RESULT OF 'SCAN'
     = ,LEFT     ! THE LEFT SIDE OF A PRODUCTION
     = ,LNG      ! THE LENGTH OF A PRODUCTION
     = ,MON      ! -> MEMBER NUMBER ONE OF A PRODUCTION
     = ,PROD     ! -> A PRODUCTION
     = ,SEMA     ! -> THE SEMANTICS FOR A PRODUCTION
     = ,SYMBOL   ! RESULT OF 'SCAN'
     = ,SINGLE   ! = 1 (0) IF EVERY PRODUCTION IS (NOT) PROCESSED
      INTEGER*2 TEST
C
      SINGLE = PARASK('SINGLE',1,6,0)
      TEST   = PARASK('GRAMAR',1,6,0)
      
CAXI  CALL LRINIT
      
      CALL SCAINI
      CALL SCANR(I,EOFILE)
      CALL SCANR(I,IDENT)
      CALL SCANR(I,NUMBER)
      CALL SCANR(I,STRIN)
      CALL SPEINS('=>',1,2,ARROW)
      CALL SPEINS('|' ,1,1,BAR)
      CALL SPEINS('=' ,1,1,EQUALS)
      CALL SPEINS('-' ,1,1,MINUS)
      CALL SPEINS('.' ,1,1,PERIOD)
      CALL SPEINS(']' ,1,1,BUS)
      CALL SPEINS('[' ,1,1,SUB)
      CALL SPEINS('#' ,1,1,NUMSIG)
      CALL SPEINS('(' ,1,1,OPENP)
      CALL SPEINS(')' ,1,1,CLOSP)
      CALL SPEINS('+' ,1,1,PLUS)
      CALL SPEINS('*' ,1,1,TIMES)
      CALL SPEINS('/' ,1,1,DIVIDE)
      CALL SPEINS(';' ,1,1,I)
      CALL SCANR (I,EOSTMT)
      AXIOM = FSYM
C
CAXI  CALL LRAXIO ()
      SYMBOL = I ! was I 2005-04-07
      SYMBOL = 0 ! was I 2005-04-07
2     IF(SYMBOL .EQ. SUB .OR. SYMBOL .EQ. EOFILE) GOTO 1
C       PROCESS THE REST OF THE INTERFACE TO THE SCANNER
        CALL SCANR(SYMBOL,ENTITY)
        IF (SYMBOL .NE. STRIN) GOTO 3
          CALL SPEINS(STRNG,SYMPOS(ENTITY),SYMEND(ENTITY),I)
3       CONTINUE ! STRIN
      GOTO 2
1     CONTINUE ! SKIP INTERFACE
      GOTO 100
101   CONTINUE
        CALL ASSERT(50,ENTITY,-ENTITY)
100   CONTINUE
        CALL SCANR (SYMBOL,ENTITY)
C       CALL XML2 ('GRAMAR', 1, 6, SYMBOL,ENTITY)
130   CONTINUE
5       IF (SYMBOL .GT. BUS) GOTO 107 ! LIDEN
          GOTO (101,101,101,101,101
     =     ,106,107,108,109,110,111,112,113,114,115),SYMBOL
C           EOF IDE NUM STR  =>  |   =   -   .   ]
109   CONTINUE
        CALL SPEINS(STRNG,SYMPOS(ENTITY),SYMEND(ENTITY),I)
        ENTITY = I
108   CONTINUE
107   CONTINUE
        ! STORE THE ENTITY IN 'MEM'
        IF (FMEM .GE. MEMHIB) GOTO 7
          MEM(FMEM) = ENTITY
          FMEM = FMEM + 1
        GOTO 8 ! NO 'MEM'-OVERFLOW
7       CONTINUE
          CALL ASSERT(57,FMEM,ENTITY)
8       CONTINUE
        GOTO 100
C
112   CONTINUE
        ADDSUB = 1
131   CONTINUE
        FMEM = FMEM - 1 ! DELETE LEFT SIDE
        LEFT = MEM(FMEM)
        MON = FMEM
        SEMA = 0
        GOTO 100
113   CONTINUE
        ADDSUB = 0
        GOTO 131
110   CONTINUE
        CALL SCANR(SYMBOL,ENTITY)
        IF (SYMBOL .NE. NUMSIG) GOTO 9
          CALL SCANR(SYMBOL,ENTITY)
          IF (SYMBOL .NE. NUMBER) GOTO 11
            CALL SYMNUM(ENTITY,SEMA)
11        CONTINUE ! NUMBER
        GOTO 10 ! = NUMSIG
9       CONTINUE
          CALL ASSERT(55,SYMBOL,NUMSIG)
10      CONTINUE
12      IF(SYMBOL .EQ. PERIOD .OR. SYMBOL .EQ. BAR
     =    .OR. SYMBOL .EQ. BUS
     =  ) GOTO 13
          CALL SCANR(SYMBOL,ENTITY)
        GOTO 12
13      CONTINUE
        GOTO 130
111   CONTINUE
114   CONTINUE
115   CONTINUE ! ']'
        LNG = FMEM - MON
        CALL PROCHA(ADDSUB,LEFT,MON,LNG,PROD)
        IF (SINGLE .NE. 1) GOTO 14
C         CALL REORG
14      CONTINUE
        IF (SEMA .LE. 0) GOTO 15
          PROSEM(PROD) = FSEM
          CALL SEMWRI(0,SEPR,SEMA)
          CALL SEMWRI(0,EOS,0)
          SEMA = 0
        GOTO 18 ! SEMA .LE. 0
15      CONTINUE
          PROSEM(PROD) = PNOSEM + PARASK('GRANOU',1,6,0)
18      CONTINUE
        MON = FMEM
        IF (SYMBOL .NE. BUS)
     =    GOTO 100 ! FOR ']' FALL THROUGH
106   CONTINUE
        RETURN
      END
