File: list2vars.f

package info (click to toggle)
scilab 4.0-12
  • links: PTS
  • area: non-free
  • in suites: etch, etch-m68k
  • size: 100,640 kB
  • ctags: 57,333
  • sloc: ansic: 377,889; fortran: 242,862; xml: 179,819; tcl: 42,062; sh: 10,593; ml: 9,441; makefile: 4,377; cpp: 1,354; java: 621; csh: 260; yacc: 247; perl: 130; lex: 126; asm: 72; lisp: 30
file content (46 lines) | stat: -rw-r--r-- 1,093 bytes parent folder | download | duplicates (4) 
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
46
 
      subroutine list2vars(n1,ltop)
c     given a list stored in position top in the stack
c     list2vars computes lstk(top:top-1+n1) pointers on the beginning of
c     each first n1 entries of the list.

c     Copyright INRIA
c     WARNING : if topk is the entry value of top, lstk(topk) is
c     incremented by sadr(3+n). Previous value is returned in ltop.
c
      include '../stack.h'
      integer iadr,sadr
c
      iadr(l) = l + l - 1
      sadr(l) = (l/2) + 1
c
      if (n1.eq.0) then
         top=top-1
         return
      endif
      il=iadr(lstk(top))
      if(istk(il).ne.15) then
         if(n1.le.1) return
         call error(98)
         return
      endif
      n=istk(il+1)
      if(n1.gt.n) then
         call error(98)
         return
      endif
      l=lstk(top)
      ltop=l
      l0=sadr(il+1+n+2)-1
      do 10 i=1,n1
         lstk(top)=l0+istk(il+1+i)
         top=top+1
 10   continue
      top=top-1
      lstk(top+1)=l0+istk(il+2+n1)
      return
      end
      subroutine ltopadj(ltop)
      include '../stack.h'
      lstk(top+1)=ltop
      return
      end