      subroutine misops
c     ================================== ( Inria    ) =============
c     operations sur les types secondaires (macros librairies...)
c     =============================================================
c     Copyright INRIA
      include '../stack.h'
c     
      integer iadr,sadr,op,rhs1,r
      integer equal,less,great,insert,extrac
      data equal/50/,less/59/,great/60/,insert/2/,extrac/3/
c     
      iadr(l)=l+l-1
      sadr(l)=(l/2)+1
c     
      r=0
      if(pt.gt.0) r=rstk(pt)
      if (r.eq.408) goto 50
      op=fin
c     
      if (ddt .eq. 4) then
         write(buf(1:4),'(i4)') fin
         call basout(io,wte,' misops '//buf(1:4))
      endif
c     
      fun=0
c     
      lw=lstk(top+1)
      if(op.eq.insert) then
         rhs1=2
      elseif(op.eq.extrac) then
         rhs1=1
      else
         rhs1=rhs
      endif
c     
      il2=iadr(lstk(top))
      if(istk(il2).lt.0) il2=iadr(istk(il2+1))
c     
c     
      ityp=0
      do 01 i=top+1-rhs1,top
        ityp=max(ityp,abs(istk(iadr(lstk(i)))))
 01   continue
      if(ityp.eq.11.or.ityp.eq.13) goto 100
      if(ityp.eq.14) goto 50
      call error(43)
      return
c
c
 50   continue
c     librairies
      call libops
      return
c     
 100  continue
c     macros
      call macroops
      return
c     
      end

      subroutine libops
c     Copyright INRIA
      include '../stack.h'
c     
      integer iadr,sadr,op,r
      integer id(nsiz)
      integer equal,less,great,insert,extrac,blank
      logical cresmat,ptover

      data equal/50/,less/59/,great/60/,insert/2/,extrac/3/
      data blank/40/
c     
      iadr(l)=l+l-1
      sadr(l)=(l/2)+1
c     
      r=0
      if(pt.gt.0) r=rstk(pt)
      if (r.eq.408) goto 32

      op=fin
      
      if(op.eq.equal.or.op.eq.less+great) then
         goto 10
      elseif (op.eq.extrac) then
         goto 30
      else
c     .  operations non implantees
         fin=-fin
         return
      endif

 10   il2=iadr(lstk(top))
      if(istk(il2).lt.0) il2=iadr(istk(il2+1))

      top = top-1
      il1=iadr(lstk(top))
      ilr=il1
      if(istk(il1).lt.0) il1=iadr(istk(il1+1))
      itrue=1
      if(op.eq.less+great) itrue=0
      ilog=1-itrue
c     
      if(istk(il1).ne.istk(il2)) goto 15
      if(istk(il1+1).ne.istk(il2+1)) goto 15
      nf=istk(il1+1)
      do 11 i=1,nf
         if(istk(il1+1+i).ne.istk(il2+1+i)) goto 15
 11   continue
      ln=2+nf
      if(istk(il1+ln).ne.istk(il2+ln)) goto 15
      nh=istk(il1+ln)
      if(nh.gt.0) then
         do 12 i=1,nh
            if(istk(il1+ln+i).ne.istk(il2+ln+i)) goto 15
 12      continue
      endif
      ln=ln+nh+1
      if(istk(il1+ln).ne.istk(il2+ln)) goto 15
      long=istk(il1+ln)
      do 13 i=1,long*nsiz
         if(istk(il1+ln+i).ne.istk(il2+ln+i)) goto 15
 13   continue
      ilog=itrue
      
 15   istk(ilr)=4
      istk(ilr+1)=1
      istk(ilr+2)=1
      istk(ilr+3)=ilog
      lstk(top+1)=sadr(ilr+4)
      return
c     
c     extraction
 30   continue
c     .  the library
      il2=iadr(lstk(top))
      if(istk(il2).lt.0) il2=iadr(istk(il2+1))

c     . the index
      il1=iadr(lstk(top-1))
      ilr=il1
      if(istk(il1).lt.0) il1=iadr(istk(il1+1))
      if(istk(il1).eq.10) then
c     .    only extract the function
         if(istk(il1+1)*istk(il1+2).ne.1) then
            call error(44)
            return
         endif
c     .  get the macro name and its length
         nn=istk(il1+5)-1
         ilnam=il1+6
      elseif(istk(il1).eq.15) then
c     .  extract and call
         n1=istk(il1+1)
         l=sadr(il1+3+n1)
         iln=iadr(l)
         if(istk(iln).ne.10) then
            call error(44)
            return
         endif
         if(istk(iln+1)*istk(iln+2).ne.1) then
            call error(44)
            return
         endif
         nn=istk(iln+5)-1
         ilnam=iln+6
      else
         call error(44)
         return
      endif
c     extract the function out of the library
c     get the lib path
      np=istk(il2+1)
      ilpath=il2+2
c     load the bin file
c     create a variable with the bin file path
      top=top+1
      if(.not.cresmat(' ',top,1,1,np+4+nn)) return
      call getsimat('load',top,top,mp,mp,1,1,ilp,nlp)
c     path
      call icopy(np,istk(ilpath),1,istk(ilp),1)
c     name
      call icopy(nn,istk(ilnam),1,istk(ilp+np),1) 
c     extension
      call cvstr(4,istk(ilp+np+nn),'.bin',0)
c     load variables stored in the given file
      srhs=rhs
      slhs=lhs
      fun=0
      rhs=1
      lhs=1
      id(1)=blank

      if(istk(il1).eq.15) then
c     simulate a macro to preserve old function definition
         k = lpt(6)
         if(k+13+nsiz.gt.lsiz) then
            call error(108)
            return
         endif
         lin(k+1) = lpt(1)
         lin(k+5) = bot
         
         lpt(1) = k + 13+nsiz
         lpt(6)=lpt(1)
         macr=macr+1
      endif

      call intload(id,k)
      if(err.gt.0) return
      rhs=srhs
      lhs=slhs
c     
      if(istk(il1).eq.10) then
         top=top-2
         istk(il1)=0
         lstk(top+1)=sadr(il1+1)
         return
      endif

      top=top-2
c     form individual variables with the 2..n1 entries of index
      l1=lstk(top)
      do 31 i=2,n1
         lstk(top+1)=lstk(top)+istk(il1+2+i)-istk(il1+1+i)
         top=top+1
 31   continue
      l=sadr(il1+3+n1)+istk(il1+3)-1
      call dcopy(istk(il1+2+n1)-istk(il1+3),stk(l),1,stk(l1),1)
      top=top-1
      rhs=n1-1

c     evaluate loaded macro for given arguments
      fin=lstk(fin)
      if (ptover(1,psiz)) return
      rstk(pt)=408
      icall=5
c     *call* macro
      return
 32   macr=macr-1
      pt=pt-1
      k = lpt(1) - (13+nsiz)
      bot=lin(k+5)
      lpt(1)=lin(k+1)
      fin=1

      return
      end

      subroutine macroops
c     Copyright INRIA
      include '../stack.h'
c     
      integer iadr,sadr,op,rhs1
      integer equal,less,great,insert,extrac
      data equal/50/,less/59/,great/60/,insert/2/,extrac/3/
c     
      iadr(l)=l+l-1
      sadr(l)=(l/2)+1
c     
      op=fin
c
      if(op.eq.equal.or.op.eq.less+great) goto 180
c     
c     operations non implantees
      fin=-fin
      return
c     
c     comparaisons of macros
 180  continue
      il2=iadr(lstk(top))
      if(istk(il2).lt.0) il2=iadr(istk(il2+1))

      top = top-1
      il1=iadr(lstk(top))
      ilr=il1
      if(istk(il1).lt.0) il1=iadr(istk(il1+1))
      itrue=1
      if(op.eq.less+great) itrue=0
      ilog=1-itrue
c     
      If(istk(il1).ne.istk(il2)) goto 185
      if(istk(il1+1).ne.istk(il2+1)) goto 185
      mrhs=istk(il1+1)
      do 181 i=1,nsiz*mrhs
         if(istk(il1+1+i).ne.istk(il2+1+i)) goto 185
 181  continue
      ln=2+nsiz*mrhs
      if(istk(il1+ln).ne.istk(il2+ln)) goto 185
      mlhs=istk(il1+ln)
      do 182 i=1,nsiz*mlhs
         if(istk(il1+ln+i).ne.istk(il2+ln+i)) goto 185
 182  continue
      ln=ln+nsiz*mlhs+1
      if(istk(il1+ln).ne.istk(il2+ln)) goto 185
      long=istk(il1+ln)
      do 183 i=1,long
         if(istk(il1+ln+i).ne.istk(il2+ln+i)) goto 185
 183  continue
      ilog=itrue
      
 185  istk(ilr)=4
      istk(ilr+1)=1
      istk(ilr+2)=1
      istk(ilr+3)=ilog
      lstk(top+1)=sadr(ilr+4)
      return
      end
