Xcos tests: fix bug_8397 because of new funptr() and replaced disp(mprintf) by disp...
[scilab.git] / scilab / modules / scicos / macros / scicos_scicos / c_pass1.sci
1 //  Scicos
2 //
3 //  Copyright (C) INRIA - METALAU Project <scicos@inria.fr>
4 //                      - Serge Steer <serge.steer@inria.fr>
5 //
6 // This program is free software; you can redistribute it and/or modify
7 // it under the terms of the GNU General Public License as published by
8 // the Free Software Foundation; either version 2 of the License, or
9 // (at your option) any later version.
10 //
11 // This program is distributed in the hope that it will be useful,
12 // but WITHOUT ANY WARRANTY; without even the implied warranty of
13 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 // GNU General Public License for more details.
15 //
16 // You should have received a copy of the GNU General Public License
17 // along with this program; if not, write to the Free Software
18 // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
19 //
20 // See the file ../license.txt
21 //
22
23 function  [blklst,cmat,ccmat,cor,corinv,ok,scs_m,flgcdgen,freof]=c_pass1(scs_m,flgcdgen)
24     //derived from c_pass1 for implicit diagrams
25     //%Purpose
26     // Determine one level blocks and connections matrix
27     //%Parameters
28     // scs_m  :   scicos data structure
29     // ksup   :
30     // blklst : a list containing the "model" information structure for each block
31     //
32     // cmat   : nx6 matrix. Each row contains, in order, the block
33     //             number and the port number and the port type of an outgoing scicopath,
34     //             and the block number and the port number and the port type of the target
35     //             ingoing scicopath. for regular links
36     //
37     // ccmat  : nx4 matrix.  Each row contains, in order, the block
38     //             number and the port number  of an outgoing scicopath,
39     //             and the block number and the port number  of the target
40     //             ingoing scicopath for clock connections
41
42     // cor    : is a list with same recursive structure as scs_m each leaf
43     //          contains the index of associated block in blklst
44     // corinv : corinv(nb) is the path of nb ith block defined in blklst
45     //          in the scs_m structure
46     //!
47     // Serge Steer 2003, Copyright INRIA
48     // flgcdgen: is a flag containing the numbre of event input of the diagram
49     //           it is used only in the Codegeneration case.
50     // freof   : it is a vector containing the frequency and the offset of the major clock.
51     //           it is used only in the Codegeneration case.
52     // Fady Nassif 2007. INRIA.
53     //c_pass1;
54
55     if argn(2)<=1 then flgcdgen=-1, end
56     freof=[];
57     MaxBlock=countblocks(scs_m);
58     blklst=[];cmat=[],ccmat=[],cor=[],corinv=[]
59     [cor,corinvt,links_table,cur_fictitious,sco_mat,ok]=scicos_flat(scs_m);
60     if ~ok then
61         disp(msprintf("%s: flat failed", "c_pass1"));
62         return;
63     end
64     [links_table,sco_mat,ok]=global_case(links_table,sco_mat)
65     if ~ok then
66         disp(msprintf("%s: global case failed", "c_pass1"));
67         return;
68     end
69     index1=find((sco_mat(:,2)=="-1")& (sco_mat(:,5)<>"10"))
70     if index1<>[] then
71         for i=index1
72             [path]=findinlist(cor,-evstr(sco_mat(i,1)))
73             full_path=path(1)
74             if flgcdgen<>-1 then full_path=[numk full_path];scs_m=all_scs_m;end
75             hilite_path(full_path,"Error in compilation, There is a FROM ''"+(sco_mat(i,3))+ "'' without a GOTO",%t)
76             ok=%f;
77             disp(msprintf("%s: invalid connection matrix", "c_pass1"));
78             return;
79         end
80     end
81
82     nb=size(corinvt);
83     reg=1:nb
84     //form the block lists
85
86     blklst=list();kr=0 ; //regular  block list
87     blklstm=list();km=0; //modelica block list
88
89     //if ind(i)>0  ith block is a regular  block and stored in blklst(ind(i))
90     //if ind(i)<0  ith block is a modelica block and stored in blklstm(-ind(i))
91
92     ind=[];
93
94     for kb=1:nb
95         o=scs_m(scs_full_path(corinvt(kb)));
96         if is_modelica_block(o) then
97             km=km+1;blklstm(km)=o.model;
98             ind(kb)=-km;
99             [modelx,ok]=build_block(o); // compile modelica block type 30004
100             if ~ok then
101                 disp(msprintf("%s: unable to build modelica block", "c_pass1"));
102                 return
103             end
104         else
105             [model,ok]=build_block(o);
106             if ~ok then
107                 disp(msprintf("%s: unable to build block", "c_pass1"));
108                 return,
109             end
110
111             if or(model.sim(1)==["plusblk"]) then
112                 [model,links_table]=adjust_sum(model,links_table,kb);
113             end
114
115             kr=kr+1;blklst(kr)=model;
116             ind(kb)=kr;
117         end
118
119     end
120
121     if (find(sco_mat(:,5)==string(4))<>[]) then
122         if flgcdgen ==-1 then
123             [links_table,blklst,corinvt,ind,ok]=sample_clk(sco_mat,links_table,blklst,corinvt,scs_m,ind,flgcdgen)
124         else
125             [links_table,blklst,corinvt,ind,ok,scs_m,flgcdgen,freof]=sample_clk(sco_mat,links_table,blklst,corinvt,scs_m,ind,flgcdgen)
126         end
127         if ~ok then
128             disp(msprintf("%s: unable to sample the whole diagram", "c_pass1"));
129             return,
130         end
131     end
132     nb=size(corinvt)
133     nl=size(links_table,1)/2
134
135     // Check if size match !
136     if(size(links_table(:,1:3), "r") == size(matrix([1;1]*(1:nl),-1,1), "r") ..
137         & size(matrix([1;1]*(1:nl),-1,1), "r") == size(links_table(:,4), "r"))
138         links_table=[links_table(:,1:3) matrix([1;1]*(1:nl),-1,1) ..
139         links_table(:,4) ];
140     else
141         disp(msprintf("%s: invalid links table size", "c_pass1"));
142         return
143     end
144     imp=find(ind<0)
145
146     reg(imp)=[]
147
148     if imp==[] then //no modelica block exists
149         cmat=matfromT(links_table(find(links_table(:,5)==1),:),nb); //data flow links
150         ccmat=cmatfromT(links_table(find(links_table(:,5)==-1),:),nb); //event links
151         corinv=corinvt
152     else // mixed diagram
153         nm=size(imp,"*") //number of modelica blocks
154         nr=nb-nm //number of regular blocks
155         cmmat=mmatfromT(links_table(find(links_table(:,5)==2),:),nb); //modelica links
156         cmat=matfromT(links_table(find(links_table(:,5)==1),:),nb); //data flow links
157         ccmat=cmatfromT(links_table(find(links_table(:,5)==-1),:),nb);//event links
158
159         //build connections between modelica world and regular one. These
160         //links should be data flow links
161         // links from modelica world to regular world
162         fromM=find(dsearch(cmat(:,1),imp,"d")>0);
163
164         // links from regular world to modelica world
165         toM=find(dsearch(cmat(:,3),imp,"d")>0);
166
167         // merge the modelica to modelica as data flow links
168         [varM, kfrom, kto] = intersect(fromM, toM);
169         fromM(kfrom) = [];
170         toM(kto) = [];
171
172         NoM=size(fromM,"*");
173         if NoM>0 then
174             //add modelica Output ports in Modelica world
175             mo=modelica();mo.model="OutPutPort";mo.outputs="vo";mo.inputs="vi";
176             for k=1:NoM,blklstm($+1)=scicos_model(equations=mo);end
177             //add modelica connections to these Output ports, set negative
178             //value to port numbers to avoid conflits with other blocks
179             cmmat=[cmmat;
180             cmat(fromM,1:2) zeros(NoM,1) -(nm+(1:NoM)'),ones(NoM,1),ones(NoM,1)];
181
182             nm=nm+NoM;
183             //add regular connection with regular block replacing the modelica world
184             cmat(fromM,1:2)=[-(nr+1)*ones(NoM,1),(1:NoM)'];
185         end
186
187         NiM=size(toM,"*");
188         if NiM>0 then
189             //add modelica Input ports in Modelica world
190             mo=modelica();mo.model="InPutPort";mo.outputs="vo";mo.inputs="vi";
191             for k=1:NiM,blklstm($+1)=scicos_model(equations=mo);end
192             //add modelica connections to these Input ports  set negative
193             //value to port numbers to avoid conflits with other blocks
194             cmmat=[cmmat;
195             -(nm+(1:NiM)'), ones(NiM,1),zeros(NiM,1), cmat(toM,3:4), ones(NiM,1) ];
196
197             nm=nm+NiM;
198             //add regular connection with regular block replacing the modelica world
199             cmat(toM,3:4)=[-(nr+1)*ones(NiM,1),(1:NiM)'];
200         end
201
202         NvM=size(varM, "*");
203         if NvM>0 then
204             //add modelica Values (both input and output) ports in Modelica world
205             l=[cmat(varM,1:2), zeros(NvM,1), cmat(varM,3:4), ones(NvM,1)];
206             cmmat=[cmmat;
207             l];
208
209             // remove the corresponding explicit link
210             cmat(varM, :) = [];
211         end
212
213         // modelica blocks with events ports are not allowed yet
214         if size(ccmat,1)>0 then
215             if or(dsearch(ccmat(:,[1 3]),imp,"d")>0) then
216                 messagebox("An implicit block has an event port","modal","error");
217                 disp(msprintf("%s: implicit block with event port", "c_pass1"));
218                 ok=%f;return
219             end
220         end
221
222         //renumber blocks according to their types
223
224         corinv=list();corinvm=list();
225
226         for kb=1:nb
227
228             if ind(kb)<0 then // modelica block
229
230                 km=-ind(kb);
231
232                 //replace by negative value to avoid conflicts
233
234                 cmmat(find(cmmat(:,1)==kb),1)=-km ;
235
236                 cmmat(find(cmmat(:,4)==kb),4)=-km;
237
238                 corinvm(km)=corinvt(kb);
239
240             else
241
242                 kr=ind(kb);
243
244                 cmat (find(cmat (:,1)==kb),1)=-kr;
245
246                 cmat (find(cmat (:,3)==kb),3)=-kr;
247
248                 ccmat(find(ccmat(:,1)==kb),1)=-kr;
249
250                 ccmat(find(ccmat(:,3)==kb),3)=-kr;
251
252                 corinv(kr)=corinvt(kb);
253
254             end
255
256         end
257
258         //renumbering done, replace negative value by positive ones
259
260
261
262         cmat(:,[1 3])=abs(cmat(:,[1 3])) ;
263
264         ccmat(:,[1 3])=abs(ccmat(:,[1 3])) ;
265
266         cmmat=abs(cmmat) ;
267
268         //create regular block associated to all modelica blocks
269
270         [model,ok]=build_modelica_block(blklstm,corinvm,cmmat,NiM,NoM,NvM,scs_m,TMPDIR+"/");
271
272         if ~ok then
273             disp(msprintf("%s: build the modelica meta-block failed", "c_pass1"));
274             return
275         end
276
277         blklst(nr+1)=model;
278
279         //make compiled modelica block refer to the set of corresponding
280
281         //modelica blocks
282
283         corinv(nr+1)=corinvm //it may be useful to adapt function making use
284
285         //of corinv
286
287         //adjust the numbering of regular block in sco_mat
288
289         //if modelica's blocks exist
290
291         //Fady 08/11/2007
292
293         for i=1:size(sco_mat,1)
294
295             if eval(sco_mat(i,1))<MaxBlock then
296
297                 sco_mat(i,1)=string(ind(eval(sco_mat(i,1))))
298
299             end
300
301         end
302
303         sco_mat=[sco_mat;[string(size(blklst)) "-1" "scicostimeclk0" "1" "10"]]
304
305     end
306
307     cor=update_cor(cor,reg)
308
309
310
311     // Taking care of the clk 0;
312
313     //*** this part has been taken from c_pass2 modified and placed here it must be tested ***
314
315     //Fady 08/11/2007
316
317     nbl=size(blklst)
318
319     fff=ones(nbl,1)==1
320
321     clkptr=zeros(nbl+1,1);clkptr(1)=1; typ_l=fff;
322
323     for i=1:nbl
324
325         ll=blklst(i);
326
327         clkptr(i+1)=clkptr(i)+size(ll.evtout,"*");
328
329         //tblock(i)=ll.dep_ut($);
330
331         typ_l(i)=ll.blocktype=="l";
332
333     end
334
335     all_out=[]
336
337     for k=1:size(clkptr,1)-1
338
339         if ~typ_l(k) then
340
341             kk=[1:(clkptr(k+1)-clkptr(k))]'
342
343             all_out=[all_out;[k*ones(kk),kk]]
344
345         end
346
347     end
348
349     all_out=[all_out;[0,0]]
350     //add time event if needed
351     tblock=find((sco_mat(:,2)=="-1")&(sco_mat(:,5)=="10"))
352     ind=sco_mat(tblock,1);
353     if ind<>[] then
354         ind=eval(ind(:))
355         //ind=find(tblock)
356         //ind=ind(:)
357         for k=ind'
358             ccmat=[ccmat;[all_out,ones(all_out)*[k,0;0,0]]]
359         end
360         for Ii=1:length(blklst)
361             if type(blklst(Ii).sim(1))==10 then
362                 if part(blklst(Ii).sim(1),1:7)=="capteur" then
363                     ccmat=[ccmat;[0 0 Ii 0]]
364                 end
365             end
366         end
367     end
368     //***
369 endfunction
370 //**-----------------------------------------------------------------------------------------------------------------
371
372 function [model,links_table]=adjust_sum(model,links_table,k)
373     //sum blocks have variable number of input ports, adapt the associated
374     //model data structure and input connection to take into account the
375     //actual number of connected ports
376     // Serge Steer 2003, Copyright INRIA
377     in=find(links_table(:,1)==k&links_table(:,3)==1)
378     nin=size(in,"*")
379     model.in=-ones(nin,1)
380     links_table(in,2)=(1:nin)'
381 endfunction
382
383
384 function mat=mmatfromT(Ts,nb)
385     //S. Steer, R. Nikoukhah 2003. Copyright INRIA
386     Ts(:,1)=abs(Ts(:,1));
387     K=unique(Ts(find(Ts(:,1)>nb),1)); // identificator of blocks to be removed
388     //remove superblocks port and split connections
389     Ts=remove_fictitious(Ts,K)
390
391     // from connection matrix
392     Imat=[];
393     for u=matrix(unique(Ts(:,4)),1,-1)
394         kue=matrix(find(Ts(:,4)==u),-1,1); //identical links
395         Imat=[Imat;[kue(2:$)  kue(1).*ones(kue(2:$))]];
396     end
397     mat=[Ts(Imat(:,1),1:3)  Ts(Imat(:,2),1:3)]
398 endfunction
399
400
401 function mat=matfromT(Ts,nb)
402     //S. Steer, R. Nikoukhah 2003. Copyright INRIA
403
404     Ts(:,1)=abs(Ts(:,1))
405     K=unique(Ts(find(Ts(:,1)>nb),1)); // identificator of blocks to be removed
406     //remove superblocks port and split connections
407     Ts=remove_fictitious(Ts,K)
408
409     // from connection matrix
410     Imat=[];
411     for u=matrix(unique(Ts(:,4)),1,-1)
412         kue=matrix(find(Ts(:,4)==u&Ts(:,3)==-1),-1,1); //look for outputs
413         jue=matrix(find(Ts(:,4)==u&Ts(:,3)==1),-1,1); //look for inputs
414         Imat=[Imat;[ones(jue).*.kue jue.*.ones(kue)]];
415     end
416     mat=[Ts(Imat(:,1),1:2)  Ts(Imat(:,2),1:2)]
417 endfunction
418
419 function mat=cmatfromT(Ts,nb)
420     //S. Steer, R. Nikoukhah 2003. Copyright INRIA
421     //this function has been modified to support
422     // CLKGOTO et CLKFROM
423     // Fady NASSIF: 11/07/2007
424     k=find(Ts(:,1)<0) //superblock ports links and CLKGOTO/CLKFROM
425     K=unique(Ts(k,1));
426     Ts=remove_fictitious(Ts,K)
427
428     if Ts==[] then mat=[],return,end
429     //  if size(Ts,1)<>int(size(Ts,1)/2)*2 then disp('PB'),pause,end
430     [s,k]=gsort(Ts(:,[4,3]),"lr","i");Ts=Ts(k,:)
431     // modified to support the CLKGOTO/CLKFROM
432     //mat=[Ts(1:2:$,1:2) Ts(2:2:$,1:2)]
433     //----------------------------------
434
435     J=find(Ts(:,3)==1); //find the destination block of the link
436     v=find([Ts(:,3);-1]==-1) // find the source block of the link
437     // many destination blocks can be connected to one source block
438     // so we have to find the number of destination blocks for each source block
439     // v(2:$)-v(1:$-1)-1
440     // then create the vector I that must be compatible with the vector J.
441     I=duplicate(v(1:$-1),v(2:$)-v(1:$-1)-1);
442     mat=[Ts(I,1:2),Ts(J,1:2)]
443
444     //----------------------------------
445     K=unique(Ts(Ts(:,1)>nb))
446     Imat=[];
447     for u=matrix(K,1,-1)
448         jue=matrix(find(mat(:,1)==u),-1,1); //look for outputs
449         kue=matrix(find(mat(:,3)==u),-1,1); //look for inputs
450         Imat=[ones(jue).*.kue jue.*.ones(kue)];
451         mat1=[mat(Imat(:,1),1:2), mat(Imat(:,2),3:4)];
452         mat([jue;kue],:)=[];
453         mat=[mat;mat1];
454     end
455
456 endfunction
457
458 function Ts=remove_fictitious(Ts,K)
459     //removes fictitious blocks connected links are replaced by a single one
460     //S. Steer, R. Nikoukhah 2003. Copyright INRIA
461     count=min(Ts(:,4))
462     for i=1:size(K,"*")
463         ki=K(i);
464         v1=find(Ts(:,1)==ki);
465         if v1<>[] then
466             v=unique(Ts(v1,4));
467             Ts(v1,:)=[];
468             if size(v)==1 then
469                 ind=find(Ts(:,4)==v);
470             else
471                 ind = find(dsearch(Ts(:,4),gsort(v,"g","i"),"d")<>0);
472             end
473             if size(ind,"*")>1 then
474                 count=count-1;
475                 Ts(ind,4)=count
476             else
477                 Ts(ind,:)=[]
478             end
479         end
480     end
481 endfunction
482
483 function cor=update_cor(cor,reg)
484     n=size(cor)
485     for k=1:n
486         if type(cor(k))==15 then
487             cor(k)=update_cor(cor(k),reg)
488         else
489             p=find(cor(k)==reg)
490             if p<>[] then
491                 cor(k)=p
492             elseif cor(k)<0 then  // GOTO FROM cases
493                 cor(k)=0
494             elseif cor(k)<>0 then
495                 cor(k)=size(reg,"*")+1
496             end
497         end
498     end
499 endfunction