← Back to branch summary

~ubuntu-branches/ubuntu/hoary/scilab/hoary

« back to all changes in this revision

Viewing changes to routines/interf/structcreate.c

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2005-01-09 22:58:21 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20050109225821-473xr8vhgugxxx5j
Tags: 3.0-12
http://bugs.debian.org/255869
changed configure.in to build scilab's own malloc.o, closes: #255869

Show diffs side-by-side

added added

removed removed

Lines of Context:
routines/interf/structcreate.c
 
1
#include "../stack-c.h"
 
2
/*
 
3
int C2F(test)()
 
4
{
 
5
  int sz[3],nz,nf,retval;
 
6
  char* fnames[2];
 
7
  
 
8
  printf("ici\n");
 
9
  sz[0]=2;
 
10
  sz[1]=3;
 
11
  sz[2]=2;
 
12
  nz=3;
 
13
 
 
14
  fnames[0]="A";
 
15
  fnames[1]="Foo";
 
16
  nf=2;
 
17
  Top = Top +1;
 
18
  C2F(structcreate)(&Top, &nz, sz, &nf, fnames, &retval);
 
19
printf("la\n");
 
20
}
 
21
*/
 
22
 
 
23
#define memused(it,mn) ((((mn)*( it % 10))/sizeof(int))+1)
 
24
 
 
25
#include "../stack-c.h"
 
26
/* Table of constant values */
 
27
 
 
28
static integer c17 = 17;
 
29
static integer c1 = 1;
 
30
static integer c4 = 4;
 
31
 
 
32
int C2F(structcreate)(lw, nz, sz, nf, fnames,retval)
 
33
integer *lw, *nz, *sz, *nf, *retval;
 
34
char *fnames[];
 
35
{
 
36
    integer next,k,lr;
 
37
 
 
38
    static integer l;
 
39
    static integer l0, n1, il;
 
40
 
 
41
    *retval = 0;
 
42
    l0 = *lstk(*lw);
 
43
 
 
44
    C2F(intersci).ntypes[*lw -Top + Rhs - 1] = '$';
 
45
    C2F(intersci).iwhere[*lw -Top + Rhs - 1] = *lstk(*lw);
 
46
 
 
47
    if (*lw > intersiz) {
 
48
      Scierror(998,"Too many arguments in the stack edit stack.h and enlarge intersiz\r\n");
 
49
        return 1;
 
50
    }
 
51
/*     size of first entry of the mlist (type) */
 
52
    structtyp(&n1, "size");
 
53
 
 
54
    *retval = 1;
 
55
 
 
56
/*     create the mlist header */
 
57
    il = iadr(l0);
 
58
    Err = sadr(il+6) + n1 - *lstk(Bot);
 
59
    if (Err > 0) {
 
60
        C2F(error)(&c17);
 
61
        return 1;
 
62
    }
 
63
    *istk(il) = 17;
 
64
    *istk(il+1) = 3+*nf;
 
65
    *istk(il + 2) = 1;
 
66
 
 
67
/*     set mlist type entry */
 
68
    l = sadr(il+6+*nf);
 
69
    structtyp(istk(iadr(l)), "set");
 
70
    *istk(il + 3) = *istk(il + 2) + n1;
 
71
    l += n1;
 
72
/*     set dims entry (int32 matrix) */
 
73
    if (!C2F(creimati)("structcreate", &l, &c4, nz, &c1, &lr, &c1,  12L)) return 1;
 
74
    C2F(icopy)(nz,sz,&c1,istk(lr),&c1);
 
75
    n1 = sadr(iadr(l)+4) + memused(c4,*nz) - l;
 
76
    *istk(il + 4) = *istk(il + 3) + n1;
 
77
    l += n1;
 
78
/*     set fields names entry (vector of strings)*/
 
79
    if (!cre_smat_from_str_i("structcreate", &l, nf, &c1, fnames, 12L ,&next)) return 1;
 
80
    n1 = next - l;
 
81
    *istk(il + 5) = *istk(il + 4) + n1;
 
82
    l += n1;
 
83
/*     set struct fields (empty lists)*/
 
84
    for (k=0;k<*nf;k++)
 
85
      {
 
86
        creemptylist(&l,&next);
 
87
        n1 = next - l;
 
88
        l += n1;
 
89
        *istk(il + 6 + k) = *istk(il + 5 + k) + n1;
 
90
      }
 
91
    *lstk(*lw+1)=l;
 
92
} 
 
93
 
 
94
 
 
95
int creemptylist(slw,lw)
 
96
     integer *slw, *lw;
 
97
{
 
98
  integer ix1;
 
99
  integer il;
 
100
  il = iadr(*slw);
 
101
  *istk(il ) = 15;
 
102
  *istk(il + 1) = 0;
 
103
  *istk(il + 2) = 1;
 
104
  ix1 = il +  + 3;
 
105
  *lw = sadr(ix1);
 
106
  return 0;
 
107
}
 
108
int structtyp(ivt, job)
 
109
integer *ivt;
 
110
char *job;
 
111
{
 
112
 
 
113
    /* Local variables */
 
114
    static integer l;
 
115
 
 
116
/*     definition of first field  of tlist's type: struct */
 
117
/*     tlist fields are: */
 
118
/*     dims */
 
119
/*     fields */
 
120
 
 
121
 
 
122
    /* Parameter adjustments */
 
123
    --ivt;
 
124
 
 
125
    if (strcmp(job, "size") == 0) {
 
126
/*        size of the data structure */
 
127
        ivt[1] = 24;
 
128
    } else if (strcmp(job, "nchar") == 0) {
 
129
/*        number of chars defining the type field */
 
130
        ivt[1] = 16;
 
131
    } else if (strcmp(job, "nfield") == 0) {
 
132
/*        number of fields in the tlist */
 
133
        ivt[1] = 3;
 
134
    } else if (strcmp(job, "ptr") == 0) {
 
135
/*        pointers on individual strings */
 
136
        ivt[1] = 1;
 
137
        ivt[2] = 7;
 
138
        ivt[3] = 11;
 
139
        ivt[4] = 17;
 
140
    } else {
 
141
/*        Character string Variable header */
 
142
        ivt[1] = 10;
 
143
        ivt[2] = 1;
 
144
        ivt[3] = 3;
 
145
        ivt[4] = 0;
 
146
        ivt[5] = 1;
 
147
        l = 8;
 
148
/*        entry (1,1) = "struct" */
 
149
        ivt[l + 1] = 28;
 
150
        ivt[l + 2] = 29;
 
151
        ivt[l + 3] = 27;
 
152
        ivt[l + 4] = 30;
 
153
        ivt[l + 5] = 12;
 
154
        ivt[l + 6] = 29;
 
155
        ivt[6] = ivt[5] + 6;
 
156
        l += 6;
 
157
/*        entry (2,1) = "dims" */
 
158
        ivt[l + 1] = 13;
 
159
        ivt[l + 2] = 18;
 
160
        ivt[l + 3] = 22;
 
161
        ivt[l + 4] = 28;
 
162
        ivt[7] = ivt[6] + 4;
 
163
        l += 4;
 
164
/*        entry (3,1) = "fields" */
 
165
        ivt[l + 1] = 15;
 
166
        ivt[l + 2] = 18;
 
167
        ivt[l + 3] = 14;
 
168
        ivt[l + 4] = 21;
 
169
        ivt[l + 5] = 13;
 
170
        ivt[l + 6] = 28;
 
171
        ivt[8] = ivt[7] + 6;
 
172
        l += 6;
 
173
    }
 
174
    return 0;
 
175
} /* structtyp_ */