← Back to branch summary

~ubuntu-branches/debian/jessie/rtai/jessie

« back to all changes in this revision

Viewing changes to rtai-lab/scicoslab/macros/RTAI/RTAICodeGen_.sci

  • Committer: Bazaar Package Importer
  • Author(s): Roland Stigge
  • Date: 2009-07-04 11:47:08 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20090704114708-0ivbkccfaawz2pby
Tags: 3.7.1-1
* New upstream release
* debian/control: Standards-Version: 3.8.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtai-lab/scicoslab/macros/RTAI/RTAICodeGen_.sci
 
1
//** INRIA / SCILAB / Roberto Bucher / Simone Mannori / Paolo Gai
 
2
//** 16 Jan 2008
 
3
//**
 
4
// Modified by Roberto Bucher roberto.bucher@supsi.ch from the original
 
5
// CodeGeneration_.sci
 
6
//
 
7
// Input editor function of Scicos code generator
 
8
//
 
9
//
 
10
//** 10 Set 2007 : cleaner startup code by Simone Mannori
 
11
 
 
12
function RTAICodeGen_()
 
13
 
 
14
//** ------------- Preliminary I/O section ___________________________________________________________________________
 
15
    k = [] ; //** index of the CodeGen source superbloc candidate
 
16
 
 
17
    xc = %pt(1); //** last valid click position 
 
18
    yc = %pt(2); 
 
19
    
 
20
    %pt = []   ;
 
21
    Cmenu = [] ;
 
22
 
 
23
    k  = getobj(scs_m,[xc;yc]) ; //** look for a block 
 
24
    //** check if we have clicked near an object
 
25
    if k==[] then
 
26
      return
 
27
    //** check if we have clicked near a block
 
28
    elseif typeof(scs_m.objs(k))<>"Block" then
 
29
      return
 
30
    end
 
31
 
 
32
    //** If the clicked/selected block is really a superblock 
 
33
    //**         <k>
 
34
    if scs_m.objs(k).model.sim(1)=="super" then
 
35
      
 
36
        XX = scs_m.objs(k); //** isolate the super block to use 
 
37
        
 
38
//---------------------------------------------------->       THE REAL CODE GEN IS HERE --------------------------------
 
39
        //** the real code generator is here 
 
40
        [ok, XX, alreadyran, flgcdgen, szclkINTemp, freof] =  do_compile_superblock42(XX, scs_m, k, alreadyran);
 
41
        
 
42
        
 
43
        //**quick fix for sblock that contains scope
 
44
        gh_curwin = scf(curwin)
 
45
    
 
46
    else
 
47
      //** the clicked/selected block is NOT a superblock 
 
48
      message("Generation Code only work for a Super Block ! ")
 
49
    end
 
50
 
 
51
endfunction
 
52
 
 
53
//==========================================================================
 
54
//BlockProto : generate prototype
 
55
//            of a scicos block
 
56
//
 
57
//
 
58
//16/06/07 Author : A.Layec
 
59
//Copyright INRIA
 
60
 
 
61
// Modified for RT purposes by Roberto Bucher - RTAI Team
 
62
// roberto.bucher@supsi.ch
 
63
 
 
64
function [txt]=BlockProto(bk)
 
65
 
 
66
  nin=inpptr(bk+1)-inpptr(bk);  //* number of input ports */
 
67
  nout=outptr(bk+1)-outptr(bk); //* number of output ports */
 
68
 
 
69
  //**
 
70
  ftyp=funtyp(bk)
 
71
  if ftyp>2000 then ftyp=ftyp-2000,end
 
72
  if ftyp>1000 then ftyp=ftyp-1000,end
 
73
 
 
74
  //** check function type
 
75
  if ftyp < 0 then //** ifthenelse eselect blocks
 
76
      txt = [];
 
77
      return;
 
78
  else
 
79
    if (ftyp<>0 & ftyp<>1 & ftyp<>2 & ftyp<>3 & ftyp<>4) then
 
80
      disp("types other than 0,1,2,3 or 4 are not yet supported.")
 
81
      txt = [];
 
82
      return;
 
83
    end
 
84
  end
 
85
 
 
86
  //** add comment
 
87
  txt=[get_comment('proto_blk',list(funs(bk),funtyp(bk),bk));]
 
88
 
 
89
  select ftyp
 
90
    //** zero funtyp
 
91
    case 0 then
 
92
 
 
93
      //*********** prototype definition ***********//
 
94
      txtp=['(int *, int *, double *, double *, double *, int *, double *, \';
 
95
            ' int *, double *, int *, double *, int *,int *, int *, \';
 
96
            ' double *, int *, double *, int *);'];
 
97
      if (funtyp(bk)>2000 & funtyp(bk)<3000)
 
98
        blank = get_blank('void '+funs(bk)+'(');
 
99
        txtp(1) = 'void '+funs(bk)+txtp(1);
 
100
      elseif (funtyp(bk)<2000)
 
101
        txtp(1) = 'void C2F('+funs(bk)+')'+txtp(1);
 
102
        blank = get_blank('void C2F('+funs(bk)+')');
 
103
      end
 
104
      txtp(2:$) = blank + txtp(2:$);
 
105
      txt = [txt;txtp];
 
106
      //*******************************************//
 
107
 
 
108
 
 
109
    //**
 
110
    case 1 then
 
111
 
 
112
      //*********** prototype definition ***********//
 
113
      txtp=['(int *, int *, double *, double *, double *, int *, double *, \';
 
114
            ' int *, double *, int *, double *, int *,int *, int *';]
 
115
      if (funtyp(bk)>2000 & funtyp(bk)<3000)
 
116
        blank = get_blank('void '+funs(bk)+'(');
 
117
        txtp(1) = 'void '+funs(bk)+txtp(1);
 
118
      elseif (funtyp(bk)<2000)
 
119
        txtp(1) = 'void C2F('+funs(bk)+')'+txtp(1);
 
120
        blank = get_blank('void C2F('+funs(bk)+')');
 
121
      end
 
122
      if nin>=1 | nout>=1 then
 
123
        txtp($)=txtp($)+', \'
 
124
        txtp=[txtp;'']
 
125
        if nin>=1 then
 
126
          for k=1:nin
 
127
            txtp($)=txtp($)+' double *, int * ,'
 
128
          end
 
129
          txtp($)=part(txtp($),1:length(txtp($))-1); //remove last ,
 
130
        end
 
131
        if nout>=1 then
 
132
          if nin>=1 then
 
133
            txtp($)=txtp($)+', \'
 
134
            txtp=[txtp;'']
 
135
          end
 
136
          for k=1:nout
 
137
            txtp($)=txtp($)+' double *, int * ,'
 
138
          end
 
139
          txtp($)=part(txtp($),1:length(txtp($))-1); //remove last ,
 
140
        end
 
141
      end
 
142
 
 
143
      if ztyp(bk) then
 
144
        txtp($)=txtp($)+', \'
 
145
        txtp=[txtp;' double *,int *);'];
 
146
      else
 
147
        txtp($)=txtp($)+');';
 
148
      end
 
149
 
 
150
      txtp(2:$) = blank + txtp(2:$);
 
151
      txt = [txt;txtp];
 
152
      //*******************************************//
 
153
 
 
154
    //**
 
155
    case 2 then
 
156
 
 
157
      //*********** prototype definition ***********//
 
158
 
 
159
      txtp=['void '+funs(bk)+...
 
160
            '(int *, int *, double *, double *, double *, int *, double *, \';
 
161
            ' int *, double *, int *, double *, int *, int *, int *, \'
 
162
            ' double **, int *, int *, double **,int *, int *'];
 
163
      if ~ztyp(bk) then
 
164
        txtp($)=txtp($)+');';
 
165
      else
 
166
        txtp($)=txtp($)+', \';
 
167
        txtp=[txtp;
 
168
              ' double *,int *);']
 
169
      end
 
170
      blank = get_blank('void '+funs(bk));
 
171
      txtp(2:$) = blank + txtp(2:$);
 
172
      txt = [txt;txtp];
 
173
      //********************************************//
 
174
 
 
175
    //**
 
176
    case 4 then
 
177
      txt=[txt;
 
178
           'void '+funs(bk)+'(scicos_block *, int );'];
 
179
 
 
180
  end
 
181
endfunction
 
182
 
 
183
//==========================================================================
 
184
//CallBlock : generate C calling sequence
 
185
//            of a scicos block
 
186
//
 
187
//inputs : bk   : bloc index
 
188
//         pt   : evt activation number
 
189
//         flag : flag
 
190
//
 
191
//output : txt  :
 
192
//
 
193
//16/06/07 Authors : Alan Layec
 
194
//Copyright INRIA
 
195
 
 
196
// Modified for RT purposes by Roberto Bucher - RTAI Team
 
197
// roberto.bucher@supsi.ch
 
198
 
 
199
function txt=call_block42(bk,pt,flag)
 
200
 
 
201
  txt=[]
 
202
  //**
 
203
  if flag==2 & ((zptr(bk+1)-zptr(bk))+..
 
204
                (ozptr(bk+1)-ozptr(bk))+..
 
205
                (xptr(bk+1)-xptr(bk)+..
 
206
                with_work(bk))==0 |..
 
207
                pt<=0) & ~(stalone & or(bk==actt(:,1))) then
 
208
    return // block without state or continuously activated
 
209
  end
 
210
  if flag==0 & ((xptr(bk+1)-xptr(bk))==0) then
 
211
    return // block without continuous state
 
212
  end
 
213
  if flag==9 & ((zcptr(bk+1)-zcptr(bk))==0) then
 
214
    return // block without continuous state
 
215
  end
 
216
  if flag==3 & ((clkptr(bk+1)-clkptr(bk))==0) then
 
217
    return
 
218
  end
 
219
 
 
220
  //** adjust pt
 
221
  if ~(flag==3 & ((zcptr(bk+1)-zcptr(bk))<>0)) then
 
222
    pt=abs(pt)
 
223
  end
 
224
 
 
225
  //** add comment
 
226
  txt=[get_comment('call_blk',list(funs(bk),funtyp(bk),bk));]
 
227
 
 
228
  //** set nevprt and flag for called block
 
229
  txt=[txt;
 
230
       'block_'+rdnom+'['+string(bk-1)+'].nevprt = '+string(pt)+';'
 
231
       'local_flag = '+string(flag)+';']
 
232
 
 
233
  //**see if its bidon, actuator or sensor
 
234
  if funs(bk)=='bidon' then
 
235
    txt=[];
 
236
    return
 
237
  elseif funs(bk)=='bidon2' then
 
238
    txt=[];
 
239
    return
 
240
  elseif or(bk==actt(:,1)) then
 
241
    ind=find(bk==actt(:,1))
 
242
    uk=actt(ind,2)
 
243
    nuk_1=actt(ind,3)
 
244
    nuk_2=actt(ind,4)
 
245
    uk_t=actt(ind,5)
 
246
    txt = [txt;
 
247
           'nport = '+string(ind)+';']
 
248
    txt = [txt;
 
249
           rdnom+'_actuator(&local_flag, &nport, &block_'+rdnom+'['+string(bk-1)+'].nevprt, \'
 
250
           get_blank(rdnom+'_actuator')+' &t, ('+mat2scs_c_ptr(outtb(uk))+' *)'+rdnom+'_block_outtbptr['+string(uk-1)+'], \'
 
251
           get_blank(rdnom+'_actuator')+' &nrd_'+string(nuk_1)+', &nrd_'+string(nuk_2)+', &nrd_'+string(uk_t)+',bbb);']
 
252
//    txt = [txt;
 
253
//           'if(local_flag < 0) return(5 - local_flag);']
 
254
    return
 
255
  elseif or(bk==capt(:,1)) then
 
256
    ind=find(bk==capt(:,1))
 
257
    yk=capt(ind,2);
 
258
    nyk_1=capt(ind,3);
 
259
    nyk_2=capt(ind,4);
 
260
    yk_t=capt(ind,5);
 
261
    txt = [txt;
 
262
           'nport = '+string(ind)+';']
 
263
    txt = [txt;
 
264
           rdnom+'_sensor(&local_flag, &nport, &block_'+rdnom+'['+string(i-1)+'].nevprt, \'
 
265
           get_blank(rdnom+'_sensor')+' &t, ('+mat2scs_c_ptr(outtb(yk))+' *)'+rdnom+'_block_outtbptr['+string(yk-1)+'], \'
 
266
           get_blank(rdnom+'_sensor')+' &nrd_'+string(nyk_1)+', &nrd_'+string(nyk_2)+', &nrd_'+string(yk_t)+',aaa);']
 
267
//    txt = [txt;
 
268
//           'if(local_flag < 0) return(5 - local_flag);']
 
269
    return
 
270
  end
 
271
 
 
272
  //**
 
273
  nx=xptr(bk+1)-xptr(bk);
 
274
  nz=zptr(bk+1)-zptr(bk);
 
275
  nrpar=rpptr(bk+1)-rpptr(bk);
 
276
  nipar=ipptr(bk+1)-ipptr(bk);
 
277
  nin=inpptr(bk+1)-inpptr(bk);  //* number of input ports */
 
278
  nout=outptr(bk+1)-outptr(bk); //* number of output ports */
 
279
 
 
280
  //**
 
281
  //l'adresse du pointeur de ipar
 
282
  if nipar<>0 then ipar=ipptr(bk), else ipar=1;end
 
283
  //l'adresse du pointeur de rpar
 
284
  if nrpar<>0 then rpar=rpptr(bk), else rpar=1; end
 
285
  //l'adresse du pointeur de z attention -1 pas sur
 
286
  if nz<>0 then z=zptr(bk)-1, else z=0;end
 
287
  //l'adresse du pointeur de x
 
288
  if nx<>0 then x=xptr(bk)-1, else x=0;end
 
289
 
 
290
  //**
 
291
  ftyp=funtyp(bk)
 
292
  if ftyp>2000 then ftyp=ftyp-2000,end
 
293
  if ftyp>1000 then ftyp=ftyp-1000,end
 
294
 
 
295
  //** check function type
 
296
  if ftyp < 0 then //** ifthenelse eselect blocks
 
297
      txt = [];
 
298
      return;
 
299
  else
 
300
    if (ftyp<>0 & ftyp<>1 & ftyp<>2 & ftyp<>3 & ftyp<>4) then
 
301
      disp("types other than 0,1,2,3 or 4 are not supported.")
 
302
      txt = [];
 
303
      return;
 
304
    end
 
305
  end
 
306
 
 
307
  select ftyp
 
308
 
 
309
    case 0 then
 
310
      //**** input/output addresses definition ****//
 
311
      if nin>1 then
 
312
        for k=1:nin
 
313
          uk=inplnk(inpptr(bk)-1+k);
 
314
          nuk=size(outtb(uk),'*');
 
315
          txt=[txt;
 
316
               'rdouttb['+string(k-1)+']=(double *)'+rdnom+'_block_outtbptr['+string(uk-1)+'];']
 
317
        end
 
318
        txt=[txt;
 
319
             'args[0]=&(rdouttb[0]);']
 
320
      elseif nin==0
 
321
        uk=0;
 
322
        nuk=0;
 
323
        txt=[txt;
 
324
             'args[0]=(double *)'+rdnom+'_block_outtbptr[0];']
 
325
      else
 
326
        uk=inplnk(inpptr(bk));
 
327
        nuk=size(outtb(uk),'*');
 
328
        txt=[txt;
 
329
             'args[0]=(double *)'+rdnom+'_block_outtbptr['+string(uk-1)+'];']
 
330
      end
 
331
 
 
332
      if nout>1 then
 
333
        for k=1:nout
 
334
          yk=outlnk(outptr(bk)-1+k);
 
335
          nyk=size(outtb(yk),'*');
 
336
          txt=[txt;
 
337
               'rdouttb['+string(k+nin-1)+']=(double *)'+rdnom+'_block_outtbptr['+string(yk-1)+'];'];
 
338
        end
 
339
        txt=[txt;
 
340
             'args[1]=&(rdouttb['+string(nin)+']);'];
 
341
      elseif nout==0
 
342
        yk=0;
 
343
        nyk=0;
 
344
        txt=[txt;
 
345
             'args[1]=(double *)'+rdnom+'_block_outtbptr[0];'];
 
346
      else
 
347
        yk=outlnk(outptr(bk));
 
348
        nyk=size(outtb(yk),'*'),;
 
349
        txt=[txt;
 
350
             'args[1]=(double *)'+rdnom+'_block_outtbptr['+string(yk-1)+'];'];
 
351
      end
 
352
      //*******************************************//
 
353
 
 
354
      //*********** call seq definition ***********//
 
355
      txtc=['(&local_flag,&block_'+rdnom+'['+string(bk-1)+'].nevprt,&t,block_'+rdnom+'['+string(bk-1)+'].xd, \';
 
356
            'block_'+rdnom+'['+string(bk-1)+'].x,&block_'+rdnom+'['+string(bk-1)+'].nx, \';
 
357
            'block_'+rdnom+'['+string(bk-1)+'].z,&block_'+rdnom+'['+string(bk-1)+'].nz,block_'+rdnom+'['+string(bk-1)+'].evout, \';
 
358
            '&block_'+rdnom+'['+string(bk-1)+'].nevout,block_'+rdnom+'['+string(bk-1)+'].rpar,&block_'+rdnom+'['+string(bk-1)+'].nrpar, \';
 
359
            'block_'+rdnom+'['+string(bk-1)+'].ipar,&block_'+rdnom+'['+string(bk-1)+'].nipar, \';
 
360
            '(double *)args[0],&nrd_'+string(nuk)+',(double *)args[1],&nrd_'+string(nyk)+');'];
 
361
      if (funtyp(bk)>2000 & funtyp(bk)<3000)
 
362
        blank = get_blank(funs(bk)+'( ');
 
363
        txtc(1) = funs(bk)+txtc(1);
 
364
      elseif (funtyp(bk)<2000)
 
365
        txtc(1) = 'C2F('+funs(bk)+')'+txtc(1);
 
366
        blank = get_blank('C2F('+funs(bk)+') ');
 
367
      end
 
368
      txtc(2:$) = blank + txtc(2:$);
 
369
      txt = [txt;txtc];
 
370
      //*******************************************//
 
371
 
 
372
 
 
373
    //**
 
374
    case 1 then
 
375
      //*********** call seq definition ***********//
 
376
      txtc=['(&local_flag,&block_'+rdnom+'['+string(bk-1)+'].nevprt,&t,block_'+rdnom+'['+string(bk-1)+'].xd, \';
 
377
            'block_'+rdnom+'['+string(bk-1)+'].x,&block_'+rdnom+'['+string(bk-1)+'].nx, \';
 
378
            'block_'+rdnom+'['+string(bk-1)+'].z,&block_'+rdnom+'['+string(bk-1)+'].nz,block_'+rdnom+'['+string(bk-1)+'].evout, \';
 
379
            '&block_'+rdnom+'['+string(bk-1)+'].nevout,block_'+rdnom+'['+string(bk-1)+'].rpar,&block_'+rdnom+'['+string(bk-1)+'].nrpar, \';
 
380
            'block_'+rdnom+'['+string(bk-1)+'].ipar,&block_'+rdnom+'['+string(bk-1)+'].nipar'];
 
381
      if (funtyp(bk)>2000 & funtyp(bk)<3000)
 
382
        blank = get_blank(funs(bk)+'( ');
 
383
        txtc(1) = funs(bk)+txtc(1);
 
384
      elseif (funtyp(bk)<2000)
 
385
        txtc(1) = 'C2F('+funs(bk)+')'+txtc(1);
 
386
        blank = get_blank('C2F('+funs(bk)+') ');
 
387
      end
 
388
      if nin>=1 | nout>=1 then
 
389
        txtc($)=txtc($)+', \'
 
390
        txtc=[txtc;'']
 
391
        if nin>=1 then
 
392
          for k=1:nin
 
393
            uk=inplnk(inpptr(bk)-1+k);
 
394
            nuk=size(outtb(uk),'*');
 
395
            txtc($)=txtc($)+'(double *)'+rdnom+'_block_outtbptr['+string(uk-1)+'],&nrd_'+string(nuk)+',';
 
396
          end
 
397
          txtc($)=part(txtc($),1:length(txtc($))-1); //remove last ,
 
398
        end
 
399
        if nout>=1 then
 
400
          if nin>=1 then
 
401
            txtc($)=txtc($)+', \'
 
402
            txtc=[txtc;'']
 
403
          end
 
404
          for k=1:nout
 
405
            yk=outlnk(outptr(bk)-1+k);
 
406
            nyk=size(outtb(yk),'*');
 
407
            txtc($)=txtc($)+'(double *)'+rdnom+'_block_outtbptr['+string(yk-1)+'],&nrd_'+string(nyk)+',';
 
408
          end
 
409
          txtc($)=part(txtc($),1:length(txtc($))-1); //remove last ,
 
410
        end
 
411
      end
 
412
 
 
413
      if ztyp(bk) then
 
414
        txtc($)=txtc($)+', \'
 
415
        txtc=[txtc;
 
416
              'block_'+rdnom+'['+string(bk-1)+'].g,&block_'+rdnom+'['+string(bk-1)+'].ng);']
 
417
      else
 
418
        txtc($)=txtc($)+');';
 
419
      end
 
420
 
 
421
      txtc(2:$) = blank + txtc(2:$);
 
422
      txt = [txt;txtc];
 
423
      //*******************************************//
 
424
 
 
425
    //**
 
426
    case 2 then
 
427
 
 
428
      //*********** call seq definition ***********//
 
429
      txtc=[funs(bk)+'(&local_flag,&block_'+rdnom+'['+string(bk-1)+'].nevprt,&t,block_'+rdnom+'['+string(bk-1)+'].xd, \';
 
430
            'block_'+rdnom+'['+string(bk-1)+'].x,&block_'+rdnom+'['+string(bk-1)+'].nx, \';
 
431
            'block_'+rdnom+'['+string(bk-1)+'].z,&block_'+rdnom+'['+string(bk-1)+'].nz,block_'+rdnom+'['+string(bk-1)+'].evout, \';
 
432
            '&block_'+rdnom+'['+string(bk-1)+'].nevout,block_'+rdnom+'['+string(bk-1)+'].rpar,&block_'+rdnom+'['+string(bk-1)+'].nrpar, \';
 
433
            'block_'+rdnom+'['+string(bk-1)+'].ipar,&block_'+rdnom+'['+string(bk-1)+'].nipar, \';
 
434
            '(double **)block_'+rdnom+'['+string(bk-1)+'].inptr,block_'+rdnom+'['+string(bk-1)+'].insz,&block_'+rdnom+'['+string(bk-1)+'].nin, \';
 
435
            '(double **)block_'+rdnom+'['+string(bk-1)+'].outptr,block_'+rdnom+'['+string(bk-1)+'].outsz, &block_'+rdnom+'['+string(bk-1)+'].nout'];
 
436
      if ~ztyp(bk) then
 
437
        txtc($)=txtc($)+');';
 
438
      else
 
439
        txtc($)=txtc($)+', \';
 
440
        txtc=[txtc;
 
441
              'block_'+rdnom+'['+string(bk-1)+'].g,&block_'+rdnom+'['+string(bk-1)+'].ng);']
 
442
      end
 
443
      blank = get_blank(funs(bk)+'( ');
 
444
      txtc(2:$) = blank + txtc(2:$);
 
445
      txt = [txt;txtc];
 
446
      //*******************************************//
 
447
 
 
448
    //**
 
449
    case 4 then
 
450
      txt=[txt;
 
451
           funs(bk)+'(&block_'+rdnom+'['+string(bk-1)+'],local_flag);'];
 
452
 
 
453
  end
 
454
 
 
455
//  txt =[txt;'if(local_flag < 0) return(5 - local_flag);']
 
456
 
 
457
endfunction
 
458
 
 
459
//==========================================================================
 
460
//utilitary fonction used to format long C instruction
 
461
//t : a string containing a C instruction
 
462
//l : max line length allowed
 
463
 
 
464
// Copyright INRIA
 
465
//Author : Rachid Djenidi
 
466
function t1=cformatline(t ,l)
 
467
 
 
468
  sep=[',','+']
 
469
  l1=l-2
 
470
  t1=[]
 
471
  kw=strindex(t,' ')
 
472
  nw=0
 
473
  if kw<>[] then
 
474
    if kw(1)==1 then // there is leading blanks
 
475
      k1=find(kw(2:$)-kw(1:$-1)<>1)
 
476
      if k1==[] then // there is a single blank
 
477
        nw=1
 
478
      else
 
479
        nw=kw(k1(1))
 
480
      end
 
481
    end
 
482
  end
 
483
  t=part(t,nw+1:length(t));
 
484
  bl=part(' ',ones(1,nw))
 
485
  l1=l-nw;first=%t
 
486
  while %t 
 
487
    if length(t)<=l then t1=[t1;bl+t],return,end
 
488
    k=strindex(t,sep);
 
489
    if k==[] then t1=[t1;bl+t],return,end
 
490
    k($+1)=length(t)+1 // positions of the commas
 
491
    i=find(k(1:$-1)<=l&k(2:$)>l) //nearest left comma (reltively to l)
 
492
    if i==[] then i=1,end
 
493
    t1=[t1;bl+part(t,1:k(i))]
 
494
    t=part(t,k(i)+1:length(t))
 
495
    if first then l1=l1-2;bl=bl+'  ';first=%f;end
 
496
  end
 
497
endfunction
 
498
 
 
499
//==========================================================================
 
500
//used in do_compile_superblock
 
501
function vec=codebinaire(v,szclkIN)
 
502
 
 
503
  vec=zeros(1,szclkIN)
 
504
  for i=1:szclkIN
 
505
    w=v/2;
 
506
    vec(i)=v-2*int(w);
 
507
    v=int(w);
 
508
  end
 
509
endfunction
 
510
 
 
511
//==========================================================================
 
512
 
 
513
// Modified for RT purposes by Roberto Bucher - RTAI Team
 
514
// roberto.bucher@supsi.ch
 
515
 
 
516
function ok = compile_standalone()
 
517
//compile rt standalone executable for standalone
 
518
// 22.01.2004
 
519
//Author : Roberto Bucher (roberto.bucher@die.supsi.ch)
 
520
 
 
521
 
 
522
  xinfo('Compiling standalone');
 
523
  wd = pwd();
 
524
  chdir(rpat);
 
525
 
 
526
  if getenv('WIN32','NO')=='OK' then
 
527
     unix_w('nmake -f Makefile.mak');
 
528
  else
 
529
     unix_w('make')
 
530
  end
 
531
  chdir(wd);
 
532
  ok = %t;
 
533
endfunction     
 
534
 
 
535
//==========================================================================
 
536
// Transforms a given Scicos discrete and continuous SuperBlock into a C defined Block
 
537
// Copyright INRIA
 
538
//
 
539
 
 
540
// Original file from Project Metalau - INRIA
 
541
// Modified for RT purposes by Roberto Bucher - RTAI Team
 
542
// roberto.bucher@supsi.ch
 
543
 
 
544
function  [ok,XX,alreadyran,flgcdgen,szclkINTemp,freof] = do_compile_superblock42(XX,all_scs_m,numk,alreadyran)
 
545
 
 
546
  scs_m = XX.model.rpar ; //** isolate the super block scs_m data structure 
 
547
  par = scs_m.props;
 
548
  
 
549
  //** SAFETY : terminate current simulation 
 
550
  if alreadyran then
 
551
    //** terminate current simulation
 
552
    do_terminate() ; 
 
553
    alreadyran  = %f ;
 
554
  end
 
555
 
 
556
  hname = scs_m.props.title(1);  //** super block name
 
557
 
 
558
  //***********************************************************
 
559
  //Check blocks properties and adapt them if necessary
 
560
  //***********************************************************
 
561
 
 
562
 
 
563
  //**  These blocks are not ALLOWED for Emb code generation 
 
564
  vorbidden_items=["CLKOUT_f","activation (events) output ports";
 
565
                   "IN_f","input ports";
 
566
                   "OUT_f","output ports";
 
567
                   "CLKOUTV_f","activation outputs";
 
568
                   "CLOCK_c","clocks";
 
569
                   "CLOCK_f","clocks";
 
570
                   "SampleCLK","clocks";
 
571
                   "RFILE_f","Read block";
 
572
                   "READC_f","Read_block";
 
573
                   "WFILE_f","Write block";
 
574
                   "WRITEC_f","Write block"]
 
575
 
 
576
  clkIN = [];
 
577
  
 
578
  //** scan 
 
579
  for i=1:size(scs_m.objs)
 
580
 
 
581
    //** BLOCKS 
 
582
    if typeof(scs_m.objs(i))=="Block" then
 
583
      ind=find(vorbidden_items==scs_m.objs(i).gui);
 
584
      if(ind~=[]) then
 
585
        ok = %f ;
 
586
        %cpr = list();
 
587
        message(vorbidden_items(ind(1),2)+" not allowed in Superblock");
 
588
        return; // EXIT point
 
589
      
 
590
      elseif scs_m.objs(i).gui=="CLKINV_f" then //** input clock from external diagram 
 
591
        //** replace event input ports by  fictious block
 
592
        scs_m.objs(i).gui="EVTGEN_f";
 
593
        scs_m.objs(i).model.sim(1)="bidon"
 
594
        if clkIN==[] then
 
595
          clkIN = 1;
 
596
        else
 
597
          ok = %f;
 
598
          %cpr = list();
 
599
          message("Only one activation block allowed!");
 
600
          return; // EXIT point
 
601
        end
 
602
      end
 
603
    end
 
604
  end
 
605
 
 
606
  
 
607
  szclkIN = size(clkIN,2);
 
608
  
 
609
 
 
610
  flgcdgen = szclkIN; //** pass the clock 
 
611
  
 
612
  //** 
 
613
  //** BEWARE : the Scicos compiler is called here ! 
 
614
  //**
 
615
  [bllst,connectmat,clkconnect,cor,corinv,ok,scs_m,flgcdgen,freof] = c_pass1(scs_m,flgcdgen);
 
616
 
 
617
  if ~ok then
 
618
    message("Sorry: problem in the pre-compilation step.")
 
619
    return ; //** EXIT point 
 
620
  end
 
621
 
 
622
  szclkINTemp = szclkIN;
 
623
  szclkIN = flgcdgen;
 
624
 
 
625
 
 
626
  for i=1:size(bllst)
 
627
    if (bllst(i).sim(1)=="bidon") then //** clock input 
 
628
      howclk = i;
 
629
    end
 
630
  end
 
631
 
 
632
  
 
633
  //** BEWARE : update to new graphics instructions ! 
 
634
  %windo = xget('window') ; 
 
635
  
 
636
  cpr = c_pass2(bllst,connectmat,clkconnect,cor,corinv)
 
637
 
 
638
  if cpr==list() then
 
639
      ok = %f
 
640
      return ; //** exit point 
 
641
  end
 
642
 
 
643
  //** Alan's patch 5/07/07: try to solve
 
644
  //   which blocks use work
 
645
  //** 
 
646
  funs_save = cpr.sim.funs           ;
 
647
  funtyp_save = cpr.sim.funtyp       ;
 
648
  with_work = zeros(cpr.sim.nblk,1)  ;
 
649
 
 
650
 
 
651
  //** ------ Windows cleaning for internal Scopes -------------------
 
652
  //**
 
653
  //**
 
654
  //** retrieve all open Scilab windows with winsid()
 
655
  //**
 
656
 
 
657
  BeforeCG_WinList = winsid(); 
 
658
 
 
659
  ierr=execstr('[state,t]=scicosim(cpr.state,0,0,cpr.sim,'+..
 
660
               '''start'',scs_m.props.tol)','errcatch')
 
661
  if ierr==0 then
 
662
    for i=1:cpr.sim.nblk
 
663
       if state.iz(i)<>0 then
 
664
          with_work(i)=%t
 
665
       end
 
666
    end
 
667
    ierr=execstr('[state,t]=scicosim(state,0,0,cpr.sim,'+..
 
668
                 '''finish'',scs_m.props.tol)','errcatch')
 
669
  end
 
670
 
 
671
  //**
 
672
  //** retrieve all open Scilab windows with winsid
 
673
  //** and close the additional windows open since first
 
674
  //** 
 
675
 
 
676
  //** This code does not cover 100% of the possible situations because the user can 
 
677
  //** destroy one or more Scicos wins manually during this intermediate phase
 
678
  //** This code is 100% functional if the the user does not close manually any win.
 
679
  //** TO BE updated in Scilab 5.0
 
680
 
 
681
  AfterCG_WinList = winsid();
 
682
  
 
683
  AfterCG_size = size(AfterCG_WinList); //** matrix
 
684
  AfterCG_size = AfterCG_size(2) ; //** vector lenght 
 
685
 
 
686
  BeforeCG_size = size(BeforeCG_WinList); //** matrix
 
687
  BeforeCG_size = BeforeCG_size(2) ; //** vector lenght
 
688
 
 
689
  if (or(AfterCG_WinList<>BeforeCG_WinList)) & (AfterCG_size>BeforeCG_size) then
 
690
     //** means that a scope or other scicos object has created some
 
691
     //** output window
 
692
 
 
693
     DiffCG_Winlist = AfterCG_WinList<>BeforeCG_WinList ; //** T/F mismatch 
 
694
     DiffCG_Index = find(DiffCG_Winlist); //** recover the mismatched indexes only 
 
695
 
 
696
     for win_idx = DiffCG_Index
 
697
         delete( scf( AfterCG_WinList(win_idx) ) ) ; //** clear the spurious windows   
 
698
     end 
 
699
     
 
700
  end  
 
701
  //**------------- end of windows cleaning for internal scopes -------------------------------
 
702
 
 
703
  cpr.sim.funs=funs_save;
 
704
  cpr.sim.funtyp=funtyp_save;
 
705
 
 
706
  //** BEWARE: replace this OLD graphics instruction !
 
707
  xset('window',%windo) ; 
 
708
 
 
709
  ///////////////////
 
710
  //** %cpr pointers 
 
711
  x = cpr.state.x;
 
712
  z = cpr.state.z;
 
713
  outtb = cpr.state.outtb;
 
714
 
 
715
  // RN
 
716
  zcptr = cpr.sim.zcptr;
 
717
  ozptr = cpr.sim.ozptr;
 
718
  rpptr = cpr.sim.rpptr;
 
719
  ipptr = cpr.sim.ipptr;
 
720
  opptr = cpr.sim.opptr;
 
721
  funs = cpr.sim.funs;
 
722
  xptr = cpr.sim.xptr;
 
723
  zptr = cpr.sim.zptr;
 
724
  inpptr = cpr.sim.inpptr;
 
725
  inplnk = cpr.sim.inplnk;
 
726
  outptr = cpr.sim.outptr;
 
727
  outlnk = cpr.sim.outlnk;
 
728
  
 
729
  // @l@n lnkptr = cpr.sim.lnkptr; ???
 
730
  
 
731
  ordclk = cpr.sim.ordclk;
 
732
  funtyp = cpr.sim.funtyp;
 
733
  cord   = cpr.sim.cord;
 
734
  ncord  = size(cord,1);
 
735
  nblk   = cpr.sim.nb;
 
736
  ztyp   = cpr.sim.ztyp;
 
737
  clkptr = cpr.sim.clkptr
 
738
  
 
739
  // taille totale de z : nztotal
 
740
  nztotal = size(z,1);
 
741
 
 
742
  //*******************************
 
743
  //Checking if superblock is valid
 
744
  //*******************************
 
745
  msg = []
 
746
 
 
747
  for i=1:length(funs)-1
 
748
 
 
749
    if funtyp(i)==3 then
 
750
      msg = [msg;"Type 3 block''s not allowed"] ;
 
751
   
 
752
// Bubu 18.03.2008
 
753
    elseif funtyp(i)==0 & funs(i)~="bidon"  then
 
754
      msg = [msg;"Type 0 block''s"+" ''"+funs(i)+"''"+" not allowed"] ;
 
755
//end
 
756
   
 
757
    elseif (clkptr(i+1)-clkptr(i))<>0 &funtyp(i)>-1 &funs(i)~="bidon" then
 
758
 
 
759
      //Alan // msg=[msg;'Regular block generating activation not allowed yet']
 
760
 
 
761
    end
 
762
 
 
763
    if msg<>[] then 
 
764
         message(msg) ;
 
765
         ok = %f ;
 
766
         return ; //** 
 
767
    end
 
768
 
 
769
  end
 
770
 
 
771
 
 
772
  //** Find the clock connected to the SuperBlock and retreive
 
773
  //** the sampling time
 
774
  
 
775
  if XX.graphics.pein==[] | XX.graphics.pein(1)==0 then
 
776
    sTsamp="0.001"; //** default value is ONE millisecond 
 
777
  else
 
778
    o_ev = XX.graphics.pein(1);
 
779
    o_ev=all_scs_m.objs(o_ev).from(1);
 
780
 
 
781
    while (all_scs_m.objs(o_ev).gui~='CLOCK_c' & ...
 
782
           all_scs_m.objs(o_ev).gui~='CLOCK_f' & ...
 
783
           all_scs_m.objs(o_ev).gui~='SampleCLK')
 
784
 
 
785
               o_ev = all_scs_m.objs(o_ev).graphics.pein(1);
 
786
               o_ev = all_scs_m.objs(o_ev).from(1);
 
787
 
 
788
    end
 
789
 
 
790
    if all_scs_m.objs(o_ev).gui=='SampleCLK' then
 
791
      sTsamp=all_scs_m.objs(o_ev).model.rpar(1);
 
792
      sTsamp=sci2exp(sTsamp);
 
793
      Tsamp_delay=all_scs_m.objs(o_ev).model.rpar(2);
 
794
      Tsamp_delay=sci2exp(Tsamp_delay);
 
795
    else
 
796
      sTsamp=all_scs_m.objs(o_ev).model.rpar.objs(2).graphics.exprs(1);
 
797
      sTsamp=sci2exp(eval(sTsamp));
 
798
      Tsamp_delay=all_scs_m.objs(o_ev).model.rpar.objs(2).graphics.exprs(2);
 
799
      Tsamp_delay=sci2exp(eval(Tsamp_delay));
 
800
    end
 
801
 
 
802
  end
 
803
 
 
804
  //***********************************
 
805
  // Get the name of the file
 
806
  //***********************************
 
807
  foo = 3; //** probably this variable is never used ? 
 
808
  okk = %f; 
 
809
  rdnom='foo'; 
 
810
  rpat = getcwd(); 
 
811
  archname=''; 
 
812
  Tsamp = sci2exp(eval(sTsamp));
 
813
  
 
814
  template = ''; //** default values for this version 
 
815
  
 
816
  if XX.model.rpar.props.void3 == [] then
 
817
        target = 'rtai'; //** default compilation chain 
 
818
        odefun = 'ode4';  //** default solver 
 
819
        odestep = '10';   //** default continous step size 
 
820
  else
 
821
        target  = XX.model.rpar.props.void3(1); //** user defined parameters 
 
822
        odefun  = XX.model.rpar.props.void3(2);
 
823
        odestep = XX.model.rpar.props.void3(3);
 
824
  end
 
825
 
 
826
  libs='';
 
827
 
 
828
  //** dialog box default variables 
 
829
  label1=[hname;getcwd()+'/'+hname+"_scig";target;template];
 
830
  label2=[hname;getcwd()+'/'+hname+"_scig";target;template;odefun;odestep];
 
831
  
 
832
  ode_x=['ode1';'ode2';'ode4']; //** available continous solver 
 
833
  
 
834
  //** Open a dialog box 
 
835
  while %t do
 
836
    ok = %t ;
 
837
    if x==[] then
 
838
      //** Pure discrete system NO CONTINOUS blocks 
 
839
     
 
840
      [okk, rdnom, rpat,target,template,label1] = getvalue(..
 
841
                    'Embedded Code Generation',..
 
842
                        ['New block''s name :';
 
843
                         'Created files Path:';
 
844
                             'Toolchain: ';
 
845
                             'Target Board: '],..
 
846
                         list('str',1,'str',1,'str',1,'str',1),label1);
 
847
    else
 
848
      //** continous blocks are presents
 
849
      [okk,rdnom,rpat,target,template,odefun,odestep,label2] = getvalue(..
 
850
                    "Embedded Code Generation",..
 
851
                        ["New block''s name: "  ;
 
852
                         "Created files Path: " ;
 
853
                             "Toolchain: "          ;
 
854
                             "Target Board: "       ;
 
855
                         "ODE solver type: "       ;
 
856
                         "ODE solver steps betw. samples: "],..
 
857
                         list('str',1,'str',1,'str',1,'str',1,'str',1,'str',1),label2);
 
858
    end
 
859
  
 
860
    if okk==%f then
 
861
      ok = %f
 
862
      return ; //** EXIT point 
 
863
    end
 
864
    rpat = stripblanks(rpat);
 
865
 
 
866
 
 
867
    //** I put a warning here in order to inform the user
 
868
    //** that the name of the superblock will change
 
869
    //** because the space char in name isn't allowed.
 
870
    if grep(rdnom," ")<>[] then
 
871
      message(['Superblock name cannot contains space characters.';
 
872
               'space chars will be automatically substituted by ""_"" '])
 
873
    end
 
874
    rdnom = strsubst(rdnom,' ','_');
 
875
 
 
876
    //** Put a warning here in order to inform the user
 
877
    //** that the name of the superblock will change
 
878
    //** because the "-" char could generate GCC problems
 
879
    //** (the C functions contains the name of the superblock).
 
880
    if grep(rdnom,"-")<>[] then
 
881
      message(['For full C compiler compatibility ';
 
882
               'Superblock name cannot contains ""-"" characters';
 
883
               '""-"" chars will be automatically substituted by ""_"" '])
 
884
    end
 
885
 
 
886
    rdnom = strsubst(rdnom,'-','_'); 
 
887
 
 
888
    dirinfo = fileinfo(rpat)
 
889
    
 
890
    if dirinfo==[] then
 
891
      [pathrp, fnamerp, extensionrp] = fileparts(rpat); 
 
892
      ok = mkdir(pathrp, fnamerp+extensionrp) ; 
 
893
      if ~ok then 
 
894
        message("Directory '+rpat+' cannot be created");
 
895
      end
 
896
    elseif filetype(dirinfo(2))<>'Directory' then
 
897
      ok = %f;
 
898
      message(rpat+" is not a directory");
 
899
    end
 
900
 
 
901
    if stripblanks(rdnom)==emptystr() then 
 
902
      ok = %f;
 
903
      message("Sorry: C file name not defined");
 
904
    end
 
905
 
 
906
 
 
907
    //** This comments will be moved in the documentation 
 
908
 
 
909
    //** /contrib/RT_templates/pippo.gen
 
910
 
 
911
    //** 1: pippo.mak 
 
912
    //** 2: pippo.cmd
 
913
 
 
914
    //** pippo.mak : scheletro del Makefile 
 
915
    //**             - GNU/Linux : Makefile template
 
916
    //**             - Windows/Erika : conf.oil
 
917
    //**                               erika.cmd
 
918
 
 
919
    //** pippo.cmd : sequenza di comandi Scilab 
 
920
 
 
921
 
 
922
    TARGETDIR = SCI+"/contrib/RTAI/RT_templates";
 
923
 
 
924
 
 
925
    [fd,ierr] = mopen(TARGETDIR+'/'+target+'.gen','r');
 
926
 
 
927
    if ierr==0 then
 
928
      mclose(fd);
 
929
    else
 
930
      ok = %f;
 
931
      message("Target not valid " + target + ".gen");
 
932
    end
 
933
    
 
934
    if ok then
 
935
      target_t = mgetl(TARGETDIR+'/'+target+'.gen');
 
936
      makfil = target_t(1);
 
937
      cmdfil = target_t(2);
 
938
 
 
939
      [fd,ierr]=mopen(TARGETDIR+'/'+makfil,'r');
 
940
      if ierr==0 then
 
941
        mclose(fd);
 
942
      else
 
943
        ok = %f ;
 
944
        message("Makefile not valid " + makfil);
 
945
      end
 
946
    end
 
947
 
 
948
    if x ~= [] then
 
949
      if grep(odefun,ode_x) == [] then
 
950
         message("Ode function not valid");
 
951
         ok = %f;
 
952
      end
 
953
    end
 
954
 
 
955
    if ok then break,end
 
956
  end
 
957
 
 
958
  //////////////////////////////////////////////////
 
959
  maxnrpar=max(rpptr(2:$)-rpptr(1:$-1))
 
960
  maxnipar=max(ipptr(2:$)-ipptr(1:$-1))
 
961
  maxnx=max(xptr(2:$)-xptr(1:$-1))
 
962
  maxnz=max(zptr(2:$)-zptr(1:$-1))
 
963
  maxnin=max(inpptr(2:$)-inpptr(1:$-1))
 
964
  maxnout=max(outptr(2:$)-outptr(1:$-1))
 
965
  maxdim=[];
 
966
  for i=1:lstsize(cpr.state.outtb)
 
967
    maxdim=max(size(cpr.state.outtb(i)))
 
968
  end
 
969
  maxtotal=max([maxnrpar;maxnipar;maxnx;maxnz;maxnin;maxnout;maxdim]);
 
970
 
 
971
//------------------ The real code generation is here ------------------------------------
 
972
 
 
973
  //************************************************************************
 
974
  //generate the call to the blocks and blocs simulation function prototypes
 
975
  //************************************************************************
 
976
  wfunclist = list();
 
977
  nbcap = 0;
 
978
  nbact = 0;
 
979
  capt  = [];
 
980
  actt  = [];
 
981
  Protostalone = [];
 
982
  Protos       = [];
 
983
  dfuns        = [] ;
 
984
  
 
985
 
 
986
 
 
987
  //** scan the data structure and call the generating functions 
 
988
  //** Substitute previous code!!!!
 
989
  
 
990
  for i=1:length(funs)
 
991
    ki= find(funs(i) == dfuns) ; //** 
 
992
    dfuns = [dfuns; funs(i)] ; 
 
993
      
 
994
    if ki==[] then
 
995
      Protostalone=[Protostalone;'';BlockProto(i)];
 
996
    end
 
997
  end
 
998
 
 
999
 
 
1000
  //***********************************
 
1001
  // Scilab and C files generation
 
1002
  //***********************************
 
1003
 
 
1004
  cmdseq = mgetl(TARGETDIR+'/' + cmdfil);
 
1005
  n_cmd = size(cmdseq,1);
 
1006
 
 
1007
  for i=1:n_cmd
 
1008
  
 
1009
    if (cmdseq(i)~="") then
 
1010
         disp("Executing " + """" +cmdseq(i)+ """" + '...'); 
 
1011
    end;
 
1012
    
 
1013
    execstr(cmdseq(i));
 
1014
  
 
1015
  end
 
1016
 
 
1017
  disp("----> Target generation terminated!");
 
1018
 
 
1019
endfunction
 
1020
 
 
1021
//==========================================================================
 
1022
function t=filetype(m)
 
1023
  m=int32(m)
 
1024
  filetypes=['Directory','Character device','Block device',...
 
1025
             'Regular file','FIFO','Symbolic link','Socket']
 
1026
  bits=[16384,8192,24576,32768,4096,40960,49152]
 
1027
  m=int32(m)&int32(61440)
 
1028
  t=filetypes(find(m==int32(bits)))
 
1029
endfunction
 
1030
 
 
1031
//==========================================================================
 
1032
//Generates Code for dynamically linked Fortran and C Blocks
 
1033
 
 
1034
// Original file from Project Metalau - INRIA
 
1035
// Modified for RT purposes by Roberto Bucher - RTAI Team
 
1036
// roberto.bucher@supsi.ch
 
1037
 
 
1038
function [CCode,FCode]=gen_blocks()
 
1039
 
 
1040
  CCode=[]
 
1041
  FCode=[]
 
1042
 
 
1043
  kdyn=find(funtyp>1000) //dynamically linked blocs
 
1044
                         //100X : Fortran blocks
 
1045
                         //200X : C blocks
 
1046
 
 
1047
  if (size(kdyn,'*') >1)
 
1048
    kfuns=[]; 
 
1049
    //get the block data structure in the initial scs_m structure
 
1050
    if size(corinv(kdyn(1)),'*')==1 then
 
1051
      O=scs_m.objs(corinv(kdyn(1)));
 
1052
    else
 
1053
      path=list('objs');
 
1054
      for l=corinv(kdyn(1))(1:$-1)
 
1055
        path($+1)=l;
 
1056
        path($+1)='model';
 
1057
        path($+1)='rpar';
 
1058
        path($+1)='objs';
 
1059
      end
 
1060
      path($+1)=corinv(kdyn(1))($);
 
1061
      O=scs_m(path);
 
1062
    end
 
1063
    if funtyp(kdyn(1))>2000 then
 
1064
      //C block
 
1065
      CCode=[CCode;O.graphics.exprs(2)]
 
1066
    else
 
1067
      FCode=[FCode;O.graphics.exprs(2)]
 
1068
    end
 
1069
    kfuns=funs(kdyn(1));
 
1070
    for i=2:size(kdyn,'*')
 
1071
      //get the block data structure in the initial scs_m structure
 
1072
      if size(corinv(kdyn(i)),'*')==1 then
 
1073
        O=scs_m.objs(corinv(kdyn(i)));
 
1074
      else
 
1075
        path=list('objs');
 
1076
         for l=corinv(kdyn(i))(1:$-1)
 
1077
           path($+1)=l;
 
1078
           path($+1)='model';
 
1079
           path($+1)='rpar';
 
1080
           path($+1)='objs';
 
1081
        end
 
1082
        path($+1)=corinv(kdyn(i))($);
 
1083
        O=scs_m(path);
 
1084
      end
 
1085
      if (find(kfuns==funs(kdyn(i))) == [])
 
1086
        kfuns=[kfuns;funs(kdyn(i))];
 
1087
        if funtyp(kdyn(i))>2000  then
 
1088
          //C block
 
1089
          CCode=[CCode;O.graphics.exprs(2)]
 
1090
        else
 
1091
          FCode=[FCode;O.graphics.exprs(2)]
 
1092
        end
 
1093
      end
 
1094
    end
 
1095
  elseif (size(kdyn,'*')==1)
 
1096
    //get the block data structure in the initial scs_m structure
 
1097
    if size(corinv(kdyn),'*')==1 then
 
1098
      O=scs_m.objs(corinv(kdyn));
 
1099
    else
 
1100
      path=list('objs');
 
1101
      for l=corinv(kdyn)(1:$-1)
 
1102
        path($+1)=l;
 
1103
        path($+1)='model';
 
1104
        path($+1)='rpar';
 
1105
        path($+1)='objs';
 
1106
      end
 
1107
      path($+1)=corinv(kdyn)($);
 
1108
      O=scs_m(path);
 
1109
    end
 
1110
    if funtyp(kdyn)>2000 then
 
1111
      //C block
 
1112
      CCode=[CCode;O.graphics.exprs(2)]
 
1113
    else
 
1114
      FCode=[FCode;O.graphics.exprs(2)]
 
1115
    end
 
1116
  end
 
1117
  if CCode==[]
 
1118
    CCode=['void no_ccode()'
 
1119
           '{'
 
1120
           '  return;'
 
1121
           '}']
 
1122
  end
 
1123
endfunction
 
1124
 
 
1125
//==========================================================================
 
1126
//get_blank : return blanks with a length
 
1127
//            of the given input string
 
1128
//
 
1129
//input : str : a string
 
1130
//
 
1131
//output : txt : blanks
 
1132
//
 
1133
//16/06/07 Author : A.Layec
 
1134
//Copyright INRIA
 
1135
function [txt] = get_blank(str)
 
1136
 txt='';
 
1137
 for i=1:length(str)
 
1138
     txt=txt+' ';
 
1139
 end
 
1140
endfunction
 
1141
 
 
1142
//==========================================================================
 
1143
// get_comment : return a C comment
 
1144
//               for generated code
 
1145
//
 
1146
//input : typ : a string
 
1147
//        param : a list
 
1148
//
 
1149
//output : a C comment
 
1150
//
 
1151
//16/06/07 Author : A.Layec
 
1152
//Copyright INRIA
 
1153
function [txt]=get_comment(typ,param)
 
1154
  txt = [];
 
1155
  select typ
 
1156
    //** main flag
 
1157
    case 'flag' then
 
1158
        select param(1)
 
1159
          case 0 then
 
1160
             txt = '/* Continuous state computation */'
 
1161
          case 1 then
 
1162
             txt = '/* Output computation */'
 
1163
          case 2 then
 
1164
             txt = '/* Discrete state computation */'
 
1165
          case 3 then
 
1166
             txt = '/* Output Event computation */'
 
1167
          case 4 then
 
1168
             txt = '/* Initialization */'
 
1169
          case 5 then
 
1170
             txt = '/* Ending */'
 
1171
          case 9 then
 
1172
             txt = '/* Update zero crossing surfaces */'
 
1173
        end
 
1174
    //** blocks activated on event number
 
1175
    case 'ev' then
 
1176
       txt = '/* Blocks activated on the event number '+string(param(1))+' */'
 
1177
 
 
1178
    //** blk calling sequence
 
1179
    case 'call_blk' then
 
1180
        txt = ['/* Call of '''+param(1) + ...
 
1181
               ''' (type '+string(param(2))+' - blk nb '+...
 
1182
                    string(param(3))];
 
1183
        if ztyp(param(3)) then
 
1184
          txt=txt+' - with zcross) */';
 
1185
        else
 
1186
          txt=txt+') */';
 
1187
        end
 
1188
    //** proto calling sequence
 
1189
    case 'proto_blk' then
 
1190
        txt = ['/* prototype of '''+param(1) + ...
 
1191
               ''' (type '+string(param(2))];
 
1192
        if ztyp(param(3)) then
 
1193
          txt=txt+' - with zcross) */';
 
1194
        else
 
1195
          txt=txt+') */';
 
1196
        end
 
1197
    //** ifthenelse calling sequence
 
1198
    case 'ifthenelse_blk' then
 
1199
        txt = ['/* Call of ''if-then-else'' blk (blk nb '+...
 
1200
                    string(param(1))+') */']
 
1201
    //** eventselect calling sequence
 
1202
    case 'evtselect_blk' then
 
1203
        txt = ['/* Call of ''event-select'' blk (blk nb '+...
 
1204
                    string(param(1))+') */']
 
1205
    //** set block structure
 
1206
    case 'set_blk' then
 
1207
        txt = ['/* set blk struc. of '''+param(1) + ...
 
1208
               ''' (type '+string(param(2))+' - blk nb '+...
 
1209
                    string(param(3))+') */'];
 
1210
    //** Update xd vector ptr
 
1211
    case 'update_xd' then
 
1212
        txt = ['/* Update xd vector ptr */'];
 
1213
    //** Update g vector ptr
 
1214
    case 'update_g' then
 
1215
        txt = ['/* Update g vector ptr */'];
 
1216
    else
 
1217
      break;
 
1218
  end
 
1219
endfunction
 
1220
 
 
1221
//==========================================================================
 
1222
//generates code of the standalone simulation procedure
 
1223
//
 
1224
//Copyright INRIA
 
1225
//
 
1226
// rmq : La fonction zdoit n'est pas utilis�e pour le moment
 
1227
 
 
1228
// Original file from Project Metalau - INRIA
 
1229
// Modified for RT purposes by Roberto Bucher - RTAI Team
 
1230
// roberto.bucher@supsi.ch
 
1231
 
 
1232
function [Code,Code_common]=make_standalone42()
 
1233
 
 
1234
  x=cpr.state.x;
 
1235
  modptr=cpr.sim.modptr;
 
1236
  rpptr=cpr.sim.rpptr;
 
1237
  ipptr=cpr.sim.ipptr;
 
1238
  opptr=cpr.sim.opptr;
 
1239
  rpar=cpr.sim.rpar;
 
1240
  ipar=cpr.sim.ipar;
 
1241
  opar=cpr.sim.opar;
 
1242
  oz=cpr.state.oz;
 
1243
  ordptr=cpr.sim.ordptr;
 
1244
  oord=cpr.sim.oord;
 
1245
  zord=cpr.sim.zord;
 
1246
  iord=cpr.sim.iord;
 
1247
  tevts=cpr.state.tevts;
 
1248
  evtspt=cpr.state.evtspt;
 
1249
  zptr=cpr.sim.zptr;
 
1250
  clkptr=cpr.sim.clkptr;
 
1251
  ordptr=cpr.sim.ordptr;
 
1252
  pointi=cpr.state.pointi;
 
1253
  funs=cpr.sim.funs;
 
1254
  noord=size(cpr.sim.oord,1);
 
1255
  nzord=size(cpr.sim.zord,1);
 
1256
  niord=size(cpr.sim.iord,1);
 
1257
 
 
1258
  Indent='  ';
 
1259
  Indent2=Indent+Indent;
 
1260
  BigIndent='          ';
 
1261
 
 
1262
  work=zeros(nblk,1)
 
1263
  Z=[z;zeros(lstsize(outtb),1);work]';
 
1264
  nX=size(x,'*');
 
1265
  nztotal=size(z,1);
 
1266
 
 
1267
  stalone = %t;
 
1268
 
 
1269
  Code=['/* Code prototype for standalone use  */'
 
1270
        '/*     Generated by Code_Generation toolbox of Scicos with '+ ..
 
1271
        getversion()+' */'
 
1272
        '/*     date : '+date()+' */'
 
1273
        ''
 
1274
        '/* ---- Headers ---- */'
 
1275
        '#include <stdlib.h>'
 
1276
        '#include <math.h>'
 
1277
        '#include <string.h>'
 
1278
        '#include <memory.h>'
 
1279
        '#include <scicos_block4.h>'
 
1280
        '#include <machine.h>'
 
1281
        ''
 
1282
        '#ifdef linux'
 
1283
        '#define __CONST__'
 
1284
        '#else'
 
1285
        '#define __CONST__ static const'
 
1286
        '#endif'
 
1287
        ''
 
1288
        'double '+rdnom+'_get_tsamp()'
 
1289
        '{'
 
1290
        '  return(' + string(Tsamp) + ');'
 
1291
        '}'
 
1292
        ''
 
1293
        'double '+rdnom+'_get_tsamp_delay()'
 
1294
        ''
 
1295
        '{'
 
1296
        '  return(' + string(Tsamp_delay) + ');'
 
1297
        '}'
 
1298
        ''
 
1299
        '/* ---- Internals functions declaration ---- */'
 
1300
        'int '+rdnom+'_init(void);'
 
1301
        'int '+rdnom+'_isr(double);'
 
1302
        'int '+rdnom+'_end(void);'
 
1303
        Protostalone
 
1304
        '']
 
1305
 
 
1306
  if x<>[] then
 
1307
    Code=[Code
 
1308
          '/* Code prototype for standalone use  */'
 
1309
          'int C2F('+rdnom+'simblk)(double , double *, double *);'
 
1310
          'extern  int C2F(dset)();'
 
1311
          'static int ode1();'
 
1312
          'static int ode2();'
 
1313
          'static int ode4();'
 
1314
          '']
 
1315
  end
 
1316
 
 
1317
  Code=[Code;
 
1318
        ''
 
1319
        '/* Some general static variables */'
 
1320
        'static double zero=0;'
 
1321
        'static double w[1];'
 
1322
        'void **'+rdnom+'_block_outtbptr;'] //** !!
 
1323
 
 
1324
  Code=[Code;
 
1325
        make_static_standalone42()]
 
1326
 
 
1327
  Code=[Code
 
1328
        '  /* Initial values */'
 
1329
        ''
 
1330
        '  /* Note that z[]=[z_initial_condition;outtbptr;work]'
 
1331
        cformatline('     z_initial_condition={'+...
 
1332
          strcat(string(z),",")+'};',70)
 
1333
        cformatline('     outtbptr={'+...
 
1334
          strcat(string(zeros(lstsize(outtb),1)),"," )+'};',70)
 
1335
        cformatline('     work= {'+...
 
1336
          strcat(string(work),"," )+'};',70)
 
1337
        '  */'
 
1338
        ''
 
1339
        cformatline('  static double z[]={'+strcat(string(Z),',')+'};',70)
 
1340
       '']
 
1341
 
 
1342
  //** declaration of outtb
 
1343
  Code_outtb = [];
 
1344
  for i=1:lstsize(outtb)
 
1345
    if mat2scs_c_nb(outtb(i)) <> 11 then
 
1346
      Code_outtb=[Code_outtb;
 
1347
                  cformatline('  static '+mat2c_typ(outtb(i))+...
 
1348
                              ' outtb_'+string(i)+'[]={'+...
 
1349
                              strcat(string(outtb(i)(:)),',')+'};',70)]
 
1350
    else //** cmplx test
 
1351
      Code_outtb=[Code_outtb;
 
1352
                  cformatline('  static '+mat2c_typ(outtb(i))+...
 
1353
                              ' outtb_'+string(i)+'[]={'+...
 
1354
                              strcat(string([real(outtb(i)(:));
 
1355
                                             imag(outtb(i)(:))]),',')+'};',70)]
 
1356
    end
 
1357
  end
 
1358
  Code=[Code;
 
1359
        Code_outtb;
 
1360
        '']
 
1361
 
 
1362
// Bubu modified
 
1363
 
 
1364
  Code1 = []
 
1365
 
 
1366
  Code2=[''
 
1367
        '/*'+part('-',ones(1,40))+'  Initialisation function */'
 
1368
        'int '+rdnom+'_init()'
 
1369
        '{'
 
1370
        '  double t;'
 
1371
        '  int local_flag;'
 
1372
//      '#ifdef linux'
 
1373
//        '  double *args[2];'
 
1374
//      '#endif'
 
1375
        '']
 
1376
 
 
1377
 
 
1378
  if size(z,1) <> 0 then
 
1379
    for i=1:(length(zptr)-1)
 
1380
      if zptr(i+1)-zptr(i)>0 then
 
1381
        if size(corinv(i),'*')==1 then
 
1382
          OO=scs_m.objs(corinv(i))
 
1383
        else
 
1384
          path=list('objs')
 
1385
          for l=cpr.corinv(i)(1:$-1)
 
1386
            path($+1)=l;path($+1)='model'
 
1387
            path($+1)='rpar'
 
1388
            path($+1)='objs'
 
1389
          end
 
1390
          path($+1)=cpr.corinv(i)($)
 
1391
          OO=scs_m(path)
 
1392
        end
 
1393
        aaa=OO.gui
 
1394
        bbb=emptystr(3,1);
 
1395
        if and(aaa+bbb~=['INPUTPORTEVTS';'OUTPUTPORTEVTS';'EVTGEN_f']) then
 
1396
          Code2($+1)='';
 
1397
          Code2($+1)=' /* Routine name of block: '+strcat(string(cpr.sim.funs(i)));
 
1398
          Code2($+1)='    Gui name of block: '+strcat(string(OO.gui));
 
1399
          //Code2($+1)='/* Name block: '+strcat(string(cpr.sim.funs(i)));
 
1400
          //Code2($+1)='Object number in diagram: '+strcat(string(cpr.corinv(i)));
 
1401
          Code2($+1)='   Compiled structure index: '+strcat(string(i));
 
1402
          if stripblanks(OO.model.label)~=emptystr() then
 
1403
            Code2=[Code2;
 
1404
                   cformatline('   Label: '+strcat(string(OO.model.label)),70)]
 
1405
          end
 
1406
          if stripblanks(OO.graphics.exprs(1))~=emptystr() then
 
1407
            Code2=[Code2;
 
1408
                   cformatline('   Exprs: '+strcat(OO.graphics.exprs(1),","),70)]
 
1409
          end
 
1410
          if stripblanks(OO.graphics.id)~=emptystr() then
 
1411
            Code2=[Code2;
 
1412
                   cformatline('   Identification: '+..
 
1413
                     strcat(string(OO.graphics.id)),70)]
 
1414
          end
 
1415
          Code2=[Code2;
 
1416
                 cformatline('   z={'+...
 
1417
                 strcat(string(z(zptr(i):zptr(i+1)-1)),",")+'};',70)]
 
1418
          Code2($+1)=' */';
 
1419
        end
 
1420
      end
 
1421
    end
 
1422
  end
 
1423
 
 
1424
  //** declaration of oz
 
1425
  Code_oz = [];
 
1426
  for i=1:lstsize(oz)
 
1427
    if mat2scs_c_nb(oz(i)) <> 11 then
 
1428
      Code_oz=[Code_oz;
 
1429
               cformatline('  '+mat2c_typ(oz(i))+...
 
1430
                           ' oz_'+string(i)+'[]={'+...
 
1431
                           strcat(string(oz(i)(:)),',')+'};',70)]
 
1432
    else //** cmplx test
 
1433
      Code_oz=[Code_oz;
 
1434
               cformatline('  '+mat2c_typ(oz(i))+...
 
1435
                           ' oz_'+string(i)+'[]={'+...
 
1436
                           strcat(string([real(oz(i)(:));
 
1437
                                          imag(oz(i)(:))]),',')+'};',70)]
 
1438
    end
 
1439
  end
 
1440
 
 
1441
  if Code_oz <> [] then
 
1442
    Code2=[Code2;
 
1443
           '  /* oz declaration */'
 
1444
           Code_oz]
 
1445
  end
 
1446
 
 
1447
  Code2=[Code2
 
1448
         '  /* Get work ptr of blocks */'
 
1449
         '  void **work;'
 
1450
         '  work = (void **)(z+'+string(size(z,'*')+lstsize(outtb))+');'
 
1451
         '']
 
1452
 
 
1453
 
 
1454
  if Code_outtb<>[] then
 
1455
    Code2=[Code2
 
1456
           '  /* outtbptr declaration */'
 
1457
           '  '+rdnom+'_block_outtbptr = (void **)(z+'+string(nztotal)+');'
 
1458
           '']
 
1459
  end
 
1460
 
 
1461
  Code_outtbptr=[];
 
1462
  for i=1:lstsize(outtb)
 
1463
    Code_outtbptr=[Code_outtbptr;
 
1464
                   '  '+rdnom+'_block_outtbptr['+...
 
1465
                    string(i-1)+'] = (void *) outtb_'+string(i)+';'];
 
1466
  end
 
1467
 
 
1468
  if Code_outtbptr<>[] then
 
1469
    Code2=[Code2;
 
1470
           Code_outtbptr
 
1471
           '']
 
1472
  end
 
1473
 
 
1474
  for kf=1:nblk
 
1475
    nx=xptr(kf+1)-xptr(kf);       //** number of continuous state
 
1476
    nin=inpptr(kf+1)-inpptr(kf);  //** number of input ports
 
1477
    nout=outptr(kf+1)-outptr(kf); //** number of output ports
 
1478
 
 
1479
    //** add comment
 
1480
    txt=[get_comment('set_blk',list(funs(kf),funtyp(kf),kf));]
 
1481
 
 
1482
    Code2=[Code2;
 
1483
           '  '+txt];
 
1484
 
 
1485
    flex_ng     = zcptr(kf+1)-zcptr(kf);
 
1486
    flex_nz     = zptr(kf+1)-zptr(kf);
 
1487
    flex_noz    = ozptr(kf+1)-ozptr(kf);
 
1488
    flex_nin    = inpptr(kf+1)-inpptr(kf);
 
1489
    flex_nout   = outptr(kf+1)-outptr(kf);
 
1490
    flex_nevout = clkptr(kf+1)-clkptr(kf);
 
1491
    flex_nopar  = opptr(kf+1)-opptr(kf);
 
1492
 
 
1493
    Code2=[Code2;
 
1494
           '  block_'+rdnom+'['+string(kf-1)+'].type   = '+string(funtyp(kf))+';';
 
1495
           '  block_'+rdnom+'['+string(kf-1)+'].ztyp   = '+string(ztyp(kf))+';';
 
1496
           '  block_'+rdnom+'['+string(kf-1)+'].ng     = '+string(flex_ng)+';';
 
1497
           '  block_'+rdnom+'['+string(kf-1)+'].nz     = '+string(flex_nz)+';';
 
1498
           '  block_'+rdnom+'['+string(kf-1)+'].noz    = '+string(flex_noz)+';';
 
1499
           '  block_'+rdnom+'['+string(kf-1)+'].nrpar  = '+string(rpptr(kf+1)-rpptr(kf))+';';
 
1500
           '  block_'+rdnom+'['+string(kf-1)+'].nopar  = '+string(flex_nopar)+';';
 
1501
           '  block_'+rdnom+'['+string(kf-1)+'].nipar  = '+string(ipptr(kf+1)-ipptr(kf))+';'
 
1502
           '  block_'+rdnom+'['+string(kf-1)+'].nin    = '+string(flex_nin)+';';
 
1503
           '  block_'+rdnom+'['+string(kf-1)+'].nout   = '+string(flex_nout)+';';
 
1504
           '  block_'+rdnom+'['+string(kf-1)+'].nevout = '+string(flex_nevout)+';';
 
1505
           '  block_'+rdnom+'['+string(kf-1)+'].nmode  = '+string(modptr(kf+1)-modptr(kf))+';';]
 
1506
 
 
1507
    if nx <> 0 then
 
1508
      Code2=[Code2;
 
1509
             '  block_'+rdnom+'['+string(kf-1)+'].nx = '+string(nx)+';';
 
1510
             '  block_'+rdnom+'['+string(kf-1)+'].x  = &(x['+string(xptr(kf)-1)+']);'
 
1511
             '  block_'+rdnom+'['+string(kf-1)+'].xd = &(xd['+string(xptr(kf)-1)+']);']
 
1512
    end
 
1513
 
 
1514
    if flex_nevout <> 0 then
 
1515
      flex_str = rdnom +'_'+string(kf-1)+'_evout'
 
1516
      Code1=[Code1;
 
1517
             'double '+flex_str+'['+string(flex_nevout)+'];'
 
1518
            ]
 
1519
      Code2=[Code2;
 
1520
             '  block_'+rdnom+'['+string(kf-1)+'].evout = '+flex_str+';';
 
1521
            ];
 
1522
    end
 
1523
 
 
1524
    //***************************** input port *****************************//
 
1525
    if flex_nin <> 0 then
 
1526
      flex_str = rdnom +'_'+string(kf-1)+'_inptr'
 
1527
      Code1=[Code1;
 
1528
             'double * '+flex_str+'['+string(flex_nin)+'];'
 
1529
            ]
 
1530
      Code2=[Code2;
 
1531
             '  block_'+rdnom+'['+string(kf-1)+'].inptr = '+flex_str+';';
 
1532
            ];
 
1533
      flex_str = rdnom +'_'+string(kf-1)+'_insz'
 
1534
 
 
1535
      Code2=[Code2;
 
1536
             '  block_'+rdnom+'['+string(kf-1)+'].insz = '+flex_str+';';
 
1537
            ];
 
1538
 
 
1539
      //** inptr **//
 
1540
      for k=1:nin
 
1541
         lprt=inplnk(inpptr(kf)-1+k);
 
1542
         Code2=[Code2
 
1543
                '  block_'+rdnom+'['+string(kf-1)+'].inptr['+string(k-1)+...
 
1544
                ']  = '+rdnom+'_block_outtbptr['+string(lprt-1)+'];']
 
1545
      end
 
1546
 
 
1547
      //** 1st dim **//
 
1548
      szCode='const int '+flex_str+'['+string(3*flex_nin)+']={'
 
1549
      for k=1:nin
 
1550
         lprt=inplnk(inpptr(kf)-1+k);
 
1551
         szCode=szCode+string(size(outtb(lprt),1))+','
 
1552
      end
 
1553
 
 
1554
      //** 2dn dim **//
 
1555
      for k=1:nin
 
1556
         lprt=inplnk(inpptr(kf)-1+k);
 
1557
         szCode=szCode+string(size(outtb(lprt),2))+','
 
1558
      end
 
1559
 
 
1560
      //** typ **//
 
1561
      for k=1:nin
 
1562
         lprt=inplnk(inpptr(kf)-1+k);
 
1563
         szCode=szCode+mat2scs_c_typ(outtb(lprt))+','
 
1564
      end
 
1565
      szCode=part(szCode,1:length(szCode)-1)+'};'
 
1566
      Code1=[Code1;
 
1567
             szCode;
 
1568
            ]
 
1569
    end
 
1570
    
 
1571
    //***************************** output port *****************************//
 
1572
    if flex_nout <> 0 then
 
1573
      flex_str = rdnom +'_'+string(kf-1)+'_outptr'
 
1574
      Code1=[Code1;
 
1575
             'double * '+flex_str+'['+string(flex_nout)+'];'
 
1576
            ]
 
1577
      Code2=[Code2;
 
1578
             '  block_'+rdnom+'['+string(kf-1)+'].outptr = '+flex_str+';';
 
1579
            ];
 
1580
      flex_str = rdnom +'_'+string(kf-1)+'_outsz'
 
1581
      Code2=[Code2;
 
1582
             '  block_'+rdnom+'['+string(kf-1)+'].outsz = '+flex_str+';';
 
1583
            ];
 
1584
 
 
1585
      //** outptr **//
 
1586
      for k=1:nout
 
1587
         lprt=outlnk(outptr(kf)-1+k);
 
1588
         Code2=[Code2
 
1589
                '  block_'+rdnom+'['+string(kf-1)+'].outptr['+string(k-1)+...
 
1590
                '] = '+rdnom+'_block_outtbptr['+string(lprt-1)+'];']
 
1591
      end
 
1592
 
 
1593
      //** 1st dim **//
 
1594
      szCode='const int '+flex_str+'['+string(3*flex_nout)+']={'
 
1595
      for k=1:nout
 
1596
         lprt=outlnk(outptr(kf)-1+k);
 
1597
         szCode=szCode+string(size(outtb(lprt),1))+','
 
1598
      end
 
1599
 
 
1600
      //** 2dn dim **//
 
1601
      for k=1:nout
 
1602
         lprt=outlnk(outptr(kf)-1+k);
 
1603
         szCode=szCode+string(size(outtb(lprt),2))+','
 
1604
      end
 
1605
 
 
1606
      //** typ **//
 
1607
      for k=1:nout
 
1608
         lprt=outlnk(outptr(kf)-1+k);
 
1609
         szCode=szCode+mat2scs_c_typ(outtb(lprt))+','
 
1610
      end
 
1611
      szCode=part(szCode,1:length(szCode)-1)+'};'
 
1612
      Code1=[Code1;
 
1613
             szCode;
 
1614
            ]    
 
1615
    end
 
1616
 
 
1617
    //**********************************************************************//
 
1618
    Code2=[Code2
 
1619
           '  block_'+rdnom+'['+string(kf-1)+...
 
1620
           '].z = &(z['+string(zptr(kf)-1)+']);']
 
1621
 
 
1622
    if (part(funs(kf),1:7) ~= 'capteur' &...
 
1623
        part(funs(kf),1:10) ~= 'actionneur' &...
 
1624
        funs(kf) ~= 'bidon') then
 
1625
      //** rpar **//
 
1626
      if (rpptr(kf+1)-rpptr(kf)>0) then
 
1627
        Code2=[Code2;
 
1628
               '  block_'+rdnom+'['+string(kf-1)+...
 
1629
               '].rpar=&(RPAR['+string(rpptr(kf)-1)+']);']
 
1630
      end
 
1631
      //** ipar **//
 
1632
      if (ipptr(kf+1)-ipptr(kf)>0) then
 
1633
        Code2=[Code2;
 
1634
               '  block_'+rdnom+'['+string(kf-1)+...
 
1635
               '].ipar=&(IPAR['+string(ipptr(kf)-1)+']);']
 
1636
      end
 
1637
 
 
1638
      //**********************************************************************//
 
1639
      //** opar **//
 
1640
 
 
1641
      if flex_nopar<> 0 then
 
1642
        flex_str = rdnom +'_'+string(kf-1)+'_oparptr'
 
1643
        Code1=[Code1;
 
1644
               'void * '+flex_str+'['+string(flex_nopar)+'];'
 
1645
            ]
 
1646
        Code2=[Code2;
 
1647
               '  block_'+rdnom+'['+string(kf-1)+'].oparptr = '+flex_str+';';
 
1648
              ];
 
1649
 
 
1650
        flex_str = rdnom +'_'+string(kf-1)+'_oparsz'
 
1651
        Code2=[Code2;
 
1652
               '  block_'+rdnom+'['+string(kf-1)+'].oparsz = '+flex_str+';';
 
1653
              ];
 
1654
 
 
1655
        flex_str = rdnom +'_'+string(kf-1)+'_opartyp'
 
1656
        Code2=[Code2;
 
1657
               '  block_'+rdnom+'['+string(kf-1)+'].opartyp = '+flex_str+';';
 
1658
              ];
 
1659
 
 
1660
        nopar = flex_nopar;
 
1661
        //** oparptr **//
 
1662
        for k=1:nopar
 
1663
          Code2=[Code2;
 
1664
                 '  block_'+rdnom+'['+string(kf-1)+'].oparptr['+string(k-1)+...
 
1665
                 ']   = (void *) OPAR_'+string(opptr(kf)-1+k)+';'];
 
1666
        end
 
1667
        //** 1st dim **//
 
1668
        szCode='const int '+rdnom+'_'+string(kf-1)+'_oparsz['+string(2*flex_nopar)+']={';
 
1669
        for k=1:nopar
 
1670
           szCode=szCode+string(size(opar(opptr(kf)-1+k),1))+',';
 
1671
        end
 
1672
        //** 2dn dim **//
 
1673
        for k=1:nopar
 
1674
           szCode=szCode+string(size(opar(opptr(kf)-1+k),2))+',';
 
1675
        end
 
1676
        szCode=part(szCode,1:length(szCode)-1)+'};'
 
1677
        Code1=[Code1;
 
1678
               szCode;
 
1679
              ]    
 
1680
 
 
1681
        //** typ **//
 
1682
        szCode='const int '+rdnom+'_'+string(kf-1)+'_opartyp['+string(flex_nopar)+']={';
 
1683
        for k=1:nopar
 
1684
           szCode=szCode+mat2scs_c_typ(opar(opptr(kf)-1+k))+',';
 
1685
        end
 
1686
        szCode=part(szCode,1:length(szCode)-1)+'};'
 
1687
        Code1=[Code1;
 
1688
               szCode;
 
1689
              ]    
 
1690
      end
 
1691
 
 
1692
      //**********************************************************************//
 
1693
      //** oz **//
 
1694
      if flex_noz>0 then
 
1695
        noz = flex_noz;
 
1696
        flex_str = rdnom +'_'+string(kf-1)+'_ozptr'
 
1697
        Code1=[Code1;
 
1698
               'void * '+flex_str+'['+string(flex_noz)+'];'
 
1699
            ]
 
1700
        Code2=[Code2;
 
1701
               '  block_'+rdnom+'['+string(kf-1)+'].ozptr = '+flex_str+';';
 
1702
              ];
 
1703
 
 
1704
        flex_str = rdnom +'_'+string(kf-1)+'_ozsz'
 
1705
        Code2=[Code2;
 
1706
               '  block_'+rdnom+'['+string(kf-1)+'].ozsz = '+flex_str+';';
 
1707
              ];
 
1708
 
 
1709
        flex_str = rdnom +'_'+string(kf-1)+'_oztyp'
 
1710
        Code2=[Code2;
 
1711
               '  block_'+rdnom+'['+string(kf-1)+'].oztyp = '+flex_str+';';
 
1712
              ];
 
1713
 
 
1714
        //** ozptr **//
 
1715
        for k=1:noz
 
1716
          Code2=[Code2;
 
1717
                 '  block_'+rdnom+'['+string(kf-1)+'].ozptr['+string(k-1)+...
 
1718
                 ']   = (void *) oz_'+string(ozptr(kf)-1+k)+';'];
 
1719
        end
 
1720
        //** 1st dim **//
 
1721
        szCode='const int '+rdnom+'_'+string(kf-1)+'_ozsz['+string(2*flex_noz)+']={';
 
1722
        for k=1:noz
 
1723
           szCode=szCode+string(size(oz(ozptr(kf)-1+k),1))+',';
 
1724
        end
 
1725
        //** 2dn dim **//
 
1726
        for k=1:noz
 
1727
           szCode=szCode+string(size(oz(ozptr(kf)-1+k),2))+',';
 
1728
        end
 
1729
        szCode=part(szCode,1:length(szCode)-1)+'};'
 
1730
        Code1=[Code1;
 
1731
               szCode;
 
1732
              ]    
 
1733
 
 
1734
        //** typ **//
 
1735
        szCode='int '+rdnom+'_'+string(kf-1)+'_oztyp['+string(flex_noz)+']={';
 
1736
        for k=1:noz
 
1737
           szCode=szCode+mat2scs_c_typ(oz(ozptr(kf)-1+k))+',';
 
1738
        end
 
1739
        szCode=part(szCode,1:length(szCode)-1)+'};'
 
1740
        Code1=[Code1;
 
1741
               szCode;
 
1742
              ]    
 
1743
      end
 
1744
    end
 
1745
    Code2=[Code2;
 
1746
           '  block_'+rdnom+'['+string(kf-1)+'].work = '+...
 
1747
           '(void **)(((double *)work)+'+string(kf-1)+');']
 
1748
  end
 
1749
 
 
1750
  //** init
 
1751
  Code=[Code;
 
1752
        Code1;
 
1753
        Code2;
 
1754
        '   '+get_comment('flag',list(4))]
 
1755
 
 
1756
  for kf=1:nblk
 
1757
//    if or(kf==act) | or(kf==cap) then
 
1758
//        txt = call_block42(kf,0,4);
 
1759
//        if txt <> [] then
 
1760
//          Code=[Code;
 
1761
//                '';
 
1762
//                '  '+txt];
 
1763
//        end
 
1764
//    else
 
1765
      txt = call_block42(kf,0,4);
 
1766
      if txt <> [] then
 
1767
        Code=[Code;
 
1768
              '';
 
1769
              '  '+txt];
 
1770
      end
 
1771
//    end
 
1772
  end
 
1773
 
 
1774
  //** cst blocks and it's dep
 
1775
  txt=write_code_idoit()
 
1776
 
 
1777
  if txt<>[] then
 
1778
    Code=[Code;
 
1779
          ''
 
1780
          '    /* Initial blocks must be called with flag 1 */'
 
1781
          txt]
 
1782
  end
 
1783
  Code=[Code;
 
1784
        '  return(local_flag);'
 
1785
        '}'];
 
1786
 
 
1787
  Code=[Code;
 
1788
        ''
 
1789
        '/*'+part('-',ones(1,40))+'  ISR function */'
 
1790
        'int '+rdnom+'_isr(double t)'
 
1791
        '{'
 
1792
//        '  int nevprt=1;'
 
1793
        '  int local_flag;'
 
1794
        '  int i;'
 
1795
//      '#ifdef linux'
 
1796
//        '  double *args[2];'
 
1797
//      '#endif'
 
1798
       ]
 
1799
 
 
1800
  if (x <> []) then
 
1801
    Code=[Code
 
1802
          '  double tout, dt, he, h;'
 
1803
          '']
 
1804
  end
 
1805
 
 
1806
  //** find source activation number
 
1807
  blks=find(funtyp>-1);
 
1808
  evs=[];
 
1809
 
 
1810
  for blk=blks
 
1811
    for ev=clkptr(blk):clkptr(blk+1)-1
 
1812
      if funs(blk)=='bidon' then
 
1813
        if ev > clkptr(howclk) -1
 
1814
         evs=[evs,ev];
 
1815
        end
 
1816
      end
 
1817
    end
 
1818
  end
 
1819
 
 
1820
  //** flag 1,2,3
 
1821
  for flag=[1,2,3]
 
1822
 
 
1823
    txt3=[]
 
1824
 
 
1825
    //** continuous time blocks must be activated
 
1826
    //** for flag 1
 
1827
    if flag==1 then
 
1828
      txt = write_code_cdoit(flag);
 
1829
 
 
1830
      if txt <> [] then
 
1831
        txt3=[''
 
1832
              '  '+get_comment('ev',list(0))
 
1833
              txt;
 
1834
             ];
 
1835
      end
 
1836
    end
 
1837
 
 
1838
    //** blocks with input discrete event must be activated
 
1839
    //** for flag 1, 2 and 3
 
1840
    if size(evs,2)>=1 then
 
1841
      txt4=[]
 
1842
      //**
 
1843
      for ev=evs
 
1844
        txt2=write_code_doit(ev,flag);
 
1845
        if txt2<>[] then
 
1846
          //** adjust event number because of bidon block
 
1847
          new_ev=ev-(clkptr(howclk)-1)
 
1848
          //**
 
1849
          txt4=[txt4;
 
1850
//                Indent+['case '+string(new_ev)+' : '+...
 
1851
//                get_comment('ev',list(new_ev))
 
1852
                Indent+[get_comment('ev',list(new_ev))
 
1853
                txt2];
 
1854
//                '    break;';
 
1855
                '']
 
1856
        end
 
1857
      end
 
1858
 
 
1859
      //**
 
1860
      if txt4 <> [] then
 
1861
        txt3=[txt3;
 
1862
              Indent+'/* Discrete activations */'
 
1863
//              Indent+'switch (nevprt) {'
 
1864
              txt4
 
1865
//              '  }'
 
1866
             ];
 
1867
      end
 
1868
    end
 
1869
 
 
1870
    //**
 
1871
    if txt3<>[] then
 
1872
      Code=[Code;
 
1873
            '  '+get_comment('flag',list(flag))
 
1874
            txt3];
 
1875
    end
 
1876
  end
 
1877
 
 
1878
  if x<>[] then
 
1879
    Code=[Code
 
1880
          ''
 
1881
          '  tout=t;'
 
1882
          '  dt='+rdnom+'_get_tsamp();'
 
1883
          '  h=dt/'+odestep+';' 
 
1884
          '  while (tout+h<t+dt){'
 
1885
          '    '+odefun+'(C2F('+rdnom+'simblk),tout,h);'
 
1886
          '     tout=tout+h;'
 
1887
          '  }'
 
1888
          ''
 
1889
          '  he=t+dt-tout;'
 
1890
          '  '+odefun+'(C2F('+rdnom+'simblk),tout,he);'
 
1891
          '']
 
1892
  end
 
1893
 
 
1894
  //** fix bug provided by Roberto Bucher
 
1895
  //** Alan, 13/10/07
 
1896
  if nX <> 0 then
 
1897
    Code=[Code;
 
1898
          ''
 
1899
          '    /* update ptrs of continuous array */']
 
1900
    for kf=1:nblk
 
1901
      nx=xptr(kf+1)-xptr(kf);  //** number of continuous state
 
1902
      if nx <> 0 then
 
1903
        Code=[Code;
 
1904
              '  block_'+rdnom+'['+string(kf-1)+'].nx = '+...
 
1905
               string(nx)+';';
 
1906
              '  block_'+rdnom+'['+string(kf-1)+'].x  = '+...
 
1907
               '&(x['+string(xptr(kf)-1)+']);'
 
1908
              '  block_'+rdnom+'['+string(kf-1)+'].xd = '+...
 
1909
               '&(xd['+string(xptr(kf)-1)+']);']
 
1910
      end
 
1911
    end
 
1912
  end
 
1913
 
 
1914
  Code=[Code
 
1915
        ''
 
1916
        '  return 0;'
 
1917
        '}']
 
1918
 
 
1919
  //** flag 5
 
1920
 
 
1921
  Code=[Code
 
1922
        '/*'+part('-',ones(1,40))+'  Termination function */'
 
1923
        'int '+rdnom+'_end()'
 
1924
        '{'
 
1925
        '  double t;'
 
1926
        '  int local_flag;'
 
1927
//      '#ifdef linux'
 
1928
//        '  double *args[2];'
 
1929
//      '#endif'
 
1930
        '']
 
1931
 
 
1932
  Code=[Code;
 
1933
        '  '+get_comment('flag',list(5))]
 
1934
 
 
1935
  for kf=1:nblk
 
1936
//    if or(kf==act) | or(kf==cap) then
 
1937
//        txt = call_block42(kf,0,5);
 
1938
//        if txt <> [] then
 
1939
//          Code=[Code;
 
1940
//                '';
 
1941
//                '  '+txt];
 
1942
//        end
 
1943
//    else
 
1944
      txt = call_block42(kf,0,5);
 
1945
      if txt <> [] then
 
1946
        Code=[Code;
 
1947
              '';
 
1948
              '  '+txt];
 
1949
      end
 
1950
//    end
 
1951
  end
 
1952
 
 
1953
  Code=[Code
 
1954
        '  return 0;'
 
1955
        '}'
 
1956
        '']
 
1957
 
 
1958
  Code_common=['/* Code prototype for common use  */'
 
1959
               '/*     Generated by Code_Generation toolbox of Scicos with '+ ..
 
1960
                getversion()+' */'
 
1961
               '/*     date : '+date()+' */'
 
1962
               ''
 
1963
               '/* ---- Headers ---- */'
 
1964
               '#include <memory.h>'
 
1965
               '#include '"machine.h'"'
 
1966
               '']
 
1967
 
 
1968
               if(isempty(grep(SCI,'5.1.1'))) then
 
1969
               Code_common=[Code_common
 
1970
               '/*'+part('-',ones(1,40))+'  Lapack messag function */';
 
1971
               'void C2F(xerbla)(SRNAME,INFO,L)'
 
1972
               '     char *SRNAME;'
 
1973
               '     int *INFO;'
 
1974
               '     long int L;'
 
1975
               '{}'
 
1976
               '']
 
1977
               end
 
1978
 
 
1979
               Code_common=[Code_common
 
1980
               'void set_block_error(int err)'
 
1981
               '{'
 
1982
               '  return;'
 
1983
               '}'
 
1984
               ''
 
1985
               'int get_phase_simulation()'
 
1986
               '{'
 
1987
               '  return 1;'
 
1988
               '}'
 
1989
               ''
 
1990
               'void * scicos_malloc(size_t size)'
 
1991
               '{'
 
1992
               '  return malloc(size);'
 
1993
               '}'
 
1994
               ''
 
1995
               'void scicos_free(void *p)'
 
1996
               '{'
 
1997
               '  free(p);'
 
1998
               '}'
 
1999
               ''
 
2000
               'void do_cold_restart()'
 
2001
               '{'
 
2002
               '  return;'
 
2003
               '}'
 
2004
               ''
 
2005
               'void sciprint (char *fmt)'
 
2006
               '{'
 
2007
               '  return;'
 
2008
               '}'
 
2009
               '']
 
2010
 
 
2011
  if (x <> []) then
 
2012
    Code=[Code;
 
2013
          'int C2F('+rdnom+'simblk)(t, xc, xdc)'
 
2014
          ''
 
2015
          '   double t, *xc, *xdc;'
 
2016
          ''
 
2017
          '     /*'
 
2018
          '      *  !purpose'
 
2019
          '      *  compute state derivative of the continuous part'
 
2020
          '      *  !calling sequence'
 
2021
          '      *  neq   : integer the size of the  continuous state'
 
2022
          '      *  t     : current time'
 
2023
          '      *  xc    : double precision vector whose contains the continuous state'
 
2024
          '      *  xdc   : double precision vector, contain the computed derivative'
 
2025
          '      *  of the state'
 
2026
          '      */'
 
2027
          '{'
 
2028
          '  int phase=2;'
 
2029
          '  int local_flag;'
 
2030
          '  int nport;'
 
2031
//          '  int nevprt=1;'
 
2032
//        '#ifdef linux'
 
2033
//          '  double *args[2];'
 
2034
//        '#endif'
 
2035
          '  C2F(dset)(&neq, &c_b14,xd , &c__1);'
 
2036
          '']
 
2037
 
 
2038
    Code=[Code;
 
2039
          '    '+get_comment('update_xd',list())]
 
2040
 
 
2041
    for kf=1:nblk
 
2042
      if (xptr(kf+1)-xptr(kf)) > 0 then
 
2043
        Code=[Code;
 
2044
              '    block_'+rdnom+'['+string(kf-1)+'].x='+...
 
2045
                '&(xc['+string(xptr(kf)-1)+']);'
 
2046
              '    block_'+rdnom+'['+string(kf-1)+'].xd='+...
 
2047
                '&(xdc['+string(xptr(kf)-1)+']);']
 
2048
      end
 
2049
    end
 
2050
 
 
2051
    Code=[Code;
 
2052
          ''
 
2053
          write_code_odoit(1)
 
2054
          write_code_odoit(0)
 
2055
         ]
 
2056
 
 
2057
    for kf=1:nblk
 
2058
      if (xptr(kf+1)-xptr(kf)) > 0 then
 
2059
        Code=[Code;
 
2060
              '    block_'+rdnom+'['+string(kf-1)+'].x='+...
 
2061
                '&(x['+string(xptr(kf)-1)+']);'
 
2062
              '    block_'+rdnom+'['+string(kf-1)+'].xd='+...
 
2063
                '&(xd['+string(xptr(kf)-1)+']);']
 
2064
      end
 
2065
    end
 
2066
 
 
2067
    Code=[Code
 
2068
          ''
 
2069
          '  return 0;'
 
2070
          '}'
 
2071
          ''
 
2072
          '/* Euler''s Method */'
 
2073
          'static int ode1(f,t,h)'
 
2074
          '  int (*f) ();'
 
2075
          '  double t, h;'
 
2076
          '{'
 
2077
          '  int i;'
 
2078
          ''
 
2079
          '  /**/'
 
2080
          '  (*f)(t,x, xd);'
 
2081
          ''
 
2082
          '  for (i=0;i<neq;i++) {'
 
2083
          '   x[i]=x[i]+h*xd[i];'
 
2084
          '  }'
 
2085
          ''
 
2086
          '  return 0;'
 
2087
          '}'
 
2088
          ''
 
2089
          '/* Heun''s Method */'
 
2090
          'static int ode2(f,t,h)'
 
2091
          '  int (*f) ();'
 
2092
          '  double t, h;'
 
2093
          '{'
 
2094
          '  int i;'
 
2095
          '  double y['+string(nX)+'],yh['+string(nX)+'],temp,f0['+string(nX)+'],th;'
 
2096
          ''
 
2097
          '  /**/'
 
2098
          '  memcpy(y,x,neq*sizeof(double));'
 
2099
          '  memcpy(f0,xd,neq*sizeof(double));'
 
2100
          ''
 
2101
          '  /**/'
 
2102
          '  (*f)(t,y, f0);'
 
2103
          ''
 
2104
          '  /**/'
 
2105
          '  for (i=0;i<neq;i++) {'
 
2106
          '    x[i]=y[i]+h*f0[i];'
 
2107
          '  }'
 
2108
          '  th=t+h;'
 
2109
          '  for (i=0;i<neq;i++) {'
 
2110
          '    yh[i]=y[i]+h*f0[i];'
 
2111
          '  }'
 
2112
          '  (*f)(th,yh, xd);'
 
2113
          ''
 
2114
          '  /**/'
 
2115
          '  temp=0.5*h;'
 
2116
          '  for (i=0;i<neq;i++) {'
 
2117
          '    x[i]=y[i]+temp*(f0[i]+xd[i]);'
 
2118
          '  }'
 
2119
          ''
 
2120
          '  return 0;'
 
2121
          '}'
 
2122
          ''
 
2123
          '/* Fourth-Order Runge-Kutta (RK4) Formula */'
 
2124
          'static int ode4(f,t,h)'
 
2125
          '  int (*f) ();'
 
2126
          '  double t, h;'
 
2127
          '{'
 
2128
          '  int i;'
 
2129
          '  double y['+string(nX)+'],yh['+string(nX)+'],'+...
 
2130
            'temp,f0['+string(nX)+'],th,th2,'+...
 
2131
            'f1['+string(nX)+'],f2['+string(nX)+'];'
 
2132
          ''
 
2133
          '  /**/'
 
2134
          '  memcpy(y,x,neq*sizeof(double));'
 
2135
          '  memcpy(f0,xd,neq*sizeof(double));'
 
2136
          ''
 
2137
          '  /**/'
 
2138
          '  (*f)(t,y, f0);'
 
2139
          ''
 
2140
          '  /**/'
 
2141
          '  for (i=0;i<neq;i++) {'
 
2142
          '    x[i]=y[i]+h*f0[i];'
 
2143
          '  }'
 
2144
          '  th2=t+h/2;'
 
2145
          '  for (i=0;i<neq;i++) {'
 
2146
          '    yh[i]=y[i]+(h/2)*f0[i];'
 
2147
          '  }'
 
2148
          '  (*f)(th2,yh, f1);'
 
2149
          ''
 
2150
          '  /**/'
 
2151
          '  temp=0.5*h;'
 
2152
          '  for (i=0;i<neq;i++) {'
 
2153
          '    x[i]=y[i]+temp*f1[i];'
 
2154
          '  }'
 
2155
          '  for (i=0;i<neq;i++) {'
 
2156
          '    yh[i]=y[i]+(h/2)*f1[i];'
 
2157
          '  }'
 
2158
          '  (*f)(th2,yh, f2);'
 
2159
          ''
 
2160
          '  /**/'
 
2161
          '  for (i=0;i<neq;i++) {'
 
2162
          '    x[i]=y[i]+h*f2[i];'
 
2163
          '  }'
 
2164
          '  th=t+h;'
 
2165
          '  for (i=0;i<neq;i++) {'
 
2166
          '    yh[i]=y[i]+h*f2[i];'
 
2167
          '  }'
 
2168
          '  (*f)(th2,yh, xd);'
 
2169
          ''
 
2170
          '  /**/'
 
2171
          '  temp=h/6;'
 
2172
          '  for (i=0;i<neq;i++) {'
 
2173
          '    x[i]=y[i]+temp*(f0[i]+2.0*f1[i]+2.0*f2[i]+xd[i]);'
 
2174
          '  }'
 
2175
          ''
 
2176
          'return 0;'
 
2177
          '}']
 
2178
  end
 
2179
endfunction
 
2180
 
 
2181
//==========================================================================
 
2182
//generates  static table definitions
 
2183
//
 
2184
//Author : Rachid Djenidi, Alan Layec
 
2185
//Copyright INRIA
 
2186
 
 
2187
// Modified for RT purposes by Roberto Bucher - RTAI Team
 
2188
// roberto.bucher@supsi.ch
 
2189
 
 
2190
function txt=make_static_standalone42()
 
2191
 
 
2192
  txt=[''];
 
2193
 
 
2194
  //*** Continuous state ***//
 
2195
  if x <> [] then
 
2196
   txt=[txt;
 
2197
        '/* def continuous state */'
 
2198
        cformatline('static double x[]={'+strcat(string(x),',')+'};',70)
 
2199
        cformatline('static double xd[]={'+strcat(string(x),',')+'};',70)
 
2200
        'static int c__1 = 1;'
 
2201
        'static double c_b14 = 0.;'
 
2202
        'static int neq='+string(nX)+';'
 
2203
        '']
 
2204
  end
 
2205
  //************************//
 
2206
 
 
2207
  txt=[txt;
 
2208
       'scicos_block block_'+rdnom+'['+string(nblk)+'];'
 
2209
       ''];
 
2210
 
 
2211
  //*** Real parameters ***//
 
2212
  nbrpa=0;strRCode='';lenRCode=[];ntot_r=0;
 
2213
  if size(rpar,1) <> 0 then
 
2214
    txt=[txt;
 
2215
         '/* def real parameters */'
 
2216
         '__CONST__ double RPAR[ ] = {'];
 
2217
 
 
2218
    for i=1:(length(rpptr)-1)
 
2219
      if rpptr(i+1)-rpptr(i)>0  then
 
2220
 
 
2221
        if size(corinv(i),'*')==1 then
 
2222
          OO=scs_m.objs(corinv(i));
 
2223
        else
 
2224
          path=list('objs');
 
2225
          for l=cpr.corinv(i)(1:$-1)
 
2226
            path($+1)=l;
 
2227
            path($+1)='model';
 
2228
            path($+1)='rpar';
 
2229
            path($+1)='objs';
 
2230
          end
 
2231
          path($+1)=cpr.corinv(i)($);
 
2232
          OO=scs_m(path);
 
2233
        end
 
2234
 
 
2235
        //** Add comments **//
 
2236
        nbrpa=nbrpa+1;
 
2237
        ntot_r = ntot_r + (rpptr(i+1)-rpptr(i));
 
2238
        txt($+1)='/* Routine name of block: '+strcat(string(cpr.sim.funs(i)));
 
2239
        txt($+1)=' * Gui name of block: '+strcat(string(OO.gui));
 
2240
        txt($+1)=' * Compiled structure index: '+strcat(string(i));
 
2241
 
 
2242
        if stripblanks(OO.model.label)~=emptystr() then
 
2243
          txt=[txt;cformatline(' * Label: '+strcat(string(OO.model.label)),70)];
 
2244
        end
 
2245
        if stripblanks(OO.graphics.exprs(1))~=emptystr() then
 
2246
          txt=[txt;cformatline(' * Exprs: '+strcat(OO.graphics.exprs(1),","),70)];
 
2247
        end
 
2248
        if stripblanks(OO.graphics.id)~=emptystr() then
 
2249
          str_id = string(OO.graphics.id);
 
2250
        else
 
2251
          str_id = 'RPARAM[' + string(nbrpa) +']';
 
2252
        end
 
2253
        txt=[txt;
 
2254
             cformatline(' * Identification: '+strcat(string(OO.graphics.id)),70)];
 
2255
        txt=[txt;cformatline('rpar= {'+strcat(string(rpar(rpptr(i):rpptr(i+1)-1)),",")+'};',70)];
 
2256
        txt($+1)='*/';
 
2257
                //******************//
 
2258
 
 
2259
        txt=[txt;
 
2260
             cformatline(strcat(msprintf('%.16g,\n',rpar(rpptr(i):rpptr(i+1)-1))),70);
 
2261
             '']
 
2262
        strRCode = strRCode + '""' + str_id + '"",';
 
2263
        lenRCode = lenRCode + string(rpptr(i+1)-rpptr(i)) + ',';
 
2264
 
 
2265
      end
 
2266
    end
 
2267
    txt=[txt;
 
2268
           '};']
 
2269
  else
 
2270
    txt($+1)='double RPAR[1];';
 
2271
  end
 
2272
 
 
2273
  txt = [txt;
 
2274
         '';
 
2275
         '#ifdef linux';
 
2276
        ]
 
2277
  txt($+1) = 'int NRPAR = '+string(nbrpa)+';';
 
2278
  txt($+1) = 'int NTOTRPAR = '+string(ntot_r)+';';
 
2279
    
 
2280
  strRCode = 'char * strRPAR[' + string(nbrpa) + '] = {' + ..
 
2281
             part(strRCode,[1:length(strRCode)-1]) + '};';
 
2282
 
 
2283
  if nbrpa <> 0 then
 
2284
    txt($+1) = strRCode;
 
2285
    lenRCode = 'int lenRPAR[' + string(nbrpa) + '] = {' + ..
 
2286
               part(lenRCode,[1:length(lenRCode)-1]) + '};';
 
2287
  else
 
2288
     txt($+1) = 'char * strRPAR;'
 
2289
     lenRCode = 'int lenRPAR[1] = {0};'
 
2290
  end
 
2291
  txt($+1) = lenRCode;
 
2292
  txt = [txt;
 
2293
         '#endif';
 
2294
         '';
 
2295
        ]
 
2296
 
 
2297
  //***********************//
 
2298
 
 
2299
  //*** Integer parameters ***//
 
2300
  nbipa=0;strICode='';lenICode=[];ntot_i=0;
 
2301
  if size(ipar,1) <> 0 then
 
2302
    txt=[txt;
 
2303
           '/* def integer parameters */'
 
2304
           '__CONST__ int IPAR[ ] = {'];
 
2305
 
 
2306
    for i=1:(length(ipptr)-1)
 
2307
      if ipptr(i+1)-ipptr(i)>0  then
 
2308
        if size(corinv(i),'*')==1 then
 
2309
          OO=scs_m.objs(corinv(i));
 
2310
        else
 
2311
          path=list('objs');
 
2312
          for l=cpr.corinv(i)(1:$-1)
 
2313
            path($+1)=l
 
2314
            path($+1)='model'
 
2315
            path($+1)='rpar'
 
2316
            path($+1)='objs'
 
2317
          end
 
2318
          path($+1)=cpr.corinv(i)($);
 
2319
          OO=scs_m(path);
 
2320
        end
 
2321
 
 
2322
        //** Add comments **//
 
2323
        nbipa=nbipa+1;
 
2324
        ntot_i = ntot_i + (ipptr(i+1)-ipptr(i));
 
2325
        txt($+1)='/* Routine name of block: '+strcat(string(cpr.sim.funs(i)));
 
2326
        txt($+1)=' * Gui name of block: '+strcat(string(OO.gui));
 
2327
        txt($+1)=' * Compiled structure index: '+strcat(string(i));
 
2328
        if stripblanks(OO.model.label)~=emptystr() then
 
2329
          txt=[txt;cformatline(' * Label: '+strcat(string(OO.model.label)),70)];
 
2330
        end
 
2331
 
 
2332
        if stripblanks(OO.graphics.exprs(1))~=emptystr() then
 
2333
          txt=[txt;
 
2334
               cformatline(' * Exprs: '+strcat(OO.graphics.exprs(1),","),70)];
 
2335
        end
 
2336
 
 
2337
        if stripblanks(OO.graphics.id)~=emptystr() then
 
2338
          str_id = string(OO.graphics.id);
 
2339
        else
 
2340
          str_id = 'IPARAM[' + string(nbipa) +']';
 
2341
        end
 
2342
 
 
2343
        txt=[txt;
 
2344
               cformatline(' * Identification: '+strcat(string(OO.graphics.id)),70)];
 
2345
        txt=[txt;cformatline('ipar= {'+strcat(string(ipar(ipptr(i):ipptr(i+1)-1)),",")+'};',70)];
 
2346
        txt($+1)='*/';
 
2347
 
 
2348
        //******************//
 
2349
 
 
2350
        txt=[txt;cformatline(strcat(string(ipar(ipptr(i):ipptr(i+1)-1))+','),70)];
 
2351
        strICode = strICode + '""' + str_id + '"",';
 
2352
        lenICode = lenICode + string(ipptr(i+1)-ipptr(i)) + ',';
 
2353
      end
 
2354
    end
 
2355
    txt=[txt;
 
2356
         '};']
 
2357
  else
 
2358
    txt($+1)='int IPAR[1];';
 
2359
  end
 
2360
 
 
2361
  txt = [txt;
 
2362
         '';
 
2363
         '#ifdef linux';
 
2364
        ]
 
2365
  txt($+1) = 'int NIPAR = '+string(nbipa)+';';
 
2366
  txt($+1) = 'int NTOTIPAR = '+string(ntot_i)+';';
 
2367
 
 
2368
  strICode = 'char * strIPAR[' + string(nbipa) + '] = {' + ..
 
2369
             part(strICode,[1:length(strICode)-1]) + '};';
 
2370
 
 
2371
  if nbipa <> 0 then
 
2372
     txt($+1) = strICode;
 
2373
     lenICode = 'int lenIPAR[' + string(nbipa) + '] = {' + ..
 
2374
                part(lenICode,[1:length(lenICode)-1]) + '};';
 
2375
  else
 
2376
     txt($+1) = 'char * strIPAR;'
 
2377
     lenICode = 'int lenIPAR[1] = {0};'
 
2378
  end
 
2379
  txt($+1) = lenICode;
 
2380
  txt = [txt;
 
2381
         '#endif';
 
2382
         '';
 
2383
        ]
 
2384
 
 
2385
  //**************************//
 
2386
 
 
2387
  //Alan added opar (27/06/07)
 
2388
  //*** Object parameters ***//
 
2389
  if lstsize(opar)<>0 then
 
2390
    txt=[txt;
 
2391
          '/* def object parameters */']
 
2392
    for i=1:(length(opptr)-1)
 
2393
      if opptr(i+1)-opptr(i)>0  then
 
2394
 
 
2395
        if size(corinv(i),'*')==1 then
 
2396
          OO=scs_m.objs(corinv(i));
 
2397
        else
 
2398
          path=list('objs');
 
2399
          for l=cpr.corinv(i)(1:$-1)
 
2400
            path($+1)=l;
 
2401
            path($+1)='model';
 
2402
            path($+1)='rpar';
 
2403
            path($+1)='objs';
 
2404
          end
 
2405
          path($+1)=cpr.corinv(i)($);
 
2406
          OO=scs_m(path);
 
2407
        end
 
2408
 
 
2409
        //** Add comments **//
 
2410
        txt($+1)='';
 
2411
        txt($+1)='/* Routine name of block: '+strcat(string(cpr.sim.funs(i)));
 
2412
        txt($+1)=' * Gui name of block: '+strcat(string(OO.gui));
 
2413
        txt($+1)=' * Compiled structure index: '+strcat(string(i));
 
2414
        if stripblanks(OO.model.label)~=emptystr() then
 
2415
          txt=[txt;cformatline(' * Label: '+strcat(string(OO.model.label)),70)];
 
2416
        end
 
2417
        if stripblanks(OO.graphics.id)~=emptystr() then
 
2418
          txt=[txt;
 
2419
               cformatline(' * Identification: '+strcat(string(OO.graphics.id)),70)];
 
2420
        end
 
2421
        txt($+1)=' */';
 
2422
        //******************//
 
2423
 
 
2424
        for j=1:opptr(i+1)-opptr(i)
 
2425
          txt =[txt;
 
2426
                cformatline('static __CONST__ '+mat2c_typ(opar(opptr(i)+j-1)) +...
 
2427
                            ' OPAR_'+string(opptr(i)+j-1) + '[] = {'+...
 
2428
                            strcat(string(opar(opptr(i)+j-1)),',')+'};',70)]
 
2429
        end
 
2430
      end
 
2431
    end
 
2432
  end
 
2433
  //*************************//
 
2434
 
 
2435
  txt=[txt;
 
2436
       '']
 
2437
endfunction
 
2438
 
 
2439
//==========================================================================
 
2440
//mat2c_typ : matrix to C type
 
2441
//sci2c_ttyp : get the C string of a scicos type
 
2442
//
 
2443
//input : outtb : a matrix
 
2444
//
 
2445
//output : txt : the string of the C scicos type
 
2446
//               of the data of outtb
 
2447
//
 
2448
//16/06/07 Author : A.Layec
 
2449
//Copyright INRIA
 
2450
function [txt]=mat2c_typ(outtb)
 
2451
 select type(outtb)
 
2452
   //real matrix
 
2453
   case 1 then
 
2454
      if isreal(outtb) then
 
2455
        txt = "double"
 
2456
      else
 
2457
        txt = "double"
 
2458
      end
 
2459
   //integer matrix
 
2460
   case 8 then
 
2461
      select typeof(outtb)
 
2462
         case 'int32' then
 
2463
           txt = "long"
 
2464
         case 'int16' then
 
2465
           txt = "short"
 
2466
         case 'int8' then
 
2467
           txt = "char"
 
2468
         case 'uint32' then
 
2469
           txt = "unsigned long"
 
2470
         case 'uint16' then
 
2471
           txt = "unsigned short"
 
2472
         case 'uint8' then
 
2473
           txt = "unsigned char"
 
2474
      end
 
2475
   else
 
2476
     break;
 
2477
 end
 
2478
endfunction
 
2479
 
 
2480
 
 
2481
//==========================================================================
 
2482
//mat2scs_c_nb  matrix to scicos C number (sci2sci_n)
 
2483
//
 
2484
//input : outtb : a matrix
 
2485
//
 
2486
//output : c_nb : the scicos C number
 
2487
//
 
2488
//16/06/07 Author : A.Layec
 
2489
//Copyright INRIA
 
2490
function [c_nb]=mat2scs_c_nb(outtb)
 
2491
 select type(outtb)
 
2492
   //real matrix
 
2493
   case 1 then
 
2494
      if isreal(outtb) then
 
2495
        c_nb = 10
 
2496
      else
 
2497
        c_nb = 11
 
2498
      end
 
2499
   //integer matrix
 
2500
   case 8 then
 
2501
      select typeof(outtb)
 
2502
         case 'int32' then
 
2503
           c_nb = 84
 
2504
         case 'int16' then
 
2505
           c_nb = 82
 
2506
         case 'int8' then
 
2507
           c_nb = 81
 
2508
         case 'uint32' then
 
2509
           c_nb = 814
 
2510
         case 'uint16' then
 
2511
           c_nb = 812
 
2512
         case 'uint8' then
 
2513
           c_nb = 811
 
2514
      end
 
2515
   else
 
2516
     break;
 
2517
 end
 
2518
endfunction
 
2519
 
 
2520
//==========================================================================
 
2521
//mat2scs_c_ptr matrix to scicos C ptr (sci2c_typ)
 
2522
//
 
2523
//input : outtb : a matrix
 
2524
//
 
2525
//output : txt : the string of the C scicos type
 
2526
//               of the data of outtb
 
2527
//
 
2528
//16/06/07 Author : A.Layec
 
2529
//Copyright INRIA
 
2530
function [txt]=mat2scs_c_ptr(outtb)
 
2531
 select type(outtb)
 
2532
   //real matrix
 
2533
   case 1 then
 
2534
      if isreal(outtb) then
 
2535
        txt = "SCSREAL_COP"
 
2536
      else
 
2537
        txt = "SCSCOMPLEX_COP"
 
2538
      end
 
2539
   //integer matrix
 
2540
   case 8 then
 
2541
      select typeof(outtb)
 
2542
         case 'int32' then
 
2543
           txt = "SCSINT32_COP"
 
2544
         case 'int16' then
 
2545
           txt = "SCSINT16_COP"
 
2546
         case 'int8' then
 
2547
           txt = "SCSINT8_COP"
 
2548
         case 'uint32' then
 
2549
           txt = "SCSUINT32_COP"
 
2550
         case 'uint16' then
 
2551
           txt = "SCSUINT16_COP"
 
2552
         case 'uint8' then
 
2553
           txt = "SCSUINT8_COP"
 
2554
      end
 
2555
   else
 
2556
     break;
 
2557
 end
 
2558
endfunction
 
2559
 
 
2560
//==========================================================================
 
2561
//mat2scs_c_typ matrix to scicos C type
 
2562
//
 
2563
//input : outtb : a matrix
 
2564
//
 
2565
//output : txt : the string of the C scicos type
 
2566
//               of the data of outtb
 
2567
//
 
2568
//16/06/07 Author : A.Layec
 
2569
//Copyright INRIA
 
2570
function [txt]=mat2scs_c_typ(outtb)
 
2571
 select type(outtb)
 
2572
   //real matrix
 
2573
   case 1 then
 
2574
      if isreal(outtb) then
 
2575
        txt = "SCSREAL_N"
 
2576
      else
 
2577
        txt = "SCSCOMPLEX_N"
 
2578
      end
 
2579
   //integer matrix
 
2580
   case 8 then
 
2581
      select typeof(outtb)
 
2582
         case 'int32' then
 
2583
           txt = "SCSINT32_N"
 
2584
         case 'int16' then
 
2585
           txt = "SCSINT16_N"
 
2586
         case 'int8' then
 
2587
           txt = "SCSINT8_N"
 
2588
         case 'uint32' then
 
2589
           txt = "SCSUINT32_N"
 
2590
         case 'uint16' then
 
2591
           txt = "SCSUINT16_N"
 
2592
         case 'uint8' then
 
2593
           txt = "SCSUINT8_N"
 
2594
      end
 
2595
   else
 
2596
     break;
 
2597
 end
 
2598
endfunction
 
2599
 
 
2600
// Modified for RT purposes by Roberto Bucher - RTAI Team
 
2601
// roberto.bucher@supsi.ch
 
2602
 
 
2603
function rename(folder,newname,ext)
 
2604
  oldname=folder+'/Makefile';
 
2605
  newname=folder+'/'+newname;
 
2606
  T=mgetl(oldname);
 
2607
  T=strsubst(T,'.obj','.o');
 
2608
  T=strsubst(T,'.o',ext);
 
2609
  T=strsubst(T,SCI,WSCI);
 
2610
  mputl(T,newname);
 
2611
  mdelete(oldname);
 
2612
endfunction
 
2613
 
 
2614
//==========================================================================
 
2615
 
 
2616
// Modified for RT purposes by Roberto Bucher - RTAI Team
 
2617
// roberto.bucher@supsi.ch
 
2618
 
 
2619
function Makename=rt_gen_make(name,files,libs)
 
2620
 
 
2621
  Makename=rpat+'/Makefile';
 
2622
 
 
2623
  T=mgetl(TARGETDIR+'/'+makfil);
 
2624
  T=strsubst(T,'$$MODEL$$',name);
 
2625
  T=strsubst(T,'$$OBJ$$',strcat(files+'.o',' '));
 
2626
  T=strsubst(T,'$$SCILAB_DIR$$',SCI);
 
2627
  mputl(T,Makename)
 
2628
 
 
2629
endfunction
 
2630
 
 
2631
 
 
2632
 
 
2633
//==========================================================================
 
2634
//scs_c_n2c_fmt : scicos C number to C format
 
2635
//
 
2636
//input : c_nb : a C scicos type
 
2637
//
 
2638
//output : txt : the string of the C format string
 
2639
//               of the data of outtb
 
2640
//
 
2641
//16/06/07 Author : A.Layec
 
2642
//Copyright INRIA
 
2643
function [txt]=scs_c_n2c_fmt(c_nb)
 
2644
 select c_nb
 
2645
   //real matrix
 
2646
   case 10 then
 
2647
     txt = '%f';
 
2648
   //complex matrix
 
2649
   case 11 then
 
2650
     txt = '%f,%f';
 
2651
   //int8 matrix
 
2652
   case 81 then
 
2653
     txt = '%d';
 
2654
   //int16 matrix
 
2655
   case 82 then
 
2656
     txt = '%d';
 
2657
   //int32 matrix
 
2658
   case 84 then
 
2659
     txt = '%d';
 
2660
   //uint8 matrix
 
2661
   case 811 then
 
2662
     txt = '%d';
 
2663
   //uint16 matrix
 
2664
   case 812 then
 
2665
     txt = '%d';
 
2666
   //uint32 matrix
 
2667
   case 814 then
 
2668
     txt = '%d';
 
2669
   else
 
2670
     txt='%f'
 
2671
     break;
 
2672
 end
 
2673
endfunction
 
2674
 
 
2675
//==========================================================================
 
2676
//scs_c_n2c_typ scicos C number to C type
 
2677
//
 
2678
//input : c_nb : a C scicos number
 
2679
//
 
2680
//output : txt : the string of the C format string
 
2681
//               of the data of outtb
 
2682
//
 
2683
//16/06/07 Author : A.Layec
 
2684
//Copyright INRIA
 
2685
function [txt]=scs_c_n2c_typ(c_nb)
 
2686
 select c_nb
 
2687
   //real matrix
 
2688
   case 10 then
 
2689
     txt = 'double';
 
2690
   //complex matrix
 
2691
   case 11 then
 
2692
     txt = 'double';
 
2693
   //int8 matrix
 
2694
   case 81 then
 
2695
     txt = 'char';
 
2696
   //int16 matrix
 
2697
   case 82 then
 
2698
     txt = 'short';
 
2699
   //int32 matrix
 
2700
   case 84 then
 
2701
     txt = 'long';
 
2702
   //uint8 matrix
 
2703
   case 811 then
 
2704
     txt = 'unsigned char';
 
2705
   //uint16 matrix
 
2706
   case 812 then
 
2707
     txt = 'unsigned short';
 
2708
   //uint32 matrix
 
2709
   case 814 then
 
2710
     txt = 'unsigned long';
 
2711
   else
 
2712
     txt='double'
 
2713
     break;
 
2714
 end
 
2715
endfunction
 
2716
 
 
2717
//==========================================================================
 
2718
//scs_c_nb2scs_nb : scicos C number to scicos number
 
2719
//
 
2720
//input : c_nb  : the scicos C number type
 
2721
//
 
2722
//output : scs_nb : the scilab number type
 
2723
//
 
2724
//16/06/07 Author : A.Layec
 
2725
//Copyright INRIA
 
2726
function [scs_nb]=scs_c_nb2scs_nb(c_nb)
 
2727
 scs_nb=zeros(size(c_nb,1),size(c_nb,2));
 
2728
 for i=1:size(c_nb,1)
 
2729
   for j=1:size(c_nb,2)
 
2730
     select (c_nb(i,j))
 
2731
       case 10 then
 
2732
         scs_nb(i,j) = 1
 
2733
       case 11 then
 
2734
         scs_nb(i,j) = 2
 
2735
       case 81 then
 
2736
         scs_nb(i,j) = 5
 
2737
       case 82 then
 
2738
         scs_nb(i,j) = 4
 
2739
       case 84 then
 
2740
         scs_nb(i,j) = 3
 
2741
       case 811 then
 
2742
         scs_nb(i,j) = 8
 
2743
       case 812 then
 
2744
         scs_nb(i,j) = 7
 
2745
       case 814 then
 
2746
         scs_nb(i,j) = 6
 
2747
       else
 
2748
         scs_nb(i,j) = 1
 
2749
     end
 
2750
   end
 
2751
 end
 
2752
endfunction
 
2753
 
 
2754
//==========================================================================
 
2755
//write_code_cdoit : generate body of the code for
 
2756
//                   for all time dependant blocks
 
2757
//
 
2758
//input : flag : flag number for block's call
 
2759
//
 
2760
//output : txt for cord blocks
 
2761
//
 
2762
//12/07/07 Alan Layec
 
2763
//Copyright INRIA
 
2764
 
 
2765
// Modified for RT purposes by Roberto Bucher - RTAI Team
 
2766
// roberto.bucher@supsi.ch
 
2767
 
 
2768
function [txt]=write_code_cdoit(flag)
 
2769
 
 
2770
  txt=[];
 
2771
 
 
2772
  for j=1:ncord
 
2773
    bk=cord(j,1);
 
2774
    pt=cord(j,2);
 
2775
    //** blk
 
2776
    if funtyp(bk)>-1 then
 
2777
//      if or(bk==act) | or(bk==cap) then
 
2778
//        if stalone then
 
2779
//          txt2=call_block42(bk,pt,flag);
 
2780
//          if txt2<>[] then
 
2781
//            txt=[txt;
 
2782
//                 '    '+txt2
 
2783
//                 ''];
 
2784
//          end
 
2785
//        end
 
2786
//      else
 
2787
        txt2=call_block42(bk,pt,flag);
 
2788
        if txt2<>[] then
 
2789
          txt=[txt;
 
2790
               '  '+txt2
 
2791
               ''];
 
2792
        end
 
2793
//      end
 
2794
    //** ifthenelse blk
 
2795
    elseif funtyp(bk)==-1 then
 
2796
      ix=-1+inplnk(inpptr(bk));
 
2797
      TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
 
2798
      thentxt=write_code_doit(clkptr(bk),flag);
 
2799
      elsetxt=write_code_doit(clkptr(bk)+1,flag);
 
2800
      if thentxt<>[] | elsetxt<>[] then
 
2801
        txt=[txt;
 
2802
             '  '+get_comment('ifthenelse_blk',list(bk));]
 
2803
        //** C **//
 
2804
        tmp_='*(('+TYPE+' *)'+rdnom+'_block_outtbptr['+string(ix)+'])'
 
2805
        txt=[txt;
 
2806
             '  if('+tmp_+'>0) {']
 
2807
        //*******//
 
2808
        txt=[txt;
 
2809
             Indent+thentxt];
 
2810
        if elsetxt<>[] then
 
2811
          //** C **//
 
2812
          txt=[txt;
 
2813
               '  }';
 
2814
               '  else {';]
 
2815
          //*******//
 
2816
          txt=[txt;
 
2817
               Indent+elsetxt];
 
2818
        end
 
2819
        //** C **//
 
2820
        txt=[txt;
 
2821
             '  }']
 
2822
        //*******//
 
2823
      end
 
2824
    //** eventselect blk
 
2825
    elseif funtyp(bk)==-2 then
 
2826
      Noutport=clkptr(bk+1)-clkptr(bk);
 
2827
      ix=-1+inplnk(inpptr(bk));
 
2828
      TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
 
2829
      II=[];
 
2830
      switchtxt=list()
 
2831
      for i=1: Noutport
 
2832
        switchtxt(i)=write_code_doit(clkptr(bk)+i-1,flag);
 
2833
        if switchtxt(i)<>[] then II=[II i];end
 
2834
      end
 
2835
      if II<>[] then
 
2836
        txt=[txt;
 
2837
             '  '+get_comment('evtselect_blk',list(bk));]
 
2838
        //** C **//
 
2839
        tmp_='*(('+TYPE+' *)'+rdnom+'_block_outtbptr['+string(ix)+'])'
 
2840
        txt=[txt;
 
2841
             '  i=max(min((int) '+...
 
2842
              tmp_+',block_'+rdnom+'['+string(bk-1)+'].nevout),1);'
 
2843
             '  switch(i)'
 
2844
             '  {']
 
2845
        //*******//
 
2846
        for i=II
 
2847
         //** C **//
 
2848
         txt=[txt;
 
2849
              '   case '+string(i)+' :';]
 
2850
         //*******//
 
2851
         txt=[txt;
 
2852
              BigIndent+write_code_doit(clkptr(bk)+i-1,flag);]
 
2853
         //** C **//
 
2854
         txt=[txt;
 
2855
              BigIndent+'break;']
 
2856
         //*******//
 
2857
        end
 
2858
        //** C **//
 
2859
        txt=[txt;
 
2860
             '  }'];
 
2861
        //*******//
 
2862
      end
 
2863
    //** Unknown block
 
2864
    else
 
2865
      error('Unknown block type '+string(bk));
 
2866
    end
 
2867
  end
 
2868
 
 
2869
endfunction
 
2870
 
 
2871
//==========================================================================
 
2872
//write_code_doit : generate body of the code for
 
2873
//                  ordering calls of blocks during
 
2874
//                  flag 1,2 & flag 3
 
2875
//
 
2876
//input : ev  : evt number for block's call
 
2877
//       flag : flag number for block's call
 
2878
//
 
2879
//output : txt for flag 1 or 2, or flag 3
 
2880
//
 
2881
//12/07/07 Alan Layec
 
2882
 
 
2883
// Modified for RT purposes by Roberto Bucher - RTAI Team
 
2884
// roberto.bucher@supsi.ch
 
2885
 
 
2886
function [txt]=write_code_doit(ev,flag)
 
2887
 
 
2888
  txt=[];
 
2889
 
 
2890
  for j=ordptr(ev):ordptr(ev+1)-1
 
2891
    bk=ordclk(j,1);
 
2892
    pt=ordclk(j,2);
 
2893
    //** blk
 
2894
    if funtyp(bk)>-1 then
 
2895
//      if or(bk==act) | or(bk==cap) then
 
2896
//        if stalone then
 
2897
//          txt2=call_block42(bk,pt,flag);
 
2898
//          if txt2<>[] then
 
2899
//            txt=[txt;
 
2900
//                 '    '+txt2
 
2901
//                 ''];
 
2902
//          end
 
2903
//        end
 
2904
//      else
 
2905
 
 
2906
        if flag==1 | pt>0 then
 
2907
          txt2=call_block42(bk,pt,flag);
 
2908
        else
 
2909
          txt2=[];
 
2910
        end
 
2911
 
 
2912
        if txt2<>[] then
 
2913
          txt=[txt;
 
2914
               '    '+txt2
 
2915
               ''];
 
2916
        end
 
2917
//      end
 
2918
    //** ifthenelse blk
 
2919
    elseif funtyp(bk)==-1 then
 
2920
      ix=-1+inplnk(inpptr(bk));
 
2921
      TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
 
2922
      thentxt=write_code_doit(clkptr(bk),flag);
 
2923
      elsetxt=write_code_doit(clkptr(bk)+1,flag);
 
2924
      if thentxt<>[] | elsetxt<>[] then
 
2925
        txt=[txt;
 
2926
             '    '+get_comment('ifthenelse_blk',list(bk));]
 
2927
        //** C **//
 
2928
        tmp_ = '*(('+TYPE+' *)'+rdnom+'_block_outtbptr['+string(ix)+'])'
 
2929
        txt=[txt;
 
2930
             '    if('+tmp_+'>0) {']
 
2931
        //*******//
 
2932
        txt=[txt;
 
2933
             Indent+thentxt]
 
2934
        if elsetxt<>[] then
 
2935
           //** C **//
 
2936
           txt=[txt;
 
2937
                '    }';
 
2938
                '    else {';]
 
2939
           //*******//
 
2940
           txt=[txt;
 
2941
                Indent+elsetxt];
 
2942
        end
 
2943
        //** C **//
 
2944
        txt=[txt;
 
2945
             '    }']
 
2946
        //*******//
 
2947
      end
 
2948
    //** eventselect blk
 
2949
    elseif funtyp(bk)==-2 then
 
2950
      Noutport=clkptr(bk+1)-clkptr(bk);
 
2951
      ix=-1+inplnk(inpptr(bk));
 
2952
      TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
 
2953
      II=[];
 
2954
      switchtxt=list()
 
2955
      for i=1: Noutport
 
2956
        switchtxt(i)=write_code_doit(clkptr(bk)+i-1,flag);
 
2957
        if switchtxt(i)<>[] then II=[II i];end
 
2958
      end
 
2959
      if II<>[] then
 
2960
        txt=[txt;
 
2961
             '    '+get_comment('evtselect_blk',list(bk));]
 
2962
        tmp_='*(('+TYPE+' *)'+rdnom+'_block_outtbptr['+string(ix)+'])'
 
2963
        //** C **//
 
2964
        txt=[txt;
 
2965
             '    i=max(min((int) '+...
 
2966
              tmp_+',block_'+rdnom+'['+string(bk-1)+'].nevout),1);'
 
2967
             '    switch(i)'
 
2968
             '    {']
 
2969
        //*******//
 
2970
        for i=II
 
2971
          //** C **//
 
2972
          txt=[txt;
 
2973
               '     case '+string(i)+' :';]
 
2974
          //*******//
 
2975
          txt=[txt;
 
2976
               BigIndent+write_code_doit(clkptr(bk)+i-1,flag);]
 
2977
          //** C **//
 
2978
          txt=[txt;
 
2979
               BigIndent+'break;']
 
2980
          //*******//
 
2981
        end
 
2982
        //** C **//
 
2983
        txt=[txt;
 
2984
             '    }']
 
2985
        //*******//
 
2986
      end
 
2987
    //** Unknown block
 
2988
    else
 
2989
      error('Unknown block type '+string(bk));
 
2990
    end
 
2991
  end
 
2992
 
 
2993
endfunction
 
2994
 
 
2995
//==========================================================================
 
2996
//write_code_idoit : generate body of the code for
 
2997
//                   ordering calls of initial
 
2998
//                   called blocks
 
2999
//
 
3000
//input : nothing (blocks are called with flag 1)
 
3001
//
 
3002
//output : txt for iord
 
3003
//
 
3004
//15/07/07 Alan Layec
 
3005
//Copyright INRIA
 
3006
 
 
3007
// Modified for RT purposes by Roberto Bucher - RTAI Team
 
3008
// roberto.bucher@supsi.ch
 
3009
 
 
3010
function [txt]=write_code_idoit()
 
3011
 
 
3012
  txt=[];
 
3013
 
 
3014
  for j=1:niord
 
3015
    bk=iord(j,1);
 
3016
    pt=iord(j,2);
 
3017
    //** blk
 
3018
    if funtyp(bk)>-1 then
 
3019
//      if or(bk==act) then
 
3020
//        if stalone then
 
3021
//          txt2=call_block42(bk,pt,1);
 
3022
//          if txt2<>[] then
 
3023
//            txt=[txt;
 
3024
//                 '  '+txt2
 
3025
//                 ''];
 
3026
//          end
 
3027
//        end
 
3028
//      else
 
3029
        txt2=call_block42(bk,pt,1);
 
3030
        if txt2<>[] then
 
3031
          txt=[txt;
 
3032
               '  '+txt2
 
3033
               ''];
 
3034
        end
 
3035
//      end
 
3036
    //** ifthenelse blk
 
3037
    elseif funtyp(bk)==-1 then
 
3038
      ix=-1+inplnk(inpptr(bk));
 
3039
      TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
 
3040
      thentxt=write_code_doit(clkptr(bk),1);
 
3041
      elsetxt=write_code_doit(clkptr(bk)+1,1);
 
3042
      if thentxt<>[] | elsetxt<>[] then
 
3043
        txt=[txt;
 
3044
             '  '+get_comment('ifthenelse_blk',list(bk));]
 
3045
        //** C **//
 
3046
        tmp_ = '*(('+TYPE+' *)'+rdnom+'_block_outtbptr['+string(ix)+'])'
 
3047
        txt=[txt;
 
3048
             '  if('+tmp_+'>0) {']
 
3049
        //*******//
 
3050
        txt=[txt;
 
3051
             Indent+thentxt];
 
3052
        if elsetxt<>[] then
 
3053
           //** C **//
 
3054
           txt=[txt;
 
3055
                '  }';
 
3056
                '  else {';]
 
3057
           //*******//
 
3058
           txt=[txt;
 
3059
                Indent+elsetxt];
 
3060
        end
 
3061
        //** C **//
 
3062
        txt=[txt;
 
3063
             '  }']
 
3064
        //*******//
 
3065
      end
 
3066
    //** eventselect blk
 
3067
    elseif funtyp(bk)==-2 then
 
3068
      Noutport=clkptr(bk+1)-clkptr(bk);
 
3069
      ix=-1+inplnk(inpptr(bk));
 
3070
      TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
 
3071
      II=[];
 
3072
      switchtxt=list()
 
3073
      for i=1: Noutport
 
3074
        switchtxt(i)=write_code_doit(clkptr(bk)+i-1,1);
 
3075
        if switchtxt(i)<>[] then II=[II i];end
 
3076
      end
 
3077
      if II<>[] then
 
3078
        txt=[txt;
 
3079
             '  '+get_comment('evtselect_blk',list(bk));]
 
3080
        //** C **//
 
3081
        tmp_='*(('+TYPE+' *)'+rdnom+'_block_outtbptr['+string(ix)+'])'
 
3082
        txt=[txt;
 
3083
             '  i=max(min((int) '+...
 
3084
              tmp_+',block_'+rdnom+'['+string(bk-1)+'].nevout),1);']
 
3085
        txt=[txt;
 
3086
             '  switch(i)'
 
3087
             '  {']
 
3088
        //*******//
 
3089
        for i=II
 
3090
          //** C **//
 
3091
          txt=[txt;
 
3092
               '   case '+string(i)+' :';]
 
3093
          //*******//
 
3094
          txt=[txt;
 
3095
               BigIndent+write_code_doit(clkptr(bk)+i-1,1);]
 
3096
          //** C **//
 
3097
          txt=[txt;
 
3098
               BigIndent+'break;']
 
3099
          //*******//
 
3100
        end
 
3101
        //** C **//
 
3102
        txt=[txt;
 
3103
             '  }'];
 
3104
        //*******//
 
3105
      end
 
3106
    //** Unknown block
 
3107
    else
 
3108
      error('Unknown block type '+string(bk));
 
3109
    end
 
3110
  end
 
3111
 
 
3112
endfunction
 
3113
 
 
3114
//==========================================================================
 
3115
//write_code_odoit : generate body of the code for
 
3116
//                   ordering calls of blocks before
 
3117
//                   continuous time integration
 
3118
//
 
3119
//input : flag : flag number for block's call
 
3120
//
 
3121
//output : txt for flag 0
 
3122
//
 
3123
//12/07/07 Alan Layec
 
3124
//Copyright INRIA
 
3125
 
 
3126
// Modified for RT purposes by Roberto Bucher - RTAI Team
 
3127
// roberto.bucher@supsi.ch
 
3128
 
 
3129
 
 
3130
function [txt]=write_code_odoit(flag)
 
3131
 
 
3132
  txt=[];
 
3133
 
 
3134
  for j=1:noord
 
3135
    bk=oord(j,1);
 
3136
    pt=oord(j,2);
 
3137
    //** blk
 
3138
    if funtyp(bk)>-1 then
 
3139
      txt2=call_block42(bk,pt,flag);
 
3140
      if txt2<>[] then
 
3141
        txt=[txt;
 
3142
             '    '+txt2
 
3143
             ''];
 
3144
      end
 
3145
    //** ifthenelse blk
 
3146
    elseif funtyp(bk)==-1 then
 
3147
      ix=-1+inplnk(inpptr(bk));
 
3148
      TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
 
3149
      thentxt=write_code_ozdoit(clkptr(bk),flag);
 
3150
      elsetxt=write_code_ozdoit(clkptr(bk)+1,flag);
 
3151
      if thentxt<>[] | elsetxt<>[] then
 
3152
        txt=[txt;
 
3153
             '    '+get_comment('ifthenelse_blk',list(bk));]
 
3154
        //** C **//
 
3155
        tmp_='*(('+TYPE+' *)'+rdnom+'_block_outtbptr['+string(ix)+'])'
 
3156
        txt=[txt;
 
3157
             '    if ((block_'+rdnom+'['+string(bk-1)+'].nmode<0'+...
 
3158
              ' && '+tmp_+'>0)'+...
 
3159
              ' || \'
 
3160
             '        (block_'+rdnom+'['+string(bk-1)+'].nmode>0'+...
 
3161
              ' && block_'+rdnom+'['+string(bk-1)+'].mode[0]==1)) {']
 
3162
        //*******//
 
3163
        txt=[txt;
 
3164
             Indent+thentxt]
 
3165
        //** C **//
 
3166
        txt=[txt;
 
3167
             '    }'];
 
3168
        //*******//
 
3169
        if elsetxt<>[] then
 
3170
          //** C **//
 
3171
          txt=[txt;
 
3172
               '    else if  ((block_'+rdnom+'['+string(bk-1)+'].nmode<0'+...
 
3173
                ' && '+tmp_+'<=0)'+...
 
3174
                ' || \'
 
3175
               '              (block_'+rdnom+'['+string(bk-1)+'].nmode>0'+...
 
3176
                ' && block_'+rdnom+'['+string(bk-1)+'].mode[0]==2)) {';]
 
3177
          //*******//
 
3178
          txt=[txt;
 
3179
               Indent+elsetxt]
 
3180
          //** C **//
 
3181
          txt=[txt;
 
3182
               '    }'];
 
3183
          //*******//
 
3184
        end
 
3185
      end
 
3186
    //** eventselect blk
 
3187
    elseif funtyp(bk)==-2 then
 
3188
      Noutport=clkptr(bk+1)-clkptr(bk);
 
3189
      ix=-1+inplnk(inpptr(bk));
 
3190
      TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
 
3191
      II=[];
 
3192
      switchtxt=list()
 
3193
      for i=1: Noutport
 
3194
        switchtxt(i)=write_code_ozdoit(clkptr(bk)+i-1,flag);
 
3195
        if switchtxt(i)<>[] then II=[II i];end
 
3196
      end
 
3197
      if II<>[] then
 
3198
        txt=[txt;
 
3199
             '    '+get_comment('evtselect_blk',list(bk));]
 
3200
        //** C **//
 
3201
        tmp_='*(('+TYPE+' *)'+rdnom+'_block_outtbptr['+string(ix)+'])'
 
3202
        txt=[txt;
 
3203
             '    if (block_'+rdnom+'['+string(bk-1)+'].nmode<0) {';
 
3204
             '      i=max(min((int) '+...
 
3205
                tmp_+',block_'+rdnom+'['+string(bk-1)+'].evout),1);'
 
3206
             '    }'
 
3207
             '    else {'
 
3208
             '      i=block_'+rdnom+'['+string(bk-1)+'].mode[0];'
 
3209
             '    }']
 
3210
        txt=[txt;
 
3211
             '    switch(i)'
 
3212
             '    {'];
 
3213
        //*******//
 
3214
        for i=II
 
3215
          //** C **//
 
3216
          txt=[txt;
 
3217
               '     case '+string(i)+' :';]
 
3218
          //*******//
 
3219
          txt=[txt;
 
3220
               BigIndent+write_code_ozdoit(clkptr(bk)+i-1,flag);]
 
3221
          //** C **//
 
3222
          txt=[txt;
 
3223
               BigIndent+'break;']
 
3224
          //*******//
 
3225
        end
 
3226
        //** C **//
 
3227
        txt=[txt;
 
3228
             '    }'];
 
3229
        //*******//
 
3230
      end
 
3231
    //** Unknown block
 
3232
    else
 
3233
      error('Unknown block type '+string(bk));
 
3234
    end
 
3235
  end
 
3236
 
 
3237
endfunction
 
3238
 
 
3239
function [files]=write_code(Code,CCode,FCode,Code_common)
 
3240
 
 
3241
// Original file from Project Metalau - INRIA
 
3242
// Modified for RT purposes by Roberto Bucher - RTAI Team
 
3243
// roberto.bucher@supsi.ch
 
3244
 
 
3245
 ierr=execstr('mputl(Code,rpat+''/''+rdnom+''.c'')','errcatch')
 
3246
  if ierr<>0 then
 
3247
    message(lasterror())
 
3248
    ok=%f
 
3249
    return
 
3250
  end
 
3251
 
 
3252
 ierr=execstr('mputl(Code_common,rpat+''/common.c'')','errcatch')
 
3253
  if ierr<>0 then
 
3254
    message(lasterror())
 
3255
    ok=%f
 
3256
    return
 
3257
  end
 
3258
 
 
3259
  if FCode<>[] then
 
3260
    ierr=execstr('mputl(FCode,rpat+''/''+rdnom+''f.f'')','errcatch')
 
3261
    if ierr<>0 then
 
3262
      message(lasterror())
 
3263
      ok=%f
 
3264
      return
 
3265
    end
 
3266
  end
 
3267
 
 
3268
  if CCode<>[] then
 
3269
    CCode = [
 
3270
          '#include <math.h>';
 
3271
          '#include <stdlib.h>';
 
3272
          '#include <scicos_block4.h>';
 
3273
          '';
 
3274
          CCode];
 
3275
    ierr=execstr('mputl(CCode,rpat+''/''+rdnom+''_Cblocks.c'')','errcatch')
 
3276
    if ierr<>0 then
 
3277
      message(lasterror())
 
3278
      ok=%f
 
3279
      return
 
3280
    end
 
3281
  end
 
3282
 
 
3283
  files=[]
 
3284
  [fd,ierr]=mopen(rpat+'/'+rdnom+'f.f','r')
 
3285
  if ierr==0 then mclose(fd),files=[files,rdnom+'f'],end
 
3286
  [fd,ierr]=mopen(rpat+'/'+rdnom+'_Cblocks.c','r')
 
3287
  if ierr==0 then mclose(fd),files=[files,rdnom+'_Cblocks'],end
 
3288
 
 
3289
endfunction
 
3290
 
 
3291
//==========================================================================