scilab/modules/scicos/macros/scicos_scicos/do_compile_superblock42.sci

   1 //  Scicos
   2 //
   3 //  Copyright (C) INRIA - METALAU Project <scicos@inria.fr>
   4 //                      - Alan Layec <alan.layec@inria.fr>
   5 //                      - Ramine Nikoukhah <ramine.nikoukhah@inria.fr>
   6 //                      - Rachid Djenidi
   7 //
   8 //                      - Scilab 5 update by Simone Mannori
   9 //
  10 //  Copyright (C) DIGITEO - 2010 - Allan CORNET
  11 //  Copyright (C) Scilab Enterprises - 2012 - Bruno JOFRET
  12 //
  13 // This program is free software; you can redistribute it and/or modify
  14 // it under the terms of the GNU General Public License as published by
  15 // the Free Software Foundation; either version 2 of the License, or
  16 // (at your option) any later version.
  17 //
  18 // This program is distributed in the hope that it will be useful,
  19 // but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 // GNU General Public License for more details.
  22 //
  23 // You should have received a copy of the GNU General Public License
  24 // along with this program; if not, write to the Free Software
  25 // Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  26 //
  27 // See the file ../license.txt
  28 //
  29
  30 //**---------------------------------------------------------------------------------------------------------------------------------
  31 //
  32 //16/06/07 Author : ?, A. Layec
  33 //
  34 function [Code,actt,proto]=call_actuator(i)
  35     nin=inpptr(i+1)-inpptr(i);  //** number of input ports
  36     nout=outptr(i+1)-outptr(i); //** number of output ports
  37
  38     if funtyp(i)==0 then
  39         if nin==0 then
  40             uk    = 0;
  41             nuk_1 = 0;
  42             nuk_2 = 0;
  43             uk_t  = 1;
  44             //Code($+1)=+'  args[0]=(double *)outtbptr[0]);';
  45         else
  46             uk    = inplnk(inpptr(i));
  47             nuk_1 = size(outtb(uk),1);
  48             nuk_2 = size(outtb(uk),2);
  49             uk_t  = mat2scs_c_nb(outtb(uk));
  50             //Code($+1)=' args[0]=('+mat2scs_c_ptr(outtb(uk))+' *)outtbptr['+string(uk-1)+'];';
  51         end
  52     end
  53     //pour la fonction gui ont a : num de bloc l'adresse dans
  54     //nouveau  z et la taille du port
  55     actt=[i uk nuk_1 nuk_2 uk_t bllst(i).ipar]
  56
  57     Code($+1)="block_"+rdnom+"["+string(i-1)+"].nevprt=nevprt;"
  58
  59     Code=["/* Call of actuator (blk nb "+string(i)+") */"
  60     Code;
  61     "nport = "+string(nbact)+";";
  62     rdnom+"_actuator(&flag, &nport, &block_"+rdnom+"["+string(i-1)+"].nevprt, told, "+..
  63     "("+mat2scs_c_ptr(outtb(uk))+" *)outtbptr["+string(uk-1)+"], &nrd_"+string(nuk_1)+", &nrd_"+..
  64     string(nuk_2)+", &nrd_"+string(uk_t)+",bbb);"];
  65
  66     proto="void "+rdnom+"_actuator("+..
  67     "int *, int *, int *, double *, void *, int *, int *,int *,int);"
  68     proto=cformatline(proto,70);
  69 endfunction
  70
  71 //CallBlock : generate C calling sequence
  72 //            of a scicos block
  73 //
  74 //inputs : bk   : bloc index
  75 //         pt   : evt activation number
  76 //         flag : flag
  77 //
  78 //output : txt  :
  79 //
  80 //16/06/07 Authors : Alan Layec
  81 function txt=call_block42(bk,pt,flag)
  82     txt=[]
  83     //**
  84     if flag==2 & ((zptr(bk+1)-zptr(bk))+..
  85         (ozptr(bk+1)-ozptr(bk))+..
  86         (xptr(bk+1)-xptr(bk)+..
  87         with_work(bk))==0 |..
  88         pt<=0) & ~(stalone & or(bk==actt(:,1))) then
  89         return // block without state or continuously activated
  90     end
  91     if flag==0 & ((xptr(bk+1)-xptr(bk))==0) then
  92         return // block without continuous state
  93     end
  94     if flag==9 & ((zcptr(bk+1)-zcptr(bk))==0) then
  95         return // block without continuous state
  96     end
  97     if flag==3 & ((clkptr(bk+1)-clkptr(bk))==0) then
  98         return
  99     end
 100
 101     //** adjust pt
 102     if ~(flag==3 & ((zcptr(bk+1)-zcptr(bk))<>0)) then
 103         pt=abs(pt)
 104     end
 105
 106     //** add comment
 107     txt=[txt;
 108     get_comment("call_blk",list(funs(bk),funtyp(bk),bk,labels(bk)));]
 109
 110     //** set nevprt and flag for called block
 111     txt=[txt;
 112     "block_"+rdnom+"["+string(bk-1)+"].nevprt = "+string(pt)+";"
 113     "local_flag = "+string(flag)+";"]
 114
 115     //**see if its bidon, actuator or sensor
 116     if funs(bk)=="bidon" then
 117         txt=[];
 118         return
 119     elseif funs(bk)=="bidon2" then
 120         txt=[];
 121         return
 122     elseif or(bk==actt(:,1)) then
 123         ind=find(bk==actt(:,1))
 124         uk=actt(ind,2)
 125         nuk_1=actt(ind,3)
 126         nuk_2=actt(ind,4)
 127         uk_t=actt(ind,5)
 128         txt = [txt;
 129         "nport = "+string(ind)+";"]
 130         txt = [txt;
 131         rdnom+"_actuator(&local_flag, &nport, &block_"+rdnom+"["+string(bk-1)+"].nevprt, \"
 132         get_blank(rdnom+"_actuator")+" &t, ("+mat2scs_c_ptr(outtb(uk))+" *)"+rdnom+"_block_outtbptr["+string(uk-1)+"], \"
 133         get_blank(rdnom+"_actuator")+" &nrd_"+string(nuk_1)+", &nrd_"+string(nuk_2)+", &nrd_"+string(uk_t)+",bbb);"]
 134         txt = [txt;
 135         "if(local_flag < 0) return(5 - local_flag);"]
 136         return
 137     elseif or(bk==capt(:,1)) then
 138         ind=find(bk==capt(:,1))
 139         yk=capt(ind,2);
 140         nyk_1=capt(ind,3);
 141         nyk_2=capt(ind,4);
 142         yk_t=capt(ind,5);
 143         txt = [txt;
 144         "nport = "+string(ind)+";"]
 145         txt = [txt;
 146         rdnom+"_sensor(&local_flag, &nport, &block_"+rdnom+"["+string(bk-1)+"].nevprt, \"
 147         get_blank(rdnom+"_sensor")+" &t, ("+mat2scs_c_ptr(outtb(yk))+" *)"+rdnom+"_block_outtbptr["+string(yk-1)+"], \"
 148         get_blank(rdnom+"_sensor")+" &nrd_"+string(nyk_1)+", &nrd_"+string(nyk_2)+", &nrd_"+string(yk_t)+",aaa);"]
 149         txt = [txt;
 150         "if(local_flag < 0) return(5 - local_flag);"]
 151         return
 152     end
 153
 154     //**
 155     nx=xptr(bk+1)-xptr(bk);
 156     nz=zptr(bk+1)-zptr(bk);
 157     nrpar=rpptr(bk+1)-rpptr(bk);
 158     nipar=ipptr(bk+1)-ipptr(bk);
 159     nin=inpptr(bk+1)-inpptr(bk);  //* number of input ports */
 160     nout=outptr(bk+1)-outptr(bk); //* number of output ports */
 161
 162     //**
 163     //l'adresse du pointeur de ipar
 164     if nipar<>0 then ipar=ipptr(bk), else ipar=1;end
 165     //l'adresse du pointeur de rpar
 166     if nrpar<>0 then rpar=rpptr(bk), else rpar=1; end
 167     //l'adresse du pointeur de z attention -1 pas sur
 168     if nz<>0 then z=zptr(bk)-1, else z=0;end
 169     //l'adresse du pointeur de x
 170     if nx<>0 then x=xptr(bk)-1, else x=0;end
 171
 172     //**
 173     ftyp=funtyp(bk)
 174     if ftyp>2000 then ftyp=ftyp-2000,end
 175     if ftyp>1000 then ftyp=ftyp-1000,end
 176
 177     //** check function type
 178     if ftyp < 0 then //** ifthenelse eselect blocks
 179         txt = [];
 180         return;
 181     else
 182         if (ftyp<>0 & ftyp<>1 & ftyp<>2 & ftyp<>3 & ftyp<>4) then
 183             disp("types other than 0,1,2,3 or 4 are not supported.")
 184             txt = [];
 185             return;
 186         end
 187     end
 188
 189     select ftyp
 190
 191     case 0 then
 192         //**** input/output addresses definition ****//
 193         if nin>1 then
 194             for k=1:nin
 195                 uk=inplnk(inpptr(bk)-1+k);
 196                 nuk=size(outtb(uk),"*");
 197                 txt=[txt;
 198                 "rdouttb["+string(k-1)+"]=(double *)"+rdnom+"_block_outtbptr["+string(uk-1)+"];"]
 199             end
 200             txt=[txt;
 201             "args[0]=&(rdouttb[0]);"]
 202         elseif nin==0
 203             uk=0;
 204             nuk=0;
 205             txt=[txt;
 206             "args[0]=(double *)"+rdnom+"_block_outtbptr[0];"]
 207         else
 208             uk=inplnk(inpptr(bk));
 209             nuk=size(outtb(uk),"*");
 210             txt=[txt;
 211             "args[0]=(double *)"+rdnom+"_block_outtbptr["+string(uk-1)+"];"]
 212         end
 213
 214         if nout>1 then
 215             for k=1:nout
 216                 yk=outlnk(outptr(bk)-1+k);
 217                 nyk=size(outtb(yk),"*");
 218                 txt=[txt;
 219                 "rdouttb["+string(k+nin-1)+"]=(double *)"+rdnom+"_block_outtbptr["+string(yk-1)+"];"];
 220             end
 221             txt=[txt;
 222             "args[1]=&(rdouttb["+string(nin)+"]);"];
 223         elseif nout==0
 224             yk=0;
 225             nyk=0;
 226             txt=[txt;
 227             "args[1]=(double *)"+rdnom+"_block_outtbptr[0];"];
 228         else
 229             yk=outlnk(outptr(bk));
 230             nyk=size(outtb(yk),"*"),;
 231             txt=[txt;
 232             "args[1]=(double *)"+rdnom+"_block_outtbptr["+string(yk-1)+"];"];
 233         end
 234         //*******************************************//
 235
 236         //*********** call seq definition ***********//
 237         txtc=["(&local_flag,&block_"+rdnom+"["+string(bk-1)+"].nevprt,&t,block_"+rdnom+"["+string(bk-1)+"].xd, \";
 238         "block_"+rdnom+"["+string(bk-1)+"].x,&block_"+rdnom+"["+string(bk-1)+"].nx, \";
 239         "block_"+rdnom+"["+string(bk-1)+"].z,&block_"+rdnom+"["+string(bk-1)+"].nz,block_"+rdnom+"["+string(bk-1)+"].evout, \";
 240         "&block_"+rdnom+"["+string(bk-1)+"].nevout,block_"+rdnom+"["+string(bk-1)+"].rpar,&block_"+rdnom+"["+string(bk-1)+"].nrpar, \";
 241         "block_"+rdnom+"["+string(bk-1)+"].ipar,&block_"+rdnom+"["+string(bk-1)+"].nipar, \";
 242         "(double *)args[0],&nrd_"+string(nuk)+",(double *)args[1],&nrd_"+string(nyk)+");"];
 243         if (funtyp(bk)>2000 & funtyp(bk)<3000)
 244             blank = get_blank(funs(bk)+"( ");
 245             txtc(1) = funs(bk)+txtc(1);
 246         elseif (funtyp(bk)<2000)
 247             txtc(1) = "C2F("+funs(bk)+")"+txtc(1);
 248             blank = get_blank("C2F("+funs(bk)+") ");
 249         end
 250         txtc(2:$) = blank + txtc(2:$);
 251         txt = [txt;txtc];
 252         //*******************************************//
 253
 254
 255         //**
 256     case 1 then
 257         //*********** call seq definition ***********//
 258         txtc=["(&local_flag,&block_"+rdnom+"["+string(bk-1)+"].nevprt,&t,block_"+rdnom+"["+string(bk-1)+"].xd, \";
 259         "block_"+rdnom+"["+string(bk-1)+"].x,&block_"+rdnom+"["+string(bk-1)+"].nx, \";
 260         "block_"+rdnom+"["+string(bk-1)+"].z,&block_"+rdnom+"["+string(bk-1)+"].nz,block_"+rdnom+"["+string(bk-1)+"].evout, \";
 261         "&block_"+rdnom+"["+string(bk-1)+"].nevout,block_"+rdnom+"["+string(bk-1)+"].rpar,&block_"+rdnom+"["+string(bk-1)+"].nrpar, \";
 262         "block_"+rdnom+"["+string(bk-1)+"].ipar,&block_"+rdnom+"["+string(bk-1)+"].nipar"];
 263         if (funtyp(bk)>2000 & funtyp(bk)<3000)
 264             blank = get_blank(funs(bk)+"( ");
 265             txtc(1) = funs(bk)+txtc(1);
 266         elseif (funtyp(bk)<2000)
 267             txtc(1) = "C2F("+funs(bk)+")"+txtc(1);
 268             blank = get_blank("C2F("+funs(bk)+") ");
 269         end
 270         if nin>=1 | nout>=1 then
 271             txtc($)=txtc($)+", \"
 272             txtc=[txtc;""]
 273             if nin>=1 then
 274                 for k=1:nin
 275                     uk=inplnk(inpptr(bk)-1+k);
 276                     nuk=size(outtb(uk),"*");
 277                     txtc($)=txtc($)+"(double *)"+rdnom+"_block_outtbptr["+string(uk-1)+"],&nrd_"+string(nuk)+",";
 278                 end
 279                 txtc($)=part(txtc($),1:length(txtc($))-1); //remove last ,
 280             end
 281             if nout>=1 then
 282                 if nin>=1 then
 283                     txtc($)=txtc($)+", \"
 284                     txtc=[txtc;""]
 285                 end
 286                 for k=1:nout
 287                     yk=outlnk(outptr(bk)-1+k);
 288                     nyk=size(outtb(yk),"*");
 289                     txtc($)=txtc($)+"(double *)"+rdnom+"_block_outtbptr["+string(yk-1)+"],&nrd_"+string(nyk)+",";
 290                 end
 291                 txtc($)=part(txtc($),1:length(txtc($))-1); //remove last ,
 292             end
 293         end
 294
 295         if ztyp(bk) then
 296             txtc($)=txtc($)+", \"
 297             txtc=[txtc;
 298             "block_"+rdnom+"["+string(bk-1)+"].g,&block_"+rdnom+"["+string(bk-1)+"].ng);"]
 299         else
 300             txtc($)=txtc($)+");";
 301         end
 302
 303         txtc(2:$) = blank + txtc(2:$);
 304         txt = [txt;txtc];
 305         //*******************************************//
 306
 307         //**
 308     case 2 then
 309
 310         //*********** call seq definition ***********//
 311         txtc=[funs(bk)+"(&local_flag,&block_"+rdnom+"["+string(bk-1)+"].nevprt,&t,block_"+rdnom+"["+string(bk-1)+"].xd, \";
 312         "block_"+rdnom+"["+string(bk-1)+"].x,&block_"+rdnom+"["+string(bk-1)+"].nx, \";
 313         "block_"+rdnom+"["+string(bk-1)+"].z,&block_"+rdnom+"["+string(bk-1)+"].nz,block_"+rdnom+"["+string(bk-1)+"].evout, \";
 314         "&block_"+rdnom+"["+string(bk-1)+"].nevout,block_"+rdnom+"["+string(bk-1)+"].rpar,&block_"+rdnom+"["+string(bk-1)+"].nrpar, \";
 315         "block_"+rdnom+"["+string(bk-1)+"].ipar,&block_"+rdnom+"["+string(bk-1)+"].nipar, \";
 316         "(double **)block_"+rdnom+"["+string(bk-1)+"].inptr,block_"+rdnom+"["+string(bk-1)+"].insz,&block_"+rdnom+"["+string(bk-1)+"].nin, \";
 317         "(double **)block_"+rdnom+"["+string(bk-1)+"].outptr,block_"+rdnom+"["+string(bk-1)+"].outsz, &block_"+rdnom+"["+string(bk-1)+"].nout"];
 318         if ~ztyp(bk) then
 319             txtc($)=txtc($)+");";
 320         else
 321             txtc($)=txtc($)+", \";
 322             txtc=[txtc;
 323             "block_"+rdnom+"["+string(bk-1)+"].g,&block_"+rdnom+"["+string(bk-1)+"].ng);"]
 324         end
 325         blank = get_blank(funs(bk)+"( ");
 326         txtc(2:$) = blank + txtc(2:$);
 327         txt = [txt;txtc];
 328         //*******************************************//
 329
 330         //**
 331     case 4 then
 332         txt=[txt;
 333         funs(bk)+"(&block_"+rdnom+"["+string(bk-1)+"],local_flag);"];
 334
 335     end
 336
 337     txt =[txt;"if(local_flag < 0) return(5 - local_flag);"]
 338
 339 endfunction
 340
 341 //CallBlock : generate C calling sequence
 342 //            of a scicos block
 343 //
 344 //inputs : bk   : bloc index
 345 //         pt   :
 346 //         flag :block_'+rdnom+'[
 347 //
 348 //output : txt  :
 349 //
 350 //16/06/07 Authors : R.Nikoukhah, A.Layec
 351 function txt=call_block4(bk)
 352     //   if flag==2 & ((zptr(bk+1)-zptr(bk))+(ozptr(bk+1)-ozptr(bk))==0 | pt<=0) then
 353     //     return // block without discrete state or continuously activated
 354     //            // If work allocated in the absence of z and oz, it does not work
 355     //   end
 356
 357     //**
 358     nx=xptr(bk+1)-xptr(bk);
 359     nz=zptr(bk+1)-zptr(bk);
 360     nrpar=rpptr(bk+1)-rpptr(bk);
 361     nipar=ipptr(bk+1)-ipptr(bk);
 362     nin=inpptr(bk+1)-inpptr(bk);  //* number of input ports */
 363     nout=outptr(bk+1)-outptr(bk); //* number of output ports */
 364
 365     //**
 366     //l'adresse du pointeur de ipar
 367     if nipar<>0 then ipar=ipptr(bk), else ipar=1;end
 368     //l'adresse du pointeur de rpar
 369     if nrpar<>0 then rpar=rpptr(bk), else rpar=1; end
 370     //l'adresse du pointeur de z attention -1 pas sur
 371     if nz<>0 then z=zptr(bk)-1, else z=0;end
 372     //l'adresse du pointeur de x
 373     if nx<>0 then x=xptr(bk)-1, else x=0;end
 374
 375     //**
 376     ftyp=funtyp(bk)
 377     if ftyp>2000 then ftyp=ftyp-2000,end
 378     if ftyp>1000 then ftyp=ftyp-1000,end
 379
 380     //** check function type
 381     if ftyp < 0 then //** ifthenelse eselect blocks
 382         txt = [];
 383         return;
 384     else
 385         if (ftyp<>0 & ftyp<>1 & ftyp<>2 & ftyp<>3 & ftyp<>4) then
 386             disp("types other than 0,1,2,3 or 4 are not supported.")
 387             txt = [];
 388             return;
 389         end
 390     end
 391
 392     //** add comment
 393     txt=[get_comment("call_blk",list(funs(bk),funtyp(bk),bk,labels(bk)));]
 394
 395     //** write nevprt activation
 396     //   nclock=abs(pt);
 397     txt=[txt;
 398     "block_"+rdnom+"["+string(bk-1)+"].nevprt=nevprt;"]
 399
 400     select ftyp
 401         //** zero funtyp
 402     case 0 then
 403         //**** input/output addresses definition ****//
 404         if nin>1 then
 405             for k=1:nin
 406                 uk=inplnk(inpptr(bk)-1+k);
 407                 nuk=size(outtb(uk),"*");
 408                 TYPE=mat2scs_c_ptr(outtb(uk));//scilab index start from 1
 409                 txt=[txt;
 410                 "rdouttb["+string(k-1)+"]=("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(uk-1)+"];"]
 411             end
 412             txt=[txt;
 413             "args[0]=&(rdouttb[0]);"]
 414         elseif nin==0
 415             uk=0;
 416             nuk=0;
 417             txt=[txt;
 418             "args[0]=(SCSREAL_COP *)"+rdnom+"_block_outtbptr[0];"]
 419         else
 420             uk=inplnk(inpptr(bk));
 421             nuk=size(outtb(uk),"*");
 422             TYPE=mat2scs_c_ptr(outtb(uk));//scilab index start from 1
 423             txt=[txt;
 424             "args[0]=("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(uk-1)+"];"]
 425         end
 426
 427         if nout>1 then
 428             for k=1:nout
 429                 yk=outlnk(outptr(bk)-1+k);
 430                 nyk=size(outtb(yk),"*");
 431                 TYPE=mat2scs_c_ptr(outtb(yk));//scilab index start from 1
 432                 txt=[txt;
 433                 "rdouttb["+string(k+nin-1)+"]=("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(yk-1)+"];"];
 434             end
 435             txt=[txt;
 436             "args[1]=&(rdouttb["+string(nin)+"]);"];
 437         elseif nout==0
 438             yk=0;
 439             nyk=0;
 440             txt=[txt;
 441             "args[1]=(SCSREAL_COP *)"+rdnom+"_block_outtbptr[0];"];
 442         else
 443             yk=outlnk(outptr(bk));
 444             nyk=size(outtb(yk),"*"),;
 445             TYPE=mat2scs_c_ptr(outtb(yk));//scilab index start from 1
 446             txt=[txt;
 447             "args[1]=("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(yk-1)+"];"];
 448         end
 449         //*******************************************//
 450
 451         //*********** call seq definition ***********//
 452         txtc=["(&flag,&block_"+rdnom+"["+string(bk-1)+"].nevprt,told,block_"+rdnom+"["+string(bk-1)+"].xd, \";
 453         "block_"+rdnom+"["+string(bk-1)+"].x,&block_"+rdnom+"["+string(bk-1)+"].nx, \";
 454         "block_"+rdnom+"["+string(bk-1)+"].z,&block_"+rdnom+"["+string(bk-1)+"].nz,block_"+rdnom+"["+string(bk-1)+"].evout, \";
 455         "&block_"+rdnom+"["+string(bk-1)+"].nevout,block_"+rdnom+"["+string(bk-1)+"].rpar,&block_"+rdnom+"["+string(bk-1)+"].nrpar, \";
 456         "block_"+rdnom+"["+string(bk-1)+"].ipar,&block_"+rdnom+"["+string(bk-1)+"].nipar, \";
 457         "(double *)args[0],&nrd_"+string(nuk)+",(double *)args[1],&nrd_"+string(nyk)+");"];
 458         if (funtyp(bk)>2000 & funtyp(bk)<3000)
 459             blank = get_blank(funs(bk)+"( ");
 460             txtc(1) = funs(bk)+txtc(1);
 461         elseif (funtyp(bk)<2000)
 462             txtc(1) = "C2F("+funs(bk)+")"+txtc(1);
 463             blank = get_blank("C2F("+funs(bk)+") ");
 464         end
 465         txtc(2:$) = blank + txtc(2:$);
 466         txt = [txt;txtc];
 467         //*******************************************//
 468
 469
 470         //**
 471     case 1 then
 472         //**** input/output addresses definition ****//
 473         //       if nin>=1 then
 474         //         for k=1:nin
 475         //           uk=inplnk(inpptr(i)-1+k);
 476         //           nuk=size(outtb(uk),'*');
 477         //         end
 478         //       end
 479         //       if nout>=1 then
 480         //         for k=1:nout
 481         //           yk=outlnk(outptr(i)-1+k);
 482         //           nyk=size(outtb(yk),'*');
 483         //         end
 484         //       end
 485         //*******************************************//
 486
 487         //*********** call seq definition ***********//
 488         txtc=["(&flag,&block_"+rdnom+"["+string(bk-1)+"].nevprt,told,block_"+rdnom+"["+string(bk-1)+"].xd, \";
 489         "block_"+rdnom+"["+string(bk-1)+"].x,&block_"+rdnom+"["+string(bk-1)+"].nx, \";
 490         "block_"+rdnom+"["+string(bk-1)+"].z,&block_"+rdnom+"["+string(bk-1)+"].nz,block_"+rdnom+"["+string(bk-1)+"].evout, \";
 491         "&block_"+rdnom+"["+string(bk-1)+"].nevout,block_"+rdnom+"["+string(bk-1)+"].rpar,&block_"+rdnom+"["+string(bk-1)+"].nrpar, \";
 492         "block_"+rdnom+"["+string(bk-1)+"].ipar,&block_"+rdnom+"["+string(bk-1)+"].nipar"];
 493         if (funtyp(bk)>2000 & funtyp(bk)<3000)
 494             blank = get_blank(funs(bk)+"( ");
 495             txtc(1) = funs(bk)+txtc(1);
 496         elseif (funtyp(bk)<2000)
 497             txtc(1) = "C2F("+funs(bk)+")"+txtc(1);
 498             blank = get_blank("C2F("+funs(bk)+") ");
 499         end
 500         if nin>=1 | nout>=1 then
 501             txtc($)=txtc($)+", \"
 502             txtc=[txtc;""]
 503             if nin>=1 then
 504                 for k=1:nin
 505                     uk=inplnk(inpptr(bk)-1+k);
 506                     nuk=size(outtb(uk),"*");
 507                     txtc($)=txtc($)+"(SCSREAL_COP *)"+rdnom+"_block_outtbptr["+string(uk-1)+"],&nrd_"+string(nuk)+",";
 508                 end
 509                 txtc($)=part(txtc($),1:length(txtc($))-1); //remove last ,
 510             end
 511             if nout>=1 then
 512                 if nin>=1 then
 513                     txtc($)=txtc($)+", \"
 514                     txtc=[txtc;""]
 515                 end
 516                 for k=1:nout
 517                     yk=outlnk(outptr(bk)-1+k);
 518                     nyk=size(outtb(yk),"*");
 519                     txtc($)=txtc($)+"(SCSREAL_COP *)"+rdnom+"_block_outtbptr["+string(yk-1)+"],&nrd_"+string(nyk)+",";
 520                 end
 521                 txtc($)=part(txtc($),1:length(txtc($))-1); //remove last ,
 522             end
 523         end
 524
 525         if ztyp(bk) then
 526             txtc($)=txtc($)+", \"
 527             txtc=[txtc;"w,&nrd_0);"];
 528         else
 529             txtc($)=txtc($)+");";
 530         end
 531
 532         txtc(2:$) = blank + txtc(2:$);
 533         txt = [txt;txtc];
 534         //*******************************************//
 535
 536         //**
 537     case 2 then
 538
 539         //*********** call seq definition ***********//
 540         txtc=[funs(bk)+"(&flag,&block_"+rdnom+"["+string(bk-1)+"].nevprt,told,block_"+rdnom+"["+string(bk-1)+"].xd, \";
 541         "block_"+rdnom+"["+string(bk-1)+"].x,&block_"+rdnom+"["+string(bk-1)+"].nx, \";
 542         "block_"+rdnom+"["+string(bk-1)+"].z,&block_"+rdnom+"["+string(bk-1)+"].nz,block_"+rdnom+"["+string(bk-1)+"].evout, \";
 543         "&block_"+rdnom+"["+string(bk-1)+"].nevout,block_"+rdnom+"["+string(bk-1)+"].rpar,&block_"+rdnom+"["+string(bk-1)+"].nrpar, \";
 544         "block_"+rdnom+"["+string(bk-1)+"].ipar,&block_"+rdnom+"["+string(bk-1)+"].nipar, \";
 545         "(double **)block_"+rdnom+"["+string(bk-1)+"].inptr,block_"+rdnom+"["+string(bk-1)+"].insz,&block_"+rdnom+"["+string(bk-1)+"].nin, \";
 546         "(double **)block_"+rdnom+"["+string(bk-1)+"].outptr,block_"+rdnom+"["+string(bk-1)+"].outsz, &block_"+rdnom+"["+string(bk-1)+"].nout"];
 547         if ~ztyp(bk) then
 548             txtc($)=txtc($)+");";
 549         else
 550             txtc($)=txtc($)+", \";
 551             txtc=[txtc;
 552             "block_"+rdnom+"["+string(bk-1)+"].g,&block_"+rdnom+"["+string(bk-1)+"].ng);"]
 553         end
 554         blank = get_blank(funs(bk)+"( ");
 555         txtc(2:$) = blank + txtc(2:$);
 556         txt = [txt;txtc];
 557         //*******************************************//
 558
 559         //**
 560     case 4 then
 561         txt=[txt;
 562         funs(bk)+"(&block_"+rdnom+"["+string(bk-1)+"],flag);"];
 563
 564     end
 565 endfunction
 566
 567 //
 568 //16/06/07 Author : ?, A. Layec
 569 //
 570 function [Code,capt,proto]=call_sensor(i)
 571     nin=inpptr(i+1)-inpptr(i); ///* number of input ports */
 572     nout=outptr(i+1)-outptr(i); ///* number of output ports */
 573
 574     //declaration des I/O des blocs de type 1
 575     if funtyp(i)==0 then
 576         if nout==0 then
 577             yk    = 0;
 578             nyk_1 = 0;
 579             nyk_2 = 0;
 580             yk_t  = 1;
 581             //Code($+1)=+'  args[1]=(double *)(outtbptr[0]);';
 582         else
 583             yk    = outlnk(outptr(i));
 584             nyk_1 = size(outtb(yk),1);
 585             nyk_2 = size(outtb(yk),2);
 586             yk_t  = mat2scs_c_nb(outtb(yk));
 587             //Code($+1)='  args[1]=('+mat2scs_c_ptr(outtb(yk))+' *)(outtbptr['+string(yk-1)+']);';
 588         end
 589
 590     end
 591     capt=[i yk nyk_1 nyk_2 yk_t bllst(i).ipar]
 592     Code($+1)="block_"+rdnom+"["+string(i-1)+"].nevprt=nevprt;"
 593     Code=["/* Call of sensor (blk nb "+string(i)+") */"
 594     Code;
 595     "nport = "+string(nbcap)+";";
 596     rdnom+"_sensor(&flag, &nport, &block_"+rdnom+"["+string(i-1)+"].nevprt, "+..
 597     "told, ("+mat2scs_c_ptr(outtb(yk))+" *)(outtbptr["+string(yk-1)+"]), &nrd_"+string(nyk_1)+..
 598     ", &nrd_"+string(nyk_2)+", &nrd_"+string(yk_t)+",aaa);"];
 599     proto="void "+rdnom+"_sensor("+..
 600     "int *, int *, int *, double *,void *, int *, int *,int *, int);"
 601     proto=cformatline(proto,70);
 602 endfunction
 603
 604 //Generates Code for dynamically linked Fortran and C Blocks
 605 function [CCode,FCode]=gen_blocks()
 606     CCode=[]
 607     FCode=[]
 608
 609     kdyn=find(funtyp>1000) //dynamically linked blocs
 610     //100X : Fortran blocks
 611     //200X : C blocks
 612
 613     if (size(kdyn,"*") >1)
 614         kfuns=[];
 615         //get the block data structure in the initial scs_m structure
 616         if size(corinv(kdyn(1)),"*")==1 then
 617             O=scs_m.objs(corinv(kdyn(1)));
 618         else
 619             path=list("objs");
 620             for l=corinv(kdyn(1))(1:$-1)
 621                 path($+1)=l;
 622                 path($+1)="model";
 623                 path($+1)="rpar";
 624                 path($+1)="objs";
 625             end
 626             path($+1)=corinv(kdyn(1))($);
 627             O=scs_m(path);
 628         end
 629         if funtyp(kdyn(1))>2000 then
 630             //C block
 631             CCode=[CCode;O.graphics.exprs(2)]
 632         else
 633             FCode=[FCode;O.graphics.exprs(2)]
 634         end
 635         kfuns=funs(kdyn(1));
 636         for i=2:size(kdyn,"*")
 637             //get the block data structure in the initial scs_m structure
 638             if size(corinv(kdyn(i)),"*")==1 then
 639                 O=scs_m.objs(corinv(kdyn(i)));
 640             else
 641                 path=list("objs");
 642                 for l=corinv(kdyn(i))(1:$-1)
 643                     path($+1)=l;
 644                     path($+1)="model";
 645                     path($+1)="rpar";
 646                     path($+1)="objs";
 647                 end
 648                 path($+1)=corinv(kdyn(i))($);
 649                 O=scs_m(path);
 650             end
 651             if (find(kfuns==funs(kdyn(i))) == [])
 652                 kfuns=[kfuns;funs(kdyn(i))];
 653                 if funtyp(kdyn(i))>2000  then
 654                     //C block
 655                     CCode=[CCode;O.graphics.exprs(2)]
 656                 else
 657                     FCode=[FCode;O.graphics.exprs(2)]
 658                 end
 659             end
 660         end
 661     elseif (size(kdyn,"*")==1)
 662         //get the block data structure in the initial scs_m structure
 663         if size(corinv(kdyn),"*")==1 then
 664             O=scs_m.objs(corinv(kdyn));
 665         else
 666             path=list("objs");
 667             for l=corinv(kdyn)(1:$-1)
 668                 path($+1)=l;
 669                 path($+1)="model";
 670                 path($+1)="rpar";
 671                 path($+1)="objs";
 672             end
 673             path($+1)=corinv(kdyn)($);
 674             O=scs_m(path);
 675         end
 676         if funtyp(kdyn)>2000 then
 677             //C block
 678             CCode=[CCode;O.graphics.exprs(2)]
 679         else
 680             FCode=[FCode;O.graphics.exprs(2)]
 681         end
 682     end
 683     if CCode==[]
 684         CCode=["void no_ccode()"
 685         "{"
 686         "  return;"
 687         "}"]
 688     end
 689 endfunction
 690
 691 //** Generates the C code for new block simulation
 692 //
 693 //12/07/07 Alan Layec
 694 function ok=gen_ccode42();
 695
 696     //** Generate code for scicos block
 697
 698     ierr=execstr("make_computational42(rpat+''/''+rdnom+''.c'')","errcatch")
 699     if ierr<>0 then
 700         message(lasterror())
 701         ok=%f
 702         return
 703     end
 704
 705     //** Generate files for dynamically linked scicos blocks
 706     [CCode,FCode]=gen_blocks()
 707     if FCode<>[] then
 708         ierr=execstr("mputl(FCode,rpat+''/''+rdnom+''f.f'')","errcatch")
 709         if ierr<>0 then
 710             message(lasterror())
 711             ok=%f
 712             return
 713         end
 714     end
 715     if CCode<>[] then
 716         ierr=execstr("mputl(CCode,rpat+''/''+rdnom+''_Cblocks.c'')","errcatch")
 717         if ierr<>0 then
 718             message(lasterror())
 719             ok=%f
 720             return
 721         end
 722     end
 723
 724     //** Generate _void_io.c
 725     try
 726         fd = mopen(rpat+"/"+rdnom+"_void_io.c", "wt")
 727
 728         mputl(["/*";
 729         "**    Copyright (c) 1989 - 2012 (INRIA)";
 730         "**    Copyright (c) 2011 - 2013 (Scilab Enterprises)";
 731         "**";
 732         "**    Generated by Code_Generation toolbox of Xcos with "+getversion();
 733         "**    Date : "+date();
 734         "*/"], fd);
 735
 736         if (readGlobal <> [] | writeGlobal <> [])
 737             mputl([""
 738             "#include ""scicos_block4.h"""], fd);
 739         end
 740
 741         mputl([""
 742         "/*---------------------------------------- Actuators */"
 743         "void "+rdnom+"_actuator(int *flag, int *nport, int *nevprt, double *t, void *u, int *nu1, int *nu2, int *ut, int *flag1)"
 744         "{"
 745         "  int k = 0,l = 0;"
 746         "}"
 747         "/*---------------------------------------- Sensor */"
 748         "void "+rdnom+"_sensor(int *flag, int *nport, int *nevprt, double *t, void *y, int *ny1, int *ny2, int *yt, int *flag1)"
 749         "{"
 750         "  int k = 0,l = 0;"
 751         "}"], fd)
 752
 753         // Generate global data read <=> FromWorkspace.
 754         if readGlobal <> []
 755             for i = readGlobal
 756                 mputl(["/*---------------------------------------- Read variable "+i+" */"
 757                 "void readGlobal_"+i+"(scicos_block *block, int flag)"
 758                 "{"
 759                 "    // Read a scilab Environment variable "+i
 760                 "    fromws_c(block, flag);"
 761                 "}"
 762                 ], fd);
 763             end
 764         end
 765
 766         // Generate global data write <=> ToWorkspace.
 767         if writeGlobal <> []
 768             for i = writeGlobal
 769                 mputl(["/*---------------------------------------- Write variable "+i+" */"
 770                 "void writeGlobal_"+i+"(scicos_block *block, int flag)"
 771                 "{"
 772                 "    // Write a scilab environment variable "+i
 773                 "    // to a C one : global"+i
 774                 "    tows_c(block, flag);"
 775                 "}"
 776                 ], fd);
 777             end
 778         end
 779
 780         mclose(fd);
 781     catch
 782         message(lasterror())
 783         ok=%f
 784         return
 785     end
 786
 787     //** Generate _standalone.c
 788
 789     ierr=execstr("make_standalone42(rpat+''/''+rdnom+''_standalone.c'')","errcatch")
 790     if ierr<>0 then
 791         message(lasterror())
 792         ok=%f
 793         return
 794     end
 795
 796     //** This copy is indispensable only for stand alone code generation
 797     //** not supported in Scilab 5
 798
 799     //** copy source code of machine.h/scicos_block4.h
 800     //   in target path
 801     //   txt=mgetl(SCI+'/modules/core/includes/machine.h');
 802     //   ierr=execstr('mputl(txt,rpat+''/machine.h'')','errcatch')
 803     //   if ierr<>0 then
 804     //     message(lasterror())
 805     //     ok=%f
 806     //     return
 807     //   end
 808     //
 809     //   txt=mgetl(SCI+'/modules/scicos_blocks/includes/scicos_block4.h');
 810     //   ierr=execstr('mputl(txt,rpat+''/scicos_block4.h'')','errcatch')
 811     //   if ierr<>0 then
 812     //     message(lasterror())
 813     //     ok=%f
 814     //     return
 815     //   end
 816
 817     //** Generate _act_sens_events.c
 818     Code=["/*"
 819     "**    Copyright (c) 1989 - 2012 (INRIA)"
 820     "**    Copyright (c) 2011 - 2012 (Scilab Enterprises)"
 821     "**"
 822     "**    Generated by Code_Generation toolbox of Xcos with "+getversion()
 823     "**    Date :"+date()
 824     "*/"
 825     ""
 826     "#include <stdio.h>"
 827     "#include <stdlib.h>"
 828     "#include <math.h>"
 829     "#include <string.h>"
 830     "extern void **"+rdnom+"_block_outtbptr;"
 831     "extern char input[50],output[50];"
 832     "FILE *fprr = NULL, *fprw = NULL;"
 833     make_outevents()
 834     make_actuator(%t)
 835     make_sensor(%t)]
 836
 837     created=[];
 838     reponse=[];
 839
 840     created=fileinfo(rpat+"/"+rdnom+"_act_sens_events.c")
 841     if created~=[] then
 842         reponse=messagebox(["File: """+rdnom+"_act_sens_events.c"" already exists,";
 843         "do you want to replace it ?"],"modal","question",["Yes","No"]);
 844     end
 845
 846     if reponse==1 |  reponse==[] then
 847         ierr=execstr("mputl(Code,rpat+''/''+rdnom+''_act_sens_events.c'')", ...
 848         "errcatch")
 849         if ierr<>0 then
 850             message(lasterror())
 851             ok=%f
 852             return
 853         end
 854     end
 855
 856     try
 857         if (readGlobal <> [] | writeGlobal <> [])
 858             fd = mopen(rpat+"/"+rdnom+"_read_write_global.c", "wt")
 859             mputl(["/*"
 860             "**    Copyright (c) 2012 - 2013 (Scilab Enterprises)"
 861             "**"
 862             "**    Generated by Code_Generation toolbox of Xcos with "+getversion()
 863             "**    Date :"+date()
 864             "*/"
 865             ""
 866             "// Uncomment this to log each To Workspace variable update"
 867             "//#define VERBOSE"
 868             ""
 869             "#ifdef VERBOSE"
 870             "#include <stdio.h>"
 871             "#endif"
 872             "#include <stdlib.h>"
 873             "#include <string.h>"
 874             "#include ""scicos_block4.h"""
 875             ""
 876             "double get_scicos_time();"
 877             ""
 878             ], fd);
 879             if writeGlobal <> []
 880                 // Generate global C variables
 881                 // #define global_XXX_Size
 882                 // static double **global_XXX
 883                 // static int global_XXX_Index (to manage buffer like variables)
 884                 for i = 1:size(writeGlobal, "*")
 885                     mputl(["/*---------------------------------------- Global Variable "+writeGlobal(i)+" */"
 886                     "#define global_"+writeGlobal(i)+"_Size    "+string(writeGlobalSize(i))
 887                     "static double **global_"+writeGlobal(i)+";"
 888                     "static int global_"+writeGlobal(i)+"_Index = 0;"
 889                     ], fd);
 890                 end
 891             end
 892
 893             if readGlobal <> []
 894                 // Generate global C variables
 895                 // #define global_XXX_Size
 896                 // #define global_XXX_Time_Size
 897                 // static double **global_XXX
 898                 // static double global_XXX_Time (manage time <-> values association)
 899                 for i = 1:size(readGlobal, "*")
 900                     mputl(["/*---------------------------------------- Global Variable "+readGlobal(i)+" */"
 901                     "#define global_"+readGlobal(i)+"_Size    "+string(readGlobalSize(i))
 902                     "#define global_"+readGlobal(i)+"_Time_Size    "+string(readGlobalTimeSize(i))
 903                     "static double **global_"+readGlobal(i)+";"
 904                     "static double *global_"+readGlobal(i)+"_Time = 0;"
 905                     ], fd);
 906                 end
 907             end
 908
 909
 910
 911             if (readGlobal <> [])
 912                 for i = 1:size(readGlobal, "*")
 913                     mputl(["/*---------------------------------------- Read variable "+readGlobal(i)+" */"
 914                     "void readGlobal_"+readGlobal(i)+"(scicos_block *block, int flag)"
 915                     "{"
 916                     "    int i = 0;"
 917                     "    int j = 0;"
 918                     "    double *y_d = NULL;"
 919                     ""
 920                     "    /* Read a scilab Environment variable "+readGlobal(i)+" */"
 921                     "    switch(flag)"
 922                     "    {"
 923                     ], fd)
 924                     //
 925                     // Init case : allocate data / timetable
 926                     // Feal data/timetable with values from Scilab.
 927                     //
 928                     mputl(["    case 4 : /* init */"
 929                     "    {"
 930                     "        // Allocate time table"
 931                     "        global_"+readGlobal(i)+"_Time = (double *) malloc(global_"+readGlobal(i)+"_Time_Size * sizeof(double));"
 932                     "        memset(global_"+readGlobal(i)+"_Time, 0x0, global_"+readGlobal(i)+"_Time_Size * sizeof(double));"
 933                     ""
 934                     "        // Allocate data"
 935                     "        global_"+readGlobal(i)+" = (double **) malloc(global_"+readGlobal(i)+"_Time_Size * sizeof(double *));"
 936                     "        for (i = 0 ; i < global_"+readGlobal(i)+"_Time_Size ; ++i)"
 937                     "        {"
 938                     "            global_"+readGlobal(i)+"[i] = (double *) malloc( global_"+readGlobal(i)+"_Size * sizeof(double));"
 939                     "            memset(global_"+readGlobal(i)+"[i], 0x0, global_"+readGlobal(i)+"_Size * sizeof(double));"
 940                     "        }"
 941                     ""
 942                     ], fd);
 943                     // Save format
 944                     oldFormat = format();
 945                     format(25);
 946
 947                     // Fead timetable
 948                     for (j = 1:readGlobalTimeSize(i))
 949                         mputl(["        global_"+readGlobal(i)+"_Time["+string(j-1)+"] = " + ...
 950                         strsubst(string(evstr(readGlobal(i)+".time("+string(j)+")")), "D", "E")+";"
 951                         ], fd)
 952                     end
 953                     // Fead data
 954                     for (j = 1:readGlobalTimeSize(i))
 955                         for (k = 1:readGlobalSize(i))
 956                             mputl(["        global_"+readGlobal(i)+"["+string(j-1)+"]["+string(k-1)+"] = " + ...
 957                             strsubst(string(evstr(readGlobal(i)+".values("+string(j)+", "+string(k)+")")), "D", "E")+";"
 958                             ], fd)
 959
 960                         end
 961                     end
 962
 963                     // Restore format
 964                     format(oldFormat(2), oldFormat(1));
 965
 966                     mputl([""
 967                     "        break;"
 968                     "    }"
 969                     ],fd);
 970                     //
 971                     // Output update case :
 972                     //
 973                     mputl(["    case 1 : /* output update */"
 974                     "    {"
 975                     "        j = 0;"
 976                     "        while(get_scicos_time() >  global_"+readGlobal(i)+"_Time[j] && j < global_"+readGlobal(i)+"_Time_Size)"
 977                     "        {"
 978                     "            j++;"
 979                     "        }"
 980                     "        y_d = GetRealOutPortPtrs(block,1);"
 981                     "        if (j == global_"+readGlobal(i)+"_Time_Size)"
 982                     "        {"
 983                     "            memset(y_d, 0x0, global_"+readGlobal(i)+"_Size * sizeof(double));"
 984                     "        }"
 985                     "        else"
 986                     "        {"
 987                     "            memcpy(y_d, global_"+readGlobal(i)+"[j], global_"+readGlobal(i)+"_Size * sizeof(double));"
 988                     "        }"
 989                     "        break;"
 990                     "    }"
 991                     ],fd);
 992                     //
 993                     // End, free memory.
 994                     //
 995                     mputl(["    case 5 : /* END */"
 996                     "    {"
 997                     "        for (i = 0 ; i < global_"+readGlobal(i)+"_Time_Size ; ++i)"
 998                     "        {"
 999                     "            free(global_"+readGlobal(i)+"[i]);"
1000                     "        }"
1001                     "        free(global_"+readGlobal(i)+");"
1002                     "        break;"
1003                     "    }"
1004                     ],fd);
1005                     // Close switch + function declaration
1006                     mputl(["    }"
1007                     "}"
1008                     ], fd);
1009                 end
1010             end
1011
1012             if writeGlobal <> []
1013                 for i = 1:size(writeGlobal, "*")
1014                     mputl(["/*---------------------------------------- Write variable "+writeGlobal(i)+" */"
1015                     "void writeGlobal_"+writeGlobal(i)+"(scicos_block *block, int flag)"
1016                     "{"
1017                     "    int i = 0;"
1018                     "    int j = 0;"
1019                     "    int nu = block->insz[0];"
1020                     "    int nu2 = block->insz[1];"
1021                     ""
1022                     "    /* Write a scilab environment variable "+writeGlobal(i)+" */"
1023                     "    /* to a C one : global_"+writeGlobal(i)+" */"
1024                     "    switch(flag)"
1025                     "    {"
1026                     "    case 4 : /* init */"
1027                     "    {"
1028                     "        global_"+writeGlobal(i)+" = (double **) malloc(global_"+writeGlobal(i)+"_Size * sizeof(double *));"
1029                     "        for (i = 0 ; i < global_"+writeGlobal(i)+"_Size ; ++i)"
1030                     "        {"
1031                     "            global_"+writeGlobal(i)+"[i] = (double *) malloc(nu * nu2 * sizeof(double));"
1032                     "            memset(global_"+writeGlobal(i)+"[i], 0x0, nu * nu2 * sizeof(double));"
1033                     "        }"
1034                     "        global_"+writeGlobal(i)+"_Index = -1;"
1035                     "#ifdef VERBOSE"
1036                     "        printf(""C_"+writeGlobal(i)+".values = zeros(%d, %d, %d)\n"", global_"+writeGlobal(i)+"_Size, nu, nu2);"
1037                     "        printf(""C_"+writeGlobal(i)+".time = -%%inf * ones(%d, 1)\n"", global_"+writeGlobal(i)+"_Size);"
1038                     "#endif"
1039                     "        break;"
1040                     "    }"
1041                     "    case 2 : /* state update */"
1042                     "    {"
1043                     "        global_"+writeGlobal(i)+"_Index = (global_"+writeGlobal(i)+"_Index + 1) % global_"+writeGlobal(i)+"_Size;"
1044                     "        memcpy(global_"+writeGlobal(i)+"[global_"+writeGlobal(i)+"_Index], block->inptr[i], nu * nu2 * sizeof(double));"
1045                     "#ifdef VERBOSE"
1046                     "        printf(""C_"+writeGlobal(i)+".time(%d) = %.25E;\n"", global_"+writeGlobal(i)+"_Index + 1, get_scicos_time());"
1047                     "        for (j = 0 ; j < nu * nu2 ; ++j)"
1048                     "        {"
1049                     "            printf(""C_"+writeGlobal(i)+".values(%d, %d) = %.25E;\n"", global_"+writeGlobal(i)+"_Index + 1, j + 1, global_"+writeGlobal(i)+"[global_"+writeGlobal(i)+"_Index][j]);"
1050                     "        }"
1051                     "#endif /* !VERBOSE */"
1052                     "        break;"
1053                     "    }"
1054                     "    case 5 : /* end */"
1055                     "    {"
1056                     "#ifdef VERBOSE"
1057                     "        //reshape to fit scilab behaviour"
1058                     "        printf(""C_"+writeGlobal(i)+".time = C_"+writeGlobal(i)+".time(C_"+writeGlobal(i)+".time <> -%%inf);\n"");"
1059                     "        printf(""C_"+writeGlobal(i)+".values = C_"+writeGlobal(i)+".values(1:size(C_"+writeGlobal(i)+".time, ''*''), :);\n"");"
1060                     "#endif"
1061                     "        for (i = 0 ; i < global_"+writeGlobal(i)+"_Size ; ++i)"
1062                     "        {"
1063                     "            free(global_"+writeGlobal(i)+"[i]);"
1064                     "        }"
1065                     "        free(global_"+writeGlobal(i)+");"
1066                     "        break;"
1067                     "    }"
1068                     "    }"
1069                     "}"
1070                     ], fd);
1071                 end
1072             end
1073
1074             mclose(fd);
1075         end
1076     catch
1077         message(lasterror())
1078         ok=%f
1079         return
1080     end
1081
1082 endfunction
1083
1084 //creates the Scicos GUI function associated with the new block
1085 //
1086 //Author : Rachid Djenidi, A.Layec
1087 //
1088 //20/06/07, A.Layec : update with in2,out2,intyp,outtyp
1089 //27/06/07, A.Layec : update opar,oz
1090 //
1091 function ok=gen_gui42();
1092     clkinput=ones(clkIN)';
1093     clkoutput=ones(clkOUT)';
1094     //outtb=outtb;
1095     oz=cpr.state.oz;
1096
1097     new_oz=list();
1098     for i=1:lstsize(oz)
1099         new_oz($+1) = oz(i)
1100     end
1101     for i=1:lstsize(outtb)
1102         new_oz($+1) = outtb(i)
1103     end
1104
1105     //outtb($+1) = zeros(nblk,1);
1106     Code=["//";
1107     "//    Copyright (c) 1989 - 2012 (INRIA)";
1108     "//    Copyright (c) 2011 - 2013 (Scilab Enterprises)";
1109     "//";
1110     "//    Generated by Code_Generation toolbox of Xcos with "+getversion();
1111     "//    Date : "+date();
1112     "//"
1113     "function [x,y,typ]="+rdnom+"_c(job,arg1,arg2)";
1114     " x=[];y=[];typ=[];";
1115     " select job";
1116     " case ''plot'' then";
1117     "   standard_draw(arg1)";
1118     " case ''getinputs'' then";
1119     "   [x,y,typ]=standard_inputs(arg1)";
1120     " case ''getoutputs'' then";
1121     "   [x,y,typ]=standard_outputs(arg1)";
1122     " case ''getorigin'' then";
1123     "   [x,y]=standard_origin(arg1)";
1124     " case ''set'' then";
1125     "   x=arg1;";
1126     " case ''define'' then"
1127     "   "+sci2exp(capt(:,3),"in",70); //input ports sizes 1
1128     "   "+sci2exp(capt(:,4),"in2",70); //input ports sizes 2
1129     "   "+sci2exp(scs_c_nb2scs_nb(capt(:,5)),"intyp",70); //input ports type
1130     "   "+sci2exp(actt(:,3),"out",70); //output ports sizes 1
1131     "   "+sci2exp(actt(:,4),"out2",70); //output ports sizes 2
1132     "   "+sci2exp(scs_c_nb2scs_nb(actt(:,5)),"outtyp",70); //output ports type
1133     "   "+sci2exp(x,"x",70); //initial continuous state
1134     "   "+sci2exp(z,"z",70); //initial discrete state
1135     "   work=zeros("+string(nblk)+",1)";
1136     "   Z=[z;work]";
1137     "   "+sci2exp(new_oz,"odstate",70);
1138     "   "+sci2exp(cpr.sim.rpar,"rpar",70); //real parameters
1139     "   "+sci2exp(cpr.sim.ipar,"ipar",70); //integer parameters
1140     "   "+sci2exp(cpr.sim.opar,"opar",70); //object parameters
1141     "   "+sci2exp(clkinput,"clkinput",70);
1142     "   "+sci2exp(clkoutput,"clkoutput",70);
1143     "   "+sci2exp(FIRING,"firing",70);
1144     "   nzcross="+string(sum(cpr.sim.zcptr(2:$)-cpr.sim.zcptr(1:$-1)))';
1145     "   nmode="+string(sum(cpr.sim.modptr(2:$)-cpr.sim.modptr(1:$-1)))';]
1146
1147     for i=1:length(bllst)
1148         deput=[%t,%f]
1149         if (bllst(i).dep_ut(2) == %t) then
1150             deput(1,2)=%t;
1151             break;
1152         end
1153     end
1154     Code($+1)="   "+sci2exp(deput,"dep_ut",70);
1155     Code=[Code
1156     "   model=scicos_model(sim=list(''"+rdnom+"'',4),.."
1157     "                      in=in,.."
1158     "                      in2=in2,.."
1159     "                      intyp=intyp,.."
1160     "                      out=out,.."
1161     "                      out2=out2,.."
1162     "                      outtyp=outtyp,.."
1163     "                      evtin=clkinput,.."
1164     "                      evtout=clkoutput,.."
1165     "                      firing=firing,.."
1166     "                      state=x,.."
1167     "                      dstate=Z,.."
1168     "                      odstate=odstate,.."
1169     "                      rpar=rpar,.."
1170     "                      ipar=ipar,.."
1171     "                      opar=opar,.."
1172     "                      blocktype=''c'',.."
1173     "                      dep_ut=dep_ut,.."
1174     "                      nzcross=nzcross,.."
1175     "                      nmode=nmode)"
1176     "   gr_i=''xstringb(orig(1),orig(2),''''"+rdnom+"'''',sz(1),.."
1177     "          sz(2),''''fill'''')''";
1178     "   x=standard_define([2 2],model,[],gr_i)";
1179     " end"
1180     "endfunction"];
1181     //Create file
1182     ierr=execstr("mputl(Code,rpat+''/''+rdnom+''_c.sci'')","errcatch")
1183     if ierr<>0 then
1184         message(lasterror())
1185         ok=%f
1186     end
1187 endfunction
1188
1189 function  [ok,XX,alreadyran,flgcdgen,szclkINTemp,freof] = do_compile_superblock42(XX,all_scs_m,numk,alreadyran)
1190     // Transforms a given Scicos discrete and continuous SuperBlock into a C defined Block
1191
1192     scs_m=XX.model.rpar
1193     par=scs_m.props;
1194     if alreadyran then
1195         //terminate current simulation
1196         do_terminate()
1197         alreadyran=%f
1198     end
1199     hname=scs_m.props.title(1) //superblock name
1200     //***********************************************************
1201     //Check blocks properties and adapt them if necessary
1202     //***********************************************************
1203
1204     IN=[];
1205     OUT=[];
1206     clkIN=[];
1207     clkOUT=[];
1208     numa=[];
1209     numc=[];
1210     writeGlobal = [];
1211     writeGlobalSize = [];
1212     readGlobal = [];
1213     readGlobalTimeSize = [];
1214     readGlobalSize = [];
1215
1216     for i=1:size(scs_m.objs)
1217         if typeof(scs_m.objs(i))=="Block" then
1218             if scs_m.objs(i).gui=="CLKOUT_f" then
1219                 ok=%f;%cpr=list();
1220                 message("Superblock should not have any activation output port.")
1221                 return
1222             elseif scs_m.objs(i).gui=="IN_f" then
1223                 //replace input ports by sensor blocks
1224                 numc=numc+1
1225                 scs_m.objs(i).gui="INPUTPORTEVTS";
1226                 scs_m.objs(i).model.evtin=1
1227                 scs_m.objs(i).model.sim(1)="capteur"+string(numc)
1228                 IN=[IN scs_m.objs(i).model.ipar]
1229             elseif scs_m.objs(i).gui=="OUT_f" then
1230                 //replace output ports by actuator blocks
1231                 numa=numa+1
1232                 scs_m.objs(i).gui="OUTPUTPORTEVTS";
1233                 scs_m.objs(i).model.sim(1)="actionneur"+string(numa)
1234                 OUT=[OUT  scs_m.objs(i).model.ipar]
1235             elseif scs_m.objs(i).gui=="CLKINV_f" then
1236                 //replace event input ports by  fictious block
1237                 scs_m.objs(i).gui="EVTGEN_f";
1238                 scs_m.objs(i).model.sim(1)="bidon"
1239                 clkIN=[clkIN scs_m.objs(i).model.ipar];
1240                 //elseif scs_m.objs(i).model.dep_ut(2)==%t then
1241                 //check for time dependency PAS IICI
1242                 //ok=%f;%cpr=list()
1243                 //message('a block have time dependence.')
1244                 //return
1245             elseif scs_m.objs(i).gui=="CLKOUTV_f" then
1246                 scs_m.objs(i).gui="EVTOUT_f";
1247                 scs_m.objs(i).model.sim(1)="bidon2"
1248                 clkOUT=[clkOUT scs_m.objs(i).model.ipar];
1249             end
1250         end
1251     end
1252
1253     //Check if input/output ports are numered properly
1254     IN=-gsort(-IN);
1255     if or(IN<>[1:size(IN,"*")]) then
1256         ok=%f;%cpr=list()
1257         message("Input ports are not numbered properly.")
1258         return
1259     end
1260     OUT=-gsort(-OUT);
1261     if or(OUT<>[1:size(OUT,"*")]) then
1262         ok=%f;%cpr=list()
1263         message("Output ports are not numbered properly.")
1264         return
1265     end
1266     clkIN=-gsort(-clkIN);
1267     if or(clkIN<>[1:size(clkIN,"*")]) then
1268         ok=%f;%cpr=list()
1269         message("Event input ports are not numbered properly.")
1270         return
1271     end
1272     clkOUT=-gsort(-clkOUT);
1273     if or(clkOUT<>[1:size(clkOUT,"*")]) then
1274         ok=%f;%cpr=list()
1275         message("Event output ports are not numbered properly.")
1276         return
1277     end
1278
1279     //Check if there is more than one clock in the diagram
1280     szclkIN=size(clkIN,2);
1281     if szclkIN==0 then
1282         szclkIN=[]
1283     end
1284     flgcdgen=szclkIN;
1285     [bllst,connectmat,clkconnect,cor,corinv,ok,scs_m,flgcdgen,freof]=c_pass1(scs_m,flgcdgen);
1286
1287     // Check for any To Workspace/FromWorkspace block
1288     for i = 1:size(bllst)
1289         if bllst(i).sim(1) == "tows_c" then
1290             // Explore scs_m to find original block
1291             towsObjIndex = corinv(i);
1292             towsObj = scs_m.objs(towsObjIndex(1));
1293             for j = 2:size(towsObjIndex, "*")
1294                 towsObj = towsObj.model.rpar.objs(towsObjIndex(j));
1295             end
1296             bllst(i).sim(1) = "writeGlobal_" + ...
1297             towsObj.graphics.exprs(2);
1298             // Force state to enable case 2 call
1299             // on generated code
1300             bllst(i).dstate = 0;
1301             writeGlobal = [writeGlobal towsObj.graphics.exprs(2)];
1302             writeGlobalSize = [writeGlobalSize bllst(i).ipar(1)];
1303         elseif bllst(i).sim(1) == "fromws_c" then
1304             fromwsObjIndex = corinv(i);
1305             fromwsObj = scs_m.objs(fromwsObjIndex(1));
1306             for j = 2:size(fromwsObjIndex, "*")
1307                 fromwsObj = fromwsObj.model.rpar.objs(fromwsObjIndex(j));
1308             end
1309             bllst(i).sim(1) = "readGlobal_" + fromwsObj.graphics.exprs(1);
1310             readGlobal = [readGlobal fromwsObj.graphics.exprs(1)];
1311             readGlobalTimeSize = [readGlobalTimeSize evstr("size(" + fromwsObj.graphics.exprs(1) + ".time, ""*"")")]
1312             readGlobalSize = [readGlobalSize evstr("size(" + fromwsObj.graphics.exprs(1) + ".values(1, :), ""*"")")]
1313         end
1314     end
1315
1316     if flgcdgen<> szclkIN
1317         clkIN=[clkIN flgcdgen]
1318     end
1319     szclkINTemp=szclkIN;
1320     szclkIN=flgcdgen;
1321     // [bllst,connectmat,clkconnect,cor,corinv,ok]=c_pass1(scs_m);
1322
1323     //Test for  ALWAYS_ACTIVE sblock (RN -25/06/07)
1324     ALWAYS_ACTIVE=%f;
1325     for blki=bllst
1326         if blki.dep_ut($) then
1327             ALWAYS_ACTIVE=%t;
1328             break;
1329         end
1330     end
1331     if ALWAYS_ACTIVE then
1332         CAPTEURS=[];
1333         for Ii=1:length(bllst)
1334             if part(bllst(Ii).sim(1),1:7)=="capteur" then
1335                 bllst(Ii).dep_ut($)=%t
1336                 //       elseif part(bllst(Ii).sim(1),1:10)=='actionneur' then
1337                 //         bllst(Ii).dep_ut($)=%t
1338             end
1339         end
1340     end
1341
1342     if ~ok then
1343         message("Sorry: problem in the pre-compilation step.")
1344         return
1345     end
1346     a=[];
1347     b=[];
1348     tt=[];
1349     howclk=[];
1350     allhowclk=[];
1351     allhowclk2=[];
1352     cap=[];
1353     act=[];
1354
1355     ///**********************************
1356     for i=1:size(bllst)
1357         // check for a scilab function block
1358         if type(bllst(i).sim(1)) == 13 then
1359             ok=%f;
1360             %cpr=list();
1361             message(_("Superblock should not contains any Scilab function block."))
1362             return
1363         end
1364
1365         for j=1:size(bllst)
1366             if (bllst(i).sim(1)=="actionneur"+string(j)) then
1367                 if tt<>i then
1368                     act=[act;i];
1369                     tt=i;
1370                 end
1371             elseif (bllst(i).sim(1)=="capteur"+string(j)) then
1372                 if tt<>i then
1373                     cap=[cap;i];
1374                     tt=i;
1375                 end
1376             elseif (bllst(i).sim(1)=="bidon") then
1377                 if tt<>i then
1378                     allhowclk=[allhowclk;i];
1379                     tt=i;
1380                 end
1381             elseif (bllst(i).sim(1)=="bidon2") then
1382                 if tt<>i then
1383                     allhowclk2=[allhowclk2;i];
1384                     tt=i;
1385                 end
1386             end
1387         end
1388     end
1389     ///**********************************
1390     if szclkIN>1 then
1391         //replace the N Event inputs by a fictious block with 2^N as many event
1392         //outputs
1393         output=ones((2^szclkIN)-1,1)
1394         bllst($+1)=scicos_model(sim=list("bidon",1),evtout=output,..
1395         blocktype="d",..
1396         firing=-output',dep_ut=[%f %f])
1397         corinv(size(bllst))=size(bllst)+1;
1398         howclk=size(bllst)
1399         // adjust the links accordingly
1400         for i=1:(2^szclkIN)-1
1401             vec=codebinaire(i,szclkIN)
1402             for j=1:szclkIN
1403                 if vec(j)*allhowclk(j)>=1 then
1404                     for k=1:size(clkconnect,1)
1405                         if clkconnect(k,1)==allhowclk(j) then
1406                             clkconnect=[clkconnect;[howclk i clkconnect(k,3:4)]]
1407                         end
1408                     end
1409                 end
1410             end
1411         end
1412     elseif szclkIN==[]&~ALWAYS_ACTIVE then
1413         //superblock has no Event input, add a fictious clock
1414         output=ones((2^(size(cap,"*")))-1,1)
1415         if (output == []) then
1416             output=0;
1417         end
1418         bllst($+1)=scicos_model(sim=list("bidon",1),evtout=output,..
1419         firing=-output,blocktype="d",dep_ut=[%f %f])
1420         corinv(size(bllst))=size(bllst)+1;
1421         howclk=size(bllst);
1422     elseif szclkIN==1  then
1423         howclk=allhowclk;
1424     end
1425
1426     //mise en ordre de clkconnect
1427     if szclkIN>1 then
1428         newclkconnect=clkconnect;
1429         clkconnect=[];
1430         for i=1:size(newclkconnect,1)-1
1431             if or(newclkconnect(i,:)<>newclkconnect(i+1,:)) then
1432                 clkconnect=[clkconnect;newclkconnect(i,:)]
1433             end
1434         end
1435         if or(newclkconnect($-1,:)<>newclkconnect($,:)) then
1436             clkconnect=[clkconnect;newclkconnect($,:)]
1437         end
1438
1439         //suppression des blocs bidons
1440         newclkconnect=clkconnect;nkt=[];
1441         for i=1:szclkIN
1442             for k=1:size(newclkconnect,1)
1443                 if newclkconnect(k,1)~=allhowclk(i) then
1444                     nkt=[nkt;newclkconnect(k,:)];
1445                 end
1446             end
1447             newclkconnect=nkt;
1448             nkt=[];
1449         end
1450         clkconnect=newclkconnect;
1451     end
1452
1453     //**************************************************
1454     // nouveau clkconnect avec liaisons sur les capteurs
1455     //**************************************************
1456
1457     //
1458     // Generate block activation fo C code
1459     //
1460     n=size(cap,1)
1461     if ~(szclkIN==[]) then
1462         // Activate sensors on each clock pulse.
1463         generatedConnection = [];
1464         for i=1:n
1465             if szclkIN>1 then
1466                 for j=1:(2^szclkIN)-1
1467                     generatedConnection = [generatedConnection ; [howclk j cap(i) 1]];
1468                 end
1469             elseif szclkIN==1 then
1470                 generatedConnection = [generatedConnection ; [howclk 1 cap(i) 1]];
1471             end
1472         end
1473         clkconnect = [clkconnect ; generatedConnection]
1474     elseif ~ALWAYS_ACTIVE then
1475         // Generate all possible activations for sensors, based on number of blocks.
1476         //codage de l'activation des capteurs dans le cas de l'heritage
1477         generatedConnection = [];
1478         for i=1:2^n-1
1479             vec=codebinaire(i,n);
1480             for j=1:n
1481                 if (vec(j)==1) then
1482                     generatedConnection = [generatedConnection ; [howclk i cap(j) 1]];
1483                 end
1484             end
1485         end
1486         clkconnect = [clkconnect ; generatedConnection]
1487     end
1488
1489     FIRING=[]
1490     for i=1:size(allhowclk2,1)
1491         j = find(clkconnect(:,3)==allhowclk2(i))
1492         if j<>[] then
1493             FIRING=[FIRING;bllst(clkconnect(j,1)).firing(clkconnect(j,2))]
1494         end
1495     end
1496
1497     Code_gene_run=[];
1498
1499     //** OLD GRAPHICS
1500     //** %windo=xget('window')
1501
1502     cpr=c_pass2(bllst,connectmat,clkconnect,cor,corinv)
1503
1504     if cpr==list() then ok=%f,return, end
1505
1506     //** Alan's patch 5/07/07: try to solve
1507     //   which blocks use work
1508     funs_save=cpr.sim.funs;
1509     funtyp_save=cpr.sim.funtyp;
1510     with_work = zeros(cpr.sim.nblk,1)
1511     for i=1:lstsize(cpr.sim.funs)
1512         if part(cpr.sim.funs(i),1:10)=="actionneur" then
1513             cpr.sim.funs(i) ="bidon"
1514             cpr.sim.funtyp(i) = 1
1515         elseif part(cpr.sim.funs(i),1:7)=="capteur" then
1516             cpr.sim.funs(i) ="bidon"
1517             cpr.sim.funtyp(i) = 1
1518         end
1519     end
1520
1521     //**
1522     //** retrieve all open Scilab windows with winsid()
1523     //**
1524
1525     BeforeCG_WinList = winsid();
1526
1527     ierr=execstr("[state,t]=scicosim(cpr.state,0,0,cpr.sim,"+..
1528     "''start'',scs_m.props.tol)","errcatch")
1529     if ierr==0 then
1530         for i=1:cpr.sim.nblk
1531             if state.iz(i)<>0 then
1532                 with_work(i)=%t
1533             end
1534         end
1535         ierr=execstr("[state,t]=scicosim(state,0,0,cpr.sim,"+..
1536         "''finish'',scs_m.props.tol)","errcatch")
1537     end
1538
1539     //**
1540     //** retrieve all open Scilab windows with winsid
1541     //** and close the additional windows open since first
1542     //**
1543
1544     //** This code does not cover 100% of the possible situations because the user can
1545     //** destroy one or more Scicos wins manually during this intermediate phase
1546     //** This code is 100% functional if the user does not close manually any win.
1547     //** TO BE updated in Scilab 5.0
1548
1549     AfterCG_WinList = winsid();
1550
1551     AfterCG_size = size(AfterCG_WinList); //** matrix
1552     AfterCG_size = AfterCG_size(2) ; //** vector length
1553
1554     BeforeCG_size = size(BeforeCG_WinList); //** matrix
1555     BeforeCG_size = BeforeCG_size(2) ; //** vector length
1556
1557     if (or(AfterCG_WinList<>BeforeCG_WinList)) & (AfterCG_size>BeforeCG_size) then
1558         //** means that a scope or other scicos object has created some
1559         //** output window
1560
1561         DiffCG_Winlist = AfterCG_WinList<>BeforeCG_WinList ; //** T/F mismatch
1562         DiffCG_Index = find(DiffCG_Winlist); //** recover the mismatched indexes only
1563
1564         for win_idx = DiffCG_Index
1565             delete( scf( AfterCG_WinList(win_idx) ) ) ; //** clear the spurious windows
1566         end
1567
1568     end
1569     //**------------- end of windows cleaning ----------------------------------------
1570
1571     cpr.sim.funs=funs_save;
1572     cpr.sim.funtyp=funtyp_save;
1573
1574     //** OLD GRAPHICS
1575     //** xset('window',%windo)
1576
1577     ///////////////////
1578     //les pointeurs de cpr :
1579     x=cpr.state.x;
1580     z=cpr.state.z;
1581     outtb=cpr.state.outtb;
1582
1583     //RN
1584     zcptr=cpr.sim.zcptr;
1585     ozptr=cpr.sim.ozptr;
1586     rpptr=cpr.sim.rpptr;
1587     ipptr=cpr.sim.ipptr;
1588     opptr=cpr.sim.opptr;
1589     funs=cpr.sim.funs;
1590     xptr=cpr.sim.xptr;
1591     zptr=cpr.sim.zptr;
1592     inpptr=cpr.sim.inpptr;
1593     inplnk=cpr.sim.inplnk;
1594     outptr=cpr.sim.outptr;
1595     outlnk=cpr.sim.outlnk;
1596     //@l@n lnkptr=cpr.sim.lnkptr;
1597     ordclk=cpr.sim.ordclk;
1598     funtyp=cpr.sim.funtyp;
1599     cord=cpr.sim.cord;
1600     ncord=size(cord,1);
1601     nblk=cpr.sim.nb;
1602     ztyp=cpr.sim.ztyp;
1603     clkptr=cpr.sim.clkptr
1604     labels=cpr.sim.labels;
1605     //taille totale de z : nztotal
1606     nztotal=size(z,1);
1607
1608     //*******************************
1609     //Checking if superblock is valid
1610     //*******************************
1611     msg=[]
1612     for i=1:length(funs)-1
1613         if funtyp(i)==3 then
1614             msg=[msg;"Type 3 block''s not allowed"]
1615             break;
1616         end
1617         if msg<>[] then message(msg),ok=%f,return,end
1618     end
1619
1620     //********************************************************
1621     // Change logical units for readf and writef blocks if any ???
1622     //********************************************************
1623     lunit=0
1624     for d=1:length(funs)
1625         if funs(d)=="readf"  then
1626             z(zptr(d)+2)=lunit
1627             lunit=lunit+1;
1628         elseif funs(d)=="writef"
1629             z(zptr(d)+1)=lunit
1630             lunit=lunit+1;
1631         end
1632     end
1633
1634     //***********************************
1635     // Get the name of the file
1636     //***********************************
1637     foo=3;
1638     okk=%f;
1639     rdnom="foo";
1640     rpat=pwd();
1641     [x,ierr] = fileinfo(rpat);
1642     S_IWRITE = 128; // mask write permission
1643     if (ierr <> 0 | bitand(x(2), S_IWRITE) == 0) then
1644         rpat = TMPDIR;
1645     end
1646
1647     libs="";
1648     label1=[hname;rpat+"/"+hname;""];
1649
1650     while %t do
1651         ok=%t  // to avoid infinite loop
1652         [okk,..
1653         rdnom,..
1654         rpat,..
1655         libs,..
1656         label1]=scicos_getvalue("Set code generator parameters :",..
1657         ["New block''s name :";
1658         "Created files Path :";
1659         "Other object files to link with (if any)"],..
1660         list("str",1,"str",1,"str",1),label1);
1661         if okk==%f then
1662             ok=%f
1663             return
1664         end
1665         rpat=stripblanks(rpat);
1666
1667         //** 1/07/06 Alan trying to solve multiple libraries during week-end
1668         if strindex(libs,"''")<>[] | strindex(libs,"""")<>[] then
1669             ierr=execstr("libs=evstr(libs)","errcatch")
1670             if ierr<>0  then
1671                 message(["Can''t solve other files to link"])
1672                 ok=%f;
1673                 return
1674             end
1675         end
1676
1677         //** Alan, I put a warning here in order to inform the user
1678         //** that the name of the superblock will change
1679         //** because the space char in name isn't allowed.
1680         if grep(rdnom," ")<>[] then
1681             message(["Superblock name cannot contains space characters.";
1682             "space chars will be automatically substituted by ""_"" "])
1683         end
1684         rdnom = strsubst(rdnom," ","_");
1685
1686         //** Put a warning here in order to inform the user
1687         //** that the name of the superblock will change
1688         //** because the "-" char could generate GCC problems
1689         //** (the C functions contains the name of the superblock).
1690         if grep(rdnom,"-")<>[] then
1691             message(["For full C compiler compatibility ";
1692             "Superblock name cannot contains ""-"" characters";
1693             """-"" chars will be automatically substituted by ""_"" "])
1694         end
1695         rdnom = strsubst(rdnom,"-","_");
1696
1697         dirinfo=fileinfo(rpat)
1698
1699         if dirinfo==[] then
1700             [pathrp,fnamerp,extensionrp]=fileparts(rpat)
1701             ok=mkdir(pathrp,fnamerp+extensionrp)
1702             if ~ok then
1703                 messagebox("Directory "+rpat+" cannot be created","modal","info");
1704             end
1705         elseif filetype(dirinfo(2))<>"Directory" then
1706             ok=%f;
1707             messagebox(rpat+" is not a directory","modal","error");
1708         end
1709
1710         if stripblanks(rdnom)==emptystr() then
1711             ok=%f;
1712             messagebox("sorry C file name not defined","modal","error");
1713         end
1714         if ok then break,end
1715     end
1716
1717     //////////////////////////////////////////////////
1718     maxnrpar=max(rpptr(2:$)-rpptr(1:$-1))
1719     maxnipar=max(ipptr(2:$)-ipptr(1:$-1))
1720     maxnx=max(xptr(2:$)-xptr(1:$-1))
1721     maxnz=max(zptr(2:$)-zptr(1:$-1))
1722     maxnin=max(inpptr(2:$)-inpptr(1:$-1))
1723     maxnout=max(outptr(2:$)-outptr(1:$-1))
1724     maxdim=[];
1725     for i=1:lstsize(cpr.state.outtb)
1726         maxdim=max(size(cpr.state.outtb(i)))
1727     end
1728     maxtotal=max([maxnrpar;maxnipar;maxnx;maxnz;maxnin;maxnout;maxdim]);
1729
1730     //************************************************************************
1731     //generate the call to the blocks and blocs simulation function prototypes
1732     //************************************************************************
1733     wfunclist=list();
1734     nbcap=0;nbact=0;capt=[];actt=[];Protostalone=[];Protos=[];
1735     dfuns=[]
1736     for i=1:length(funs)
1737         if or(i==act) then //block is an actuator
1738             nbact=nbact+1;
1739             [Code,actti,protoi]=call_actuator(i)
1740             wfunclist($+1)=[Code;"if(flag < 0 ) return(5 - flag);"]
1741             if nbact==1 then Protostalone=[Protostalone;"";protoi],end
1742             actt=[actt;actti]
1743         elseif or(i==cap) then //block is a sensor
1744             nbcap=nbcap+1;
1745             [Code,capti,protoi]=call_sensor(i)
1746             wfunclist($+1)=[Code;"if(flag < 0 ) return(5 - flag);"]
1747             if nbcap==1 then Protostalone=[Protostalone;"";protoi] ,end
1748             capt=[capt;capti]
1749         elseif funs(i)=="bidon"
1750             wfunclist($+1)=" "
1751         elseif funs(i)=="bidon2"
1752             wfunclist($+1)=" "
1753         else
1754             ki=find(funs(i)==dfuns)
1755             dfuns=[dfuns;funs(i)]
1756             //[Code,protoi]=call_block(i)
1757             [Code]=call_block4(i)
1758             if Code<>[] then
1759                 wfunclist($+1)=[Code;"if(flag < 0 ) return(5 - flag);"]
1760             else
1761                 wfunclist($+1)=" ";
1762             end
1763             if ki==[] then
1764                 Protos=[Protos;"";BlockProto(i)];
1765                 Protostalone=[Protostalone;"";BlockProto(i)];
1766             end
1767         end
1768     end
1769
1770     //**************************************
1771     //on prend en compte l'ordre des numerotation graphique des
1772     //capteur et des actionneur
1773     [junk,index]=gsort(-actt(:,$));
1774     actt=actt(index,1:$) ;
1775     [junk,index]=gsort(-capt(:,$));
1776     capt=capt(index,1:$) ;
1777
1778     //***************************************************
1779     //Compute the initial state and outtb (links)  values
1780     //***************************************************
1781     //petite modification pour uniformiser les fichiers capteurs
1782     //et actionneurs ???
1783     rdcpr=cpr.sim.funs;
1784     for r=1:length(cap),rdcpr(cap(r))="bidon";end
1785     for r=1:length(act),rdcpr(act(r))="bidon";end
1786     Total_rdcpr=cpr.sim;Total_rdcpr.funs=rdcpr;
1787     //
1788     tcur=0;
1789     tf=scs_m.props.tf;
1790     tolerances=scs_m.props.tol;
1791     //[state,t]=scicosim(cpr.state,tcur,tf,Total_rdcpr,'start',tolerances);
1792     //cpr.state=state;
1793     z=cpr.state.z;
1794     outtb=cpr.state.outtb;
1795     //[junk_state,t]=scicosim(cpr.state,tcur,tf,Total_rdcpr,'finish',tolerances);
1796
1797     //***********************************
1798     // Scilab and C files generation
1799     //***********************************
1800
1801     //** generate scilab interfacing function
1802     //   of the generated scicos block
1803     ok=gen_gui42();
1804
1805
1806     //** generate C files
1807     //   of the generated scicos block
1808     if ok then
1809         ok=gen_ccode42()
1810     end
1811
1812     //** Generates Makefile, loader
1813     //   and compile and link C files
1814
1815     //** def files to build
1816     files=[rdnom rdnom+"_void_io" rdnom+"_Cblocks"]
1817
1818     //** def files to build for standalone
1819     filestan=[rdnom+"_standalone" rdnom+"_act_sens_events" rdnom+"_Cblocks"]
1820
1821     if ok then
1822         ok = buildnewblock(rdnom,files,filestan,rpat,libs,"","")
1823     end
1824
1825     //**
1826     //if ok then ok=gen_loader(),end
1827
1828     if ok then
1829         //load the gui function
1830         exec(rpat+"/"+rdnom+"_c.sci");
1831         //Change diagram superblock to new generated block
1832         XX=update_block(XX);
1833         execstr(rdnom+"_c=resume("+rdnom+"_c)")
1834     end
1835
1836 endfunction
1837
1838 //BlockProto : generate prototype
1839 //            of a scicos block
1840 //
1841 //inputs : bk   : bloc index
1842 //
1843 //output : txt  :
1844 //
1845 //16/06/07 Author : A.Layec
1846 function [txt]=BlockProto(bk)
1847
1848     nin=inpptr(bk+1)-inpptr(bk);  //* number of input ports */
1849     nout=outptr(bk+1)-outptr(bk); //* number of output ports */
1850
1851     //**
1852     ftyp=funtyp(bk)
1853     if ftyp>2000 then ftyp=ftyp-2000,end
1854     if ftyp>1000 then ftyp=ftyp-1000,end
1855
1856     //** check function type
1857     if ftyp < 0 then //** ifthenelse eselect blocks
1858         txt = [];
1859         return;
1860     else
1861         if (ftyp<>0 & ftyp<>1 & ftyp<>2 & ftyp<>3 & ftyp<>4) then
1862             disp("types other than 0,1,2,3 or 4 are not yet supported.")
1863             txt = [];
1864             return;
1865         end
1866     end
1867
1868     //** add comment
1869     txt=[get_comment("proto_blk",list(funs(bk),funtyp(bk),bk,labels(bk)));]
1870
1871     select ftyp
1872         //** zero funtyp
1873     case 0 then
1874
1875         //*********** prototype definition ***********//
1876         txtp=["(int *, int *, double *, double *, double *, int *, double *, \";
1877         " int *, double *, int *, double *, int *,int *, int *, \";
1878         " double *, int *, double *, int *);"];
1879         if (funtyp(bk)>2000 & funtyp(bk)<3000)
1880             blank = get_blank("void "+funs(bk)+"(");
1881             txtp(1) = "void "+funs(bk)+txtp(1);
1882         elseif (funtyp(bk)<2000)
1883             txtp(1) = "void C2F("+funs(bk)+")"+txtp(1);
1884             blank = get_blank("void C2F("+funs(bk)+")");
1885         end
1886         txtp(2:$) = blank + txtp(2:$);
1887         txt = [txt;txtp];
1888         //*******************************************//
1889
1890
1891         //**
1892     case 1 then
1893
1894         //*********** prototype definition ***********//
1895         txtp=["(int *, int *, double *, double *, double *, int *, double *, \";
1896         " int *, double *, int *, double *, int *,int *, int *";]
1897         if (funtyp(bk)>2000 & funtyp(bk)<3000)
1898             blank = get_blank("void "+funs(bk)+"(");
1899             txtp(1) = "void "+funs(bk)+txtp(1);
1900         elseif (funtyp(bk)<2000)
1901             txtp(1) = "void C2F("+funs(bk)+")"+txtp(1);
1902             blank = get_blank("void C2F("+funs(bk)+")");
1903         end
1904         if nin>=1 | nout>=1 then
1905             txtp($)=txtp($)+", \"
1906             txtp=[txtp;""]
1907             if nin>=1 then
1908                 for k=1:nin
1909                     txtp($)=txtp($)+" double *, int * ,"
1910                 end
1911                 txtp($)=part(txtp($),1:length(txtp($))-1); //remove last ,
1912             end
1913             if nout>=1 then
1914                 if nin>=1 then
1915                     txtp($)=txtp($)+", \"
1916                     txtp=[txtp;""]
1917                 end
1918                 for k=1:nout
1919                     txtp($)=txtp($)+" double *, int * ,"
1920                 end
1921                 txtp($)=part(txtp($),1:length(txtp($))-1); //remove last ,
1922             end
1923         end
1924
1925         if ztyp(bk) then
1926             txtp($)=txtp($)+", \"
1927             txtp=[txtp;" double *,int *);"];
1928         else
1929             txtp($)=txtp($)+");";
1930         end
1931
1932         txtp(2:$) = blank + txtp(2:$);
1933         txt = [txt;txtp];
1934         //*******************************************//
1935
1936         //**
1937     case 2 then
1938
1939         //*********** prototype definition ***********//
1940
1941         txtp=["void "+funs(bk)+...
1942         "(int *, int *, double *, double *, double *, int *, double *, \";
1943         " int *, double *, int *, double *, int *, int *, int *, \"
1944         " double **, int *, int *, double **,int *, int *"];
1945         if ~ztyp(bk) then
1946             txtp($)=txtp($)+");";
1947         else
1948             txtp($)=txtp($)+", \";
1949             txtp=[txtp;
1950             " double *,int *);"]
1951         end
1952         blank = get_blank("void "+funs(bk));
1953         txtp(2:$) = blank + txtp(2:$);
1954         txt = [txt;txtp];
1955         //********************************************//
1956
1957         //**
1958     case 4 then
1959         txt=[txt;
1960         "void "+funs(bk)+"(scicos_block *, int );"];
1961
1962     end
1963 endfunction
1964
1965 //Generating the routine for actuators interfacing
1966 //
1967 //
1968 //Authors : R. Djenid, R. Nikoukhah, A. Layec
1969 //
1970 //actt=[i uk nuk_1 nuk_2 uk_t bllst(i).ipar]
1971 function Code=make_actuator(standalone)
1972     Call=["/*"
1973     "**    Copyright (c) 1989 - 2012 (INRIA)"
1974     "**    Copyright (c) 2011 - 2013 (Scilab Enterprises)"
1975     "**"
1976     "**    Generated by Code_Generation toolbox of Xcos with "+getversion()
1977     "**    Date : "+date()
1978     "*/"
1979     ""
1980     "/*"+part("-",ones(1,40))+" Actuators */";
1981     "void "+rdnom+"_actuator(int *flag, int *nport, int *nevprt, double *t, void *u, int *nu1, int *nu2, int *ut, int flag1)"]
1982
1983     comments=["     /*"
1984     "      * To be customized for standalone execution";
1985     "      * flag  : specifies the action to be done"
1986     "      * nport : specifies the  index of the Super Bloc"
1987     "      *         regular input (The input ports are numbered"
1988     "      *         from the top to the bottom )"
1989     "      * nevprt: indicates if an activation had been received"
1990     "      *         0 = no activation"
1991     "      *         1 = activation"
1992     "      * t     : the current time value"
1993     "      * u     : the vector inputs value"
1994     "      * nu1   : the input size 1"
1995     "      * nu2   : the input size 2"
1996     "      * ut    : the input type"
1997     "      * flag1 : learn mode (0 from terminal,1 from input file"
1998     "      */"]
1999
2000     dcl=["{"
2001     "  int j,k,l;"];
2002
2003     if standalone then
2004         a_actuator=["  /* skeleton to be customized */"
2005         "    switch (*flag) {"
2006         "    /* OutputUpdate (*flag==1) will be called on each iteration */"
2007         "    case 1 :"
2008         "      /*if(*nevprt>0) { get the input value */"
2009         "        switch (*ut) {"
2010         "        case 10 :"
2011         "          for (l=0;l<*nu2;l++) {"
2012         "            for (k=0;k<*nu1;k++) {"
2013         "              printf(""Actuator: time=%f, "+...
2014         "u(%d,%d) of actuator %d is %f "+...
2015         "\n"", \"
2016         "                     *t, k, l, *nport,"+...
2017         "*((double *) u+(k+l*(*nu1))));"
2018         "            }"
2019         "          }"
2020         "          break;"
2021         ""
2022         "        case 11 :"
2023         "          for (l=0;l<*nu2;l++) {"
2024         "            for (k=0;k<*nu1;k++) {"
2025         "              printf(""Actuator: time=%f, "+...
2026         "u(%d,%d) of actuator %d is %f,%f "+...
2027         "\n"", \"
2028         "                     *t, k, l, *nport,"+...
2029         "*((double *) u+(k+l*(*nu1))),"+...
2030         "*((double *) u+((*nu1)*(*nu2)+k+l*(*nu1))));"
2031         "            }"
2032         "          }"
2033         "          break;"
2034         ""
2035         "        case 81 :"
2036         "          for (l=0;l<*nu2;l++) {"
2037         "            for (k=0;k<*nu1;k++) {"
2038         "              printf(""Actuator: time=%f, "+...
2039         "u(%d,%d) of actuator %d is %i "+...
2040         "\n"", \"
2041         "                     *t, k, l, *nport,"+...
2042         "*((char *) u+(k+l*(*nu1))));"
2043         "            }"
2044         "          }"
2045         "          break;"
2046         ""
2047         "        case 82 :"
2048         "          for (l=0;l<*nu2;l++) {"
2049         "            for (k=0;k<*nu1;k++) {"
2050         "              printf(""Actuator: time=%f, "+...
2051         "u(%d,%d) of actuator %d is %hd "+...
2052         "\n"", \"
2053         "                     *t, k, l, *nport,"+...
2054         "*((short *) u+(k+l*(*nu1))));"
2055         "            }"
2056         "          }"
2057         "          break;"
2058         ""
2059         "        case 84 :"
2060         "          for (l=0;l<*nu2;l++) {"
2061         "            for (k=0;k<*nu1;k++) {"
2062         "              printf(""Actuator: time=%f, "+...
2063         "u(%d,%d) of actuator %d is %ld "+...
2064         "\n"", \"
2065         "                     *t, k, l, *nport,"+...
2066         "*((long *) u+(k+l*(*nu1))));"
2067         "            }"
2068         "          }"
2069         "          break;"
2070         ""
2071         "        case 811 :"
2072         "          for (l=0;l<*nu2;l++) {"
2073         "            for (k=0;k<*nu1;k++) {"
2074         "              printf(""Actuator: time=%f, "+...
2075         "u(%d,%d) of actuator %d is %d "+...
2076         "\n"", \"
2077         "                     *t, k, l, *nport,"+...
2078         "*((unsigned char *) u+(k+l*(*nu1))));"
2079         "            }"
2080         "          }"
2081         "          break;"
2082         ""
2083         "        case 812 :"
2084         "          for (l=0;l<*nu2;l++) {"
2085         "            for (k=0;k<*nu1;k++) {"
2086         "              printf(""Actuator: time=%f, "+...
2087         "u(%d,%d) of actuator %d is %hu "+...
2088         "\n"", \"
2089         "                     *t, k, l, *nport,"+...
2090         "*((unsigned short *) u+(k+l*(*nu1))));"
2091         "            }"
2092         "          }"
2093         "          break;"
2094         ""
2095         "        case 814 :"
2096         "          for (l=0;l<*nu2;l++) {"
2097         "            for (k=0;k<*nu1;k++) {"
2098         "              printf(""Actuator: time=%f, "+...
2099         "u(%d,%d) of actuator %d is %lu "+...
2100         "\n"", \"
2101         "                     *t, k, l, *nport,"+...
2102         "*((unsigned long *) u+(k+l*(*nu1))));"
2103         "            }"
2104         "          }"
2105         "          break;"
2106         "        }"
2107         "      /*} */"
2108         "      break;"
2109         "    case 4 : /* actuator initialisation */"
2110         "      /* do whatever you want to initialize the actuator */"
2111         "      break;"
2112         "    case 5 : /* actuator ending */"
2113         "      /* do whatever you want to end the actuator */"
2114         "      break;"
2115         "    }"]
2116     else
2117         a_actuator=[]
2118     end
2119
2120     // pour fprintf
2121     nc=size(act,"*") // Alan : d'o? viens act ?????
2122     // reponse : de do_compile_superblock!
2123     typ=["""%f "]; //time
2124     for i=1:nc
2125         typ($)=typ($)+""" \"
2126         typ=[typ;""""];
2127         for j=1:sum(actt(i,3)*actt(i,4))
2128             //typ=typ+'%f ';
2129             typ($)=typ($)+scs_c_n2c_fmt(actt(i,5))+" ";
2130         end
2131     end
2132     typ($)=typ($)+"\n"", \"
2133     typ(1)="    fprintf(fprw,"+typ(1);
2134     bl    ="                 ";
2135     if size(typ,1) <> 1 then
2136         typ(2:$) = bl+typ(2:$);
2137     end
2138     //Code1='    fprintf(fprw, '"'+typ+' \n'",*t'
2139     Code1=[typ;bl+"*t"];
2140     //actt=[i uk nuk_1 nuk_2 uk_t bllst(i).ipar]
2141     for i=1:size(actt,1)
2142         ni=actt(i,3)*actt(i,4) // dimension of ith output
2143         Code1($)=Code1($)+","
2144         Code1=[Code1;bl];
2145         for j=1:ni
2146             if actt(i,5)<>11 then
2147                 Code1($)=Code1($)+...
2148                 "*((("+scs_c_n2c_typ(actt(i,5))+" *)("+...
2149                 rdnom+"_block_outtbptr+"+string(actt(i,2)-1)+"))"+...
2150                 "+"+string(j-1)+")";
2151             else //CAS CMPLX
2152                 Code1($)=Code1($)+...
2153                 "*((("+scs_c_n2c_typ(actt(i,5))+" *)("+...
2154                 rdnom+"_block_outtbptr+"+string(actt(i,2)-1)+"))"+...
2155                 "+"+string((j-1))+"), "+...
2156                 "*((("+scs_c_n2c_typ(actt(i,5))+" *)("+...
2157                 rdnom+"_block_outtbptr+"+string(actt(i,2)-1)+"))"+...
2158                 "+"+string(ni+(j-1))+")";
2159             end
2160             if j<>ni then
2161                 Code1($)=Code1($)+", ";
2162             end
2163         end
2164     end
2165     Code1($)=Code1($)+");"
2166
2167     Code=[]
2168
2169     if nc==1|~standalone then
2170         Code=[Call
2171         comments
2172         dcl
2173         "  if (flag1 == 0) {"
2174         a_actuator
2175         "  }"
2176         "  else if (flag1 == 1) {"
2177         "    if (*flag == 4 && *nport == 1) {"
2178         "      fprw=fopen(output,'"wt'");"
2179         "      if( fprw == NULL )"
2180         "        {"
2181         "          printf('"Error opening file: %s\n'", output);"
2182         "          return;"
2183         "        }"
2184         "    }else if (*flag == 2 /* && *nevprt>0 */) {"
2185         Code1
2186         "    }else if (*flag == 5 && *nport == 1) {"
2187         "      fclose(fprw);"
2188         "    }"
2189         "  }"
2190         "}"]
2191     elseif nc>1 then
2192         S="  switch (*nport) {"
2193         for k=1:nc
2194             S=[S;
2195             "  case "+string(k)+" :/* Port number "+string(k)+" ----------*/"
2196             "  "+a_actuator
2197             "  break;"]
2198         end
2199         S=[S;"  }"]
2200
2201         Code=[Code
2202         Call
2203         comments
2204         dcl
2205         "  if (flag1 == 0){"
2206         S
2207         "  }"
2208         "  else if (flag1 == 1) {"
2209         "    if (*flag == 4 && *nport == 1) {"
2210         "      fprw=fopen(output,'"wt'");"
2211         "      if( fprw == NULL ) {"
2212         "        printf('"Error opening file: %s\n'", output);"
2213         "        return;"
2214         "        }"
2215         "    }"
2216         "    else if (*flag == 2 /*&& *nevprt>0*/ ) {"
2217         Code1
2218         "    }"
2219         "    else if (*flag == 5 && *nport == 1) {"
2220         "      fclose(fprw);"
2221         "    }"
2222         "  }"
2223         "}"]
2224     end
2225 endfunction
2226
2227 //** Generates the scicos computational function
2228 //   associated with the block
2229 //12/07/07 Alan Layec
2230 function make_computational42(filename)
2231     z=cpr.state.z;
2232     oz=cpr.state.oz;
2233     outtb=cpr.state.outtb;
2234     tevts=cpr.state.tevts;
2235     evtspt=cpr.state.evtspt;
2236     outptr=cpr.sim.outptr;
2237     funtyp=cpr.sim.funtyp;
2238     clkptr=cpr.sim.clkptr;
2239     ordptr=cpr.sim.ordptr;
2240     pointi=cpr.state.pointi;
2241     ztyp=cpr.sim.ztyp;
2242     zcptr=cpr.sim.zcptr;
2243     zptr=cpr.sim.zptr;
2244     ozptr=cpr.sim.ozptr;
2245     opptr=cpr.sim.opptr;
2246     opar=cpr.sim.opar;
2247     rpptr=cpr.sim.rpptr;
2248     ipptr=cpr.sim.ipptr;
2249     inpptr=cpr.sim.inpptr;
2250     funs=cpr.sim.funs;
2251     xptr=cpr.sim.xptr;
2252     modptr=cpr.sim.modptr;
2253     inplnk=cpr.sim.inplnk;
2254     nblk=cpr.sim.nb;
2255     outlnk=cpr.sim.outlnk;
2256     oord=cpr.sim.oord;
2257     zord=cpr.sim.zord;
2258     iord=cpr.sim.iord;
2259     noord=size(cpr.sim.oord,1);
2260     nzord=size(cpr.sim.zord,1);
2261     niord=size(cpr.sim.iord,1);
2262
2263     Indent="  ";
2264     Indent2=Indent+Indent;
2265     BigIndent="          ";
2266
2267     nZ=size(z,"*"); //** index of work in z
2268     nO=lstsize(oz); //** index of outtb in oz
2269
2270     stalone=%f
2271
2272     // Open file to write in
2273     fd = mopen(filename, "wt");
2274
2275     mputl(["/*"
2276     "**    SCILAB Computational function"
2277     "**    Copyright (c) 1989 - 2012 (INRIA)"
2278     "**    Copyright (c) 2011 - 2013 (Scilab Enterprises)"
2279     "**"
2280     "**    Generated by Code_Generation toolbox of Xcos with "+getversion()
2281     "**    Date : "+date()
2282     "*/"
2283     ""
2284     "/* ---- Headers ---- */"
2285     "#include <stdio.h>"
2286     "#include <stdlib.h>"
2287     "#include <memory.h>"
2288     "#include <string.h>"
2289     "#include ""machine.h"" "
2290     "#include ""scicos.h"" "
2291     "#include ""scicos_malloc.h"" "
2292     "#include ""scicos_free.h"" "
2293     ""], fd);
2294
2295     if getos() == "Windows" then
2296
2297         mputl([" "
2298         "#define max(a,b) ((a) >= (b) ? (a) : (b))"
2299         "#define min(a,b) ((a) <= (b) ? (a) : (b))"
2300         " "
2301         ], fd);
2302     end
2303
2304     mputl([Protos ; ""], fd);
2305
2306     mputl(["/* Table of constant values */"
2307     "static int nrd_"+string(0:maxtotal)'+" = "+string(0:maxtotal)'+";"], fd);
2308
2309     if maxtotal<10 then
2310         mputl("static int nrd_10 = 10;", fd);
2311     end
2312     if maxtotal<11 then
2313         mputl("static int nrd_11 = 11;", fd);
2314     end
2315
2316     if maxtotal<81 then
2317         mputl("static int nrd_81 = 81;", fd);
2318     end
2319     if maxtotal<82 then
2320         mputl("static int nrd_82 = 82;", fd);
2321     end
2322     if maxtotal<84 then
2323         mputl("static int nrd_84 = 84;", fd);
2324     end
2325     if maxtotal<811 then
2326         mputl("static int nrd_811 = 811;", fd);
2327     end
2328     if maxtotal<812 then
2329         mputl("static int nrd_812 = 812;", fd);
2330     end
2331     if maxtotal<814 then
2332         mputl("static int nrd_814 = 814;", fd);
2333     end
2334
2335     mputl([""
2336     "/* Some general static variables */"
2337     "static double zero=0;"
2338     "static double w[1];"
2339     "static int aaa=0, bbb=0;"], fd);
2340
2341     mputl([""
2342     "/*"+part("-",ones(1,40))+" Block Computational function */ ";
2343     "int  "+rdnom+"(scicos_block *block, int flag)"
2344     "{"
2345     "  /* declaration of local variables for that block struct */"
2346     "  double* z      = block->z;"
2347     "  void **ozptr   = block->ozptr;"
2348     "  void **oparptr = block->oparptr;"
2349     "  int nopar      = block->nopar;"
2350     "  double* x      = block->x;"
2351     "  double* xd     = block->xd;"
2352     "  double* res    = block->res;"
2353     "  void** u       = block->inptr;"
2354     "  void** y       = block->outptr;"
2355     "  int nevprt     = block->nevprt;"
2356     "  double* rpar   = block->rpar;"
2357     "  int nrpar      = block->nrpar;"
2358     "  int* ipar      = block->ipar;"
2359     "  int nipar      = block->nipar;"
2360     "  double* g      = block->g;"
2361     "  int* mode      = block->mode;"
2362     "  void **work    = block->work;"
2363     ""
2364     "  double t     = get_scicos_time();"
2365     "  int    phase = get_phase_simulation();"
2366     ""
2367     "  int kf = 0;"
2368     "  int i = 0;"
2369     "  int* reentryflag = NULL;"
2370     ""
2371     "  double *args[100];"
2372     "  int local_flag;"
2373     "  int nport;"
2374     "  void **"+rdnom+"_block_outtbptr;"
2375     "  scicos_block *block_"+rdnom+";"
2376     ""
2377     "  /*  work of blocks are catenated at the end of z */"
2378     "  work = (void **)(z+"+string(nZ)+");"
2379     ""
2380     "  /*  "+rdnom+"_block_outtbptr is catenated at the end of oz */"
2381     "  "+rdnom+"_block_outtbptr = (void **)(ozptr+"+string(nO)+");"
2382     ""
2383     "  /* struct of all blocks are stored in work of that block struct */"
2384     "  block_"+rdnom+"=(scicos_block*) *block->work;"
2385     ""
2386     "  /* Copy inputs in the block outtb */"], fd);
2387
2388
2389     for i=1:size(capt,1)
2390         ni=capt(i,3)*capt(i,4); //** dimension of ith input
2391         if capt(i,5)<>11 then
2392             mputl(["  memcpy(*("+rdnom+"_block_outtbptr+"+string(capt(i,2)-1)+"),"+...
2393             "*(u+"+string(capt(i,6)-1)+"),"+...
2394             string(ni)+"*sizeof("+mat2c_typ(capt(i,5))+"));"], fd);
2395         else //** Cas cmplx
2396             mputl(["  memcpy(*("+rdnom+"_block_outtbptr+"+string(capt(i,2)-1)+"),"+...
2397             "*(u+"+string(capt(i,6)-1)+"),"+...
2398             string(2*ni)+"*sizeof("+mat2c_typ(capt(i,5))+"));"], fd);
2399         end
2400     end
2401
2402     mputl([""
2403     "  if (flag != 4 && flag != 6 && flag != 5){"
2404     "    reentryflag=(int*) ((scicos_block *)(*block->work)+"+string(nblk)+");"
2405     "    if (*reentryflag==0){"
2406     "      *reentryflag=1;"], fd);
2407
2408     for kf=1:nblk
2409         nin=inpptr(kf+1)-inpptr(kf);  //** number of input ports
2410         nout=outptr(kf+1)-outptr(kf); //** number of output ports
2411         nx=xptr(kf+1)-xptr(kf);
2412         ng=zcptr(kf+1)-zcptr(kf);
2413         nmode=modptr(kf+1)-modptr(kf);
2414
2415         //** add comment
2416         mputl([""
2417         "      "+get_comment("set_blk",list(funs(kf),funtyp(kf),kf,labels(kf)));], fd);
2418
2419         for k=1:nin
2420             lprt=inplnk(inpptr(kf)-1+k);
2421             mputl(["      block_"+rdnom+"["+string(kf-1)+"].inptr["+string(k-1)+"]  = "+...
2422             rdnom+"_block_outtbptr["+string(lprt-1)+"];"], fd);
2423         end
2424         for k=1:nout
2425             lprt=outlnk(outptr(kf)-1+k);
2426             mputl(["      block_"+rdnom+"["+string(kf-1)+"].outptr["+string(k-1)+"] = "+...
2427             rdnom+"_block_outtbptr["+string(lprt-1)+"];"], fd);
2428         end
2429         mputl(["      block_"+rdnom+"["+string(kf-1)+"].z         = &(z["+...
2430         string(zptr(kf)-1)+"]);"], fd);
2431         if nx <> 0 then
2432             mputl(["      block_"+rdnom+"["+string(kf-1)+"].x         = &(x["+...
2433             string(xptr(kf)-1)+"]);"], fd);
2434         else
2435             mputl(["      block_"+rdnom+"["+string(kf-1)+"].x         = &(zero);"
2436             "      block_"+rdnom+"["+string(kf-1)+"].xd        = w;"], fd);
2437         end
2438         if ng <> 0 then
2439             mputl(["      block_"+rdnom+"["+string(kf-1)+"].g         = &(g["+...
2440             string(zcptr(kf)-1)+"]);"], fd);
2441         else
2442             mputl(["      block_"+rdnom+"["+string(kf-1)+"].g         = &(zero);";], fd);
2443         end
2444         if nmode <> 0 then
2445             mputl(["      block_"+rdnom+"["+string(kf-1)+"].mode      = &(mode["+...
2446             string(modptr(kf)-1)+"]);"], fd);
2447         end
2448         if (part(funs(kf),1:7) ~= "capteur" &...
2449             part(funs(kf),1:10) ~= "actionneur" &...
2450             funs(kf) ~= "bidon" &...
2451             funs(kf) ~= "bidon2") then
2452             //** rpar **//
2453             if (rpptr(kf+1)-rpptr(kf)>0) then
2454                 mputl(["      block_"+rdnom+"["+string(kf-1)+"].rpar      = &(rpar["+...
2455                 string(rpptr(kf)-1)+"]);"], fd);
2456             end
2457             //** ipar **//
2458             if (ipptr(kf+1)-ipptr(kf)>0) then
2459                 mputl(["      block_"+rdnom+"["+string(kf-1)+"].ipar      = &(ipar["+...
2460                 string(ipptr(kf)-1)+"]);"], fd);
2461             end
2462             //** opar **//
2463             if (opptr(kf+1)-opptr(kf)>0) then
2464                 nopar = opptr(kf+1)-opptr(kf);
2465                 for k=1:nopar
2466                     mputl(["      block_"+rdnom+"["+string(kf-1)+"].oparptr["+string(k-1)+...
2467                     "] = oparptr["+string(opptr(kf)-1+k-1)+"];"], fd);
2468                 end
2469             end
2470             //** oz **//
2471             if (ozptr(kf+1)-ozptr(kf)>0) then
2472                 noz = ozptr(kf+1)-ozptr(kf);
2473                 for k=1:noz
2474                     mputl(["      block_"+rdnom+"["+string(kf-1)+"].ozptr["+string(k-1)+...
2475                     "]  = ozptr["+string(ozptr(kf)-1+k-1)+"];"], fd);
2476                 end
2477             end
2478         end
2479         mputl(["      block_"+rdnom+"["+string(kf-1)+"].work      ="+...
2480         " (void **)(((double *)work)+"+string(kf-1)+");"], fd);
2481     end
2482
2483     mputl(["    }"
2484     "  }"
2485     ""
2486     ], fd);
2487
2488     /////////////////////////////////////////////
2489
2490
2491     //** find activation number
2492     blks=find(funtyp>-1);
2493     evs=[];
2494
2495     for blk=blks
2496         for ev=clkptr(blk):clkptr(blk+1)-1
2497             if funs(blk)=="bidon" then
2498                 if ev > clkptr(howclk) -1
2499                     evs=[evs,ev];
2500                 end
2501             end
2502         end
2503     end
2504
2505     //** flag 0
2506     flag = 0;
2507
2508     block_has_output=%f
2509     txt   = [];
2510     txt22 = [];
2511
2512     for kf=1:nblk
2513         nx=xptr(kf+1)-xptr(kf);
2514         if nx <> 0 then
2515             txt=[txt;
2516             "    block_"+rdnom+"["+string(kf-1)+"].xd=&(xd["+...
2517             string(xptr(kf)-1)+"]);"]
2518         end
2519         if part(funs(kf),1:10) == "actionneur" then
2520             block_has_output=%t
2521         end
2522     end
2523     if txt<>[] then
2524         txt22=[txt22;
2525         "    "+get_comment("update_xd",list())
2526         txt
2527         ""
2528         ]
2529     end
2530     txt22=[txt22;
2531     write_code_odoit(1) //** first pass
2532     write_code_odoit(0) //** second pass
2533     ]
2534
2535     if txt22<>[] then
2536         mputl(["  if (flag == 0) { "+get_comment("flag",list(flag))
2537         txt22
2538         "  }"], fd);
2539     end
2540
2541     //** flag 1,2,3
2542     for flag=[1,2,3]
2543
2544         txt3=[]
2545
2546         //** continuous time blocks must be activated
2547         //** for flag 1
2548         if flag==1 then
2549             txt = write_code_cdoit(flag);
2550
2551             if txt <> [] then
2552                 txt3=[txt3;
2553                 Indent+"  switch (nevprt) {"
2554                 ];
2555                 txt3=[txt3;
2556                 Indent2+"  case "+string(0)+" : "+...
2557                 get_comment("ev",list(0))
2558                 "    "+txt;
2559                 ];
2560                 txt3=[txt3;"      break;";""]
2561             end
2562         else
2563             txt=[];
2564         end
2565
2566         //** blocks with input discrete event must be activated
2567         //** for flag 1, 2 and 3
2568         if size(evs,2)>=1 then
2569             txt4=[]
2570             //**
2571             for ev=evs
2572                 txt2=write_code_doit(ev,flag);
2573                 if txt2<>[] then
2574                     //** adjust event number because of bidon block
2575                     new_ev=ev-(clkptr(howclk)-1)
2576                     //**
2577                     txt4=[txt4;
2578                     Indent2+["  case "+string(new_ev)+" : "+...
2579                     get_comment("ev",list(new_ev))
2580                     txt2];
2581                     "      break;";""]
2582                 end
2583             end
2584
2585             //**
2586             if txt == [] then
2587                 if txt4 <> [] then
2588                     txt3=[txt3;
2589                     Indent+"  switch (nevprt) {"
2590                     txt4
2591                     "    }"];
2592                 end
2593             else
2594                 txt3=[txt3;
2595                 txt4]
2596             end
2597         end
2598
2599         //**
2600         if txt <> [] then
2601             txt3=[txt3;
2602             "    }"];
2603         end
2604
2605         //**
2606         if txt3<>[] then
2607             if flag==1 & txt22==[] then
2608                 mputl(["  if (flag == "+string(flag)+") { "+...
2609                 get_comment("flag",list(flag))
2610                 txt3
2611                 "  }"], fd);
2612             else
2613                 mputl(["  else if (flag == "+string(flag)+") { "+...
2614                 get_comment("flag",list(flag))
2615                 txt3
2616                 "  }"], fd);
2617             end
2618         end
2619     end
2620
2621     //** flag 9
2622     ng=zcptr($)-1;
2623     if (ng ~= 0) then
2624         flag = 9;
2625         mputl(["  else if (flag == "+string(flag)+") { "+...
2626         get_comment("flag",list(flag))], fd);
2627
2628         txt=[]
2629         for kf=1:nblk
2630             if zcptr(kf+1)-zcptr(kf) <> 0 then
2631                 txt=[txt;
2632                 "    block_"+rdnom+"["+string(kf-1)+"].g="+...
2633                 "&(g["+string(zcptr(kf)-1)+"]);"]
2634             end
2635         end
2636
2637         mputl(["    "+get_comment("update_g",list())
2638         txt
2639         ""
2640         write_code_zdoit()
2641         ], fd);
2642
2643         mputl(["  }"], fd);
2644     end
2645
2646     //** flag 4
2647     mputl(["  else if (flag == 4) { "+get_comment("flag",list(4))
2648     "    if ((*block->work=scicos_malloc(sizeof(scicos_block)*"+...
2649     string(nblk)+"+sizeof(int)))== NULL) return 0;";
2650     "    reentryflag=(int*) ((scicos_block *)(*block->work)+"+string(nblk)+");"
2651     "    *reentryflag=0;"
2652     "    block_"+rdnom+"=(scicos_block*) *block->work;"], fd);
2653
2654     for kf=1:nblk
2655         nin=inpptr(kf+1)-inpptr(kf);  //* number of input ports */
2656         nout=outptr(kf+1)-outptr(kf); //* number of output ports */
2657         nx=xptr(kf+1)-xptr(kf);
2658         ng=zcptr(kf+1)-zcptr(kf);
2659         nmode=modptr(kf+1)-modptr(kf);
2660
2661         //** add comment
2662         mputl([""
2663         "    "+get_comment("set_blk",list(funs(kf),funtyp(kf),kf,labels(kf)));], fd);
2664
2665         mputl(["    block_"+rdnom+"["+string(kf-1)+"].type   = "+...
2666         string(funtyp(kf))+";";
2667         "    block_"+rdnom+"["+string(kf-1)+"].ztyp   = "+...
2668         string(ztyp(kf))+";";
2669         "    block_"+rdnom+"["+string(kf-1)+"].ng     = "+...
2670         string(zcptr(kf+1)-zcptr(kf))+";"], fd);
2671
2672         if nx <> 0 then
2673             mputl(["    block_"+rdnom+"["+string(kf-1)+"].nx     = "+...
2674             string(nx)+";";
2675             "    block_"+rdnom+"["+string(kf-1)+"].x      = &(x["+...
2676             string(xptr(kf)-1)+"]);"], fd);
2677         else
2678             mputl(["    block_"+rdnom+"["+string(kf-1)+"].nx     = 1;";
2679             "    block_"+rdnom+"["+string(kf-1)+"].x      = &(zero);"
2680             "    block_"+rdnom+"["+string(kf-1)+"].xd     = w;"], fd);
2681         end
2682
2683         if ng <> 0 then
2684             mputl(["    block_"+rdnom+"["+string(kf-1)+"].g      = &(g["+...
2685             string(zcptr(kf)-1)+"]);"], fd);
2686         else
2687             mputl(["    block_"+rdnom+"["+string(kf-1)+"].g      = &(zero);";], fd);
2688         end
2689         if nmode <> 0 then
2690             mputl(["    block_"+rdnom+"["+string(kf-1)+"].mode   = &(mode["+...
2691             string(modptr(kf)-1)+"]);"], fd);
2692         end
2693         mputl(["    block_"+rdnom+"["+string(kf-1)+"].nz     = "+...
2694         string(zptr(kf+1)-zptr(kf))+";";
2695         "    block_"+rdnom+"["+string(kf-1)+"].noz    = "+...
2696         string(ozptr(kf+1)-ozptr(kf))+";";
2697         "    block_"+rdnom+"["+string(kf-1)+"].nrpar  = "+...
2698         string(rpptr(kf+1)-rpptr(kf))+";";
2699         "    block_"+rdnom+"["+string(kf-1)+"].nopar  = "+...
2700         string(opptr(kf+1)-opptr(kf))+";";
2701         "    block_"+rdnom+"["+string(kf-1)+"].nipar  = "+...
2702         string(ipptr(kf+1)-ipptr(kf))+";"
2703         "    block_"+rdnom+"["+string(kf-1)+"].nin    = "+...
2704         string(inpptr(kf+1)-inpptr(kf))+";";
2705         "    block_"+rdnom+"["+string(kf-1)+"].nout   = "+...
2706         string(outptr(kf+1)-outptr(kf))+";";
2707         "    block_"+rdnom+"["+string(kf-1)+"].nevout = "+...
2708         string(clkptr(kf+1)-clkptr(kf))+";";
2709         "    block_"+rdnom+"["+string(kf-1)+"].nmode  = "+...
2710         string(modptr(kf+1)-modptr(kf))+";"], fd);
2711
2712         mputl(["    if ((block_"+rdnom+"["+string(kf-1)+"].evout  = "+...
2713         "calloc(block_"+rdnom+"["+string(kf-1)+"].nevout,sizeof(double)))== NULL) return 0;"], fd);
2714
2715         //***************************** input port *****************************//
2716         //** alloc insz/inptr **//
2717         mputl(["    if ((block_"+rdnom+"["+string(kf-1)+"].insz   = "+...
2718         "malloc(3*sizeof(int)*block_"+rdnom+"["+string(kf-1)+"].nin))== NULL) return 0;";
2719         "    if ((block_"+rdnom+"["+string(kf-1)+"].inptr  = "+...
2720         "malloc(sizeof(void *)*block_"+rdnom+"["+string(kf-1)+"].nin))== NULL) return 0;"], fd);
2721
2722         //** inptr **//
2723         for k=1:nin
2724             lprt=inplnk(inpptr(kf)-1+k);
2725             mputl(["    block_"+rdnom+"["+string(kf-1)+"].inptr["+string(k-1)+"]  = "+...
2726             rdnom+"_block_outtbptr["+string(lprt-1)+"];"], fd);
2727         end
2728
2729         //** 1st dim **//
2730         for k=1:nin
2731             lprt=inplnk(inpptr(kf)-1+k);
2732             mputl(["    block_"+rdnom+"["+string(kf-1)+"].insz["+string((k-1))+"]   = "+...
2733             string(size(outtb(lprt),1))+";"], fd);
2734         end
2735
2736         //** 2dn dim **//
2737         for k=1:nin
2738             lprt=inplnk(inpptr(kf)-1+k);
2739             mputl(["    block_"+rdnom+"["+string(kf-1)+"].insz["+string((k-1)+nin)+"]   = "+...
2740             string(size(outtb(lprt),2))+";"], fd);
2741         end
2742
2743         //** typ **//
2744         for k=1:nin
2745             lprt=inplnk(inpptr(kf)-1+k);
2746             mputl(["    block_"+rdnom+"["+string(kf-1)+"].insz["+string((k-1)+2*nin)+"]   = "+...
2747             mat2scs_c_typ(outtb(lprt))+";"], fd);
2748         end
2749         //**********************************************************************//
2750
2751         //***************************** output port *****************************//
2752         //** alloc outsz/outptr **//
2753         mputl(["    if ((block_"+rdnom+"["+string(kf-1)+"].outsz  = "+...
2754         "malloc(3*sizeof(int)*block_"+rdnom+"["+string(kf-1)+"].nout))== NULL) return 0;";
2755         "    if ((block_"+rdnom+"["+string(kf-1)+"].outptr = "+...
2756         "malloc(sizeof(void*)*block_"+rdnom+"["+string(kf-1)+"].nout))== NULL) return 0;"], fd);
2757
2758         //** outptr **//
2759         for k=1:nout
2760             lprt=outlnk(outptr(kf)-1+k);
2761             mputl(["    block_"+rdnom+"["+string(kf-1)+"].outptr["+string(k-1)+"] = "+...
2762             rdnom+"_block_outtbptr["+string(lprt-1)+"];"], fd);
2763         end
2764
2765         //** 1st dim **//
2766         for k=1:nout
2767             lprt=outlnk(outptr(kf)-1+k);
2768             mputl(["    block_"+rdnom+"["+string(kf-1)+"].outsz["+string((k-1))+...
2769             "]  = "+string(size(outtb(lprt),1))+";"], fd);
2770         end
2771
2772         //** 2dn dim **//
2773         for k=1:nout
2774             lprt=outlnk(outptr(kf)-1+k);
2775             mputl(["    block_"+rdnom+"["+string(kf-1)+"].outsz["+string((k-1)+nout)+...
2776             "]  = "+string(size(outtb(lprt),2))+";"], fd)
2777         end
2778
2779         //** typ **//
2780         for k=1:nout
2781             lprt=outlnk(outptr(kf)-1+k);
2782             mputl(["    block_"+rdnom+"["+string(kf-1)+"].outsz["+string((k-1)+2*nout)+...
2783             "]  = "+mat2scs_c_typ(outtb(lprt))+";"], fd);
2784         end
2785         //**********************************************************************//
2786
2787         mputl(["    block_"+rdnom+"["+string(kf-1)+"].z         = &(z["+...
2788         string(zptr(kf)-1)+"]);"], fd);
2789
2790         //***************************** object state *****************************//
2791         if (ozptr(kf+1)-ozptr(kf)>0) then
2792             noz = ozptr(kf+1)-ozptr(kf);
2793             mputl(["    if ((block_"+rdnom+"["+string(kf-1)+"].ozptr = "+...
2794             "malloc(sizeof(void *)*block_"+rdnom+"["+string(kf-1)+"].noz))== NULL) return 0;";
2795             "    if ((block_"+rdnom+"["+string(kf-1)+"].ozsz  = "+...
2796             "malloc(2*sizeof(int)*block_"+rdnom+"["+string(kf-1)+"].noz))== NULL) return 0;";
2797             "    if ((block_"+rdnom+"["+string(kf-1)+"].oztyp = "+...
2798             "malloc(sizeof(int)*block_"+rdnom+"["+string(kf-1)+"].noz))== NULL) return 0;";], fd);
2799
2800             //** ozptr **//
2801             for k=1:noz
2802                 mputl(["    block_"+rdnom+"["+string(kf-1)+"].ozptr["+string(k-1)+...
2803                 "]  = ozptr["+string(ozptr(kf)-1+k-1)+"];"], fd);
2804             end
2805
2806             //** 1st dim **//
2807             for k=1:noz
2808                 mputl(["    block_"+rdnom+"["+string(kf-1)+"].ozsz["+string(k-1)+...
2809                 "]   = "+string(size(oz(ozptr(kf)-1+k),1))+";"], fd);
2810             end
2811
2812             //** 2nd dim **//
2813             for k=1:noz
2814                 mputl(["    block_"+rdnom+"["+string(kf-1)+"].ozsz["+string(k-1)+...
2815                 "]   = "+string(size(oz(ozptr(kf)-1+k),2))+";"], fd);
2816             end
2817
2818             //** typ **//
2819             for k=1:noz
2820                 mputl(["    block_"+rdnom+"["+string(kf-1)+"].oztyp["+string(k-1)+...
2821                 "]  = "+mat2scs_c_typ(oz(ozptr(kf)-1+k))+";"], fd);
2822             end
2823         end
2824         //************************************************************************//
2825
2826         if (part(funs(kf),1:7) ~= "capteur" &...
2827             part(funs(kf),1:10) ~= "actionneur" &...
2828             funs(kf) ~= "bidon" &...
2829             funs(kf) ~= "bidon2") then
2830             if (rpptr(kf+1)-rpptr(kf)>0) then
2831                 mputl(["    block_"+rdnom+"["+string(kf-1)+...
2832                 "].rpar      = &(rpar["+string(rpptr(kf)-1)+"]);"], fd);
2833             end
2834             if (ipptr(kf+1)-ipptr(kf)>0) then
2835                 mputl(["    block_"+rdnom+"["+string(kf-1)+...
2836                 "].ipar      = &(ipar["+string(ipptr(kf)-1)+"]);"], fd);
2837             end
2838             //** opar
2839             if (opptr(kf+1)-opptr(kf)>0) then
2840                 mputl(["    if ((block_"+rdnom+"["+string(kf-1)+"].oparptr = "+...
2841                 "malloc(sizeof(void *)*block_"+rdnom+"["+string(kf-1)+"].nopar))== NULL) return 0;";
2842                 "    if ((block_"+rdnom+"["+string(kf-1)+"].oparsz  = "+...
2843                 "malloc(2*sizeof(int)*block_"+rdnom+"["+string(kf-1)+"].nopar))== NULL) return 0;";
2844                 "    if ((block_"+rdnom+"["+string(kf-1)+"].opartyp = "+...
2845                 "malloc(sizeof(int)*block_"+rdnom+"["+string(kf-1)+"].nopar))== NULL) return 0;";
2846                 ], fd);
2847                 nopar = opptr(kf+1)-opptr(kf);
2848                 //** oparptr **//
2849                 for k=1:nopar
2850                     mputl(["    block_"+rdnom+"["+string(kf-1)+"].oparptr["+string(k-1)+...
2851                     "]  = oparptr["+string(opptr(kf)-1+k-1)+"];"], fd);
2852                 end
2853                 //** 1st dim **//
2854                 for k=1:nopar
2855                     mputl(["    block_"+rdnom+"["+string(kf-1)+"].oparsz["+string(k-1)+...
2856                     "]   = "+string(size(opar(opptr(kf)-1+k),1))+";"], fd);
2857                 end
2858                 //** 2dn dim **//
2859                 for k=1:nopar
2860                     mputl(["    block_"+rdnom+"["+string(kf-1)+"].oparsz["+string(nopar+(k-1))+...
2861                     "]   = "+string(size(opar(opptr(kf)-1+k),2))+";"], fd)
2862                 end
2863                 //** typ **//
2864                 for k=1:nopar
2865                     mputl(["    block_"+rdnom+"["+string(kf-1)+"].opartyp["+string(k-1)+...
2866                     "]  = "+mat2scs_c_typ(opar(opptr(kf)-1+k))+";"], fd)
2867                 end
2868             end
2869         end
2870
2871         mputl(["    block_"+rdnom+"["+string(kf-1)+...
2872         "].work      = (void **)(((double *)work)+"+string(kf-1)+");"
2873         "    block_"+rdnom+"["+string(kf-1)+...
2874         "].nevprt    = nevprt;"], fd);
2875
2876     end //for kf=1:nblk
2877
2878     //** init
2879     for kf=1:nblk
2880         //     if or(kf==act) | or(kf==cap) then
2881         //       if stalone then
2882         //         txt = call_block42(kf,0,4);
2883         //         if txt <> [] then
2884         //           Code=[Code;
2885         //                 '';
2886         //                 '    '+txt];
2887         //         end
2888         //       end
2889         //     else
2890         txt = call_block42(kf,0,4);
2891         if txt <> [] then
2892             mputl(["";
2893             "    "+txt], fd);
2894         end
2895         //     end
2896     end
2897
2898     //** cst blocks and it's dep
2899     txt=write_code_idoit()
2900
2901     if txt<>[] then
2902         mputl([""
2903         "    /* initial blocks must be called with flag 1 */"
2904         txt], fd);
2905     end
2906     //   for kf=iord(:,1)'
2907     // //     if or(kf==act) then
2908     // //       if stalone then
2909     // //         txt = call_block42(kf,0,1);
2910     // //         if txt <> [] then
2911     // //           Code=[Code;
2912     // //                 '';
2913     // //                 '    '+txt];
2914     // //         end
2915     // //       end
2916     // //     else
2917     //       txt = call_block42(kf,0,1);
2918     //       if txt <> [] then
2919     //         Code=[Code;
2920     //               '';
2921     //               '    '+txt];
2922     //       end
2923     // //     end
2924     //   end
2925
2926     mputl(["  }"], fd);
2927
2928     //** flag 5
2929     mputl(["  else if (flag == 5) { "+get_comment("flag",list(5))
2930     "    block_"+rdnom+"=*block->work;"], fd);
2931
2932     for kf=1:nblk
2933         nin=inpptr(kf+1)-inpptr(kf);  //* number of input ports */
2934         nout=outptr(kf+1)-outptr(kf); //* number of output ports */
2935
2936         //** add comment
2937         txt=mputl([""
2938         "    "+get_comment("set_blk",list(funs(kf),funtyp(kf),kf,labels(kf)));], fd);
2939
2940         for k=1:nin
2941             lprt=inplnk(inpptr(kf)-1+k);
2942             mputl(["    block_"+rdnom+"["+string(kf-1)+"].inptr["+string(k-1)+...
2943             "]  = "+rdnom+"_block_outtbptr["+string(lprt-1)+"];"], fd);
2944         end
2945         for k=1:nout
2946             lprt=outlnk(outptr(kf)-1+k);
2947             mputl(["    block_"+rdnom+"["+string(kf-1)+"].outptr["+string(k-1)+...
2948             "] = "+rdnom+"_block_outtbptr["+string(lprt-1)+"];"], fd);
2949         end
2950         mputl(["    block_"+rdnom+"["+string(kf-1)+"].z=&(z["+...
2951         string(zptr(kf)-1)+"]);"], fd);
2952         if (part(funs(kf),1:7) ~= "capteur" &...
2953             part(funs(kf),1:10) ~= "actionneur" &...
2954             funs(kf) ~= "bidon" &...
2955             funs(kf) ~= "bidon2") then
2956             //** rpar **//
2957             if (rpptr(kf+1)-rpptr(kf)>0) then
2958                 mputl(["    block_"+rdnom+"["+string(kf-1)+...
2959                 "].rpar=&(rpar["+string(rpptr(kf)-1)+"]);"], fd);
2960             end
2961             //** ipar **//
2962             if (ipptr(kf+1)-ipptr(kf)>0) then
2963                 mputl(["    block_"+rdnom+"["+string(kf-1)+...
2964                 "].ipar=&(ipar["+string(ipptr(kf)-1)+"]);"], fd);
2965             end
2966             //** opar **//
2967             if (opptr(kf+1)-opptr(kf)>0) then
2968                 nopar = opptr(kf+1)-opptr(kf);
2969                 for k=1:nopar
2970                     mputl(["    block_"+rdnom+"["+string(kf-1)+"].oparptr["+string(k-1)+...
2971                     "]  = oparptr["+string(opptr(kf)-1+k-1)+"];"], fd);
2972                 end
2973             end
2974             //** oz **//
2975             if (ozptr(kf+1)-ozptr(kf)>0) then
2976                 noz = ozptr(kf+1)-ozptr(kf);
2977                 for k=1:noz
2978                     mputl(["    block_"+rdnom+"["+string(kf-1)+"].ozptr["+string(k-1)+...
2979                     "]  = ozptr["+string(ozptr(kf)-1+k-1)+"];"], fd);
2980                 end
2981             end
2982         end
2983
2984         mputl(["    block_"+rdnom+"["+string(kf-1)+...
2985         "].work=(void **)(((double *)work)+"+string(kf-1)+");"], fd)
2986     end
2987
2988     for kf=1:nblk
2989         //     if or(kf==act) | or(kf==cap) then
2990         //       if stalone then
2991         //         txt = call_block42(kf,0,5);
2992         //         if txt <> [] then
2993         //           Code=[Code;
2994         //                 '';
2995         //                 '    '+txt];
2996         //         end
2997         //       end
2998         //     else
2999         txt = call_block42(kf,0,5);
3000         if txt <> [] then
3001             mputl(["";
3002             "    "+txt], fd);
3003         end
3004         //     end
3005     end
3006
3007     mputl([""
3008     "    for (kf = 0; kf < "+string(nblk)+"; ++kf) {"
3009     "      if (block_"+rdnom+"[kf].insz!=NULL) {"
3010     "        free(block_"+rdnom+"[kf].insz);"
3011     "      }else {"
3012     "        break;"
3013     "      }"
3014     "      if (block_"+rdnom+"[kf].outsz!=NULL){"
3015     "        free(block_"+rdnom+"[kf].outsz);"
3016     "      }else {"
3017     "        break;"
3018     "      }"
3019     "      if (block_"+rdnom+"[kf].nopar!=0){"
3020     "        if (block_"+rdnom+"[kf].oparptr!=NULL){"
3021     "          free(block_"+rdnom+"[kf].oparptr);"
3022     "        }else {"
3023     "          break;"
3024     "        }"
3025     "        if (block_"+rdnom+"[kf].oparsz!=NULL){"
3026     "          free(block_"+rdnom+"[kf].oparsz);"
3027     "        }else {"
3028     "          break;"
3029     "        }"
3030     "        if (block_"+rdnom+"[kf].opartyp!=NULL){"
3031     "          free(block_"+rdnom+"[kf].opartyp);"
3032     "        }else {"
3033     "          break;"
3034     "        }"
3035     "      }"
3036     "      if (block_"+rdnom+"[kf].noz!=0){"
3037     "        if (block_"+rdnom+"[kf].ozptr!=NULL){"
3038     "          free(block_"+rdnom+"[kf].ozptr);"
3039     "        }else {"
3040     "          break;"
3041     "        }"
3042     "        if (block_"+rdnom+"[kf].ozsz!=NULL){"
3043     "          free(block_"+rdnom+"[kf].ozsz);"
3044     "        }else {"
3045     "          break;"
3046     "        }"
3047     "        if (block_"+rdnom+"[kf].oztyp!=NULL){"
3048     "          free(block_"+rdnom+"[kf].oztyp);"
3049     "        }else {"
3050     "          break;"
3051     "        }"
3052     "      }"
3053     "      if (block_"+rdnom+"[kf].evout!=NULL){"
3054     "        free(block_"+rdnom+"[kf].evout);"
3055     "      }else {"
3056     "        break;"
3057     "      }"
3058     "    }"
3059     "    scicos_free(block_"+rdnom+");"
3060     "  }"
3061     ""], fd);
3062
3063     for i=1:size(actt,1)
3064         ni=actt(i,3)*actt(i,4); // dimension of ith input
3065         if actt(i,5)<>11 then
3066             mputl(["  memcpy(*(y+"+string(actt(i,6)-1)+"),"+...
3067             "*("+rdnom+"_block_outtbptr+"+string(actt(i,2)-1)+"),"+...
3068             string(ni)+"*sizeof("+mat2c_typ(actt(i,5))+"));"], fd);
3069         else //** Cas cmplx
3070             mputl(["  memcpy(*(y+"+string(actt(i,6)-1)+"),"+...
3071             "*("+rdnom+"_block_outtbptr+"+string(actt(i,2)-1)+"),"+...
3072             string(2*ni)+"*sizeof("+mat2c_typ(actt(i,5))+"));"], fd);
3073         end
3074     end
3075
3076     //**
3077     mputl(["  return 0;"
3078     ""
3079     "} /* "+rdnom+" */"], fd);
3080
3081     mclose(fd);
3082
3083 endfunction
3084
3085 //generates skeleton of external world events handling function
3086 function Code=make_outevents()
3087     z="0"
3088     if szclkIN==[] then
3089         newszclkIN=0;
3090     else
3091         newszclkIN=szclkIN;
3092     end
3093
3094     Code=[ "/*"+part("-",ones(1,40))+"  External events handling function */";
3095     "void "+rdnom+"_events(int *nevprt,double *t)";
3096     "{"
3097     "/*  set next event time and associated events ports"
3098     " *  nevprt has binary expression b1..b"+string(newszclkIN)+" where bi is a bit"
3099     " *  bi is set to 1 if an activation is received by port i. Note that"
3100     " *  more than one activation can be received simultaneously"
3101     " *  Caution: at least one bi should be equal to one */"
3102     ""]
3103
3104     if (newszclkIN <> 0) then
3105         Code=[Code;
3106         "    int i,p,b[]={"+strcat(z(ones(1,newszclkIN)),",")+"};"
3107         ""
3108         "/* this is an example for the activation of events ports */"
3109         "    b[0]=1;"]
3110
3111         if newszclkIN>1 then
3112             for bb=2:newszclkIN
3113                 Code($+1)="    b["+string(bb-1)+"]=1;"
3114             end
3115         end
3116
3117         Code=[Code;
3118         ""
3119         "/* definition of the step time  */"
3120         "    *t = *t + 0.1;"
3121         ""
3122         "/* External events handling process */"
3123         "    *nevprt=0;p=1;"
3124         "    for (i=0;i<"+string(newszclkIN)+";i++) {"
3125         "      *nevprt=*nevprt+b[i]*p;"
3126         "      p=p*2;"
3127         "    }"
3128         "}"]
3129     else
3130         Code=[Code;
3131         "";
3132         "/* definition of the step time  */"
3133         "    *t = *t + 0.1;"
3134         "}"]
3135     end
3136 endfunction
3137
3138 //Generating the routine for sensors interfacing
3139 //
3140 //
3141 //Author : R. Djenidi, R. Nikoukhah, A. Layec
3142 //
3143 function Code=make_sensor(standalone)
3144     Call=["/*"+part("-",ones(1,40))+" Sensor */";
3145     "void "+rdnom+"_sensor(int *flag, int *nport, int *nevprt, double *t, void *y, int *ny1, int *ny2, int *yt, int *flag1)"]
3146
3147     comments=["     /*"
3148     "      * To be customized for standalone execution";
3149     "      * flag  : specifies the action to be done"
3150     "      * nport : specifies the  index of the Super Bloc"
3151     "      *         regular input (The input ports are numbered"
3152     "      *         from the top to the bottom )"
3153     "      * nevprt: indicates if an activation had been received"
3154     "      *         0 = no activation"
3155     "      *         1 = activation"
3156     "      * t     : the current time value"
3157     "      * y     : the vector outputs value"
3158     "      * ny1   : the output size 1"
3159     "      * ny2   : the output size 2"
3160     "      * yt    : the output type"
3161     "      * flag1 : learn mode (0 from terminal,1 from input file"
3162     "      */"]
3163
3164     dcl=["{"
3165     "  int j,k,l;"
3166     "  double temps;"]
3167
3168     if standalone then
3169
3170         a_sensor=["    switch (*flag) {"
3171         "    case 1 : /* set the output value */"
3172         "      printf(""Require outputs of sensor number %d\n"", *nport);"
3173         "      printf(""time is: %f\n"", *t);"
3174         "      printf(""sizes of the sensor output is: %d,%d\n"", *ny1,*ny2);"
3175         "      switch (*yt) {"
3176         "      case 10 :"
3177         "        printf(""type of the sensor output is: %d (double) \n"", *yt);"
3178         "        puts(""Please set the sensor output values"");"
3179         "        for (l=0;l<*ny2;l++) {"
3180         "          for (k=0;k<*ny1;k++) {"
3181         "            printf(""y(%d,%d) : "",k,l);"
3182         "            scanf(""%lf"", (double *) y+(k+l*(*ny1)));"
3183         "          }"
3184         "        }"
3185         "        break;"
3186         ""
3187         "      case 11 :"
3188         "        printf(""type of the sensor output is: %d (complex) \n"", *yt);"
3189         "        puts(""Please set the sensor output values"");"
3190         "        for (l=0;l<*ny2;l++) {"
3191         "          for (k=0;k<*ny1;k++) {"
3192         "            printf(""y(%d,%d) real part : "",k,l);"
3193         "            scanf(""%lf"", (double *) y+(k+l*(*ny1)));"
3194         "            printf(""y(%d,%d) imag part : "",k,l);"
3195         "            scanf(""%lf"", (double *) y+((*ny1)*(*ny2)+k+l*(*ny1)));"
3196         "          }"
3197         "        }"
3198         "        break;"
3199         ""
3200         "      case 81 :"
3201         "        printf(""type of the sensor output is: %d (char) \n"", *yt);"
3202         "        puts(""Please set the sensor output values"");"
3203         "        for (l=0;l<*ny2;l++) {"
3204         "          for (k=0;k<*ny1;k++) {"
3205         "            printf(""y(%d,%d) : "",k,l);"
3206         "            scanf(""%i"", (char *) y+(k+l*(*ny1)));"
3207         "          }"
3208         "        }"
3209         "        break;"
3210         ""
3211         "      case 82 :"
3212         "        printf(""type of the sensor output is: %d (char) \n"", *yt);"
3213         "        puts(""Please set the sensor output values"");"
3214         "        for (l=0;l<*ny2;l++) {"
3215         "          for (k=0;k<*ny1;k++) {"
3216         "            printf(""y(%d,%d) : "",k,l);"
3217         "            scanf(""%hd"", (short *) y+(k+l*(*ny1)));"
3218         "          }"
3219         "        }"
3220         "        break;"
3221         ""
3222         "      case 84 :"
3223         "        printf(""type of the sensor output is: %d (long) \n"", *yt);"
3224         "        puts(""Please set the sensor output values"");"
3225         "        for (l=0;l<*ny2;l++) {"
3226         "          for (k=0;k<*ny1;k++) {"
3227         "            printf(""y(%d,%d) : "",k,l);"
3228         "            scanf(""%ld"", (long *) y+(k+l*(*ny1)));"
3229         "          }"
3230         "        }"
3231         "        break;"
3232         ""
3233         "      case 811 :"
3234         "        printf(""type of the sensor output is: %d (unsigned char) \n"", *yt);"
3235         "        puts(""Please set the sensor output values"");"
3236         "        for (l=0;l<*ny2;l++) {"
3237         "          for (k=0;k<*ny1;k++) {"
3238         "            printf(""y(%d,%d) : "",k,l);"
3239         "            scanf(""%d"", (unsigned char *) y+(k+l*(*ny1)));"
3240         "          }"
3241         "        }"
3242         "        break;"
3243         ""
3244         "      case 812 :"
3245         "        printf(""type of the sensor output is: %d (unsigned short) \n"", *yt);"
3246         "        puts(""Please set the sensor output values"");"
3247         "        for (l=0;l<*ny2;l++) {"
3248         "          for (k=0;k<*ny1;k++) {"
3249         "            printf(""y(%d,%d) : "",k,l);"
3250         "            scanf(""%hu"", (unsigned short *) y+(k+l*(*ny1)));"
3251         "          }"
3252         "        }"
3253         "        break;"
3254         ""
3255         "      case 814 :"
3256         "        printf(""type of the sensor output is: %d (unsigned long) \n"", *yt);"
3257         "        puts(""Please set the sensor output values"");"
3258         "        for (l=0;l<*ny2;l++) {"
3259         "          for (k=0;k<*ny1;k++) {"
3260         "            printf(""y(%d,%d) : "",k,l);"
3261         "            scanf(""%lu"", (unsigned long *) y+(k+l*(*ny1)));"
3262         "          }"
3263         "        }"
3264         "        break;"
3265         ""
3266         "      }"
3267         "      break;"
3268         "    case 4 : /* sensor initialisation */"
3269         "      /* do whatever you want to initialize the sensor */"
3270         "      break;"
3271         "    case 5 : /* sensor ending */"
3272         "      /* do whatever you want to end the sensor */"
3273         "      break;"
3274         "    }"]
3275     else
3276         a_sensor=[]
3277     end
3278
3279     nc=size(cap,"*")
3280
3281     // pour fscanf
3282     typ=["""%lf "]; //temps
3283     for i=1:nc
3284         typ($)=typ($)+""" \"
3285         typ=[typ;""""];
3286         for j=1:sum(capt(i,3)*capt(i,4))
3287             //typ=typ+'%f ';
3288             typ($)=typ($)+scs_c_n2c_fmt(capt(i,5))+" ";
3289         end
3290     end
3291     typ($)=typ($)+"\n"", \"
3292     typ=strsubst(typ,"%f","%lf");
3293     typ(1)="    fscanf(fprr,"+typ(1);
3294     bl    ="                ";
3295     if size(typ,1) <> 1 then
3296         typ(2:$) = bl+typ(2:$);
3297     end
3298     //Code1=['      fscanf( fprr, '"'+typ+' \n'",&temps']
3299     Code1=[typ;bl+"&temps"];
3300     for i=1:size(capt,1)
3301         ni=capt(i,3)*capt(i,4); // dimension of ith input
3302         Code1($)=Code1($)+",";
3303         Code1=[Code1;bl];
3304         for j=1:ni
3305             if capt(i,5)<>11 then
3306                 Code1($)=Code1($)+...
3307                 "("+scs_c_n2c_typ(capt(i,5))+" *)("+...
3308                 rdnom+"_block_outtbptr+"+string(capt(i,2)-1)+")"+...
3309                 "+"+string(j-1)+"";
3310             else //CAS CMPLX
3311                 Code1($)=Code1($)+...
3312                 "("+scs_c_n2c_typ(capt(i,5))+" *)("+...
3313                 rdnom+"_block_outtbptr+"+string(capt(i,2)-1)+")"+...
3314                 "+"+string((j-1))+", "+...
3315                 "("+scs_c_n2c_typ(capt(i,5))+" *)("+...
3316                 rdnom+"_block_outtbptr+"+string(capt(i,2)-1)+")"+...
3317                 "+"+string(ni+(j-1))+"";
3318             end
3319             if j<>ni then
3320                 Code1($)=Code1($)+", ";
3321             end
3322         end
3323     end
3324     Code1($)=Code1($)+");"
3325
3326     Code=[]
3327     if nc==1|~standalone then
3328         Code=[Code;
3329         Call
3330         comments
3331         dcl
3332         "  if (flag1 == 0) {"
3333         a_sensor;
3334         "  } "
3335         "  else if (flag1 == 1) {"
3336         "    if (*flag == 4 && *nport == 1) {"
3337         "      fprr=fopen(input,'"r'");"
3338         "      if( fprr == NULL ) {"
3339         "        printf('"Error opening file: %s\n'", input);"
3340         "        return;"
3341         "      }"
3342         "    }"
3343         "    else if (*flag == 1) {"
3344         Code1
3345         "    }"
3346         "    else if (*flag == 5 && *nport == 1) {"
3347         "      fclose(fprr);"
3348         "    }"
3349         "  }"
3350         "}"];
3351
3352     elseif nc>1 then
3353         S="  switch (*nport) {"
3354         for k=1:nc
3355             S=[S;
3356             "  case "+string(k)+" : /* Port number "+string(k)+" ----------*/"
3357             "  "+a_sensor
3358             "  break;"]
3359         end
3360         S=[S;"  }"]
3361
3362         Code=[Code
3363         Call
3364         comments
3365         dcl
3366         "  if (flag1 == 0) {"
3367         S
3368         "  }"
3369         "  else if (flag1 == 1){"
3370         "    if (*flag == 4 && *nport == 1) {"
3371         "      fprr=fopen(input,'"r'");"
3372         "      if( fprr == NULL ) {"
3373         "        printf('"Error opening file: %s\n'", input);"
3374         "        return ;"
3375         "      }"
3376         "    }"
3377         "    else if (*flag == 1) {"
3378         Code1
3379         "    }"
3380         "    else if (*flag == 5 && *nport == 1) {"
3381         "      fclose(fprr);"
3382         "    }"
3383         "  }"
3384         "}"]
3385     end
3386 endfunction
3387
3388 //generates code of the standalone simulation procedure
3389 //
3390 //
3391 // rmq : La fonction zdoit n'est pas utilis?e pour le moment
3392 function make_standalone42(filename)
3393
3394     x=cpr.state.x;
3395     modptr=cpr.sim.modptr;
3396     rpptr=cpr.sim.rpptr;
3397     ipptr=cpr.sim.ipptr;
3398     opptr=cpr.sim.opptr;
3399     rpar=cpr.sim.rpar;
3400     ipar=cpr.sim.ipar;
3401     opar=cpr.sim.opar;
3402     oz=cpr.state.oz;
3403     ordptr=cpr.sim.ordptr;
3404     oord=cpr.sim.oord;
3405     zord=cpr.sim.zord;
3406     iord=cpr.sim.iord;
3407     tevts=cpr.state.tevts;
3408     evtspt=cpr.state.evtspt;
3409     zptr=cpr.sim.zptr;
3410     clkptr=cpr.sim.clkptr;
3411     ordptr=cpr.sim.ordptr;
3412     pointi=cpr.state.pointi;
3413     funs=cpr.sim.funs;
3414     noord=size(cpr.sim.oord,1);
3415     nzord=size(cpr.sim.zord,1);
3416     niord=size(cpr.sim.iord,1);
3417
3418     Indent="  ";
3419     Indent2=Indent+Indent;
3420     BigIndent="          ";
3421
3422     work=zeros(nblk,1)
3423     Z=[z;zeros(lstsize(outtb),1);work]';
3424     nX=size(x,"*");
3425     nztotal=size(z,1);
3426
3427     stalone = %t;
3428
3429     fd = mopen(filename, "wt");
3430
3431     mputl(["/*"
3432     "**    Code prototype for standalone use"
3433     "**"
3434     "**    Copyright (c) 1989 - 2012 (INRIA)"
3435     "**    Copyright (c) 2011 - 2013 (Scilab Enterprises)"
3436     "**"
3437     "**    Generated by Code_Generation toolbox of Xcos with "+getversion()
3438     "**    Date : "+date()
3439     "*/"
3440     ""
3441     "/* To learn how to use the standalone code, type '"./standalone -h'" */"
3442     ""
3443     "/* ---- Headers ---- */"
3444     "#include <stdio.h>"
3445     "#include <stdlib.h>"
3446     "#include <math.h>"
3447     "#include <string.h>"
3448     "#include <memory.h>"
3449     "#include '"scicos_block4.h'""
3450     "#include '"machine.h'""
3451     ""
3452     "/* ---- Internals functions declaration ---- */"
3453     "int "+rdnom+"_sim(double, double, double, int);"
3454     Protostalone
3455     ""], fd);
3456
3457     if getos() == "Windows" then
3458         mputl([" "
3459         "#define max(a,b) ((a) >= (b) ? (a) : (b))"
3460         "#define min(a,b) ((a) <= (b) ? (a) : (b))"
3461         " "
3462         ], fd);
3463     end
3464
3465
3466     if x<>[] then
3467         mputl(["/* Code prototype for standalone use  */"
3468         "int C2F("+rdnom+"simblk)(double , double *, double *);"
3469         "int dset(int *n, double *dx, double *dy, int *incy);"
3470         "int ode1();"
3471         "int ode2();"
3472         "int ode4();"
3473         ""], fd);
3474     end
3475
3476     mputl(["/* Table of constant values */"
3477     "static int nrd_"+string(0:maxtotal)'+" = "+string(0:maxtotal)'+";"], fd);
3478
3479     if maxtotal<10 then
3480         mputl(["static int nrd_10 = 10;"], fd);
3481     end
3482     if maxtotal<11 then
3483         mputl(["static int nrd_11 = 11;"], fd)
3484     end
3485
3486     if maxtotal<81 then
3487         mputl(["static int nrd_81 = 81;"], fd);
3488     end
3489     if maxtotal<82 then
3490         mputl(["static int nrd_82 = 82;"], fd);
3491     end
3492     if maxtotal<84 then
3493         mputl(["static int nrd_84 = 84;"], fd);
3494     end
3495     if maxtotal<811 then
3496         mputl(["static int nrd_811 = 811;"], fd);
3497     end
3498     if maxtotal<812 then
3499         mputl(["static int nrd_812 = 812;"], fd);
3500     end
3501     if maxtotal<814 then
3502         mputl(["static int nrd_814 = 814;"], fd);
3503     end
3504
3505     mputl([""
3506     "/* Some general static variables */"
3507     "static double zero=0;"
3508     "static double w[1];"
3509     "static int aaa=0, bbb=0;"
3510     "void **"+rdnom+"_block_outtbptr;"], fd); //** !!
3511
3512     mputl([make_static_standalone42()], fd);
3513
3514     mputl(["static void usage();"
3515     ""
3516     "/* Main program */"
3517     "int main(int argc, char *argv[])"
3518     "{"
3519     "  double tf=30;"  // FIXME : Add current simulation tf.
3520     "  double dt=0.1;" // FIXME : Try to figure out what is the given Simulation step.
3521     "  double h=0.001;"
3522     "  int solver=3;"
3523     "  char * progname = argv[0];"
3524     "  int c;"
3525     "  strcpy(input,'"'");"
3526     "  strcpy(output,'"'");"
3527     "  while ((c = getopt(argc , argv, '"i:o:d:t:e:s:hv'")) != -1)"
3528     "    switch (c) {"
3529     "    case ''i'':"
3530     "      strcpy(input,argv[optind-1]);"
3531     "      break;"
3532     "    case ''o'':"
3533     "      strcpy(output,argv[optind-1]);"
3534     "      break;"
3535     "    case ''d'':"
3536     "      strcpy(s,argv[optind-1]);"
3537     "      dt=strtod(s,p);"
3538     "      break;"
3539     "    case ''t'':"
3540     "      strcpy(sf,argv[optind-1]);"
3541     "      tf=strtod(sf,p);"
3542     "      break;"
3543     "    case ''e'':"
3544     "      strcpy(se,argv[optind-1]);"
3545     "      h=strtod(se,p);"
3546     "      break;"
3547     "    case ''s'':"
3548     "      strcpy(ss,argv[optind-1]);"
3549     "      solver=(int) strtod(ss,p);"
3550     "      break;"
3551     "    case ''h'':"
3552     "      usage(progname);"
3553     "      printf(""Options : \n'");"
3554     "      printf(""     -h for the help  \n"");"
3555     "      printf(""     -v for printing the Scilab Version \n"");"
3556     "      printf(""     -i for input file name, by default is Terminal \n"");"
3557     "      printf(""     -o for output file name, by default is Terminal \n"");"
3558     "      printf(""     -d for the clock period, by default is 0.1 \n"");"
3559     "      printf(""     -t for the final time, by default is 30 \n"");"
3560     "      printf(""     -e for the solvers step size, by default is 0.001 \n"");"
3561     "      printf(""     -s integer parameter for select the numerical solver : \n"");"
3562     "      printf(""        1 for Euler''s method \n"");"
3563     "      printf(""        2 for Heun''s method \n"");"
3564     "      printf(""        3 (default value) for the Fourth-Order Runge-Kutta"+...
3565     " (RK4) Formula \n"");"
3566     "      return 0;"
3567     "      break;"
3568     "    case ''v'':"
3569     "      printf(""Generated by Code_Generation toolbox of Xcos """
3570     "             ""with "+getversion()+" version \n"");"
3571     "      return 0;"
3572     "      break;"
3573     "    case ''?'':"
3574     "      errflg++;"
3575     "      break;"
3576     "    }"
3577     "    if (errflg){"
3578     "      usage(progname);"
3579     "      return 0;"
3580     "    }"
3581     " "
3582     "  "+rdnom+"_sim(tf,dt,h,solver);"
3583     "  return 0;"
3584     "}"
3585     ""
3586     "static void usage(prog)"
3587     "       char *prog;"
3588     "{"
3589     "  fprintf(stderr, ""Usage: %s [-h] [-v] [-i arg] [-o arg] """
3590     "                  ""[-d arg] [-t arg] [-e arg] [-s arg]\n"", prog);"
3591     "}"
3592     ""], fd);
3593
3594     mputl(["/*"+part("-",ones(1,40))+"  External simulation function */"
3595     "int "+rdnom+"_sim(tf,dt,h,solver)"
3596     ""
3597     "   double tf,dt,h;"
3598     "   int solver;"
3599     "{"
3600     "  double t;"
3601     "  int nevprt=1;"
3602     "  int local_flag;"
3603     "  int nport;"
3604     "  int i;"
3605     "  double *args[100];"
3606     ""], fd);
3607
3608     if (x <> []) then
3609         mputl(["  double tout;"
3610         "  double he=0.1;"
3611         ""], fd);
3612     end
3613
3614     mputl(["  /* Initial values */"
3615     ""
3616     "  /* Note that z[]=[z_initial_condition;outtbptr;work]"
3617     cformatline("     z_initial_condition={"+...
3618     strcat(string(z),",")+"};",70)
3619     cformatline("     outtbptr={"+...
3620     strcat(string(zeros(lstsize(outtb),1)),"," )+"};",70)
3621     cformatline("     work= {"+...
3622     strcat(string(work),"," )+"};",70)
3623     "  */"
3624     ""
3625     cformatline("  double z[]={"+strcat(string(Z),",")+"};",70)], fd);
3626
3627     if size(z,1) <> 0 then
3628         for i=1:(length(zptr)-1)
3629             if zptr(i+1)-zptr(i)>0 then
3630                 if size(corinv(i),"*")==1 then
3631                     OO=scs_m.objs(corinv(i))
3632                 else
3633                     path=list("objs")
3634                     for l=cpr.corinv(i)(1:$-1)
3635                         path($+1)=l;path($+1)="model"
3636                         path($+1)="rpar"
3637                         path($+1)="objs"
3638                     end
3639                     path($+1)=cpr.corinv(i)($)
3640                     OO=scs_m(path)
3641                 end
3642                 aaa=OO.gui
3643                 bbb=emptystr(3,1);
3644                 if and(aaa+bbb~=["INPUTPORTEVTS";"OUTPUTPORTEVTS";"EVTGEN_f"]) then
3645                     mputl(["";
3646                     "  /* Routine name of block: "+strcat(string(cpr.sim.funs(i)));
3647                     "     Gui name of block: "+strcat(string(OO.gui));
3648                     //'/* Name block: '+strcat(string(cpr.sim.funs(i)));
3649                     //'Object number in diagram: '+strcat(string(cpr.corinv(i)));
3650                     "     Compiled structure index: "+strcat(string(i));], fd);
3651                     if stripblanks(OO.model.label)~=emptystr() then
3652                         mputl([cformatline("     Label: "+strcat(string(OO.model.label)),70)], fd);
3653                     end
3654                     if stripblanks(OO.graphics.exprs(1))~=emptystr() then
3655                         mputl([cformatline("     Exprs: "+strcat(OO.graphics.exprs(1),","),70)], fd);
3656                     end
3657                     if stripblanks(OO.graphics.id)~=emptystr() then
3658                         mputl([cformatline("     Identification: "+..
3659                         strcat(string(OO.graphics.id)),70)], fd);
3660                     end
3661                     mputl([cformatline("     z={"+...
3662                     strcat(string(z(zptr(i):zptr(i+1)-1)),",")+"};",70)
3663                     " */"], fd);
3664                 end
3665             end
3666         end
3667     end
3668
3669     //** declaration of oz
3670     Code_oz = [];
3671     for i=1:lstsize(oz)
3672         if mat2scs_c_nb(oz(i)) <> 11 then
3673             Code_oz=[Code_oz;
3674             cformatline("  "+mat2c_typ(oz(i))+...
3675             " oz_"+string(i)+"[]={"+...
3676             strcat(string(oz(i)(:)),",")+"};",70)]
3677         else //** cmplx test
3678             Code_oz=[Code_oz;
3679             cformatline("  "+mat2c_typ(oz(i))+...
3680             " oz_"+string(i)+"[]={"+...
3681             strcat(string([real(oz(i)(:));
3682             imag(oz(i)(:))]),",")+"};",70)]
3683         end
3684     end
3685
3686     if Code_oz <> [] then
3687         mputl(["  /* oz declaration */"
3688         Code_oz], fd);
3689     end
3690
3691     //** declaration of outtb
3692     Code_outtb = [];
3693     for i=1:lstsize(outtb)
3694         if mat2scs_c_nb(outtb(i)) <> 11 then
3695             Code_outtb=[Code_outtb;
3696             cformatline("  "+mat2c_typ(outtb(i))+...
3697             " outtb_"+string(i)+"[]={"+...
3698             strcat(string(outtb(i)(:)),",")+"};",70)]
3699         else //** cmplx test
3700             Code_outtb=[Code_outtb;
3701             cformatline("  "+mat2c_typ(outtb(i))+...
3702             " outtb_"+string(i)+"[]={"+...
3703             strcat(string([real(outtb(i)(:));
3704             imag(outtb(i)(:))]),",")+"};",70)]
3705         end
3706     end
3707
3708     if Code_outtb<>[] then
3709         mputl([""
3710         "  /* outtb declaration */"
3711         Code_outtb
3712         ""], fd);
3713     end
3714
3715     Code_outtbptr=[];
3716     for i=1:lstsize(outtb)
3717         Code_outtbptr=[Code_outtbptr;
3718         "  "+rdnom+"_block_outtbptr["+...
3719         string(i-1)+"] = (void *) outtb_"+string(i)+";"];
3720     end
3721
3722     //** declaration of work
3723     mputl(["  /* work ptr declaration */"
3724     "  void **work;"
3725     ""
3726     //## affectation of work
3727     "  /* Get work ptr of blocks */"
3728     "  work = (void **)(z+"+string(size(z,"*")+lstsize(outtb))+");"
3729     ""], fd);
3730
3731     //## affection of outtbptr
3732     if Code_outtb<>[] then
3733         mputl(["  /* Get outtbptr ptr of blocks */"
3734         "  "+rdnom+"_block_outtbptr = (void **)(z+"+string(nztotal)+");"
3735         ""], fd);
3736     end
3737     if Code_outtbptr<>[] then
3738         mputl([Code_outtbptr
3739         ""], fd);
3740     end
3741
3742     for kf=1:nblk
3743         nx=xptr(kf+1)-xptr(kf);       //** number of continuous state
3744         nin=inpptr(kf+1)-inpptr(kf);  //** number of input ports
3745         nout=outptr(kf+1)-outptr(kf); //** number of output ports
3746
3747         //** add comment
3748         mputl([""
3749         "  "+get_comment("set_blk",list(funs(kf),funtyp(kf),kf,labels(kf)));], fd);
3750
3751         mputl(["  block_"+rdnom+"["+string(kf-1)+"].type   = "+string(funtyp(kf))+";";
3752         "  block_"+rdnom+"["+string(kf-1)+"].ztyp   = "+string(ztyp(kf))+";";
3753         "  block_"+rdnom+"["+string(kf-1)+"].ng     = "+string(zcptr(kf+1)-zcptr(kf))+";";
3754         "  block_"+rdnom+"["+string(kf-1)+"].nz     = "+string(zptr(kf+1)-zptr(kf))+";";
3755         "  block_"+rdnom+"["+string(kf-1)+"].noz    = "+string(ozptr(kf+1)-ozptr(kf))+";";
3756         "  block_"+rdnom+"["+string(kf-1)+"].nrpar  = "+string(rpptr(kf+1)-rpptr(kf))+";";
3757         "  block_"+rdnom+"["+string(kf-1)+"].nopar  = "+string(opptr(kf+1)-opptr(kf))+";";
3758         "  block_"+rdnom+"["+string(kf-1)+"].nipar  = "+string(ipptr(kf+1)-ipptr(kf))+";"
3759         "  block_"+rdnom+"["+string(kf-1)+"].nin    = "+string(inpptr(kf+1)-inpptr(kf))+";";
3760         "  block_"+rdnom+"["+string(kf-1)+"].nout   = "+string(outptr(kf+1)-outptr(kf))+";";
3761         "  block_"+rdnom+"["+string(kf-1)+"].nevout = "+string(clkptr(kf+1)-clkptr(kf))+";";
3762         "  block_"+rdnom+"["+string(kf-1)+"].nmode  = "+string(modptr(kf+1)-modptr(kf))+";";], fd);
3763
3764         if nx <> 0 then
3765             mputl(["  block_"+rdnom+"["+string(kf-1)+"].nx = "+string(nx)+";";
3766             "  block_"+rdnom+"["+string(kf-1)+"].x  = &(x["+string(xptr(kf)-1)+"]);"
3767             "  block_"+rdnom+"["+string(kf-1)+"].xd = &(xd["+string(xptr(kf)-1)+"]);"], fd);
3768         end
3769
3770         mputl(["  if ((block_"+rdnom+"["+string(kf-1)+"].evout  = "+...
3771         "calloc(block_"+rdnom+"["+string(kf-1)+"].nevout,sizeof(double)))== NULL) return 0;"], fd);
3772
3773         //***************************** input port *****************************//
3774         //** alloc insz/inptr **//
3775         mputl(["  if ((block_"+rdnom+"["+string(kf-1)+"].inptr  = "+...
3776         "malloc(sizeof(double*)*block_"+rdnom+"["+string(kf-1)+"].nin))== NULL) return 0;";
3777         "  if ((block_"+rdnom+"["+string(kf-1)+"].insz   = "+...
3778         "malloc(3*sizeof(int)*block_"+rdnom+"["+string(kf-1)+"].nin))== NULL) return 0;"], fd);
3779
3780         //** inptr **//
3781         for k=1:nin
3782             lprt=inplnk(inpptr(kf)-1+k);
3783             mputl(["  block_"+rdnom+"["+string(kf-1)+"].inptr["+string(k-1)+...
3784             "]  = "+rdnom+"_block_outtbptr["+string(lprt-1)+"];"], fd);
3785         end
3786
3787         //** 1st dim **//
3788         for k=1:nin
3789             lprt=inplnk(inpptr(kf)-1+k);
3790             mputl(["  block_"+rdnom+"["+string(kf-1)+"].insz["+string((k-1))+...
3791             "]   = "+string(size(outtb(lprt),1))+";"], fd);
3792         end
3793
3794         //** 2dn dim **//
3795         for k=1:nin
3796             lprt=inplnk(inpptr(kf)-1+k);
3797             mputl(["  block_"+rdnom+"["+string(kf-1)+"].insz["+string((k-1)+nin)+...
3798             "]   = "+string(size(outtb(lprt),2))+";"], fd);
3799         end
3800
3801         //** typ **//
3802         for k=1:nin
3803             lprt=inplnk(inpptr(kf)-1+k);
3804             mputl(["  block_"+rdnom+"["+string(kf-1)+"].insz["+string((k-1)+2*nin)+...
3805             "]   = "+mat2scs_c_typ(outtb(lprt))+";"], fd);
3806         end
3807         //**********************************************************************//
3808
3809         //***************************** output port *****************************//
3810         //** alloc outsz/outptr **//
3811         mputl(["  if ((block_"+rdnom+"["+string(kf-1)+"].outsz  = "+...
3812         "malloc(3*sizeof(int)*block_"+rdnom+"["+string(kf-1)+"].nout))== NULL) return 0;";
3813         "  if ((block_"+rdnom+"["+string(kf-1)+"].outptr = "+...
3814         "malloc(sizeof(double*)*block_"+rdnom+"["+string(kf-1)+"].nout))== NULL) return 0;"], fd);
3815
3816         //** outptr **//
3817         for k=1:nout
3818             lprt=outlnk(outptr(kf)-1+k);
3819             mputl(["  block_"+rdnom+"["+string(kf-1)+"].outptr["+string(k-1)+...
3820             "] = "+rdnom+"_block_outtbptr["+string(lprt-1)+"];"], fd);
3821         end
3822
3823         //** 1st dim **//
3824         for k=1:nout
3825             lprt=outlnk(outptr(kf)-1+k);
3826             mputl(["  block_"+rdnom+"["+string(kf-1)+"].outsz["+string((k-1))+...
3827             "]  = "+string(size(outtb(lprt),1))+";"], fd);
3828         end
3829
3830         //** 2dn dim **//
3831         for k=1:nout
3832             lprt=outlnk(outptr(kf)-1+k);
3833             mputl(["  block_"+rdnom+"["+string(kf-1)+"].outsz["+string((k-1)+nout)+...
3834             "]  = "+string(size(outtb(lprt),2))+";"], fd);
3835         end
3836
3837         //** typ **//
3838         for k=1:nout
3839             lprt=outlnk(outptr(kf)-1+k);
3840             mputl(["  block_"+rdnom+"["+string(kf-1)+"].outsz["+string((k-1)+2*nout)+...
3841             "]  = "+mat2scs_c_typ(outtb(lprt))+";"], fd);
3842         end
3843         //**********************************************************************//
3844
3845         mputl(["  block_"+rdnom+"["+string(kf-1)+...
3846         "].z = &(z["+string(zptr(kf)-1)+"]);"], fd);
3847
3848         if (part(funs(kf),1:7) ~= "capteur" &...
3849             part(funs(kf),1:10) ~= "actionneur" &...
3850             funs(kf) ~= "bidon") then
3851             //** rpar **//
3852             if (rpptr(kf+1)-rpptr(kf)>0) then
3853                 mputl([ "  block_"+rdnom+"["+string(kf-1)+...
3854                 "].rpar=&(RPAR1["+string(rpptr(kf)-1)+"]);"], fd);
3855             end
3856             //** ipar **//
3857             if (ipptr(kf+1)-ipptr(kf)>0) then
3858                 mputl(["  block_"+rdnom+"["+string(kf-1)+...
3859                 "].ipar=&(IPAR1["+string(ipptr(kf)-1)+"]);"], fd);
3860             end
3861             //** opar **//
3862             if (opptr(kf+1)-opptr(kf)>0) then
3863                 mputl(["  if ((block_"+rdnom+"["+string(kf-1)+"].oparptr = "+...
3864                 "malloc(sizeof(void *)*block_"+rdnom+"["+string(kf-1)+"].nopar))== NULL ) return 0;";
3865                 "  if ((block_"+rdnom+"["+string(kf-1)+"].oparsz  = "+...
3866                 "malloc(2*sizeof(int)*block_"+rdnom+"["+string(kf-1)+"].nopar))== NULL ) return 0;";
3867                 "  if ((block_"+rdnom+"["+string(kf-1)+"].opartyp = "+...
3868                 "malloc(sizeof(int)*block_"+rdnom+"["+string(kf-1)+"].nopar))== NULL ) return 0;";
3869                 ], fd);
3870                 nopar = opptr(kf+1)-opptr(kf);
3871                 //** oparptr **//
3872                 for k=1:nopar
3873                     mputl(["  block_"+rdnom+"["+string(kf-1)+"].oparptr["+string(k-1)+...
3874                     "]   = (void *) OPAR_"+string(opptr(kf)-1+k)+";"], fd);
3875                 end
3876                 //** 1st dim **//
3877                 for k=1:nopar
3878                     mputl(["  block_"+rdnom+"["+string(kf-1)+"].oparsz["+string(k-1)+...
3879                     "]    = "+string(size(opar(opptr(kf)-1+k),1))+";"], fd);
3880                 end
3881                 //** 2dn dim **//
3882                 for k=1:nopar
3883                     mputl(["  block_"+rdnom+"["+string(kf-1)+"].oparsz["+string(nopar+(k-1))+...
3884                     "]    = "+string(size(opar(opptr(kf)-1+k),2))+";"], fd);
3885                 end
3886                 //** typ **//
3887                 for k=1:nopar
3888                     mputl(["  block_"+rdnom+"["+string(kf-1)+"].opartyp["+string(k-1)+...
3889                     "]   = "+mat2scs_c_typ(opar(opptr(kf)-1+k))+";"], fd);
3890                 end
3891             end
3892             //** oz **//
3893             if (ozptr(kf+1)-ozptr(kf)>0) then
3894                 noz = ozptr(kf+1)-ozptr(kf);
3895                 mputl(["  if ((block_"+rdnom+"["+string(kf-1)+"].ozptr = "+...
3896                 "malloc(sizeof(void *)*block_"+rdnom+"["+string(kf-1)+"].noz))== NULL) return 0;";
3897                 "  if ((block_"+rdnom+"["+string(kf-1)+"].ozsz  = "+...
3898                 "malloc(2*sizeof(int)*block_"+rdnom+"["+string(kf-1)+"].noz))== NULL) return 0;";
3899                 "  if ((block_"+rdnom+"["+string(kf-1)+"].oztyp = "+...
3900                 "malloc(sizeof(int)*block_"+rdnom+"["+string(kf-1)+"].noz))== NULL) return 0;";], fd);
3901                 //** ozptr **//
3902                 for k=1:noz
3903                     mputl(["  block_"+rdnom+"["+string(kf-1)+"].ozptr["+string(k-1)+...
3904                     "]  = (void *) oz_"+string(ozptr(kf)-1+k)+";"], fd);
3905                 end
3906                 //** 1st dim **//
3907                 for k=1:noz
3908                     mputl(["  block_"+rdnom+"["+string(kf-1)+"].ozsz["+string(k-1)+...
3909                     "]  = "+string(size(oz(ozptr(kf)-1+k),1))+";"], fd);
3910                 end
3911                 //** 2nd dim **//
3912                 for k=1:noz
3913                     mputl(["  block_"+rdnom+"["+string(kf-1)+"].ozsz["+string(noz+(k-1))+...
3914                     "]  = "+string(size(oz(ozptr(kf)-1+k),2))+";"], fd);
3915                 end
3916                 //** typ **//
3917                 for k=1:noz
3918                     mputl(["  block_"+rdnom+"["+string(kf-1)+"].oztyp["+string(k-1)+...
3919                     "]  = "+mat2scs_c_typ(oz(ozptr(kf)-1+k))+";"], fd);
3920                 end
3921             end
3922         end
3923         mputl(["  block_"+rdnom+"["+string(kf-1)+"].work = "+...
3924         "(void **)(((double *)work)+"+string(kf-1)+");"], fd);
3925     end
3926
3927     mputl(["  if (strlen(input) > 0)"
3928     "    aaa=1;"
3929     "  if (strlen(output)> 0)"
3930     "    bbb=1;"
3931     ""
3932     "  /* set initial time */"
3933     "  t=0.0;"
3934     ""], fd);
3935
3936     //** init
3937     mputl(["  "+get_comment("flag",list(4))], fd);
3938
3939     for kf=1:nblk
3940         if or(kf==act) | or(kf==cap) then
3941             txt = call_block42(kf,0,4);
3942             if txt <> [] then
3943                 mputl(["";
3944                 "  "+txt], fd);
3945             end
3946         else
3947             txt = call_block42(kf,0,4);
3948             if txt <> [] then
3949                 mputl(["";
3950                 "  "+txt], fd);
3951             end
3952         end
3953     end
3954
3955     //** cst blocks and it's dep
3956     txt=write_code_idoit()
3957
3958     if txt<>[] then
3959         mputl([""
3960         "    /* Initial blocks must be called with flag 1 */"
3961         txt], fd);
3962     end
3963
3964     //** begin input main loop on time
3965     mputl([""
3966     "  while (t < tf) {";
3967     "    /* */"
3968     "    sci_time=t;"
3969     ""], fd);
3970
3971     //** find source activation number
3972     blks=find(funtyp>-1);
3973     evs=[];
3974
3975     for blk=blks
3976         for ev=clkptr(blk):clkptr(blk+1)-1
3977             if funs(blk)=="bidon" then
3978                 if ev > clkptr(howclk) -1
3979                     evs=[evs,ev];
3980                 end
3981             end
3982         end
3983     end
3984
3985     //** flag 1,2,3
3986     for flag=[1,2,3]
3987
3988         txt3=[]
3989
3990         //** continuous time blocks must be activated
3991         //** for flag 1
3992         if flag==1 then
3993             txt = write_code_cdoit(flag);
3994
3995             if txt <> [] then
3996                 txt3=[""
3997                 "    "+get_comment("ev",list(0))
3998                 txt;
3999                 ];
4000             end
4001         end
4002
4003         //** blocks with input discrete event must be activated
4004         //** for flag 1, 2 and 3
4005         if size(evs,2)>=1 then
4006             txt4=[]
4007             //**
4008             for ev=evs
4009                 txt2=write_code_doit(ev,flag);
4010                 if txt2<>[] then
4011                     //** adjust event number because of bidon block
4012                     new_ev=ev-(clkptr(howclk)-1)
4013                     //**
4014                     txt4=[txt4;
4015                     Indent2+["  case "+string(new_ev)+" : "+...
4016                     get_comment("ev",list(new_ev))
4017                     txt2];
4018                     "      break;";""]
4019                 end
4020             end
4021
4022             //**
4023             if txt4 <> [] then
4024                 txt3=[txt3;
4025                 Indent+"  /* Discrete activations */"
4026                 Indent+"  switch (nevprt) {"
4027                 txt4
4028                 "    }"];
4029             end
4030         end
4031
4032         //**
4033         if txt3<>[] then
4034             mputl(["    "+get_comment("flag",list(flag))
4035             txt3], fd);
4036         end
4037     end
4038
4039     if x<>[] then
4040         mputl([""
4041         "    tout=t;"
4042         ""
4043         "   /* integrate until the cumulative add of the integration"
4044         "    * time step doesn''t cross the sample time step"
4045         "    */"
4046         "    while (tout+h<t+dt){"
4047         "      switch (solver) {"
4048         "      case 1:"
4049         "        ode1(C2F("+rdnom+"simblk),tout,h);"
4050         "        break;"
4051         "      case 2:"
4052         "        ode2(C2F("+rdnom+"simblk),tout,h);"
4053         "        break;"
4054         "      case 3:"
4055         "        ode4(C2F("+rdnom+"simblk),tout,h);"
4056         "        break;"
4057         "      default :"
4058         "        ode4(C2F("+rdnom+"simblk),tout,h);"
4059         "        break;"
4060         "        }"
4061         "       tout=tout+h;"
4062         "    }"
4063         ""
4064         "    /* integration for the remainder piece of time */"
4065         "    he=t+dt-tout;"
4066         "    switch (solver) {"
4067         "    case 1:"
4068         "      ode1(C2F("+rdnom+"simblk),tout,he);"
4069         "      break;"
4070         "    case 2:"
4071         "      ode2(C2F("+rdnom+"simblk),tout,he);"
4072         "      break;"
4073         "    case 3:"
4074         "      ode4(C2F("+rdnom+"simblk),tout,he);"
4075         "      break;"
4076         "    default :"
4077         "      ode4(C2F("+rdnom+"simblk),tout,he);"
4078         "      break;"
4079         "    }"], fd);
4080     end
4081
4082     //** fix bug provided by Roberto Bucher
4083     //** Alan, 13/10/07
4084     if nX <> 0 then
4085         mputl([""
4086         "    /* update ptrs of continuous array */"], fd);
4087         for kf=1:nblk
4088             nx=xptr(kf+1)-xptr(kf);  //** number of continuous state
4089             if nx<>0 then
4090                 mputl(["    block_"+rdnom+"["+string(kf-1)+"].nx = "+...
4091                 string(nx)+";";
4092                 "    block_"+rdnom+"["+string(kf-1)+"].x  = "+...
4093                 "&(x["+string(xptr(kf)-1)+"]);"
4094                 "    block_"+rdnom+"["+string(kf-1)+"].xd = "+...
4095                 "&(xd["+string(xptr(kf)-1)+"]);"], fd);
4096             end
4097         end
4098     end
4099
4100     mputl([""
4101     "    /* update current time */"
4102     "    t=t+dt;"
4103     "  }"
4104     //** flag 5
4105     ""
4106     " sci_time = tf;"
4107     ""
4108     "  "+get_comment("flag",list(5))], fd);
4109
4110     for kf=1:nblk
4111         if or(kf==act) | or(kf==cap) then
4112             txt = call_block42(kf,0,5);
4113             if txt <> [] then
4114                 mputl(["";
4115                 "  "+txt], fd);
4116             end
4117         else
4118             txt = call_block42(kf,0,5);
4119             if txt <> [] then
4120                 mputl(["";
4121                 "  "+txt], fd);
4122             end
4123         end
4124     end
4125
4126     mputl([""
4127     "  return 0;"
4128     "}"
4129     ""
4130     "/*"+part("-",ones(1,40))+"  Lapack messag function */";
4131     "void C2F(xerbla)(char *SRNAME,int *INFO,long int L)"
4132     "{"
4133     "  printf(""** On entry to %s, parameter number %d"""
4134     "         ""  had an illegal value\n"",SRNAME,*INFO);"
4135     "}"
4136     ""
4137     "void set_block_error(int err)"
4138     "{"
4139     "  return;"
4140     "}"
4141     ""
4142     "int get_phase_simulation()"
4143     "{"
4144     "  return 1;"
4145     "}"
4146     ""
4147     "void * scicos_malloc(size_t size)"
4148     "{"
4149     "  return malloc(size);"
4150     "}"
4151     ""
4152     "void scicos_free(void *p)"
4153     "{"
4154     "  free(p);"
4155     "}"
4156     ""
4157     "double get_scicos_time()"
4158     "{"
4159     "  return sci_time;"
4160     "}"
4161     ""
4162     "void do_cold_restart()"
4163     "{"
4164     "  return;"
4165     "}"
4166     ""
4167     "void sciprint (char *fmt)"
4168     "{"
4169     "  return;"
4170     "}"
4171     ""
4172     "int getopt (int argc, char *argv[], char *optstring)"
4173     "{"
4174     "  char *group, option, *sopt;"
4175     "  int len;"
4176     "  option = -1;"
4177     "  optarg = NULL;"
4178     "  while ( optind < argc )"
4179     "    { "
4180     "      group = argv[optind];"
4181     "      if ( *group != ''-'' )"
4182     "        {"
4183     "         option = -1;"
4184     "         optarg = group;"
4185     "         optind++;"
4186     "         break;"
4187     "        }"
4188     "      len = strlen (group);"
4189     "      group = group + offset;"
4190     "      if ( *group == ''-'' )"
4191     "        {"
4192     "         group++;"
4193     "         offset += 2;"
4194     "        }"
4195     "      else"
4196     "        offset++ ;"
4197     "      option = *group ;"
4198     "      sopt = strchr ( optstring, option ) ;"
4199     "      if ( sopt != NULL )"
4200     "        {"
4201     "         sopt++ ;"
4202     "         if ( *sopt == '':'' )"
4203     "           {"
4204     "             optarg = group + 1;"
4205     "             if ( *optarg == ''\0'' )"
4206     "                optarg = argv[++optind];"
4207     "             if ( *optarg == ''-'' )"
4208     "                {"
4209     "                 fprintf ( stderr, '"\n%s: illegal option -- %c'","
4210     "                           argv[0], option );"
4211     "                 option = ''?'';"
4212     "                 break;"
4213     "                }"
4214     "             else"
4215     "                {"
4216     "                 optind++;"
4217     "                 offset = 0;"
4218     "                 break;"
4219     "                }"
4220     "           }"
4221     "         if ( offset >= len )"
4222     "           {"
4223     "             optind++;"
4224     "             offset = 0;"
4225     "           }"
4226     "         break;"
4227     "        }"
4228     "      else"
4229     "        {"
4230     "         fprintf ( stderr, '"\n%s: illegal option -- %c'", argv[0], option );"
4231     "         option = ''?'';"
4232     "         break;"
4233     "        }"
4234     "    }"
4235     "  return ( option );"
4236     "}"
4237     ""], fd);
4238
4239     if (x <> []) then
4240         mputl(["int C2F("+rdnom+"simblk)(t, x, xd)"
4241         ""
4242         "   double t, *x, *xd;"
4243         ""
4244         "     /*"
4245         "      *  !purpose"
4246         "      *  compute state derivative of the continuous part"
4247         "      *  !calling sequence"
4248         "      *  neq   : integer the size of the  continuous state"
4249         "      *  t     : current time"
4250         "      *  x     : double precision vector whose contains the continuous state"
4251         "      *  xd    : double precision vector, contain the computed derivative"
4252         "      *  of the state"
4253         "      */"
4254         "{"
4255         "  int phase=2;"
4256         "  int local_flag;"
4257         "  int nport;"
4258         "  int nevprt=1;"
4259         "  double *args[100];"
4260         "  dset(&neq, &c_b14,xd , &c__1);"
4261         ""
4262         "    "+get_comment("update_xd",list())], fd);
4263
4264         for kf=1:nblk
4265             if (xptr(kf+1)-xptr(kf)) > 0 then
4266                 mputl(["    block_"+rdnom+"["+string(kf-1)+"].x="+...
4267                 "&(x["+string(xptr(kf)-1)+"]);"
4268                 "    block_"+rdnom+"["+string(kf-1)+"].xd="+...
4269                 "&(xd["+string(xptr(kf)-1)+"]);"], fd);
4270             end
4271         end
4272
4273         mputl([""
4274         write_code_odoit(1)
4275         write_code_odoit(0)
4276         ""
4277         "  return 0;"
4278         "}"
4279         ""
4280         "int dset(int *n, double *dx, double *dy, int *incy)"
4281         "{"
4282         "    int iMax = 0;"
4283         "    int i = 0, iy = 0;"
4284         "    --dy;"
4285         "    if (*n <= 0) return 0;"
4286         "    iy = 1;"
4287         "    if (*incy < 0)"
4288         "    {"
4289         "      iy = (-(*n) + 1) * *incy + 1;"
4290         "    }"
4291         "    iMax = *n;"
4292         "    for (i = 1; i <= iMax; ++i)"
4293         "    {"
4294         "      dy[iy] = *dx;"
4295         "      iy += *incy;"
4296         "    }"
4297         "    return 0;"
4298         "}"
4299         ""
4300         "/* Euler''s Method */"
4301         "int ode1(f,t,h)"
4302         "  int (*f) ();"
4303         "  double t, h;"
4304         "{"
4305         "  int i;"
4306         ""
4307         "  /**/"
4308         "  (*f)(t,x, xd);"
4309         ""
4310         "  for (i=0;i<neq;i++) {"
4311         "   x[i]=x[i]+h*xd[i];"
4312         "  }"
4313         ""
4314         "  return 0;"
4315         "}"
4316         ""
4317         "/* Heun''s Method */"
4318         "int ode2(f,t,h)"
4319         "  int (*f) ();"
4320         "  double t, h;"
4321         "{"
4322         "  int i;"
4323         "  double y["+string(nX)+"],yh["+string(nX)+"],temp,f0["+string(nX)+"],th;"
4324         ""
4325         "  /**/"
4326         "  memcpy(y,x,neq*sizeof(double));"
4327         "  memcpy(f0,xd,neq*sizeof(double));"
4328         ""
4329         "  /**/"
4330         "  (*f)(t,y, f0);"
4331         ""
4332         "  /**/"
4333         "  for (i=0;i<neq;i++) {"
4334         "    x[i]=y[i]+h*f0[i];"
4335         "  }"
4336         "  th=t+h;"
4337         "  for (i=0;i<neq;i++) {"
4338         "    yh[i]=y[i]+h*f0[i];"
4339         "  }"
4340         "  (*f)(th,yh, xd);"
4341         ""
4342         "  /**/"
4343         "  temp=0.5*h;"
4344         "  for (i=0;i<neq;i++) {"
4345         "    x[i]=y[i]+temp*(f0[i]+xd[i]);"
4346         "  }"
4347         ""
4348         "  return 0;"
4349         "}"
4350         ""
4351         "/* Fourth-Order Runge-Kutta (RK4) Formula */"
4352         "int ode4(f,t,h)"
4353         "  int (*f) ();"
4354         "  double t, h;"
4355         "{"
4356         "  int i;"
4357         "  double y["+string(nX)+"],yh["+string(nX)+"],"+...
4358         "temp,f0["+string(nX)+"],th,th2,"+...
4359         "f1["+string(nX)+"],f2["+string(nX)+"];"
4360         ""
4361         "  /**/"
4362         "  memcpy(y,x,neq*sizeof(double));"
4363         "  memcpy(f0,xd,neq*sizeof(double));"
4364         ""
4365         "  /**/"
4366         "  (*f)(t,y, f0);"
4367         ""
4368         "  /**/"
4369         "  for (i=0;i<neq;i++) {"
4370         "    x[i]=y[i]+h*f0[i];"
4371         "  }"
4372         "  th2=t+h/2;"
4373         "  for (i=0;i<neq;i++) {"
4374         "    yh[i]=y[i]+(h/2)*f0[i];"
4375         "  }"
4376         "  (*f)(th2,yh, f1);"
4377         ""
4378         "  /**/"
4379         "  temp=0.5*h;"
4380         "  for (i=0;i<neq;i++) {"
4381         "    x[i]=y[i]+temp*f1[i];"
4382         "  }"
4383         "  for (i=0;i<neq;i++) {"
4384         "    yh[i]=y[i]+(h/2)*f1[i];"
4385         "  }"
4386         "  (*f)(th2,yh, f2);"
4387         ""
4388         "  /**/"
4389         "  for (i=0;i<neq;i++) {"
4390         "    x[i]=y[i]+h*f2[i];"
4391         "  }"
4392         "  th=t+h;"
4393         "  for (i=0;i<neq;i++) {"
4394         "    yh[i]=y[i]+h*f2[i];"
4395         "  }"
4396         "  (*f)(th2,yh, xd);"
4397         ""
4398         "  /**/"
4399         "  temp=h/6;"
4400         "  for (i=0;i<neq;i++) {"
4401         "    x[i]=y[i]+temp*(f0[i]+2.0*f1[i]+2.0*f2[i]+xd[i]);"
4402         "  }"
4403         ""
4404         "return 0;"
4405         "}"], fd);
4406     end
4407
4408     mclose(fd);
4409 endfunction
4410
4411 //generates  static table definitions
4412 //
4413 //Author : Rachid Djenidi, Alan Layec
4414 function txt=make_static_standalone42()
4415     oldFormat = format();
4416     format(25);
4417     txt=[];
4418
4419     //*** Continuous state ***//
4420     if x <> [] then
4421         txt=[txt;
4422         "/* def continuous state */"
4423         cformatline("double x[]={"+strcat(string(x),",")+"};",70)
4424         cformatline("double xd[]={"+strcat(string(x),",")+"};",70)
4425         "static int c__1 = 1;"
4426         "static double c_b14 = 0.;"
4427         "static int neq="+string(nX)+";"
4428         ""]
4429     end
4430     //************************//
4431
4432     txt=[txt;
4433     "char input[50], output[50],s[1],sf[1],se[1],ss[1],**p;"
4434     "static double sci_time;"
4435     "static int errflg = 0;"
4436     "static char *optarg = NULL ;"
4437     "static int optind = 1, offset = 0 ;"
4438     "scicos_block block_"+rdnom+"["+string(nblk)+"];"
4439     ""];
4440
4441     //*** Real parameters ***//
4442     if size(rpar,1) <> 0 then
4443         txt=[txt;
4444         "/* def real parameters */"
4445         "static double RPAR1[ ] = {"];
4446
4447         for i=1:(length(rpptr)-1)
4448             if rpptr(i+1)-rpptr(i)>0  then
4449
4450                 if size(corinv(i),"*")==1 then
4451                     OO=scs_m.objs(corinv(i));
4452                 else
4453                     path=list("objs");
4454                     for l=cpr.corinv(i)(1:$-1)
4455                         path($+1)=l;
4456                         path($+1)="model";
4457                         path($+1)="rpar";
4458                         path($+1)="objs";
4459                     end
4460                     path($+1)=cpr.corinv(i)($);
4461                     OO=scs_m(path);
4462                 end
4463
4464                 //** Add comments **//
4465                 txt($+1)="/* Routine name of block: "+strcat(string(cpr.sim.funs(i)));
4466                 txt($+1)=" * Gui name of block: "+strcat(string(OO.gui));
4467                 txt($+1)=" * Compiled structure index: "+strcat(string(i));
4468
4469                 if stripblanks(OO.model.label)~=emptystr() then
4470                     txt=[txt;cformatline(" * Label: "+strcat(string(OO.model.label)),70)];
4471                 end
4472                 if stripblanks(OO.graphics.exprs(1))~=emptystr() then
4473                     txt=[txt;cformatline(" * Exprs: "+strcat(OO.graphics.exprs(1),","),70)];
4474                 end
4475                 if stripblanks(OO.graphics.id)~=emptystr() then
4476                     txt=[txt;
4477                     cformatline(" * Identification: "+strcat(string(OO.graphics.id)),70)];
4478                 end
4479                 txt=[txt;" * rpar="];
4480                 txt($+1)=" */";
4481                 //******************//
4482
4483                 txt=[txt;
4484                 cformatline(strcat(msprintf("%.25E,\n",rpar(rpptr(i):rpptr(i+1)-1))),70);
4485                 ""]
4486
4487             end
4488         end
4489         txt=[txt;
4490         "};"
4491         ""]
4492
4493     else
4494         txt($+1)="static double RPAR1[1];";
4495     end
4496     //***********************//
4497
4498     //*** Integer parameters ***//
4499     if size(ipar,1) <> 0 then
4500         txt=[txt;
4501         "/* def integer parameters */"
4502         "static int IPAR1[ ] = {"];
4503
4504         for i=1:(length(ipptr)-1)
4505             if ipptr(i+1)-ipptr(i)>0  then
4506                 if size(corinv(i),"*")==1 then
4507                     OO=scs_m.objs(corinv(i));
4508                 else
4509                     path=list("objs");
4510                     for l=cpr.corinv(i)(1:$-1)
4511                         path($+1)=l
4512                         path($+1)="model"
4513                         path($+1)="rpar"
4514                         path($+1)="objs"
4515                     end
4516                     path($+1)=cpr.corinv(i)($);
4517                     OO=scs_m(path);
4518                 end
4519
4520                 //** Add comments **//
4521                 txt($+1)="/* Routine name of block: "+strcat(string(cpr.sim.funs(i)));
4522                 txt($+1)=" * Gui name of block: "+strcat(string(OO.gui));
4523                 txt($+1)=" * Compiled structure index: "+strcat(string(i));
4524                 if stripblanks(OO.model.label)~=emptystr() then
4525                     txt=[txt;cformatline(" * Label: "+strcat(string(OO.model.label)),70)];
4526                 end
4527
4528                 if stripblanks(OO.graphics.exprs(1))~=emptystr() then
4529                     txt=[txt;
4530                     cformatline(" * Exprs: "+strcat(OO.graphics.exprs(1),","),70)];
4531                 end
4532                 if stripblanks(OO.graphics.id)~=emptystr() then
4533                     txt=[txt;
4534                     cformatline(" * Identification: "+strcat(string(OO.graphics.id)),70)];
4535                 end
4536                 txt=[txt;
4537                 cformatline(" * ipar= {"+strcat(string(ipar(ipptr(i):ipptr(i+1)-1)),",")+"};",70)];
4538                 txt($+1)=" */";
4539                 //******************//
4540
4541                 txt=[txt;cformatline(strcat(string(ipar(ipptr(i):ipptr(i+1)-1))+","),70)];
4542                 txt($+1)="";
4543             end
4544         end
4545         txt=[txt;
4546         "};"
4547         ""]
4548     else
4549         txt($+1)="static int IPAR1[1];";
4550     end
4551     //**************************//
4552
4553     //Alan added opar (27/06/07)
4554     //*** Object parameters ***//
4555     if lstsize(opar)<>0 then
4556         txt=[txt;
4557         "/* def object parameters */"]
4558         for i=1:(length(opptr)-1)
4559             if opptr(i+1)-opptr(i)>0  then
4560
4561                 if size(corinv(i),"*")==1 then
4562                     OO=scs_m.objs(corinv(i));
4563                 else
4564                     path=list("objs");
4565                     for l=cpr.corinv(i)(1:$-1)
4566                         path($+1)=l;
4567                         path($+1)="model";
4568                         path($+1)="rpar";
4569                         path($+1)="objs";
4570                     end
4571                     path($+1)=cpr.corinv(i)($);
4572                     OO=scs_m(path);
4573                 end
4574
4575                 //** Add comments **//
4576                 txt($+1)="";
4577                 txt($+1)="/* Routine name of block: "+strcat(string(cpr.sim.funs(i)));
4578                 txt($+1)=" * Gui name of block: "+strcat(string(OO.gui));
4579                 txt($+1)=" * Compiled structure index: "+strcat(string(i));
4580                 if stripblanks(OO.model.label)~=emptystr() then
4581                     txt=[txt;cformatline(" * Label: "+strcat(string(OO.model.label)),70)];
4582                 end
4583                 if stripblanks(OO.graphics.id)~=emptystr() then
4584                     txt=[txt;
4585                     cformatline(" * Identification: "+strcat(string(OO.graphics.id)),70)];
4586                 end
4587                 txt($+1)=" */";
4588                 //******************//
4589
4590
4591                 for j=1:opptr(i+1)-opptr(i)
4592                     txt =[txt;
4593                     cformatline("static "+mat2c_typ(opar(opptr(i)+j-1)) +...
4594                     " OPAR_"+string(opptr(i)+j-1) + "[] = {"+...
4595                     strcat(string(opar(opptr(i)+j-1)),",")+"};",70)]
4596                 end
4597             end
4598         end
4599     end
4600     //*************************//
4601
4602     txt=[txt;
4603     ""]
4604     format(oldFormat(2), oldFormat(1));
4605 endfunction
4606
4607 //utilitary fonction used to format long C instruction
4608 //t : a string containing a C instruction
4609 //l : max line length allowed
4610
4611 //Author : Rachid Djenidi
4612 function t1=cformatline(t ,l)
4613     // Force format to avoid precision loss
4614     oldFormat = format();
4615     format(25);
4616
4617     sep=[",","+"]
4618     l1=l-2
4619     t1=[]
4620     kw=strindex(t," ")
4621     nw=0
4622     if kw<>[] then
4623         if kw(1)==1 then // there is leading blanks
4624             k1=find(kw(2:$)-kw(1:$-1)<>1)
4625             if k1==[] then // there is a single blank
4626                 nw=1
4627             else
4628                 nw=kw(k1(1))
4629             end
4630         end
4631     end
4632     t=part(t,nw+1:length(t));
4633     bl=part(" ",ones(1,nw))
4634     l1=l-nw;first=%t
4635     while %t
4636         if length(t)<=l then
4637             t1=[t1;bl+t]
4638             break
4639         end
4640         k=strindex(t,sep);
4641         if k==[] then
4642             t1=[t1;bl+t]
4643             break
4644         end
4645         k($+1)=length(t)+1 // positions of the commas
4646         i=find(k(1:$-1)<=l&k(2:$)>l) //nearest left comma (reltively to l)
4647         if i==[] then
4648             i=1
4649         end
4650         t1=[t1;bl+part(t,1:k(i))]
4651         t=part(t,k(i)+1:length(t))
4652         if first then
4653             l1=l1-2;bl=bl+"  ";
4654             first=%f;
4655         end
4656     end
4657
4658     format(oldFormat(2), oldFormat(1));
4659 endfunction
4660
4661 //
4662 // Generate Matrix of all binary code from
4663 // 1 to 2^n-1
4664 //
4665 function vec = binaryTable(n)
4666     n = int(n);
4667     vec = [];
4668     for i = 1:n
4669         accu = [];
4670         for j = 1:2^(n-i-1)
4671             accu = [accu ; zeros(2^(i-1),1) ; ones(2^(i-1),1)]
4672         end
4673         vec = [accu, vec]
4674     end
4675     vec=vec(2:$, :); // Remove first line [ 0 --- 0 ]
4676 endfunction
4677
4678 //used in do_compile_superblock
4679 function vec=codebinaire(v,szclkIN)
4680     vec=zeros(1,szclkIN)
4681     for i=1:szclkIN
4682         w=v/2;
4683         vec(i)=v-2*int(w);
4684         v=int(w);
4685     end
4686 endfunction
4687
4688 function t=filetype(m)
4689     m=int32(m)
4690     filetypes=["Directory","Character device","Block device",...
4691     "Regular file","FIFO","Symbolic link","Socket"]
4692     bits=[16384,8192,24576,32768,4096,40960,49152]
4693     m=int32(m)&int32(61440)
4694     t=filetypes(find(m==int32(bits)))
4695 endfunction
4696
4697 //get_blank : return blanks with a length
4698 //            of the given input string
4699 //
4700 //input : str : a string
4701 //
4702 //output : txt : blanks
4703 //
4704 //16/06/07 Author : A.Layec
4705 function [txt] = get_blank(str)
4706     txt="";
4707     for i=1:length(str)
4708         txt=txt+" ";
4709     end
4710 endfunction
4711
4712 // get_comment : return a C comment
4713 //               for generated code
4714 //
4715 //input : typ : a string
4716 //        param : a list
4717 //
4718 //output : a C comment
4719 //
4720 //16/06/07 Author : A.Layec
4721 function [txt]=get_comment(typ,param)
4722     txt = [];
4723     select typ
4724         //** main flag
4725     case "flag" then
4726         select param(1)
4727         case 0 then
4728             txt = "/* Continuous state computation */"
4729         case 1 then
4730             txt = "/* Output computation */"
4731         case 2 then
4732             txt = "/* Discrete state computation */"
4733         case 3 then
4734             txt = "/* Output Event computation */"
4735         case 4 then
4736             txt = "/* Initialization */"
4737         case 5 then
4738             txt = "/* Ending */"
4739         case 9 then
4740             txt = "/* Update zero crossing surfaces */"
4741         end
4742         //** blocks activated on event number
4743     case "ev" then
4744         txt = "/* Blocks activated on the event number "+string(param(1))+" */"
4745
4746         //** blk calling sequence
4747     case "call_blk" then
4748         txt = ["/* Call of ''"+param(1) + ...
4749         "'' (type "+string(param(2))+" - blk nb "+...
4750         string(param(3))+" - uid "+param(4)];
4751         if ztyp(param(3)) then
4752             txt=txt+" - with zcross) */";
4753         else
4754             txt=txt+") */";
4755         end
4756         //** proto calling sequence
4757     case "proto_blk" then
4758         txt = ["/* prototype of ''"+param(1) + ...
4759         "'' (type "+string(param(2))];
4760         if ztyp(param(3)) then
4761             txt=txt+" - with zcross) */";
4762         else
4763             txt=txt+") */";
4764         end
4765         //** ifthenelse calling sequence
4766     case "ifthenelse_blk" then
4767         txt = ["/* Call of ''if-then-else'' blk (blk nb "+...
4768         string(param(1))+") */"]
4769         //** eventselect calling sequence
4770     case "evtselect_blk" then
4771         txt = ["/* Call of ''event-select'' blk (blk nb "+...
4772         string(param(1))+") */"]
4773         //** set block structure
4774     case "set_blk" then
4775         txt = ["/* set blk struc. of ''"+param(1) + ...
4776         "'' (type "+string(param(2))+" - blk nb "+...
4777         string(param(3))++" - uid "+param(4)+") */"];
4778         //** Update xd vector ptr
4779     case "update_xd" then
4780         txt = ["/* Update xd vector ptr */"];
4781         //** Update g vector ptr
4782     case "update_g" then
4783         txt = ["/* Update g vector ptr */"];
4784     else
4785         break;
4786     end
4787 endfunction
4788
4789 //mat2c_typ : matrix to C type
4790 //sci2c_ttyp : get the C string of a scicos type
4791 //
4792 //input : outtb : a matrix
4793 //
4794 //output : txt : the string of the C scicos type
4795 //               of the data of outtb
4796 //
4797 //16/06/07 Author : A.Layec
4798 function [txt]=mat2c_typ(outtb)
4799     select type(outtb)
4800         //real matrix
4801     case 1 then
4802         if isreal(outtb) then
4803             txt = "double"
4804         else
4805             txt = "double"
4806         end
4807         //integer matrix
4808     case 8 then
4809         select typeof(outtb)
4810         case "int32" then
4811             txt = "long"
4812         case "int16" then
4813             txt = "short"
4814         case "int8" then
4815             txt = "char"
4816         case "uint32" then
4817             txt = "unsigned long"
4818         case "uint16" then
4819             txt = "unsigned short"
4820         case "uint8" then
4821             txt = "unsigned char"
4822         end
4823     else
4824         break;
4825     end
4826 endfunction
4827
4828 //mat2scs_c_nb  matrix to scicos C number (sci2sci_n)
4829 //
4830 //input : outtb : a matrix
4831 //
4832 //output : c_nb : the scicos C number
4833 //
4834 //16/06/07 Author : A.Layec
4835 function [c_nb]=mat2scs_c_nb(outtb)
4836     select type(outtb)
4837         //real matrix
4838     case 1 then
4839         if isreal(outtb) then
4840             c_nb = 10
4841         else
4842             c_nb = 11
4843         end
4844         //integer matrix
4845     case 8 then
4846         select typeof(outtb)
4847         case "int32" then
4848             c_nb = 84
4849         case "int16" then
4850             c_nb = 82
4851         case "int8" then
4852             c_nb = 81
4853         case "uint32" then
4854             c_nb = 814
4855         case "uint16" then
4856             c_nb = 812
4857         case "uint8" then
4858             c_nb = 811
4859         end
4860     else
4861         break;
4862     end
4863 endfunction
4864
4865 //mat2scs_c_ptr matrix to scicos C ptr (sci2c_typ)
4866 //
4867 //input : outtb : a matrix
4868 //
4869 //output : txt : the string of the C scicos type
4870 //               of the data of outtb
4871 //
4872 //16/06/07 Author : A.Layec
4873 function [txt]=mat2scs_c_ptr(outtb)
4874     select type(outtb)
4875         //real matrix
4876     case 1 then
4877         if isreal(outtb) then
4878             txt = "SCSREAL_COP"
4879         else
4880             txt = "SCSCOMPLEX_COP"
4881         end
4882         //integer matrix
4883     case 8 then
4884         select typeof(outtb)
4885         case "int32" then
4886             txt = "SCSINT32_COP"
4887         case "int16" then
4888             txt = "SCSINT16_COP"
4889         case "int8" then
4890             txt = "SCSINT8_COP"
4891         case "uint32" then
4892             txt = "SCSUINT32_COP"
4893         case "uint16" then
4894             txt = "SCSUINT16_COP"
4895         case "uint8" then
4896             txt = "SCSUINT8_COP"
4897         end
4898     else
4899         break;
4900     end
4901 endfunction
4902
4903 //mat2scs_c_typ matrix to scicos C type
4904 //
4905 //input : outtb : a matrix
4906 //
4907 //output : txt : the string of the C scicos type
4908 //               of the data of outtb
4909 //
4910 //16/06/07 Author : A.Layec
4911 function [txt]=mat2scs_c_typ(outtb)
4912     select type(outtb)
4913         //real matrix
4914     case 1 then
4915         if isreal(outtb) then
4916             txt = "SCSREAL_N"
4917         else
4918             txt = "SCSCOMPLEX_N"
4919         end
4920         //integer matrix
4921     case 8 then
4922         select typeof(outtb)
4923         case "int32" then
4924             txt = "SCSINT32_N"
4925         case "int16" then
4926             txt = "SCSINT16_N"
4927         case "int8" then
4928             txt = "SCSINT8_N"
4929         case "uint32" then
4930             txt = "SCSUINT32_N"
4931         case "uint16" then
4932             txt = "SCSUINT16_N"
4933         case "uint8" then
4934             txt = "SCSUINT8_N"
4935         end
4936     else
4937         break;
4938     end
4939 endfunction
4940
4941 //scs_c_n2c_fmt : scicos C number to C format
4942 //
4943 //input : c_nb : a C scicos type
4944 //
4945 //output : txt : the string of the C format string
4946 //               of the data of outtb
4947 //
4948 //16/06/07 Author : A.Layec
4949 function [txt]=scs_c_n2c_fmt(c_nb)
4950     select c_nb
4951         //real matrix
4952     case 10 then
4953         txt = "%f";
4954         //complex matrix
4955     case 11 then
4956         txt = "%f,%f";
4957         //int8 matrix
4958     case 81 then
4959         txt = "%d";
4960         //int16 matrix
4961     case 82 then
4962         txt = "%d";
4963         //int32 matrix
4964     case 84 then
4965         txt = "%d";
4966         //uint8 matrix
4967     case 811 then
4968         txt = "%d";
4969         //uint16 matrix
4970     case 812 then
4971         txt = "%d";
4972         //uint32 matrix
4973     case 814 then
4974         txt = "%d";
4975     else
4976         txt="%f"
4977         break;
4978     end
4979 endfunction
4980
4981 //scs_c_n2c_typ scicos C number to C type
4982 //
4983 //input : c_nb : a C scicos number
4984 //
4985 //output : txt : the string of the C format string
4986 //               of the data of outtb
4987 //
4988 //16/06/07 Author : A.Layec
4989 function [txt]=scs_c_n2c_typ(c_nb)
4990     select c_nb
4991         //real matrix
4992     case 10 then
4993         txt = "double";
4994         //complex matrix
4995     case 11 then
4996         txt = "double";
4997         //int8 matrix
4998     case 81 then
4999         txt = "char";
5000         //int16 matrix
5001     case 82 then
5002         txt = "short";
5003         //int32 matrix
5004     case 84 then
5005         txt = "long";
5006         //uint8 matrix
5007     case 811 then
5008         txt = "unsigned char";
5009         //uint16 matrix
5010     case 812 then
5011         txt = "unsigned short";
5012         //uint32 matrix
5013     case 814 then
5014         txt = "unsigned long";
5015     else
5016         txt="double"
5017         break;
5018     end
5019 endfunction
5020
5021 //scs_c_nb2scs_nb : scicos C number to scicos number
5022 //
5023 //input : c_nb  : the scicos C number type
5024 //
5025 //output : scs_nb : the scilab number type
5026 //
5027 //16/06/07 Author : A.Layec
5028 function [scs_nb]=scs_c_nb2scs_nb(c_nb)
5029     scs_nb=zeros(size(c_nb,1),size(c_nb,2));
5030     for i=1:size(c_nb,1)
5031         for j=1:size(c_nb,2)
5032             select (c_nb(i,j))
5033             case 10 then
5034                 scs_nb(i,j) = 1
5035             case 11 then
5036                 scs_nb(i,j) = 2
5037             case 81 then
5038                 scs_nb(i,j) = 5
5039             case 82 then
5040                 scs_nb(i,j) = 4
5041             case 84 then
5042                 scs_nb(i,j) = 3
5043             case 811 then
5044                 scs_nb(i,j) = 8
5045             case 812 then
5046                 scs_nb(i,j) = 7
5047             case 814 then
5048                 scs_nb(i,j) = 6
5049             else
5050                 scs_nb(i,j) = 1
5051             end
5052         end
5053     end
5054 endfunction
5055
5056 //used in do_compile_superblock
5057 function XX=update_block(XX)
5058     execstr("o="+rdnom+"_c(''define'')")
5059     XX.model=o.model
5060     XX.gui=rdnom+"_c";
5061     XX.graphics.gr_i=o.graphics.gr_i
5062 endfunction
5063
5064 //write_code_cdoit : generate body of the code for
5065 //                   for all time dependant blocks
5066 //
5067 //input : flag : flag number for block's call
5068 //
5069 //output : txt for cord blocks
5070 //
5071 //12/07/07 Alan Layec
5072 function [txt]=write_code_cdoit(flag)
5073     txt=[];
5074
5075     for j=1:ncord
5076         bk=cord(j,1);
5077         pt=cord(j,2);
5078         //** blk
5079         if funtyp(bk)>-1 then
5080             if or(bk==act) | or(bk==cap) then
5081                 if stalone then
5082                     txt2=call_block42(bk,pt,flag);
5083                     if txt2<>[] then
5084                         txt=[txt;
5085                         "    "+txt2
5086                         ""];
5087                     end
5088                 end
5089             else
5090                 txt2=call_block42(bk,pt,flag);
5091                 if txt2<>[] then
5092                     txt=[txt;
5093                     "    "+txt2
5094                     ""];
5095                 end
5096             end
5097             //** ifthenelse blk
5098         elseif funtyp(bk)==-1 then
5099             ix=-1+inplnk(inpptr(bk));
5100             TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
5101             thentxt=write_code_doit(clkptr(bk),flag);
5102             elsetxt=write_code_doit(clkptr(bk)+1,flag);
5103             if thentxt<>[] | elsetxt<>[] then
5104                 txt=[txt;
5105                 "    "+get_comment("ifthenelse_blk",list(bk));]
5106                 //** C **//
5107                 tmp_="*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5108                 txt=[txt;
5109                 "    if("+tmp_+">0) {"]
5110                 //*******//
5111                 txt=[txt;
5112                 Indent+thentxt];
5113                 if elsetxt<>[] then
5114                     //** C **//
5115                     txt=[txt;
5116                     "    }";
5117                     "    else {";]
5118                     //*******//
5119                     txt=[txt;
5120                     Indent+elsetxt];
5121                 end
5122                 //** C **//
5123                 txt=[txt;
5124                 "    }"]
5125                 //*******//
5126             end
5127             //** eventselect blk
5128         elseif funtyp(bk)==-2 then
5129             Noutport=clkptr(bk+1)-clkptr(bk);
5130             ix=-1+inplnk(inpptr(bk));
5131             TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
5132             II=[];
5133             switchtxt=list()
5134             for i=1: Noutport
5135                 switchtxt(i)=write_code_doit(clkptr(bk)+i-1,flag);
5136                 if switchtxt(i)<>[] then II=[II i];end
5137             end
5138             if II<>[] then
5139                 txt=[txt;
5140                 "    "+get_comment("evtselect_blk",list(bk));]
5141                 //** C **//
5142                 tmp_="*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5143                 txt=[txt;
5144                 "    i=max(min((int) "+...
5145                 tmp_+",block_"+rdnom+"["+string(bk-1)+"].evout),1);"
5146                 "    switch(i)"
5147                 "    {"]
5148                 //*******//
5149                 for i=II
5150                     //** C **//
5151                     txt=[txt;
5152                     "     case "+string(i)+" :";]
5153                     //*******//
5154                     txt=[txt;
5155                     BigIndent+write_code_doit(clkptr(bk)+i-1,flag);]
5156                     //** C **//
5157                     txt=[txt;
5158                     BigIndent+"break;"]
5159                     //*******//
5160                 end
5161                 //** C **//
5162                 txt=[txt;
5163                 "    }"];
5164                 //*******//
5165             end
5166             //** Unknown block
5167         else
5168             error("Unknown block type "+string(bk));
5169         end
5170     end
5171
5172 endfunction
5173
5174 //write_code_doit : generate body of the code for
5175 //                  ordering calls of blocks during
5176 //                  flag 1,2 & flag 3
5177 //
5178 //input : ev  : evt number for block's call
5179 //       flag : flag number for block's call
5180 //
5181 //output : txt for flag 1 or 2, or flag 3
5182 //
5183 //12/07/07 Alan Layec
5184 function [txt]=write_code_doit(ev,flag)
5185     txt=[];
5186
5187     for j=ordptr(ev):ordptr(ev+1)-1
5188         bk=ordclk(j,1);
5189         pt=ordclk(j,2);
5190         //** blk
5191         if funtyp(bk)>-1 then
5192             if or(bk==act) | or(bk==cap) then
5193                 if stalone then
5194                     txt2=call_block42(bk,pt,flag);
5195                     if txt2<>[] then
5196                         txt=[txt;
5197                         "    "+txt2
5198                         ""];
5199                     end
5200                 end
5201             else
5202                 txt2=call_block42(bk,pt,flag);
5203                 if txt2<>[] then
5204                     txt=[txt;
5205                     "    "+txt2
5206                     ""];
5207                 end
5208             end
5209             //** ifthenelse blk
5210         elseif funtyp(bk)==-1 then
5211             ix=-1+inplnk(inpptr(bk));
5212             TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
5213             thentxt=write_code_doit(clkptr(bk),flag);
5214             elsetxt=write_code_doit(clkptr(bk)+1,flag);
5215             if thentxt<>[] | elsetxt<>[] then
5216                 txt=[txt;
5217                 "    "+get_comment("ifthenelse_blk",list(bk));]
5218                 //** C **//
5219                 tmp_ = "*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5220                 txt=[txt;
5221                 "    if("+tmp_+">0) {"]
5222                 //*******//
5223                 txt=[txt;
5224                 Indent+thentxt]
5225                 if elsetxt<>[] then
5226                     //** C **//
5227                     txt=[txt;
5228                     "    }";
5229                     "    else {";]
5230                     //*******//
5231                     txt=[txt;
5232                     Indent+elsetxt];
5233                 end
5234                 //** C **//
5235                 txt=[txt;
5236                 "    }"]
5237                 //*******//
5238             end
5239             //** eventselect blk
5240         elseif funtyp(bk)==-2 then
5241             Noutport=clkptr(bk+1)-clkptr(bk);
5242             ix=-1+inplnk(inpptr(bk));
5243             TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
5244             II=[];
5245             switchtxt=list()
5246             for i=1: Noutport
5247                 switchtxt(i)=write_code_doit(clkptr(bk)+i-1,flag);
5248                 if switchtxt(i)<>[] then II=[II i];end
5249             end
5250             if II<>[] then
5251                 txt=[txt;
5252                 "    "+get_comment("evtselect_blk",list(bk));]
5253                 tmp_="*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5254                 //** C **//
5255                 txt=[txt;
5256                 "    i=max(min((int) "+...
5257                 tmp_+",block_"+rdnom+"["+string(bk-1)+"].evout),1);"
5258                 "    switch(i)"
5259                 "    {"]
5260                 //*******//
5261                 for i=II
5262                     //** C **//
5263                     txt=[txt;
5264                     "     case "+string(i)+" :";]
5265                     //*******//
5266                     txt=[txt;
5267                     BigIndent+write_code_doit(clkptr(bk)+i-1,flag);]
5268                     //** C **//
5269                     txt=[txt;
5270                     BigIndent+"break;"]
5271                     //*******//
5272                 end
5273                 //** C **//
5274                 txt=[txt;
5275                 "    }"]
5276                 //*******//
5277             end
5278             //** Unknown block
5279         else
5280             error("Unknown block type "+string(bk));
5281         end
5282     end
5283
5284 endfunction
5285
5286 //write_code_idoit : generate body of the code for
5287 //                   ordering calls of initial
5288 //                   called blocks
5289 //
5290 //input : nothing (blocks are called with flag 1)
5291 //
5292 //output : txt for iord
5293 //
5294 //15/07/07 Alan Layec
5295 function [txt]=write_code_idoit()
5296     txt=[];
5297
5298     for j=1:niord
5299         bk=iord(j,1);
5300         pt=iord(j,2);
5301         //** blk
5302         if funtyp(bk)>-1 then
5303             if or(bk==act) then
5304                 if stalone then
5305                     txt2=call_block42(bk,pt,1);
5306                     if txt2<>[] then
5307                         txt=[txt;
5308                         "    "+txt2
5309                         ""];
5310                     end
5311                 end
5312             else
5313                 txt2=call_block42(bk,pt,1);
5314                 if txt2<>[] then
5315                     txt=[txt;
5316                     "    "+txt2
5317                     ""];
5318                 end
5319             end
5320             //** ifthenelse blk
5321         elseif funtyp(bk)==-1 then
5322             ix=-1+inplnk(inpptr(bk));
5323             TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
5324             thentxt=write_code_doit(clkptr(bk),1);
5325             elsetxt=write_code_doit(clkptr(bk)+1,1);
5326             if thentxt<>[] | elsetxt<>[] then
5327                 txt=[txt;
5328                 "    "+get_comment("ifthenelse_blk",list(bk));]
5329                 //** C **//
5330                 tmp_ = "*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5331                 txt=[txt;
5332                 "    if("+tmp_+">0) {"]
5333                 //*******//
5334                 txt=[txt;
5335                 Indent+thentxt];
5336                 if elsetxt<>[] then
5337                     //** C **//
5338                     txt=[txt;
5339                     "    }";
5340                     "    else {";]
5341                     //*******//
5342                     txt=[txt;
5343                     Indent+elsetxt];
5344                 end
5345                 //** C **//
5346                 txt=[txt;
5347                 "    }"]
5348                 //*******//
5349             end
5350             //** eventselect blk
5351         elseif funtyp(bk)==-2 then
5352             Noutport=clkptr(bk+1)-clkptr(bk);
5353             ix=-1+inplnk(inpptr(bk));
5354             TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
5355             II=[];
5356             switchtxt=list()
5357             for i=1: Noutport
5358                 switchtxt(i)=write_code_doit(clkptr(bk)+i-1,1);
5359                 if switchtxt(i)<>[] then II=[II i];end
5360             end
5361             if II<>[] then
5362                 txt=[txt;
5363                 "    "+get_comment("evtselect_blk",list(bk));]
5364                 //** C **//
5365                 tmp_="*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5366                 txt=[txt;
5367                 "    i=max(min((int) "+...
5368                 tmp_+",block_"+rdnom+"["+string(bk-1)+"].evout),1);"]
5369                 txt=[txt;
5370                 "    switch(i)"
5371                 "    {"]
5372                 //*******//
5373                 for i=II
5374                     //** C **//
5375                     txt=[txt;
5376                     "     case "+string(i)+" :";]
5377                     //*******//
5378                     txt=[txt;
5379                     BigIndent+write_code_doit(clkptr(bk)+i-1,1);]
5380                     //** C **//
5381                     txt=[txt;
5382                     BigIndent+"break;"]
5383                     //*******//
5384                 end
5385                 //** C **//
5386                 txt=[txt;
5387                 "    }"];
5388                 //*******//
5389             end
5390             //** Unknown block
5391         else
5392             error("Unknown block type "+string(bk));
5393         end
5394     end
5395
5396 endfunction
5397
5398 //write_code_odoit : generate body of the code for
5399 //                   ordering calls of blocks before
5400 //                   continuous time integration
5401 //
5402 //input : flag : flag number for block's call
5403 //
5404 //output : txt for flag 0
5405 //
5406 //12/07/07 Alan Layec
5407 function [txt]=write_code_odoit(flag)
5408     txt=[];
5409
5410     for j=1:noord
5411         bk=oord(j,1);
5412         pt=oord(j,2);
5413         //** blk
5414         if funtyp(bk)>-1 then
5415             txt2=call_block42(bk,pt,flag);
5416             if txt2<>[] then
5417                 txt=[txt;
5418                 "    "+txt2
5419                 ""];
5420             end
5421             //** ifthenelse blk
5422         elseif funtyp(bk)==-1 then
5423             ix=-1+inplnk(inpptr(bk));
5424             TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
5425             thentxt=write_code_ozdoit(clkptr(bk),flag);
5426             elsetxt=write_code_ozdoit(clkptr(bk)+1,flag);
5427             if thentxt<>[] | elsetxt<>[] then
5428                 txt=[txt;
5429                 "    "+get_comment("ifthenelse_blk",list(bk));]
5430                 //** C **//
5431                 tmp_="*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5432                 txt=[txt;
5433                 "    if ((block_"+rdnom+"["+string(bk-1)+"].nmode<0"+...
5434                 " && "+tmp_+">0)"+...
5435                 " || \"
5436                 "        (block_"+rdnom+"["+string(bk-1)+"].nmode>0"+...
5437                 " && block_"+rdnom+"["+string(bk-1)+"].mode[0]==1)) {"]
5438                 //*******//
5439                 txt=[txt;
5440                 Indent+thentxt]
5441                 //** C **//
5442                 txt=[txt;
5443                 "    }"];
5444                 //*******//
5445                 if elsetxt<>[] then
5446                     //** C **//
5447                     txt=[txt;
5448                     "    else if  ((block_"+rdnom+"["+string(bk-1)+"].nmode<0"+...
5449                     " && "+tmp_+"<=0)"+...
5450                     " || \"
5451                     "              (block_"+rdnom+"["+string(bk-1)+"].nmode>0"+...
5452                     " && block_"+rdnom+"["+string(bk-1)+"].mode[0]==2)) {";]
5453                     //*******//
5454                     txt=[txt;
5455                     Indent+elsetxt]
5456                     //** C **//
5457                     txt=[txt;
5458                     "    }"];
5459                     //*******//
5460                 end
5461             end
5462             //** eventselect blk
5463         elseif funtyp(bk)==-2 then
5464             Noutport=clkptr(bk+1)-clkptr(bk);
5465             ix=-1+inplnk(inpptr(bk));
5466             TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
5467             II=[];
5468             switchtxt=list()
5469             for i=1: Noutport
5470                 switchtxt(i)=write_code_ozdoit(clkptr(bk)+i-1,flag);
5471                 if switchtxt(i)<>[] then II=[II i];end
5472             end
5473             if II<>[] then
5474                 txt=[txt;
5475                 "    "+get_comment("evtselect_blk",list(bk));]
5476                 //** C **//
5477                 tmp_="*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5478                 txt=[txt;
5479                 "    if (block_"+rdnom+"["+string(bk-1)+"].nmode<0) {";
5480                 "      i=max(min((int) "+...
5481                 tmp_+",block_"+rdnom+"["+string(bk-1)+"].evout),1);"
5482                 "    }"
5483                 "    else {"
5484                 "      i=block_"+rdnom+"["+string(bk-1)+"].mode[0];"
5485                 "    }"]
5486                 txt=[txt;
5487                 "    switch(i)"
5488                 "    {"];
5489                 //*******//
5490                 for i=II
5491                     //** C **//
5492                     txt=[txt;
5493                     "     case "+string(i)+" :";]
5494                     //*******//
5495                     txt=[txt;
5496                     BigIndent+write_code_ozdoit(clkptr(bk)+i-1,flag);]
5497                     //** C **//
5498                     txt=[txt;
5499                     BigIndent+"break;"]
5500                     //*******//
5501                 end
5502                 //** C **//
5503                 txt=[txt;
5504                 "    }"];
5505                 //*******//
5506             end
5507             //** Unknown block
5508         else
5509             error("Unknown block type "+string(bk));
5510         end
5511     end
5512
5513 endfunction
5514
5515 //write_code_ozdoit : generate body of the code for both
5516 //                    flag 0 & flag 9
5517 //
5518 //input: ev  : evt number for block's call
5519 //      flag : flag number for block's call
5520 //
5521 //output : txt for flag 0 or flag 9
5522 //
5523 //12/07/07 Alan Layec
5524 function [txt]=write_code_ozdoit(ev,flag)
5525     txt=[];
5526
5527     for j=ordptr(ev):ordptr(ev+1)-1
5528         bk=ordclk(j,1);
5529         pt=ordclk(j,2);
5530         //** blk
5531         if funtyp(bk)>-1 then
5532             if (or(bk==act) | or(bk==cap)) & (flag==1) then
5533                 if stalone then
5534                     txt=[txt;
5535                     "    "+call_block42(bk,pt,flag)
5536                     ""];
5537                 end
5538             else
5539                 txt2=call_block42(bk,pt,flag);
5540                 if txt2<>[] then
5541                     txt=[txt;
5542                     "    "+txt2
5543                     ""];
5544                 end
5545             end
5546             //** ifthenelse blk
5547         elseif funtyp(bk)==-1 then
5548             ix=-1+inplnk(inpptr(bk));
5549             TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
5550             thentxt=write_code_ozdoit(clkptr(bk),flag);
5551             elsetxt=write_code_ozdoit(clkptr(bk)+1,flag);
5552             if thentxt<>[] | elsetxt<>[] then
5553                 txt=[txt;
5554                 "    "+get_comment("ifthenelse_blk",list(bk));]
5555                 //** C **//
5556                 tmp_ = "*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5557                 txt=[txt;
5558                 "    if (((phase==1"+...
5559                 " || block_"+rdnom+"["+string(bk-1)+"].nmode==0)"+...
5560                 " && "+tmp_+">0)"+...
5561                 " || \"
5562                 "        ((phase!=1"+...
5563                 " && block_"+rdnom+"["+string(bk-1)+"].nmode!=0)"+...
5564                 " && block_"+rdnom+"["+string(bk-1)+"].mode[0]==1)) {"]
5565                 //*******//
5566                 txt=[txt;
5567                 Indent+thentxt]
5568                 //** C **//
5569                 txt=[txt;
5570                 "    }"];
5571                 //*******//
5572                 if elsetxt<>[] then
5573                     //** C **//
5574                     txt=[txt;
5575                     "      else if (((phase==1"+...
5576                     " || block_"+rdnom+"["+string(bk-1)+"].nmode==0)"+...
5577                     " && "+tmp_+"<=0)"+...
5578                     " || \"
5579                     "               ((phase!=1"+...
5580                     " && block_"+rdnom+"["+string(bk-1)+"].nmode!=0)"+...
5581                     " && block_"+rdnom+"["+string(bk-1)+"].mode[0]==2)) {";]
5582                     //*******//
5583                     txt=[txt;
5584                     Indent+elsetxt]
5585                     //** C **//
5586                     txt=[txt;
5587                     "    }"];
5588                     //*******//
5589                 end
5590             end
5591             //** eventselect blk
5592         elseif funtyp(bk)==-2 then
5593             Noutport=clkptr(bk+1)-clkptr(bk);
5594             ix=-1+inplnk(inpptr(bk));
5595             TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
5596             II=[];
5597             switchtxt=list()
5598             for i=1: Noutport
5599                 switchtxt(i)=write_code_ozdoit(clkptr(bk)+i-1,flag);
5600                 if switchtxt(i)<>[] then II=[II i];end
5601             end
5602             if II<>[] then
5603                 txt=[txt;
5604                 "    "+get_comment("evtselect_blk",list(bk));]
5605                 //** C **//
5606                 tmp_="*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5607                 txt=[txt;
5608                 "    if (phase==1 || block_"+rdnom+"["+string(bk-1)+"].nmode==0) {";
5609                 "      i=max(min((int) "+...
5610                 tmp_+",block_"+rdnom+"["+string(bk-1)+"].evout),1);"
5611                 "    }"
5612                 "    else {"
5613                 "      i=block_"+rdnom+"["+string(bk-1)+"].mode[0];"
5614                 "    }"]
5615                 txt=[txt;
5616                 "    switch(i)"
5617                 "    {"];
5618                 //*******//
5619                 for i=II
5620                     //** C **//
5621                     txt=[txt;
5622                     "     case "+string(i)+" :";]
5623                     //*******//
5624                     txt=[txt;
5625                     BigIndent+write_code_ozdoit(clkptr(bk)+i-1,flag);]
5626                     //** C **//
5627                     txt=[txt;
5628                     BigIndent+"break;"]
5629                     //*******//
5630                 end
5631                 //** C **//
5632                 txt=[txt;
5633                 "    }"];
5634                 //*******//
5635             end
5636             //** Unknown block
5637         else
5638             error("Unknown block type "+string(bk));
5639         end
5640     end
5641
5642 endfunction
5643
5644 //write_code_zdoit : generate body of the code for
5645 //                   ordering calls of blocks before
5646 //                   continuous time zero crossing
5647 //                   detection
5648 //
5649 //input : noting
5650 //
5651 //output : txt for flag 9
5652 //
5653 //12/07/07 Alan Layec
5654 function [txt]=write_code_zdoit()
5655     txt=[];
5656
5657     //** first pass (flag 1)
5658     for j=1:nzord
5659         bk=zord(j,1);
5660         pt=zord(j,2);
5661         //** blk
5662         if funtyp(bk)>-1 then
5663             if or(bk==act) | or(bk==cap) then
5664                 if stalone then
5665                     txt=[txt;
5666                     "    "+call_block42(bk,pt,1)
5667                     ""];
5668                 end
5669             else
5670                 txt2=call_block42(bk,pt,1);
5671                 if txt2<>[] then
5672                     txt=[txt;
5673                     "    "+txt2
5674                     ""];
5675                 end
5676             end
5677             //** ifthenelse blk
5678         elseif funtyp(bk)==-1 then
5679             ix=-1+inplnk(inpptr(bk));
5680             TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
5681             thentxt=write_code_ozdoit(clkptr(bk),1);
5682             elsetxt=write_code_ozdoit(clkptr(bk)+1,1);
5683             if thentxt<>[] | elsetxt<>[] then
5684                 txt=[txt;
5685                 "    "+get_comment("ifthenelse_blk",list(bk));]
5686                 //** C **//
5687                 tmp_ = "*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5688                 txt=[txt;
5689                 "    if (((phase==1"+...
5690                 " || block_"+rdnom+"["+string(bk-1)+"].nmode==0)"+...
5691                 " && "+tmp_+">0)"+...
5692                 " || \"
5693                 "        ((phase!=1"+...
5694                 " && block_"+rdnom+"["+string(bk-1)+"].nmode!=0)"+...
5695                 " && block_"+rdnom+"["+string(bk-1)+"].mode[0]==1)) {"]
5696                 //*******//
5697                 txt=[txt;
5698                 Indent+thentxt]
5699                 //** C **//
5700                 txt=[txt;
5701                 "    }"];
5702                 //*******//
5703                 if elsetxt<>[] then
5704                     //** C **//
5705                     txt=[txt;
5706                     "      else if (((phase==1"+...
5707                     " || block_"+rdnom+"["+string(bk-1)+"].nmode==0)"+...
5708                     " && "+tmp_+"<=0)"+...
5709                     " || \"
5710                     "               ((phase!=1"+...
5711                     " && block_"+rdnom+"["+string(bk-1)+"].nmode!=0)"+...
5712                     " && block_"+rdnom+"["+string(bk-1)+"].mode[0]==2)) {";]
5713                     //*******//
5714                     txt=[txt;
5715                     Indent+elsetxt]
5716                     //** C **//
5717                     txt=[txt;
5718                     "    }"];
5719                     //*******//
5720                 end
5721             end
5722             //** eventselect blk
5723         elseif funtyp(bk)==-2 then
5724             Noutport=clkptr(bk+1)-clkptr(bk);
5725             ix=-1+inplnk(inpptr(bk));
5726             TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
5727             II=[];
5728             switchtxt=list()
5729             for i=1: Noutport
5730                 switchtxt(i)=write_code_ozdoit(clkptr(bk)+i-1,1);
5731                 if switchtxt(i)<>[] then II=[II i];end
5732             end
5733             if II<>[] then
5734                 txt=[txt;
5735                 "    "+get_comment("evtselect_blk",list(bk));]
5736                 //** C **//
5737                 tmp_="*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5738                 txt=[txt;
5739                 "    if (phase==1 || block_"+rdnom+"["+string(bk-1)+"].nmode==0){";
5740                 "      i=max(min((int) "+...
5741                 tmp_+",block_"+rdnom+"["+string(bk-1)+"].evout),1);"
5742                 "    else {"
5743                 "      i=block_"+rdnom+"["+string(bk-1)+"].mode[0];"
5744                 "    }"]
5745                 txt=[txt;
5746                 "      switch(i)"
5747                 "      {"];
5748                 //*******//
5749                 for i=II
5750                     //** C **//
5751                     txt=[txt;
5752                     "       case "+string(i)+" :";]
5753                     //*******//
5754                     txt=[txt;
5755                     BigIndent+write_code_ozdoit(clkptr(bk)+i-1,1);]
5756                     //** C **//
5757                     txt=[txt;
5758                     BigIndent+"break;"]
5759                     //*******//
5760                 end
5761                 //** C **//
5762                 txt=[txt;
5763                 "      }"];
5764                 //*******//
5765             end
5766             //** Unknown block
5767         else
5768             error("Unknown block type "+string(bk));
5769         end
5770     end
5771
5772     //** second pass (flag 9)
5773     for j=1:nzord
5774         bk=zord(j,1);
5775         pt=zord(j,2);
5776         //** blk
5777         if funtyp(bk)>-1 then
5778             if or(bk==act) | or(bk==cap) then
5779                 if stalone then
5780                     txt=[txt;
5781                     "    "+call_block42(bk,pt,9)
5782                     ""];
5783                 end
5784             else
5785                 txt2=call_block42(bk,pt,9);
5786                 if txt2<>[] then
5787                     txt=[txt;
5788                     "    "+txt2
5789                     ""];
5790                 end
5791             end
5792
5793             //** ifthenelse blk
5794         elseif funtyp(bk)==-1 then
5795             ix=-1+inplnk(inpptr(bk));
5796             TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
5797             //** C **//
5798             tmp_="*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5799             //*******//
5800             thentxt=write_code_zzdoit(clkptr(bk),9);
5801             elsetxt=write_code_zzdoit(clkptr(bk)+1,9);
5802             txt=[txt;
5803             "    "+get_comment("ifthenelse_blk",list(bk));]
5804             //** C **//
5805             txt=[txt;
5806             "    g["+string(zcptr(bk)-1)+"]=(double)"+tmp_+";"]
5807             //*******//
5808             if thentxt<>[] | elsetxt<>[] then
5809                 //** C **//
5810                 txt=[txt;
5811                 "    if (g["+string(zcptr(bk)-1)+"] > 0.){"]
5812                 //*******//
5813                 txt=[txt;
5814                 Indent+thentxt]
5815                 //** C **//
5816                 txt=[txt;
5817                 "      }"]
5818                 //*******//
5819                 if elsetxt <> [] then
5820                     //** C **//
5821                     txt=[txt;
5822                     "      else {"]
5823                     //*******//
5824                     txt=[txt;
5825                     Indent+elsetxt]
5826                     //** C **//
5827                     txt=[txt;
5828                     "      }"]
5829                     //*******//
5830                 end
5831             end
5832             //** C **//
5833             txt=[txt;
5834             "    if(phase==1 && block_"+rdnom+"["+string(bk-1)+"].nmode > 0){"
5835             "      if (g["+string(zcptr(bk)-1)+"] > 0.){"
5836             "        block_"+rdnom+"["+string(bk-1)+"].mode[0] = 1;"
5837             "      }"
5838             "      else {"
5839             "        block_"+rdnom+"["+string(bk-1)+"].mode[0] = 2;"
5840             "      }"
5841             "    }"]
5842             //*******//
5843             //** eventselect blk
5844         elseif funtyp(bk)==-2 then
5845             Noutport=clkptr(bk+1)-clkptr(bk);
5846             ix=-1+inplnk(inpptr(bk));
5847             TYPE=mat2c_typ(outtb(ix+1));  //** scilab index start from 1
5848             //** C **//
5849             tmp_="*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5850             //*******//
5851             II=[];
5852             switchtxt=list()
5853             for i=1:Noutport
5854                 switchtxt(i)=write_code_zzdoit(clkptr(bk)+i-1,9);
5855                 if switchtxt(i)<>[] then II=[II i];end
5856             end
5857             txt=[txt;
5858             "    "+get_comment("evtselect_blk",list(bk));]
5859             if II<>[] then
5860                 //** C **//
5861                 txt=[txt;
5862                 "    j=max(min((int) "+...
5863                 tmp_+",block_"+rdnom+"["+string(bk-1)+"].nevout),1);"]
5864                 txt=[txt;
5865                 "    switch(j)"
5866                 "    {"];
5867                 //*******//
5868                 for i=II
5869                     //** C **//
5870                     txt=[txt;
5871                     "     case "+string(j)+" :";]
5872                     //*******//
5873                     txt=[txt;
5874                     BigIndent+write_code_zzdoit(clkptr(bk)+i-1,9);]
5875                     //** C **//
5876                     txt=[txt;
5877                     BigIndent+"break;"]
5878                     //*******//
5879                 end
5880                 //** C **//
5881                 txt=[txt;
5882                 "    }"];
5883                 //*******//
5884             end
5885             //** C **//
5886             txt=[txt;
5887             "  for (jj=0;jj<block_"+rdnom+"["+string(fun-1)+"].nevout-1;++jj) {"
5888             "    g["+string(zcptr(bk)-1)+"+jj]=(double)"+tmp_+"-(double)(jj+2);"
5889             "  }"
5890             "  if(phase==1 && block_"+rdnom+"["+string(bk-1)+"].nmode>0){"
5891             "    j=max(min((int) "+tmp_+","
5892             "              block_"+rdnom+"["+string(bk-1)+"].nevout),1);"
5893             "    block_"+rdnom+"["+string(bk-1)+"].mode[0]= j;"
5894             "  }"]
5895             //*******//
5896             //** Unknown block
5897         else
5898             error("Unknown block type "+string(bk));
5899         end
5900     end
5901
5902 endfunction
5903
5904 //write_code_zzdoit : generate body of the code for
5905 //                    flag 9
5906 //
5907 //input: ev  : evt number for block's call
5908 //      flag : flag number for block's call
5909 //
5910 //output : txt for flag 9
5911 //
5912 //12/07/07 Alan Layec
5913 function [txt]=write_code_zzdoit(ev,flag)
5914     txt=[];
5915
5916     for j=ordptr(ev):ordptr(ev+1)-1
5917         bk=ordclk(j,1);
5918         pt=ordclk(j,2);
5919         //** blk
5920         if funtyp(bk)>-1 then
5921             if or(bk==act) | or(bk==cap) then
5922                 if stalone then
5923                     txt=[txt;
5924                     "    "+call_block42(bk,pt,flag)
5925                     ""];
5926                 end
5927             else
5928                 txt2=call_block42(bk,pt,flag);
5929                 if txt2<>[] then
5930                     txt=[txt;
5931                     "    "+txt2
5932                     ""];
5933                 end
5934             end
5935             //** ifthenelse blk
5936         elseif funtyp(bk)==-1 then
5937             ix=-1+inplnk(inpptr(bk));
5938             TYPE=mat2c_typ(outtb(ix+1)); //** scilab index start from 1
5939             //** C **//
5940             tmp_="*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5941             //*******//
5942             thentxt=write_code_zzdoit(clkptr(bk),9);
5943             elsetxt=write_code_zzdoit(clkptr(bk)+1,9);
5944             txt=[txt;
5945             "    "+get_comment("ifthenelse_blk",list(bk));]
5946             //** C **//
5947             txt=[txt;
5948             "    g["+string(zcptr(bk)-1)+"]=(double)"+tmp_+";"]
5949             //*******//
5950             if thentxt<>[] | elsetxt<>[] then
5951                 //** C **//
5952                 txt=[txt;
5953                 "    if (g["+string(zcptr(bk)-1)+"] > 0.){"]
5954                 //*******//
5955                 txt=[txt;
5956                 Indent+thentxt]
5957                 //** C **//
5958                 txt=[txt;
5959                 "      }"]
5960                 //*******//
5961                 if elsetxt <> [] then
5962                     //** C **//
5963                     txt=[txt;
5964                     "      else {"]
5965                     //*******//
5966                     txt=[txt;
5967                     Indent+elsetxt]
5968                     //** C **//
5969                     txt=[txt;
5970                     "      }"]
5971                     //*******//
5972                 end
5973             end
5974             //** C **//
5975             txt=[txt;
5976             "    if(phase==1 && block_"+rdnom+"["+string(bk-1)+"].nmode > 0){"
5977             "      if (g["+string(zcptr(bk)-1)+"] > 0.){"
5978             "        block_"+rdnom+"["+string(bk-1)+"].mode[0] = 1;"
5979             "      }"
5980             "      else {"
5981             "        block_"+rdnom+"["+string(bk-1)+"].mode[0] = 2;"
5982             "      }"
5983             "    }"]
5984             //*******//
5985
5986             //** eventselect blk
5987         elseif funtyp(bk)==-2 then
5988             Noutport=clkptr(bk+1)-clkptr(bk);
5989             ix=-1+inplnk(inpptr(bk));
5990             TYPE=mat2c_typ(outtb(ix+1));  //** scilab index start from 1
5991             //** C **//
5992             tmp_="*(("+TYPE+" *)"+rdnom+"_block_outtbptr["+string(ix)+"])"
5993             //*******//
5994             II=[];
5995             switchtxt=list()
5996             for i=1:Noutport
5997                 switchtxt(i)=write_code_zzdoit(clkptr(bk)+i-1,9);
5998                 if switchtxt(i)<>[] then II=[II i];end
5999             end
6000             txt=[txt;
6001             "    "+get_comment("evtselect_blk",list(bk));]
6002             if II<>[] then
6003                 //** C **//
6004                 txt=[txt;
6005                 "    j=max(min((int) "+...
6006                 tmp_+",block_"+rdnom+"["+string(bk-1)+"].nevout),1);"]
6007                 txt=[txt;
6008                 "    switch(j)"
6009                 "    {"];
6010                 //*******//
6011                 for i=II
6012                     //** C **//
6013                     txt=[txt;
6014                     "     case "+string(j)+" :";]
6015                     //*******//