File: setgetmode.f

package info (click to toggle)
scilab 2.4-1
  • links: PTS
  • area: non-free
  • in suites: potato, slink
  • size: 55,196 kB
  • ctags: 38,019
  • sloc: ansic: 231,970; fortran: 148,976; tcl: 7,099; makefile: 4,585; sh: 2,978; csh: 154; cpp: 101; asm: 39; sed: 5
file content (45 lines) | stat: -rw-r--r-- 1,356 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
      integer function setgetmode(id)
c     Determine if stackg may get the variable id by reference (-4) or
c      by value (0)
c     
c     Copyright INRIA
      include '../stack.h'
c
      integer plus,minus,comma,rparen
      data plus/45/,minus/46/,comma/52/,rparen/42/

      imode=0
      if(sym.eq.plus.or.sym.eq.minus) then
c         imode=-2
         call cvname(id,buf,1)
c         call basout(io,wte,' setgetmode '//buf(1:nlgh)//'+- ')
         goto 33
      endif

      if(rstk(pt).ne.201.or.
     $     rstk(pt-1).ne.101.or.pstk(pt-1).ne.301.or.
     $     rstk(pt-2).ne.307) goto 33
c     pstk(pt-1).ne.301 checks if name is not preceeded by a minus sign
c     name is a first factor of an argument or subscript 
      ip=pt-2

 31   if (sym.ne.comma.and.sym.ne.rparen) goto 33
c     name is followed by a , or a )
      
c     variable is an argument of a function
 32   continue
      ifun=ids(1,ip)
      if (ifun.eq.6.or.ifun.eq.16.or.ifun.eq.21.or.ifun.eq.41.or.
     $     ifun.lt.0) then
c       if(ifun.lt.0) then
         if(ddt.ge.4) then
            call cvname(id,buf,1)
            write(buf(nlgh+1:nlgh+16),'(2i8)') ifun,rstk(ip)
            call basout(io,wte,' setgetmode '//buf(1:nlgh)//' '//
     $           buf(nlgh+1:nlgh+16))
         endif
         imode=-4
      endif
 33   setgetmode=imode
      return
      end