      subroutine clause
c     ======================================================================
c     gestion des structures de controle
c     ======================================================================
c     Copyright INRIA
      include '../stack.h'
      integer while(nsiz),iff(nsiz),else(nsiz),ennd(nsiz)
      integer do(nsiz),thenn(nsiz),cas(nsiz),sel(nsiz)
      integer elsif(nsiz)
      integer semi,equal,eol,blank,comma,name,cmt
      integer lparen,rparen
      integer r,r1
      logical eqid,istrue,ok,first,eptover
      parameter (nz1=nsiz-1,nz2=nsiz-2)
      parameter (iif=1,iwhile=2,iselect=3)
      data semi/43/,equal/50/,eol/99/,blank/40/
      data comma/52/,name/1/,cmt/2/
      data lparen/41/,rparen/42/
      data do/673716237,nz1*673720360/, else/236721422,nz1*673720360/
      data ennd/671946510,nz1*673720360/
      data iff/673713938,nz1*673720360/
      data thenn/386797853,nz1*673720360/
      data while/353505568,673720334,nz2*673720360/
      data cas/236718604,nz1*673720360/
      data sel/236260892,673717516,nz2*673720360/
      data elsif/236721422,673713938,nz2*673720360/
      



c     
      r = -fin-10
      fin = 0
      r1=0
      if(pt.gt.0) r1=rstk(pt)
c     
      if (ddt .eq. 4) then
         write(buf(1:12),'(3i4)') pt,r1,r
         call basout(io,wte,' clause pt:'//buf(1:4)//' rstk(pt):'//
     &        buf(5:8)//' -fin-10:'//buf(9:12))
      endif
c     
      if(r.le.0.and.pt.le.0) then
         call error(34)
         return
      endif
      go to (02,30,30,55,30,55,55),r
c     
 01   r = rstk(pt)
      ir=r/100
      if(ir.ne.8) goto 99
      goto(05,15,40,45,55,65,46),r-800
      goto 99
c     
c     for
c     
 02   call getsym
      if ( eptover(2,psiz))  return
      pstk(pt-1)=0
      rstk(pt-1)=0
      if (sym .ne. name) then
         if (sym. eq. lparen) then
c     .  for matlab compatiblity  for (k=1:n)
            call getsym
            pstk(pt-1)=1
         else
            call error(34)
            return
         endif
      endif
      call putid(ids(1,pt),syn)
      call getsym
      if (sym .ne. equal) then
         call error(34)
         return
      endif
      call getsym
      if(comp(1).ne.0) then
         rstk(pt) = 800
         call compcl
         if(err.gt.0) return
      endif
      rstk(pt) = 801
      icall=1
c     *call* expr
      return
 05   continue
      if(err1.gt.0) goto 20
      if(comp(1).ne.0) call compcl
      if(err.gt.0) return
      if (pstk(pt-1).eq.1) then
c     .  for matlab compatiblity: for (k=1:n)
         if (sym. eq. rparen) then
            call getsym
         else
            call error(3)
            return
         endif
      endif
      pstk(pt-1) = 0
      ids(1,pt-1)=top
      if (eqid(syn,do)) then
         sym=comma
         if(char1.eq.eol) call getsym
      endif
      if(sym.eq.comma.or.sym.eq.semi) then
         sym = semi
         pstk(pt) = lpt(4) - 1
      elseif( sym.eq.cmt) then
         call parsecomment
         sym=semi
         pstk(pt) = lpt(4)
      elseif( sym.eq.eol) then
         sym=semi
         pstk(pt) = lpt(4)
      elseif(lin(lpt(3)-2).eq.blank) then
         sym=semi
         lpt(4)=lpt(3)-1
         pstk(pt) = lpt(4)
         char1=blank
      else
         call error(35)
         return
      endif
c     on recherche le "end" pour s'assurer que toutes les lignes relatives 
c     sont chargee (pb des matrices sur plusieurs lignes)
      call skpins(1)
      if(err.gt.0) return
      first=.true.
 10   if(top.ne.ids(1,pt-1)) then 
         call error(115)
         return
      endif
      call nextj(ids(1,pt),pstk(pt-1))
      if(err.gt.0) return
      if(pstk(pt-1).eq.0) goto  20
      first=.false.
      lpt(4) = pstk(pt)
      char1 = blank
      rstk(pt) = 802
      icall=7
c     *call* parse
      return
 15   continue
      if(err1.gt.0.and.catch.eq.0) then
        
c     .  remove variable associated to the expression and skip to the end
         top=ids(1,pt-1)-1
         goto 20
      endif
      if(comp(1).eq.0) goto 10
      call compcl
      if(err.gt.0) return
c     
c     fin for
 20   continue
      pt = pt-2
      icall=7
c      char1 = blank
      return
c     
c     while  if  select/case or if/elseif
c   
 30   if ( eptover(1,psiz)) return
      if (eqid(syn,while))  then
         ids(1,pt)=iwhile
      elseif(eqid(syn,sel))  then
         ids(1,pt)=iselect
      else
         ids(1,pt)=iif
      endif
C      call putid(ids(1,pt),syn)

      pstk(pt) = lpt(4)-1

      if(ids(1,pt).eq.iwhile) then
c     .  while, look for the end to be sure all lines are loaded
         call skpins(1)
         if(err.gt.0) return
      endif
 35   lpt(4) = pstk(pt)
      pstk(pt)=lpt(4)
      char1 = blank
      call getsym
      rstk(pt)=803
      if(comp(1).ne.0) call compcl
      if(err.gt.0) return
      goto 37
 36   rstk(pt) = 803
      call getsym
 37   icall=1
c     *call* expr
      return
 40   if (ids(1,pt).ne.iselect) goto 46
c     select expression evaluated
 41   continue
c     skip following commas or semi columns if any
      if(sym.eq.comma.or.sym.eq.semi) then
         call getsym
         goto 41
      endif
c     end of line reached?
      if(sym.eq.eol.or.sym.eq.cmt) then
         if(sym.eq.cmt) call parsecomment
         if(macr.gt.0.and.lin(lpt(4)+1).eq.eol) then
            call error(47)
            return
         endif
         if(comp(1).ne.0) call seteol()
c    .    get the following line
         if(lpt(4).eq.lpt(6))  then
            call getlin(1,0)
         else
            lpt(4)=lpt(4)+1
            char1=blank
         endif
         call getsym
         goto 41
      endif
c     looking for the "case" keyword
      if(sym.eq.name.and.eqid(syn,cas)) then
         rstk(pt)=807
         if(comp(1).ne.0) then
            call compcl
            if(err.gt.0) return
         endif
      elseif(lin(lpt(3)-2).eq.blank) then
         sym=semi
         lpt(4)=lpt(3)-1
         char1=blank
         goto 41
      else
         call error(35)
         return
      endif   

 42   if(comp(1).eq.0) then
c     recopie de la premiere expression
         l=lstk(top)
         l1=lstk(top+1)
         if(top+2.ge.bot) then
            call error(18)
            if(err.gt.0) return
         endif
         err=lstk(top+1)+l1-l-lstk(bot)
         if(err.gt.0) then
            call error(17)
            if(err.gt.0) return
         endif
         call unsfdcopy(l1-l,stk(l),1,stk(l1),1)
         top=top+1
         lstk(top+1)=lstk(top)+l1-l
      endif
 43   call getsym
      rstk(pt) = 804
      icall=1
c     *call* expr
      return
 45   continue
      if(comp(2).ne.0) goto 46
      rstk(pt)=807
      fin = equal
      rhs=2
      icall=4
c     *call* allops(==)
      return
 46   if (eqid(syn,do) .or. eqid(syn,thenn)
     &     .or.sym.eq.comma.or.sym.eq.semi.or.sym.eq.eol) then
         sym = semi
      elseif(sym.eq.cmt) then
         call parsecomment
         sym = semi
      elseif(lin(lpt(3)-2).eq.blank) then
c     .  added for matlab compatibility (then or , is not mandatory)
         sym=semi
         lpt(4)=lpt(3)-1
         char1=blank
      else
         call error(35)
         return
      endif
      if(comp(1).ne.0) goto 48
c     comparaison ...
      ok=istrue(1)
      if(err.gt.0) return
      if(ok) then
         goto 50
      else
         call skpins(0)
         if(err.gt.0) return
         if(eqid(syn,else)) goto 60
         if(eqid(syn,elsif)) then
            if(ids(1,pt).ne.iif) then
               call error(34)
               return
            endif
            goto 36
         endif
         if(eqid(syn,cas)) then
            if(ids(1,pt).ne.iselect) then
               call error(34)
               return
            endif
            goto 42
         endif
         if(eqid(syn,ennd)) goto 66
      endif
 48   rstk(pt)=804
      call  compcl
      if(err.gt.0) return
c     
c     then
c     --------
 50   toperr=top
      rstk(pt) = 805
      icall=7
c     *call* parse
      return
 55   if(comp(1).eq.0) then
         if (ids(1,pt).eq.iwhile) go to 35
         if(.not.eqid(syn,ennd)) then
            call skpins(1)
            if(err.gt.0) return
         endif
      else
         call compcl
         if(err.gt.0) return
         if(eqid(syn,else)) goto 60
         if(eqid(syn,elsif)) goto 36
         if(eqid(syn,cas))  goto 43
      endif
      goto 66
c     
c     else
c     ---------
 60   rstk(pt) = 806
      icall=7
c     *call parse*
      return
 65   if(comp(1).ne.0) then
         call compcl
         if(err.gt.0) return
      endif
      goto 66
c     
c     fin if ou while ou select
c------------------------------
 66   if(ids(1,pt).eq.iselect.and.comp(1).eq.0) top=top-1
      pt=pt-1
      icall=7
      return
c
 99   call error(22)
      if (err .gt. 0) return
      return
      end
