PIPS
mpi_conversion.c
Go to the documentation of this file.
1 /*
2 
3  $Id$
4 
5  Copyright 1989-2017 MINES ParisTech
6 
7  This file is part of PIPS.
8 
9  PIPS is free software: you can redistribute it and/or modify it
10  under the terms of the GNU General Public License as published by
11  the Free Software Foundation, either version 3 of the License, or
12  any later version.
13 
14  PIPS is distributed in the hope that it will be useful, but WITHOUT ANY
15  WARRANTY; without even the implied warranty of MERCHANTABILITY or
16  FITNESS FOR A PARTICULAR PURPOSE.
17 
18  See the GNU General Public License for more details.
19 
20  You should have received a copy of the GNU General Public License
21  along with PIPS. If not, see <http://www.gnu.org/licenses/>.
22 
23 */
24 #ifdef HAVE_CONFIG_H
25  #include "pips_config.h"
26 #endif
27 
28 
29 /**
30  * Pass: MPI_CONVERSION
31  * Debug mode: MPI_GENERATION_DEBUG_LEVEL
32  * Properties used:
33  * - MPI_NBR_CLUSTER
34  * - MPI_DUPLICATE_VARIABLE_PREFIX
35  * Resource needed:
36  * - DBR_TASK
37  *
38  */
39 
40 #include <stdlib.h>
41 #include <stdio.h>
42 
43 #include "genC.h"
44 #include "linear.h"
45 
46 #include "resources.h"
47 #include "database.h"
48 #include "ri.h"
49 #include "ri-util.h"
50 #include "pipsdbm.h"
51 
52 #include "control.h"
53 
54 #include "misc.h"
55 #include "syntax.h"
56 #include "c_syntax.h"
57 
58 #include "properties.h"
59 
60 #include "task_parallelization.h"
61 #include "prettyprint.h"
62 
65 }
66 
67 /*******************************************************
68  * GENERIC MPI FUNCTION MAKER : BEGIN *
69  *******************************************************/
75 };
76 
77 /**
78  * Functions to generate standard MPI function statement
79  * Can maybe also make function to return MPI function like instruction instead of statement to be more flexible?
80  * Only C version are made, for Fortran version, have to add an error manager variable
81  * (instead return result in C than represent possible error, add it in call function, cf MPI doc)
82  * All these functions can be general and move into a MPI manager?
83  * In that case only unstatic function that return statement or type
84  */
85 /**
86  * generate statement:
87  * MPI_Comm_size(communicator, &size);
88  * or
89  * result = MPI_Comm_size(communicator, &size);
90  */
91 static statement mpic_make_mpi_comm_size(entity communicator, entity size, entity result) {
92  list args = NIL;
93  args = CONS(EXPRESSION, make_entity_expression(communicator, NIL), args);
95  args = gen_nreverse(args);
97  call mpi_call = make_call(called_function, args);
99  if (entity_undefined_p(result)) {
100  mpi_st = call_to_statement(mpi_call);
101  }
102  else {
104  }
105  return mpi_st;
106 }
107 
108 /**
109  * generate statement:
110  * MPI_Comm_rank(communicator, &rank);
111  * or
112  * result = MPI_Comm_rank(communicator, &rank);
113  */
114 static statement mpic_make_mpi_comm_rank(entity communicator, entity rank, entity result) {
115  list args = NIL;
116  args = CONS(EXPRESSION, make_entity_expression(communicator, NIL), args);
118  args = gen_nreverse(args);
120  call mpi_call = make_call(called_function, args);
122  if (entity_undefined_p(result)) {
123  mpi_st = call_to_statement(mpi_call);
124  }
125  else {
127  }
128  return mpi_st;
129 }
130 
131 /**
132  * argc and argv must be defined
133  * generate statement:
134  * MPI_Init(&argc, &argv);
135  * or
136  * result = MPI_Init(&argc, &argv);
137  */
138 static statement mpic_make_mpi_init(entity result, entity argc, entity argv) {
139  list args = NIL;
140  if (argc == NULL || entity_undefined_p(argc) || entity_undefined_p(argv)) {
141  pips_user_error("argc and argv must be defined\n");
142  return statement_undefined;
143  }
146  args = gen_nreverse(args);
148  call mpi_call = make_call(called_function, args);
150  if (entity_undefined_p(result)) {
151  mpi_st = call_to_statement(mpi_call);
152  }
153  else {
155  }
156  return mpi_st;
157 }
158 
159 /**
160  * generate statement:
161  * MPI_Finalize();
162  * or
163  * result = MPI_Finalize();
164  */
166  list args = NIL;
167  args = gen_nreverse(args);
169  call mpi_call = make_call(called_function, args);
171  if (entity_undefined_p(result)) {
172  mpi_st = call_to_statement(mpi_call);
173  }
174  else {
176  }
177  return mpi_st;
178 }
179 
180 /*static statement mpifortran_make_mpi_finalize(entity result) {
181  list args = CONS(EXPRESSION, make_entity_expression(result, NIL), NIL);
182  args = gen_nreverse(args);
183  statement mpi_st = make_call_statement(MPI_FINALIZE_FUNCTION_NAME, args, entity_undefined, string_undefined);
184  return mpi_st;
185 }
186 */
187 /**
188  * make a list of expression that will be use as argument for MPI send/receive functions
189  * ds is the destination or the source depend of a send or receive function
190  * (&buffer, size, mpitype, ds, tag, communicator{, status/request})
191  */
194  int size,
195  entity mpitype,
196  int ds,
197  int tag,
198  entity communicator,
199  entity status,
200  entity request)
201 {
202  list args = NIL;
203 
205  args = CONS(EXPRESSION, int_to_expression(size), args);
206 
207  pips_assert("mpitype must defined.\n", !entity_undefined_p(mpitype));
208  args = CONS(EXPRESSION, make_entity_expression(mpitype, NIL), args);
209 
210 // basic bas = variable_basic(type_variable(entity_type(expression_to_entity(buffer))));
211 // switch(basic_tag(bas)){
212 // case is_basic_int:
213 // //don't know what to put for size (so 100 for the moment...)
214 // args = CONS(EXPRESSION, make_entity_expression(make_constant_entity("MPI_INT", is_basic_string, 100), NIL), args);
215 // break;
216 // case is_basic_float:
217 // //don't know what to put for size (so 100 for the moment...)
218 // args = CONS(EXPRESSION, make_entity_expression(make_constant_entity("MPI_FLOAT", is_basic_string, 100), NIL), args);
219 // break;
220 // default:
221 // pips_user_warning("type %s not handled yet in MPI\n", basic_to_string(bas));
222 // break;
223 // }
224 
225  args = CONS(EXPRESSION, int_to_expression(ds), args);
226  args = CONS(EXPRESSION, int_to_expression(tag), args);
227 
228  args = CONS(EXPRESSION, make_entity_expression(communicator, NIL), args);
229 
230  if (!entity_undefined_p(status) && !entity_undefined_p(request)) {
231  pips_internal_error("MPI_Status and MPI_Request can't be use at the same time\n"
232  " use MPI_status for blocking function\n"
233  " use MPI_Request for non-blocking function\n");
234  }
235  else if (!entity_undefined_p(request)) {
237  }
238  else if (!entity_undefined_p(status)) {
240  }
241 
242  args = gen_nreverse(args);
243  return args;
244 }
245 
248  int size,
249  entity mpitype,
250  int dest,
251  int tag,
252  entity communicator,
253  entity request,
254  //bool blocking, //this information is contained inside request, if (request==entity_undefied) then blocking==true else blocking==false
256 {
257  list args = mpic_make_args_mpi_send_or_receiv(buffer, size, mpitype, dest, tag, communicator, entity_undefined, request);
258 
259  entity called_function = entity_undefined;
260  switch (mode) {
262  if (entity_undefined_p(request))
263  called_function = entity_intrinsic(MPI_SSEND_FUNCTION_NAME);
264  else
265  called_function = entity_intrinsic(MPI_ISSEND_FUNCTION_NAME);
266  break;
268  if (entity_undefined_p(request))
269  called_function = entity_intrinsic(MPI_RSEND_FUNCTION_NAME);
270  else
271  called_function = entity_intrinsic(MPI_IRSEND_FUNCTION_NAME);
272  break;
274  if (entity_undefined_p(request))
275  called_function = entity_intrinsic(MPI_BSEND_FUNCTION_NAME);
276  else
277  called_function = entity_intrinsic(MPI_IBSEND_FUNCTION_NAME);
278  break;
280  default:
281  if (entity_undefined_p(request))
282  called_function = entity_intrinsic(MPI_SEND_FUNCTION_NAME);
283  else
284  called_function = entity_intrinsic(MPI_ISEND_FUNCTION_NAME);
285  break;
286  }
287 
288  call mpi_call = make_call(called_function, args);
289  return mpi_call;
290 }
291 
294  int size,
295  entity mpitype,
296  int dest,
297  int tag,
298  entity communicator,
299  entity status,
300  entity request
301  //bool blocking, //this information is contained inside request, if (request==entity_undefied) then blocking==true else blocking==false
302 )
303 {
304  if (!entity_undefined_p(status) && !entity_undefined_p(request))
305  pips_internal_error("MPI_Status and MPI_Request can't be use at the same time for MPI_Recv/MPI_Irecv instruction\n"
306  " use MPI_status for blocking receive (MPI_Recv)\n"
307  " use MPI_Request for non-blocking receive (MPI_Irecv)\n");
308  else if (entity_undefined_p(status) && entity_undefined_p(request))
309  pips_internal_error("MPI_Status xor MPI_Request must be use present for MPI_Recv/MPI_Irecv instruction\n"
310  " use MPI_status for blocking receive (MPI_Recv)\n"
311  " use MPI_Request for non-blocking receive (MPI_Irecv)\n");
312 
313  list args = mpic_make_args_mpi_send_or_receiv(buffer, size, mpitype, dest, tag, communicator, status, request);
314 
315  entity called_function = entity_undefined;
316  if (entity_undefined_p(request))
317  called_function = entity_intrinsic(MPI_RECV_FUNCTION_NAME);
318  else
319  called_function = entity_intrinsic(MPI_IRECV_FUNCTION_NAME);
320 
321  call mpi_call = make_call(called_function, args);
322  return mpi_call;
323 }
324 
325 /**
326  * generate statement:
327  * {result =} MPI_Send(&buffer, size, mpitype, dest, tag, communicator);
328  */
331  int size,
332  entity mpitype,
333  int dest,
334  int tag,
335  entity communicator,
336  entity result)
337 {
338  call mpi_call = mpic_make_generic_mpi_send_call(buffer, size, mpitype, dest, tag, communicator, entity_undefined, mpi_communication_default_mode);
340  if (entity_undefined_p(result)) {
341  mpi_st = call_to_statement(mpi_call);
342  }
343  else {
345  }
346  return mpi_st;
347 }
348 /**
349  * generate statement:
350  * {result =} MPI_Isend(&buffer, size, mpitype, dest, tag, communicator, &request);
351  */
354  int size,
355  entity mpitype,
356  int dest,
357  int tag,
358  entity communicator,
359  entity request,
360  entity result)
361 {
362  call mpi_call = mpic_make_generic_mpi_send_call(buffer, size, mpitype, dest, tag, communicator, request, mpi_communication_default_mode);
364  if (entity_undefined_p(result)) {
365  mpi_st = call_to_statement(mpi_call);
366  }
367  else {
369  }
370  return mpi_st;
371 }
372 /**
373  * TODO do the same for MPI_Rsend/Irsend/Bsend/Ibsend/Ssend/Issend
374  */
375 
376 /**
377  * generate statement:
378  * {result =} MPI_Recv(&buffer, size, mpitype, source, tag, communicator, &status);
379  */
382  int size,
383  entity mpitype,
384  int source,
385  int tag,
386  entity communicator,
387  entity status,
388  entity result)
389 {
390  call mpi_call = mpic_make_generic_mpi_receive_call(buffer, size, mpitype, source, tag, communicator, status, entity_undefined);
392  if (entity_undefined_p(result)) {
393  mpi_st = call_to_statement(mpi_call);
394  }
395  else {
397  }
398  return mpi_st;
399 }
400 /**
401  * generate statement:
402  * {result =} MPI_Irecv(&buffer, size, mpitype, source, tag, communicator, &request);
403  */
406  int size,
407  entity mpitype,
408  int source,
409  int tag,
410  entity communicator,
411  entity request,
412  entity result)
413 {
414  call mpi_call = mpic_make_generic_mpi_receive_call(buffer, size, mpitype, source, tag, communicator, entity_undefined, request);
416  if (entity_undefined_p(result)) {
417  mpi_st = call_to_statement(mpi_call);
418  }
419  else {
421  }
422  return mpi_st;
423 }
424 
425 /**
426  * return the type for MPI communicator:
427  * MPI_Comm
428  */
434  }
435  type comm_t = MakeTypeVariable(make_basic_typedef(comm), NIL);
436  if(type_undefined_p(entity_type(comm))) {
437  entity_type(comm) = ImplicitType(comm);
438  }
439  return comm_t;
440 }
441 
442 /**
443  * return the type for MPI status:
444  * MPI_Status
445  */
451  }
452  type stat_t = MakeTypeVariable(make_basic_typedef(stat), NIL);
453  if(type_undefined_p(entity_type(stat))) {
454  entity_type(stat) = ImplicitType(stat);
455  }
456  return stat_t;
457 }
458 
459 /**
460  * return the type for MPI request:
461  * MPI_Request
462  */
468  }
470  if(type_undefined_p(entity_type(req))) {
471  entity_type(req) = ImplicitType(req);
472  }
473  return req_t;
474 }
475 
476 /**
477  * return the type for MPI datatype (to make custom datatype for example):
478  * MPI_Datatype
479  */
480 //* Not use
481 /*static type mpi_type_MPI_Datatype() {
482  entity req = FindOrCreateEntity(TOP_LEVEL_MODULE_NAME, MPI_DATATYPE);
483  if(storage_undefined_p(entity_storage(req)))
484  {
485  entity_storage(req) = make_storage_rom();
486  put_new_typedef(MPI_DATATYPE);
487  }
488  type req_t =MakeTypeVariable(make_basic_typedef(req), NIL);
489  if(type_undefined_p(entity_type(req))) {
490  entity_type(req) = ImplicitType(req);
491  }
492  return req_t;
493 }
494 */
495 //*/
496 
497 /*******************************************************
498  * GENERIC MPI FUNCTION MAKER : END *
499  *******************************************************/
500 
501 
502 /*******************************************************
503  * CONTEXT_MPI + MPI FUNCTION MAKER : BEGIN *
504  *******************************************************/
505 /**
506  * Wrapper to call generic MPI function maker
507  */
508 typedef struct ctx_mpi {
509  entity size; // total number of proc
510  entity rank; // id of proc used
511  entity mpi_communicator; // mpi_communicator for communication
512  entity mpi_status; // mpi_status of a synchronous receive
513  entity mpi_request; // mpi_request for asynchronous communication
514  entity error; // for error handling
516 
518  ctx_mpi_t ctx;
521 
525  }
527  //FIXME global variable, what kind of storage?
528  // It's certainly not the good storage here...
529  const char* module_name = module_local_name(module);
532 // make_storage_rom();
533  make_storage_ram(make_ram(module, area, 0/*CurrentOffsetOfArea(area, ctx.mpi_communicator)*/, NIL));
534  }
535 
538 
541 
542  ctx.error = entity_undefined;
543  return ctx;
544 }
545 static void mpi_free_ctx(__attribute__ ((__unused__)) ctx_mpi_t * ctx) {
546  //Nothing to do
547  return;
548 }
549 
551  return mpic_make_mpi_comm_size(ctx.mpi_communicator, ctx.size, ctx.error);
552 }
553 
555  return mpic_make_mpi_comm_rank(ctx.mpi_communicator, ctx.rank, ctx.error);
556 }
557 
558 static statement mpi_init_ctx(const ctx_mpi_t ctx) {
559  entity argc = gen_find_tabulated("main:argc", entity_domain);
560  entity argv = gen_find_tabulated("main:argv", entity_domain);
561  return mpic_make_mpi_init(ctx.error, argc, argv);
562 }
563 
565  return mpic_make_mpi_finalize(ctx.error);
566 }
567 
568 static statement mpi_send_ctx(const ctx_mpi_t ctx, expression buffer, int size, int dest, int tag, bool blocking) {
569  entity mpitype = entity_undefined;
571  switch(basic_tag(bas)){
572  case is_basic_int:
573  //don't know what to put for size (so 100 for the moment...)
574  mpitype = make_constant_entity("MPI_INT", is_basic_string, 100);
575  break;
576  case is_basic_float:
577  //don't know what to put for size (so 100 for the moment...)
578 // mpitype = make_constant_entity("MPI_FLOAT", is_basic_string, 100);
579  mpitype = make_constant_entity("MPI_DOUBLE", is_basic_string, 100);
580  break;
581  default:
582  pips_user_warning("type %s not handled yet in MPI\n", basic_to_string(bas));
583  break;
584  }
585 
586  if (!blocking)
587  return mpic_make_mpi_isend(buffer, size, mpitype, dest, tag, ctx.mpi_communicator, ctx.mpi_request, ctx.error);
588  else
589  return mpic_make_mpi_send(buffer, size, mpitype, dest, tag, ctx.mpi_communicator, ctx.error);
590 }
591 /**
592  * TODO do the same for Ssend, Rsend, Bsend
593  */
594 
595 static statement mpi_recv_ctx(const ctx_mpi_t ctx, expression buffer, int size, int source, int tag, bool blocking) {
596  entity mpitype = entity_undefined;
598  switch(basic_tag(bas)){
599  case is_basic_int:
600  //don't know what to put for size (so 100 for the moment...)
601  mpitype = make_constant_entity("MPI_INT", is_basic_string, 100);
602  break;
603  case is_basic_float:
604  //don't know what to put for size (so 100 for the moment...)
605 // mpitype = make_constant_entity("MPI_FLOAT", is_basic_string, 100);
606  mpitype = make_constant_entity("MPI_DOUBLE", is_basic_string, 100);
607  break;
608  default:
609  pips_user_warning("type %s not handled yet in MPI\n", basic_to_string(bas));
610  break;
611  }
612 
613  if (blocking)
614  return mpic_make_mpi_recv(buffer, size, mpitype, source, tag, ctx.mpi_communicator, ctx.mpi_status, ctx.error);
615  else
616  return mpic_make_mpi_irecv(buffer, size, mpitype, source, tag, ctx.mpi_communicator, ctx.mpi_request, ctx.error);
617 }
618 
619 /*******************************************************
620  * CONTEXT_MPI + MPI FUNCTION MAKER : END *
621  *******************************************************/
622 
623 
624 /*******************************************************
625  * CONTEXT MANAGEMENT : BEGIN *
626  *******************************************************/
627 
628 typedef struct ctx_conv {
630 // hash_table hash_statement_to_add; //to memorize the global statements to add
631 // // (don't work with it but with hash_statement_receive)
632 // hash_table hash_statement_receive; //work on these statements
633 // statement* statement_to_add; //to memorize the global statements to add
634 // // (don't work with it but with statement_send_receive)
635  //statement* statement_body; //work on these statements
636  statement* statement_send_receive; //work on these statements
641  //int last_cluster; //only to free useless stuff
642  int** tag; //tag[sender][receiver]
645 
646 static ctx_conv_t conv_make_ctx(entity module, int nbr_cluster) {
647  pips_assert("number of cluster can't be equal to 0", nbr_cluster != 0);
648  ctx_conv_t ctx;
649 
650  ctx.ctx_mpi = mpi_make_ctx(module);
651 
652 // ctx.hash_statement_to_add = hash_table_make(hash_int, nbr_cluster);
653 // ctx.hash_statement_receive = hash_table_make(hash_int, nbr_cluster);
654 // ctx.statement_to_add = malloc(sizeof(*(ctx.statement_to_add)) * nbr_cluster);
655  //ctx.statement_body = malloc(sizeof(*(ctx.statement_body)) * nbr_cluster);
656  ctx.statement_send_receive = malloc(sizeof(*(ctx.statement_send_receive)) * nbr_cluster);
657  for (int i = 0; i < nbr_cluster; ++i) {
659  }
661 
662  ctx.nbr_cluster = nbr_cluster;
663  ctx.current_cluster = -2;
665  //ctx.last_cluster = -2;
666 
667  ctx.tag = malloc(sizeof(*(ctx.tag)) * nbr_cluster);
668  for (int i = 0; i < nbr_cluster; ++i) {
669  ctx.tag[i] = malloc(sizeof(**(ctx.tag)) * nbr_cluster);
670  for (int j = 0; j < nbr_cluster; ++j) {
671  ctx.tag[i][j] = 0;
672  }
673  }
674 
676 
677  return ctx;
678 }
679 static void conv_free_ctx(ctx_conv_t * ctx) {
680 // pips_assert("stack of task not empty", stack_size(ctx->stack_task) == 0);
681 //// pips_assert("current_task have to be undefined", ctx->current_task == task_undefined);
682  mpi_free_ctx(&ctx->ctx_mpi);
683 
684 // if (ctx->current_cluster >= 0) {
685 // statement st = (statement)hash_get(ctx->hash_statement_to_add, &(ctx->current_cluster);
686 // free_statement(st);
687 // }
688  for (int i = 0; i < ctx->nbr_cluster; ++i) {
689  free(ctx->tag[i]);
690  }
691  free(ctx->tag);
692 
693 // free(ctx->statement_to_add);
694  //free(ctx->statement_body);
696  return;
697 }
698 
699 
700 
701 static void ctx_init(ctx_conv_t * ctx) {
702  int i = 0;
703  for (i=0; i<ctx->nbr_cluster; i++) {
704  // statement body = make_empty_block_statement();
705  // expression cond = MakeBinaryCall(entity_intrinsic(EQUAL_OPERATOR_NAME), entity_to_expression(ctx->ctx_mpi.rank), int_to_expression(i));
706  // statement stadd = make_test_statement(cond, body, make_empty_block_statement());
707 
708 // hash_put_or_update(ctx->hash_statement_receive, (void *)i, receive);
709 // hash_put_or_update(ctx->hash_statement_to_add, (void *)i, stadd);
711  //ctx->statement_body[i] = body;
712 // ctx->statement_to_add[i] = stadd;
713  }
714 }
715 //static void ctx_reset(ctx_conv_t * ctx) {
716 // int i = 0;
717 // int current_cluster = ctx->current_cluster;
718 // if (current_cluster != -2) {
719 // for (i=0; i<ctx->nbr_cluster; i++) {
720 //// if (i != current_cluster) {
721 // statement receive = make_empty_block_statement();
722 // expression cond = MakeBinaryCall(entity_intrinsic(EQUAL_OPERATOR_NAME), entity_to_expression(ctx->ctx_mpi.rank), int_to_expression(i));;
723 // statement stadd = make_test_statement(cond, receive, make_continue_statement(entity_empty_label()));
724 //
725 // hash_update(ctx->hash_statement_receive, &i, receive);
726 // hash_update(ctx->hash_statement_to_add, &i, stadd);
727 //// }
728 // }
729 // }
730 //}
731 
734  pips_user_error("Can only have one return statement :(\n");
735  }
736  ctx->return_statement = copy_statement(rs);
737 }
739  return ctx.return_statement;
740 }
741 
743  //each time we work on a new task, we reinitialize the context
744  //especially the statements to generate
745  ctx_init(ctx);
746 
748  ctx->current_task = ta;
749  int cluster = task_on_cluster(ta);
750  ctx->current_cluster = cluster;
751 
752  statement stat = copy_statement(st);
755 
756 // statement testst = (statement) hash_get(ctx->hash_statement_to_add, (void *)(cluster));
757 // statement testst = ctx->statement_to_add[cluster];
758 // test te = statement_test(testst);
759 // free_statement(test_true(te));
760 // test_true(te) = stat;
761 
762 // hash_put_or_update(ctx->hash_statement_receive, (void *)(cluster), st);
763  //ctx->statement_body[cluster] = stat;
764  ctx->statement_work_on = stat;
765 }
767  //int current_cluster = ctx.current_cluster;
768  //statement st = ctx.statement_body[current_cluster];
769  statement st = ctx.statement_work_on;
770  return st;
771 }
772 
773 //static statement ctx_new_body_cluster(ctx_conv_t * ctx, int for_cluster) {
774 // pips_assert("for_cluster and ctx.current_cluster must be different\n", ctx->current_cluster!=for_cluster);
775 // if (!empty_statement_or_continue_p(ctx->statement_body[for_cluster])) {
776 // ctx->statement_body[for_cluster] = make_empty_block_statement();
777 // }
778 // return ctx.statement_body[for_cluster];
779 //}
780 //static void ctx_add_to_body_cluster(ctx_conv_t * ctx, statement stat, int for_cluster) {
781 // if (!statement_undefined_p(stat)) {
782 // statement st = ctx->statement_body[for_cluster];
783 // insert_statement(st, stat, false);
784 // }
785 //}
786 //static statement ctx_get_body_cluster(const ctx_conv_t ctx, int for_cluster) {
787 // //pips_assert("for_cluster and ctx.current_cluster must be different\n", ctx.current_cluster!=for_cluster);
788 // return ctx.statement_body[for_cluster];
789 //}
790 //static void ctx_update_body_cluster(ctx_conv_t * ctx, int for_cluster) {
791 // pips_assert("for_cluster and ctx.current_cluster must be different\n", ctx->current_cluster!=for_cluster);
792 // if (!empty_statement_or_continue_p(ctx->statement_body[for_cluster])) {
793 // test_true(statement_test(ctx->statement_to_add[for_cluster])) = ctx->statement_body[for_cluster];
794 // //ctx->statement_body[for_cluster] = make_empty_block_statement();
795 // }
796 //}
797 //static void ctx_set_body_cluster(ctx_conv_t * ctx, statement stat, int for_cluster) {
798 // pips_assert("for_cluster and ctx.current_cluster must be different\n", ctx->current_cluster!=for_cluster);
799 // if (!statement_undefined_p(ctx->statement_body[for_cluster])) {
800 // ctx->statement_body[for_cluster] = stat;
801 // test_true(statement_test(ctx->statement_to_add[for_cluster])) = stat;
802 // }
803 //}
804 
805 static void ctx_set_send_statement(ctx_conv_t * ctx, statement send) {
806  pips_assert("ctx->send_statement must be statement_undefined\n", statement_undefined_p(ctx->statement_send_receive[ctx->current_cluster]));
807  ctx->statement_send_receive[ctx->current_cluster] = send;
808 }
810  pips_assert("ctx->send_statement mustn't be statement_undefined\n", !statement_undefined_p(ctx->statement_send_receive[ctx->current_cluster]));
812  print_statement(send);
814  return send;
815 }
816 static void ctx_set_receive_statement(ctx_conv_t * ctx, statement receive, int for_cluster) {
817  pips_assert("for_cluster and ctx.current_cluster must be different\n", ctx->current_cluster!=for_cluster);
818  ctx->statement_send_receive[for_cluster] = receive;
819 }
820 static statement ctx_get_receive_statement(const ctx_conv_t ctx, int for_cluster) {
821  pips_assert("for_cluster and ctx.current_cluster must be different\n", ctx.current_cluster!=for_cluster);
822  statement receive = ctx.statement_send_receive[for_cluster];
823  return receive;
824 }
825 //static void ctx_update_receive_statement_from_body_statement(ctx_conv_t * ctx, int for_cluster) {
826 // pips_assert("for_cluster and ctx.current_cluster must be different\n", ctx->current_cluster!=for_cluster);
827 // ctx->statement_send_receive[for_cluster] = ctx->statement_body[for_cluster];
828 //}
829 
830 //static void ctx_set_body_statement_to_add(ctx_conv_t * ctx, statement new_body, int for_cluster) {
831 // pips_assert("for_cluster and ctx.current_cluster must be different\n", ctx->current_cluster!=for_cluster);
832 // if (empty_statement_or_continue_p(test_true(statement_test(ctx->statement_to_add[for_cluster])))) {
833 // free(test_true(statement_test(ctx->statement_to_add[for_cluster])));
834 // }
835 // test_true(statement_test(ctx->statement_to_add[for_cluster])) = new_body;
836 //}
837 //static statement ctx_get_body_statement_to_add(const ctx_conv_t ctx, int for_cluster) {
838 // pips_assert("for_cluster and ctx.current_cluster must be different\n", ctx.current_cluster!=for_cluster);
839 // return test_true(statement_test(ctx.statement_to_add[for_cluster]));
840 //}
841 
842 static bool ctx_is_blocking(const ctx_conv_t ctx) {
843  task ta = ctx.current_task;
844  return (bool) task_synchronization(ta);
845 }
846 
847 static int ctx_get_tag(const ctx_conv_t ctx, int sender, int receiver) {
848  pips_assert("sender_cluster<nbr_cluster\n", sender<ctx.nbr_cluster);
849  pips_assert("receiver_cluster<nbr_cluster\n", receiver<ctx.nbr_cluster);
850  return ctx.tag[sender][receiver];
851 }
852 static void ctx_inc_tag(ctx_conv_t * ctx, int sender, int receiver) {
853  pips_assert("sender_cluster<nbr_cluster\n", sender<ctx->nbr_cluster);
854  pips_assert("receiver_cluster<nbr_cluster\n", receiver<ctx->nbr_cluster);
855  ctx->tag[sender][receiver]++;
856 }
857 /**
858  *
859  * \return
860  * if (rank==p) {
861  * [...]
862  * MPI_Send();
863  * }
864  * if (rank==0) {
865  * [...]
866  * MPI_Recv();
867  * }
868  * [...]
869  * if (rank==n) {
870  * [...]
871  * MPI_Recv();
872  * }
873  */
875  int current_cluster = ctx.current_cluster;
877 // hash_table hsta = ctx.hash_statement_to_add;
878 
879  {
880 // statement current = (statement) hash_get(hsta, (void *)(current_cluster+1));
881 // statement current = ctx.statement_to_add[current_cluster];
882 // insert_statement(st, current, false);
886  insert_statement(st, add, false);
887  }
888 
889  int i=0;
890  for (i=0; i<ctx.nbr_cluster; i++) {
891  if (i != current_cluster) {
892 // statement add = (statement) hash_get(hsta, (void *)i);
893 // statement add = ctx.statement_to_add[i];
894  statement receiv = ctx.statement_send_receive[i];
895  if (!statement_undefined_p(receiv)) {
898  insert_statement(st, add, false);
900  }
901  }
902  }
903 
904  return st;
905 }
906 
907 /*******************************************************
908  * CONTEXT MANAGEMENT : END *
909  *******************************************************/
910 
911 /**
912  * put initialize MPI functions at the beginning of the module_stateent (function):
913  * // Generated by Pass MPI_CONVERSION
914  * MPI_Status status0;
915  * // Generated by Pass MPI_CONVERSION
916  * MPI_Request request0;
917  * // Generated by Pass MPI_CONVERSION
918  * int size0, rank0;
919  * MPI_Init(&argc, &argv);
920  * MPI_Comm_size(MPI_COMM_WORLD, &size0);
921  * MPI_Comm_rank(MPI_COMM_WORLD, &rank0);
922  */
927 
934 }
935 
936 /**
937  * put finalize MPI functions at the end of the module_stateent (function), before the return:
938  * MPI_Finalize();
939  */
943  if (!statement_undefined_p(rs))
945 }
946 
947 
948 static bool is_distributed_comments(string comments) {
949  if (empty_comments_p(comments))
950  return false;
951 
952  string dist = "distributed";
953 
954  return strstr(comments, dist) != NULL;
955 }
956 
957 static bool is_distributed_send_comments(string comments) {
958  if (empty_comments_p(comments))
959  return false;
960 
961  string dist = "distributed";
962  string send = "send";
963 
964  return strstr(comments, dist) != NULL && strstr(comments, send) != NULL;
965 }
966 
967 static bool is_distributed_receive_comments(string comments) {
968  if (empty_comments_p(comments))
969  return false;
970 
971  string dist = "distributed";
972  string receive = "receive";
973 
974  return strstr(comments, dist) != NULL && strstr(comments, receive) != NULL;
975 }
976 
977 static int find_sender_cluster(ctx_conv_t * ctx, __attribute__ ((__unused__)) statement stat) {
978 // pips_assert("statement stat is copy receive statement",
979 // is_distributed_send_comments(statement_comments(stat)) && assignment_statement_p(stat));
980 //
981 // call c = statement_call(stat);
982 // list args = call_arguments(c);
983 // expression rhs = EXPRESSION(CAR(CDR(args)));
984 //
985 // entity rhse = expression_to_entity(rhs);
986 // string rhsname = entity_name(rhse);
987 // list l = strsplit(rhsname, "_");
988 // return atoi(STRING(CAR(gen_nreverse(l))));
989  return ctx->current_cluster;
990 }
991 
992 static int find_receiver_cluster(__attribute__ ((__unused__)) ctx_conv_t * ctx, statement stat) {
993  pips_assert("statement stat is copy receive statement",
995 
996  call c = statement_call(stat);
997  list args = call_arguments(c);
998  expression lhs = EXPRESSION(CAR(args));
999 
1000  entity lhse = expression_to_entity(lhs);
1001  string lhsname = entity_name(lhse);
1002  list l = strsplit(lhsname, "_");
1003  return atoi(STRING(CAR(gen_nreverse(l))));
1004 }
1005 
1008 
1009  pips_assert("statement stat is copy send statement",
1011 
1013  int sender = find_sender_cluster(ctx, stat);
1014  int receiver = find_receiver_cluster(ctx, stat);
1015  int tag = ctx_get_tag(*ctx, sender, receiver);
1016  bool blocking = ctx_is_blocking(*ctx);
1017 
1018  call c = statement_call(stat);
1019  list args = call_arguments(c);
1020  // expression lhs = EXPRESSION(CAR(args));
1021  expression rhs = EXPRESSION(CAR(CDR(args)));
1022 
1023  buffer = copy_expression(rhs);
1024 
1025  st = mpi_send_ctx(ctx->ctx_mpi, buffer, 1, receiver, tag, blocking);
1026 
1027  return st;
1028 }
1029 
1032 
1033  pips_assert("statement stat is copy receive statement",
1035 
1037  int sender = find_sender_cluster(ctx, stat);
1038  int receiver = find_receiver_cluster(ctx, stat);
1039  int tag = ctx_get_tag(*ctx, sender, receiver);
1040  bool blocking = ctx_is_blocking(*ctx);
1041 
1042  call c = statement_call(stat);
1043  list args = call_arguments(c);
1044  expression lhs = EXPRESSION(CAR(args));
1045  // expression rhs = EXPRESSION(CAR(CDR(args)));
1046 
1047  buffer = copy_expression(lhs);
1048 
1049  st = mpi_recv_ctx(ctx->ctx_mpi, buffer, 1, sender, tag, blocking);
1050 
1051  return st;
1052 }
1053 
1054 
1056  pips_debug(8, "begin\n");
1057  entity ent = reference_variable(ref);
1058  const char * prefix = get_string_property((const char * ) MPI_GENERATION_PREFIX);
1059  const char * ent_name = entity_user_name(ent);
1060  if (same_stringn_p(prefix, ent_name, strlen(prefix))) {
1061  char * prefix2 = strdup(concatenate(prefix, "_index_", NULL));
1062  if (!same_stringn_p(prefix2, ent_name, strlen(prefix2))) {
1063  // It's not an iterator variable, so need to modify to have the receiver variable
1064  pips_user_warning("Not implemented yet.\n"
1065  "Modify variable to use vriable of the cluster number %i", *receiv_cluster);
1066  //NOT good...
1067 // string cluster_id = strrchr(entity_name(ent),'_');
1068 // string new_name = gen_strndup0( entity_name(ent), strlen(entity_name(ent))-strlen(cluster_id)+1 );
1069 //// string new_name = strdup(entity_name(ent));
1070 //// string cluster_id = strrchr(new_name,'_');
1071 //// new_name[cluster_id-new_name+1] = '\0';
1072 // pips_user_warning("new_name=%s\n", new_name);
1073 // new_name = concatenate(new_name, i2a(*receiv_cluster), NULL);
1074 // pips_user_warning("new_name=%s\n", new_name);
1075 //
1076 // entity new_entity = gen_find_tabulated(new_name, entity_domain);
1077 // if (entity_undefined_p(new_entity)) {
1078 // pips_user_error("The entity %s doesn't exit\n", new_name);
1079 // return;
1080 // }
1081 //
1082 // reference_variable(ref) = new_entity;
1083  }
1084  free(prefix2);
1085  }
1086  else {
1087  // TODO more com need to be add here, case of dynamic scheduling
1088  pips_user_warning("NOT a generated MPI variable (entity_name(ent)=%s)\n"
1089  //"Be sure that it's only a iterator variable\n"
1090  , entity_name(ent));
1091  }
1092 
1093  pips_debug(8, "end\n");
1094 }
1095 
1096 
1097 
1098 
1099 static bool sequence_working_false(sequence seq, ctx_conv_t * ctx);
1100 static bool test_working_false(test t, ctx_conv_t * ctx);
1101 static bool search_copy_communication(statement stat, ctx_conv_t * ctx);
1102 static void make_send_receive_conversion(statement stat, ctx_conv_t * ctx);
1103 
1104 
1105 /**
1106  * This function update the receive statements for a sequential statement
1107  * NB : This function can be put in search_copy_communication;
1108  * in this case search_copy_communication can return true and false
1109  * And have to treat the declaration here instead of in make_send_receive_conversion
1110  * \param seq sequence to treat
1111  * \param ctx context
1112  * \return always false, we make another gen_recurse in this function
1113  */
1114 static bool sequence_working_false(sequence seq, ctx_conv_t * ctx) {
1115  pips_debug(8, "begin\n");
1116  list stats = sequence_statements(seq);
1117 
1118  int nbr_cluster = ctx->nbr_cluster;
1119 
1120  // st[cluster_num] will correspond to a sequence of MPI_recv that will update
1121  // the receive statements to add
1122  statement st[nbr_cluster];
1123  for (int i = 0; i < nbr_cluster; ++i) {
1124  if (i!=ctx->current_cluster) {
1125  st[i] = make_empty_block_statement();
1126 // st[i] = ctx_new_body_cluster(ctx, i);
1127  }
1128  }
1129 
1130  FOREACH(STATEMENT, s, stats) {
1131  //TODO ...
1132 
1133  for (int i = 0; i < nbr_cluster; ++i) {
1134  if (i!=ctx->current_cluster) {
1135  pips_assert("receiv_statement must be undefined when we enter this function\n",
1137  }
1138 // else {
1139 // pips_assert("\n", statement_undefined_p(ctx_get_send_statement(ctx)));
1140 // }
1141  }
1142 
1144 // gen_context_recurse(s, ctx
1147  , test_domain, test_working_false, gen_core /*gen_null*/
1148 // , loop_domain, gen_true, gen_true
1149 // , whileloop_domain, gen_true, gen_true
1150 // , forloop_domain, gen_true, gen_true
1151 // //, call_domain, gen_true, gen_true // to detect copy for communication statement done in statement_domaine case
1152 // //, multitest_domain, gen_true, gen_true // don't exist in PIPS yet
1153 // //, unstructured_domain, gen_true, gen_true // never happens? bug case?
1154 // //, expression_domain, gen_true, gen_true
1155  , NULL
1156  );
1157 
1158  // between each statement of the sequence,
1159  // if a receive statement is present, then it is memorize in st and we reset the receive statement for the next statement to analyze
1160  for (int i = 0; i < nbr_cluster; ++i) {
1161  if (i!=ctx->current_cluster) {
1162  statement receive_statement = ctx_get_receive_statement(*ctx, i);
1163  if (!statement_undefined_p(receive_statement)) {
1164  insert_statement(st[i], receive_statement, false);
1166  }
1167  }
1168  }
1169  }
1170 
1171  // At the end of the sequence,
1172  // the receive statement is modified to be to the st that correspond to all the receive statements that mus be done by the sequence
1173  for (int i = 0; i < nbr_cluster; ++i) {
1174  if (i!=ctx->current_cluster) {
1175  if (!empty_statement_or_continue_p(st[i])) {
1176  ctx_set_receive_statement(ctx, st[i], i);
1177 // ctx_set_body_statement_to_add(ctx, st[i], i);
1178  }
1179  else {
1180  free(st[i]);
1181  }
1182 // ctx_update_receive_statement_from_body_statement(ctx, i);
1183 // ctx_update_body_cluster(ctx, i);
1184  }
1185  }
1186 
1187  pips_debug(8, "end\n");
1188  return false;
1189 }
1190 
1191 
1192 /**
1193  * This function update the receive statements for a test statement
1194  * NB : This function can be put in search_copy_communication;
1195  * in this case search_copy_communication can return true and false
1196  * \param t test to treat
1197  * \param ctx context
1198  * \return always false, we make another gen_recurse
1199  */
1200 static bool test_working_false(test t, ctx_conv_t * ctx) {
1201  pips_debug(8, "begin\n");
1202 
1203  int nbr_cluster = ctx->nbr_cluster;
1204  statement st[nbr_cluster];
1205  statement st_true[nbr_cluster];
1206  statement st_false[nbr_cluster];
1207  for (int i = 0; i < nbr_cluster; ++i) {
1208  if (i!=ctx->current_cluster) {
1209 // st[i] = make_empty_block_statement();
1210  st[i] = statement_undefined;
1211  st_true[i] = statement_undefined;
1212  st_false[i] = statement_undefined;
1213  // st[i] = ctx_new_body_cluster(ctx, i);
1214  }
1215  }
1216 
1217  expression cond = test_condition(t);
1218  statement ttrue = test_true(t);
1219  statement tfalse = test_false(t);
1220 
1221  // //TODO analyze dynamic
1222  // if (cond!=entier) {
1223  // for (int i = 0; i < ctx->nbr_cluster; ++i) {
1224  // if (i!=ctx->current_cluster) {
1225  //
1226  // }
1227  // else {
1228  // //TODO modify AST
1229  // }
1230  // }
1231  // }
1232 
1233  //true case
1234  if (!statement_undefined_p(ttrue)) {
1235  for (int i = 0; i < nbr_cluster; ++i) {
1236  if (i!=ctx->current_cluster) {
1238  }
1239  }
1240 
1241  gen_context_multi_recurse(ttrue, ctx
1242  // gen_context_recurse(s, ctx
1245  , test_domain, test_working_false, gen_core /*gen_null*/
1246  // , loop_domain, gen_true, gen_true
1247  // , whileloop_domain, gen_true, gen_true
1248  // , forloop_domain, gen_true, gen_true
1249  // //, call_domain, gen_true, gen_true // to detect copy for communication statement done in statement_domaine case
1250  // //, multitest_domain, gen_true, gen_true // don't exist in PIPS yet
1251  // //, unstructured_domain, gen_true, gen_true // never happens? bug case?
1252  // //, expression_domain, gen_true, gen_true
1253  , NULL
1254  );
1255 
1256  //Memorize the result of the true case
1257  for (int i = 0; i < ctx->nbr_cluster; ++i) {
1258  if (i!=ctx->current_cluster) {
1259  st_true[i] = ctx_get_receive_statement(*ctx, i);
1261  }
1262  }
1263  }
1264 
1265  //false case
1266  if (!statement_undefined_p(tfalse)) {
1267  for (int i = 0; i < nbr_cluster; ++i) {
1268  if (i!=ctx->current_cluster) {
1270  }
1271  }
1272 
1273  gen_context_multi_recurse(tfalse, ctx
1274  // gen_context_recurse(s, ctx
1277  , test_domain, test_working_false, gen_core /*gen_null*/
1278  // , loop_domain, gen_true, gen_true
1279  // , whileloop_domain, gen_true, gen_true
1280  // , forloop_domain, gen_true, gen_true
1281  // //, call_domain, gen_true, gen_true // to detect copy for communication statement done in statement_domaine case
1282  // //, multitest_domain, gen_true, gen_true // don't exist in PIPS yet
1283  // //, unstructured_domain, gen_true, gen_true // never happens? bug case?
1284  // //, expression_domain, gen_true, gen_true
1285  , NULL
1286  );
1287 
1288  //Memorize the result of the false case
1289  for (int i = 0; i < ctx->nbr_cluster; ++i) {
1290  if (i!=ctx->current_cluster) {
1291  st_false[i] = ctx_get_receive_statement(*ctx, i);
1293  }
1294  }
1295  }
1296 
1297  for (int i = 0; i < ctx->nbr_cluster; ++i) {
1298  // bool need_more_com = false; //TODO: Not implemented yet
1299  expression ncond = copy_expression(cond);
1300  if (!integer_constant_expression_p(ncond)) {
1302  }
1303 
1304  if (i!=ctx->current_cluster) {
1305  if (!statement_undefined_p(st_true[i]) || !statement_undefined_p(st_false[i])) {
1306  //Generate if statement considering whether true or false case make communication
1307  if (statement_undefined_p(st_false[i])) {
1308  //Generate "if (ncond) st_true"
1309  st[i] = make_test_statement(
1310  ncond,
1311  st_true[i],
1313  }
1314  else if (statement_undefined_p(st_true[i])) {
1315  //Generate "if (!ncond) st_false"
1316  st[i] = make_test_statement(
1317  not_expression(ncond),
1318  //unary_intrinsic_expression(C_NOT_OPERATOR_NAME, ncond),
1319  st_false[i],
1321  }
1322  else {
1323  //Generate "if (ncond) st_true else st_false"
1324  st[i] = make_test_statement(
1325  ncond,
1326  st_true[i],
1327  st_false[i]);
1328  }
1329 
1330  ctx_set_receive_statement(ctx, st[i], i);
1331 // ctx_set_body_statement_to_add(ctx, st[i], i);
1332  }
1333  }
1334  }
1335 
1336  pips_debug(8, "end\n");
1337  return false;
1338 }
1339 
1340 /**
1341  * use as filter for gen_context_recurse
1342  * check if the statement stat will be communication
1343  * if so, generate the MPI_Send and MPI_Receive corresponding.
1344  * by this fact, when we leave the statement, we know if we encounter a communication in the explored AST
1345  * \param stat statement analyzed
1346  * \param ctx context
1347  * \return always true
1348  */
1350  pips_debug(8, "begin\n");
1352  int sender_cluster = find_sender_cluster(ctx, stat);
1353  int receiver_cluster = find_receiver_cluster(ctx, stat);
1354  statement mpi_send_st = generate_send_from_statement(ctx, stat);
1355  statement mpi_receive_st = generate_receive_from_statement(ctx, stat);
1356 
1357  ctx_inc_tag(ctx, sender_cluster, receiver_cluster);
1358 
1359  ctx_set_send_statement(ctx, mpi_send_st);
1360  ctx_set_receive_statement(ctx, mpi_receive_st, receiver_cluster);
1361  //TODO remplacer la copi par le send dans le rewrite si meme if --> Done
1362  //TODO modifier les flow pour le receive dans le rewrite si statement est control flow
1363  //TODO add declaration pour les receive si statement sequence
1364  }
1365 
1366  pips_debug(8, "end\n");
1367  return true;
1368 }
1369 
1370 /**
1371  * Update statement that we work on by replace communication assignment by real MPI_send function
1372  * and compute the corresponding MPI_receiv that must be done
1373  */
1375  pips_debug(5, "begin\n");
1377  statement mpi_send_st = statement_undefined;
1378 
1379  /**
1380  * if the statement is a sequence
1381  * add the declaration for all the receive cluster (that have a receive statement)
1382  */
1383  if (statement_sequence_p(stat)) {
1384  //Only add the declaration
1386  for (int i = 0; i < ctx->nbr_cluster; ++i) {
1387  if (i!=ctx->current_cluster) {
1388  statement receive_statement = ctx_get_receive_statement(*ctx, i);
1389  // verify the presence of a receive message
1390  if (!statement_undefined_p(receive_statement)) {
1391  receive_statement = make_block_with_stmt_if_not_already(receive_statement);
1392  if (receive_statement != ctx_get_receive_statement(*ctx, i)) {
1393  ctx_set_receive_statement(ctx, receive_statement, i);
1394  }
1395 
1396  //Copy all the declaration of the sequence
1397  // FIXME: Problem with the scope name? same entity declare at many places (but totally different scope so no collision)?
1398  FOREACH(ENTITY, decl, statement_declarations(stat)) {
1399  receive_statement = add_declaration_statement(receive_statement, decl);
1400  statement_declarations(receive_statement) = CONS(ENTITY, decl, statement_declarations(receive_statement));
1401  }
1402  }
1403  }
1404  }
1406  }
1407  /**
1408  * if the statement stat is copy statement for communication
1409  * replace the copy statement by the send communication statement
1410  */
1412  //if it's a copy-communication statement, the last function called by PIPS was search_copy_communication
1413  // and this function must have create a send_statement
1414  mpi_send_st = ctx_get_send_statement(ctx);
1415  ifdebug(8) {
1416  pips_debug(8, "mpi_send_st\n");
1417  print_statement(mpi_send_st);
1418  pips_debug(8, "ctx_get_statement_work_on(*ctx)\n");
1420  pips_debug(8, "end ctx_get_statement_work_on(*ctx)\n");
1421  }
1422 
1423  if (statement_replace_in_root_statement(stat, mpi_send_st, ctx_get_statement_work_on(*ctx)))
1424  free_statement(stat);
1425  else
1426  pips_internal_error("This case never happen.\n");
1427  }
1428 
1429  /**
1430  * look the parent statement of the AST
1431  * to duplicate it for the receiver's clusters
1432  * the duplication of the AST is only done if there is a receive statement
1433  * (if (!statement_undefined_p(ctx_get_receive_statement(*ctx, i))))
1434  * TODO and potentially modify the AST in case of dynamic flow by adding variable and send/receive of this dynamic value \\
1435  * (This case can only happen if copy_value_of_write is used, but this compilation process is unsure in many point)
1436  */
1437  if (st != NULL) {
1438  for (int i = 0; i < ctx->nbr_cluster; ++i) {
1439  if (i!=ctx->current_cluster) {
1440  statement receive_statement = ctx_get_receive_statement(*ctx, i);
1441 
1442  if (!statement_undefined_p(receive_statement)) {
1443  switch (instruction_tag(statement_instruction(st))) {
1445  {
1446  // Nothing to do
1447  pips_internal_error("This case never happen because sequence_working_false always return false\n");
1448  break;
1449  }
1450  case is_instruction_test:
1451  {
1452  pips_internal_error("This case never happen because test_working_false always return false\n");
1453 // test t = statement_test(st);
1454 // expression cond = test_condition(t);
1455 // statement new_statement = statement_undefined;
1456 //
1457 // expression ncond = copy_expression(cond);
1458 // bool need_more_com = false; // TO DO: Not implemented yet
1459 // if (!integer_constant_expression_p(ncond)) {
1460 // gen_context_recurse(ncond, &i, reference_domain, gen_true, replace_sender_entity_by_receiver_entity_in_reference);
1461 // }
1462 // if (need_more_com) {
1463 // // TO DO modify AST if dynamic
1464 // //add more send/receive com
1465 // pips_internal_error("some variables do not exist on receive cluster. Need to send them.\n");
1466 // }
1467 //
1468 // statement receive_statement = ctx_get_receive_statement(*ctx, i);
1469 // if (!statement_undefined_p(receive_statement)) {
1470 // if (test_true(t)==stat) {
1471 // new_statement = make_test_statement(
1472 // ncond,
1473 // receive_statement,
1474 // make_empty_block_statement());
1475 // }
1476 // else if (test_false(t)==stat) {
1477 // new_statement = make_test_statement(
1478 // not_expression(ncond),
1479 // //unary_intrinsic_expression(C_NOT_OPERATOR_NAME, copy_expression(cond)),
1480 // receive_statement,
1481 // make_empty_block_statement());
1482 // }
1483 // else {
1484 // pips_internal_error("This case never happen;\n");
1485 // }
1486 //
1487 // ctx_set_receive_statement(ctx, new_statement, i);
1488 // new_statement = statement_undefined;
1489 // }
1490  break;
1491  }
1492  case is_instruction_loop:
1493  {
1494  ifdebug(8) {
1495  pips_debug(8, "is_instruction_loop\n");
1496  print_statement(st);
1497  pips_debug(8, "\n");
1498  }
1499 
1500  loop l = statement_loop(st);
1501  range rg = loop_range(l);
1502  expression lower = range_lower(rg);
1503  expression upper = range_upper(rg);
1504  expression increment = range_increment(rg);
1505  statement new_statement = statement_undefined;
1506 
1507  expression nlower = copy_expression(lower);
1508  expression nupper = copy_expression(upper);
1509  expression nincrement = copy_expression(increment);
1510  bool need_more_com = false; //TODO: Not implemented yet
1511  if (!integer_constant_expression_p(nlower))
1513  if (!integer_constant_expression_p(nupper))
1515  if (!integer_constant_expression_p(nincrement))
1517  if (need_more_com) {
1518  //TODO modify AST if dynamic
1519  //add more send/receive com
1520  pips_internal_error("some variables do not exist on receive cluster. Need to send/receive them.\n");
1521  }
1522 
1523  // Try to aggregate the communication when sending adjacent array element
1524  syntax snincrement = expression_syntax(nincrement);
1525  syntax snlower = expression_syntax(nlower);
1526  syntax snupper = expression_syntax(nupper);
1527  ifdebug(8) {
1528  pips_debug(8, "nincrement\n");
1529  print_expression(nincrement);
1530  pips_debug(8, "nsincrement\n");
1531  print_syntax(snincrement);
1532 
1533  pips_debug(8, "nlower\n");
1534  print_expression(nlower);
1535  pips_debug(8, "snlower\n");
1536  print_syntax(snlower);
1537 
1538  pips_debug(8, "nupper\n");
1539  print_expression(nupper);
1540  pips_debug(8, "snupper\n");
1541  print_syntax(snupper);
1542  }
1543 
1544  // Increment must be +1
1545  if (expression_constant_p(nincrement) && expression_to_int(nincrement) == 1) {
1546 // new_statement = generate_receive_from_statement(ctx, stat);
1547 // new_statement = mpi_recv_ctx(ctx->ctx_mpi, buffer, 1, sender, tag, blocking);
1548 // mpic_make_mpi_recv(buffer, size, mpitype, source, tag, ctx.mpi_communicator, ctx.mpi_status, ctx.error);
1549 // if (entity_undefined_p(result)) {
1550 // mpi_st = call_to_statement(mpi_call);
1551 // }
1552 // else {
1553 // mpi_st = make_assign_statement(entity_to_expression(result), call_to_expression(mpi_call));
1554 // }
1555 // {result =} MPI_Recv(&buffer, size, mpitype, source, tag, communicator, &status);
1556 // {result =} MPI_Irecv(&buffer, size, mpitype, source, tag, communicator, &request);
1557  call mpi_call_recv;
1558  entity result = entity_undefined;
1559  // receive_statement is : [result =] MPI_[I]Recv(&buffer, size, mpitype, source, tag, communicator, &status);
1560  // or : [result =] MPI_IRecv(&buffer, size, mpitype, source, tag, communicator, &request);
1561  if (assignment_statement_p(receive_statement)) {
1562  call assign_call = instruction_call(statement_instruction(receive_statement));
1563  list args = call_arguments(assign_call);
1564  expression lhs = EXPRESSION(CAR(args));
1565  expression rhs = EXPRESSION(CAR(CDR(args)));
1566  result = expression_to_entity(lhs);
1567  mpi_call_recv = expression_call(rhs);
1568  }
1569  else {
1570  mpi_call_recv = statement_call(receive_statement);
1571  }
1572 
1573 
1574  list args = call_arguments(mpi_call_recv);
1575  expression argbuf = (EXPRESSION(CAR(args)));
1576  // expression argsize = (EXPRESSION(CAR(CDR(args))));
1577 // expression argtype = copy_expression(EXPRESSION(CAR(CDR(CDR(args)))));
1578 // expression argsource = copy_expression(EXPRESSION(CAR(CDR(CDR(CDR(args))))));
1579 // expression argtag = copy_expression(EXPRESSION(CAR(CDR(CDR(CDR(CDR(args)))))));
1580 // expression argcom = copy_expression(EXPRESSION(CAR(CDR(CDR(CDR(CDR(CDR(args))))))));
1581 // expression argstatreq = copy_expression(EXPRESSION(CAR(CDR(CDR(CDR(CDR(CDR(CDR(args)))))))));
1582  entity lindex = loop_index(l);
1584  ifdebug(8) {
1585  pips_debug(8, "argbufent\n");
1586  print_entity_variable(argbufent);
1587  pips_debug(8, "argbuf\n");
1588  print_expression(argbuf);
1589  }
1590 
1591  // verify that we work on the most inside array index for C code
1592  // TODO need to make the inverse for Fortran code...
1593  call refcall = expression_call(argbuf);
1595  list indices = reference_indices(refbuf);
1596  ifdebug(8) {
1597  pips_debug(8, "refbuf\n");
1598  print_reference(refbuf);
1599  pips_debug(8, "lindex\n");
1600  print_entity_variable(lindex);
1601  }
1602  //while (indices != NIL && !same_entity_p(lindex, expression_to_entity(EXPRESSION(CAR(indices))))) {
1603  // indices = CDR(indices);
1604  //}
1605  for (indices = reference_indices(refbuf);
1607  indices = CDR(indices));
1608 
1610  // if we are in the most inside array index (C code)
1611  if (CDR(indices) == NIL
1612  // expression_constant_p(argsize) && expression_to_int(argsize) == 1 // Normally is already verify in our case
1613  ) {
1614  // We can replace the MPI_Receiv to a more aggregate one.
1615  // ie. instead of making (for (i=[n;m]) MPI_Recv(a[i])) -> MPI_Recv(a[n:m])
1616  expression newtype = copy_expression(EXPRESSION(CAR(CDR(CDR(args)))));
1617  expression newsource = copy_expression(EXPRESSION(CAR(CDR(CDR(CDR(args))))));
1618  expression newtag = copy_expression(EXPRESSION(CAR(CDR(CDR(CDR(CDR(args)))))));
1619  expression newcom = copy_expression(EXPRESSION(CAR(CDR(CDR(CDR(CDR(CDR(args))))))));
1620  expression newstatreq = copy_expression(EXPRESSION(CAR(CDR(CDR(CDR(CDR(CDR(CDR(args)))))))));
1622  expression newsize = expression_undefined;
1623 
1624  // Compute the new size of element to communicate
1625  if (zero_expression_p(nlower)) {
1626  //newsize = copy_expression(nupper); // it's false, we have to add 1 to this number...
1627  intptr_t upint;
1628  if (expression_integer_value(nupper, &upint))
1629  newsize = int_to_expression(upint+1);
1630  else
1631  newsize = expressions_to_operation(
1633  copy_expression(nupper),
1634  int_to_expression(1),
1635  NULL),
1637  //CreateIntrinsic(PLUS_C_OPERATOR_NAME));
1638  }
1639  else {
1640  intptr_t lowint, upint;
1641  if (expression_integer_value(nlower, &lowint) && expression_integer_value(nupper, &upint)) {
1642  intptr_t newsizeint = upint-lowint+1;
1643  if (newsizeint > 0)
1644  newsize = int_to_expression(newsizeint);
1645  else
1646  pips_internal_error("communication of a negative number of elements (%ld)\n"
1647  "This case never happen...", newsizeint);
1648  }
1649  else
1650  newsize = expressions_to_operation(
1654  //CreateIntrinsic(MINUS_C_OPERATOR_NAME)),
1655  int_to_expression(1),
1656  NULL),
1658  //CreateIntrinsic(PLUS_C_OPERATOR_NAME));
1659  }
1660 
1661  // Compute the new first array element to communicate
1662  list oldindices = reference_indices(refbuf);
1663  list newindices = NIL;
1664  while (oldindices != NIL) {
1665  if (same_entity_p(lindex, expression_to_entity(EXPRESSION(CAR(oldindices)))))
1666  newindices = CONS(EXPRESSION, copy_expression(nlower), newindices);
1667  //newindices = gen_append(CONS(EXPRESSION, int_to_expression(0), NIL), newindices);
1668  else
1669  newindices = CONS(EXPRESSION, EXPRESSION(CAR(oldindices)), newindices);
1670  //newindices = gen_append(CONS(EXPRESSION, EXPRESSION(CAR(oldindices)), NIL), newindices);
1671  oldindices = CDR(oldindices);
1672  }
1673  newindices = gen_nreverse(newindices);
1674  newbuf = make_address_of_expression(make_entity_expression(argbufent, newindices));
1675  //newbuf = make_call_expression(call_function(expression_call(argbuf)), make_entity_expression(argbufent, newindices));
1676 
1677  ifdebug(8) {
1678  pips_debug(8, "newsize\n");
1679  print_expression(newsize);
1680  expression_consistent_p(newsize);
1681  pips_debug(8, "newbuf\n");
1682  print_expression(newbuf);
1683  }
1684 
1685  //Generate the new aggregate receive statement in MPI
1686  call receive_call;
1687  list newarg = gen_make_list(expression_domain, newbuf, newsize, newtype, newsource, newtag, newcom, newstatreq, NULL);
1688  receive_call = make_call(call_function(mpi_call_recv), newarg);
1689  if (entity_undefined_p(result)) {
1690  new_statement = call_to_statement(receive_call);
1691  }
1692  else {
1693  new_statement = make_assign_statement(entity_to_expression(result), call_to_expression(receive_call));
1694  }
1695 
1696  //Replace the the communication for the sender
1697  call send_call, mpi_send_call;
1698  entity result_send = entity_undefined;
1699  if (assignment_statement_p(mpi_send_st)) {
1700  call assign_call = instruction_call(statement_instruction(mpi_send_st));
1701  list args = call_arguments(assign_call);
1702  expression lhs = EXPRESSION(CAR(args));
1703  expression rhs = EXPRESSION(CAR(CDR(args)));
1704  result_send = expression_to_entity(lhs);
1705  mpi_send_call = expression_call(rhs);
1706  }
1707  else {
1708  mpi_send_call = statement_call(mpi_send_st);
1709  }
1710 
1711  list sendarg;
1713  expression sendreq = expression_undefined;
1715  expression sendsize = copy_expression(newsize);
1716  expression sendtype = copy_expression(newtype);
1717  expression senddest = int_to_expression(i);
1718  expression sendtag = copy_expression(newtag);
1719  expression sendcom = copy_expression(newcom);
1720  // expression sendtype = copy_expression(EXPRESSION(CAR(CDR(CDR(call_arguments(mpi_send_call))))));
1721  // expression senddest = copy_expression(EXPRESSION(CAR(CDR(CDR(CDR(call_arguments(mpi_send_call)))))));
1722  // expression sendtag = copy_expression(EXPRESSION(CAR(CDR(CDR(CDR(CDR(call_arguments(mpi_send_call))))))));
1723  // expression sendcom = copy_expression(EXPRESSION(CAR(CDR(CDR(CDR(CDR(CDR(call_arguments(mpi_send_call)))))))));
1725  //MPI_Send
1726  sendarg = gen_make_list(expression_domain, sendbuf, sendsize, sendtype, senddest, sendtag, sendcom, NULL);
1727  }
1728  else {
1729  //MPI_Isend
1730  sendreq = copy_expression(EXPRESSION(CAR(CDR(CDR(CDR(CDR(CDR(CDR(call_arguments(mpi_send_call))))))))));
1731  sendarg = gen_make_list(expression_domain, sendbuf, sendsize, sendtype, senddest, sendtag, sendcom, sendreq, NULL);
1732  }
1733  send_call = make_call(call_function(mpi_send_call), sendarg);
1734 
1735 
1736  statement send_statement;
1737  if (entity_undefined_p(result_send)) {
1738  send_statement = call_to_statement(send_call);
1739  }
1740  else {
1741  send_statement = make_assign_statement(entity_to_expression(result_send), call_to_expression(send_call));
1742  }
1743 
1744  if (!statement_replace_in_root_statement(st, send_statement, ctx_get_statement_work_on(*ctx)))
1745  pips_internal_error("This case never happen.\n");
1746 
1747  ifdebug(5) {
1748  pips_debug(5, "send_statement\n");
1749  print_statement(send_statement);
1750  statement_consistent_p(send_statement);
1751  pips_debug(5, "\n");
1752  }
1753 
1754 
1755  // clean the memory
1756  free_statement(receive_statement);
1757  receive_statement = statement_undefined;
1758  free_statement(mpi_send_st);
1759  mpi_send_st = statement_undefined;
1760  free_expression(nlower);
1761  free_expression(nupper);
1762  free_expression(nincrement);
1763  }
1764  // else we have to verify that each more index are 0,
1765  // and the total size of the MPI_[I]Recv is equal to the size of all the inside array...
1766  else {
1767  // TODO: implementation for multidimensional array communication
1768  // Not implemented yet...
1769  // Does an array resizing can be a issue ?
1770  // For instance the array size for the reception is contiguous but not for the sender...
1771  // How to implement it:
1772  // We have to verify that the loop concern the last (resp. first for fortran) index of the array to communicate
1773  // that all the inner (resp. outer) dimension start at 0 and communicate all there dimension elements
1774  // that the current dimension that we want to communicate is on all the dimension array and not just part of it
1775  // ie. that the loop start at 0 and end at the size of the array.
1776  // Then replace the start of the array to communicate by a 0 for the concern dimension
1777  // and multiply the size to communicate by the size of the current dimension that it's treated.
1778  // Do not forget to replace the com for the sender
1779  // Do not forget to clean the memory
1780  new_statement = make_loop_statement(
1781  loop_index(l),
1782  nlower, nupper, nincrement,
1783  receive_statement);
1784  }
1785  }
1786  }
1787  // if (statement_undefined_p(new_statement)) {
1788  else {
1789  new_statement = make_loop_statement(
1790  loop_index(l),
1791  nlower, nupper, nincrement,
1792  receive_statement);
1793  }
1794  ctx_set_receive_statement(ctx, new_statement, i);
1795 
1796  ifdebug(5) {
1797  pips_debug(5, "receive_statement\n");
1798  print_statement(receive_statement);
1799  statement_consistent_p(receive_statement);
1800  pips_debug(5, "new_statement\n");
1801  print_statement(new_statement);
1802  statement_consistent_p(new_statement);
1803  pips_debug(5, "\n");
1804  }
1805  //new_statement = statement_undefined;
1806  break;
1807  }
1809  {
1810  ifdebug(8) {
1811  pips_debug(8, "is_instruction_whileloop\n");
1812  print_statement(st);
1813  pips_debug(8, "\n");
1814  }
1815 
1817  expression cond = whileloop_condition(l);
1818  statement new_statement = statement_undefined;
1819 
1820  expression ncond = copy_expression(cond);
1821  bool need_more_com = false; //TODO: Not implemented yet
1822  if (!integer_constant_expression_p(ncond))
1824  if (need_more_com) {
1825  //TODO modify AST if dynamic
1826  //add more send/receive com
1827  pips_internal_error("some variables do not exist on receive cluster. Need to send/receive them.\n");
1828  }
1829 
1830  new_statement = make_whileloop_statement(
1831  ncond,
1832  receive_statement,
1835  ctx_set_receive_statement(ctx, new_statement, i);
1836  //new_statement = statement_undefined;
1837  break;
1838  }
1840  {
1841  ifdebug(8) {
1842  pips_debug(8, "is_instruction_whileloop\n");
1843  print_statement(st);
1844  pips_debug(8, "\n");
1845  }
1846 
1847  forloop l = statement_forloop(st);
1849  expression cond = forloop_condition(l);
1850  expression incr = forloop_increment(l);
1851  statement new_statement = statement_undefined;
1852 
1853  expression ninit = copy_expression(init);
1854  expression ncond = copy_expression(cond);
1855  expression nincr = copy_expression(incr);
1856  bool need_more_com = false; //TODO: Not implemented yet
1857  if (!integer_constant_expression_p(ninit))
1859  if (!integer_constant_expression_p(ncond))
1861  if (!integer_constant_expression_p(nincr))
1863  if (need_more_com) {
1864  //TODO modify AST if dynamic
1865  //add more send/receive com
1866  pips_internal_error("some variables do not exist on receive cluster. Need to send them.\n");
1867  }
1868 
1869  new_statement = make_forloop_statement(
1870  ninit,
1871  ncond,
1872  nincr,
1873  receive_statement);
1874  ctx_set_receive_statement(ctx, new_statement, i);
1875  //new_statement = statement_undefined;
1876  break;
1877  }
1878  case is_instruction_call:
1879  //{
1880  // break;
1881  //}
1884  case is_instruction_goto:
1886  pips_internal_error("This case never happen? tag=%d\n", instruction_tag(statement_instruction(st)));
1887  break;
1888  default:
1889  pips_internal_error("This tag doesn't exist: %d\n", instruction_tag(statement_instruction(st)));
1890  break;
1891  }
1892  }
1893  }
1894  }
1895  }
1896  pips_debug(5, "end\n");
1897 }
1898 
1899 
1900 
1902  ifdebug(2) {
1903  pips_debug(2, "begin\n");
1904  pips_debug(2, "statement with : \n");
1906  }
1907  statement new_module_statement = make_empty_block_statement();
1908 
1909 
1912  ctx_conv_t ctx;
1913  ctx = conv_make_ctx(module, nbr_copy);
1915  list stats = sequence_statements(seq);
1916 
1917  //0. init the environement
1918  initilization(new_module_statement , ctx);
1919 
1920  //1. Work task by task
1921  // Modify the control flow graph
1922  // To add if (rank==x) ...
1923  FOREACH(STATEMENT, s, stats) {
1924  if (declaration_statement_p(s)) {
1925  statement new_decl = copy_statement(s);
1926  insert_statement_no_matter_what(new_module_statement, new_decl, false);
1927  //No need?
1928  //statement_declarations(new_module_statement) = gen_append(statement_declarations(new_module_statement), statement_declarations(new_decl));
1929  }
1930  else if (return_statement_p(s)) {
1931  ctx_set_return_statement(&ctx, s);
1932  }
1933  else if (statement_sequence_p(s)) {
1934  ctx_set_statement_work_on(&ctx, s);
1935 
1936 
1938 // gen_context_recurse(ctx_get_statement_work_on(ctx), &ctx
1941  , test_domain, test_working_false, gen_core /*gen_null*/
1942 // , loop_domain, gen_true, gen_true
1943 // , whileloop_domain, gen_true, gen_true
1944 // , forloop_domain, gen_true, gen_true
1945 // //, call_domain, gen_true, gen_true // to detect copy for communication statement done in statement_domaine case
1946 // //, multitest_domain, gen_true, gen_true // don't exist in PIPS yet
1947 // //, unstructured_domain, gen_true, gen_true // never happens? bug case?
1948 // //, expression_domain, gen_true, gen_true
1949  , NULL
1950  );
1951 
1952 // gen_context_recurse(ctx_get_statement_work_on(ctx), &ctx, statement_domain, gen_true, make_send_conversion);
1953 // gen_context_recurse(ctx_get_statement_work_on(ctx), &ctx, statement_domain, gen_true, make_receive_conversion);
1954 
1955  insert_statement(new_module_statement , ctx_generate_new_statement_cluster_dependant(ctx), false);
1956 // free_statement(s);
1957 // s = status_undefined;
1958 // print_statement(new_module_statement );
1959  }
1960  else {
1961  print_statement(s);
1962  pips_internal_error("This case never happen?\n");
1963  }
1964  }
1965 
1966  //2. close the environement
1967  finalization(new_module_statement , ctx);
1968 
1969  conv_free_ctx(&ctx);
1971  } else {
1972  free_statement(new_module_statement);
1973  pips_internal_error("The statement must be the module statement (a sequence of instruction).\n");
1974  new_module_statement = module_statement;
1975  }
1976 
1977  ifdebug(2) {
1978  pips_debug(2, "statement with : \n");
1979  print_statement(new_module_statement);
1980  pips_debug(2, "end\n");
1981  }
1982  return new_module_statement ;
1983 }
1984 
1985 
1986 /**
1987  * PIPS pass
1988  */
1989 bool mpi_conversion(const char* module_name) {
1990  entity module;
1992  bool good_result_p = true;
1993 
1994  debug_on("MPI_GENERATION_DEBUG_LEVEL");
1995  pips_debug(1, "begin\n");
1996 
1997  //-- configure environment --//
2000 
2002  db_get_memory_resource(DBR_CODE, module_name, true) );
2004 
2005  pips_assert("Statement should be OK before...",
2007 
2009 
2010  //-- get dependencies --//
2011 // if(use_points_to) {
2012 // set_pointer_info_kind(with_points_to); //enough?
2013 // }
2015  db_get_memory_resource(DBR_TASK, module_name, true));
2016 
2017  //-- Make the job -- //
2019 
2020  pips_assert("Statement should be OK after...",
2022 
2023  // Removed useless block created by the insert_statement
2025 
2026  /* Reorder the module, because some statements have been added.
2027  Well, the order on the remaining statements should be the same,
2028  but by reordering the statements, the number are consecutive. Just
2029  for pretty print... :-) */
2031 
2032  pips_assert("Statement should be OK after...",
2034 
2035  //-- Save modified code to database --//
2037 
2042 
2043  pips_debug(1, "end\n");
2044  debug_off();
2045 
2046  return (good_result_p);
2047 }
2048 
float a2sf[2] __attribute__((aligned(16)))
USER generates a user error (i.e., non fatal) by printing the given MSG according to the FMT.
Definition: 3dnow.h:3
int get_int_property(const string)
call make_call(entity a1, list a2)
Definition: ri.c:269
basic make_basic_typedef(entity _field_)
Definition: ri.c:185
storage make_storage_rom(void)
Definition: ri.c:2285
ram make_ram(entity a1, entity a2, intptr_t a3, list a4)
Definition: ri.c:1999
expression copy_expression(expression p)
EXPRESSION.
Definition: ri.c:850
statement copy_statement(statement p)
STATEMENT.
Definition: ri.c:2186
void free_extensions(extensions p)
Definition: ri.c:950
bool statement_consistent_p(statement p)
Definition: ri.c:2195
bool expression_consistent_p(expression p)
Definition: ri.c:859
void free_expression(expression p)
Definition: ri.c:853
storage make_storage_ram(ram _field_)
Definition: ri.c:2279
void free_statement(statement p)
Definition: ri.c:2189
static reference ref
Current stmt (an integer)
Definition: adg_read_paf.c:163
static statement module_statement
Definition: alias_check.c:125
void put_new_typedef(const char *)
This function is used by libraries "step"* and "task_parallelization".
Definition: util.c:1078
struct _newgen_struct_statement_ * statement
Definition: cloning.h:21
entity make_constant_entity(string name, tag bt, size_t size)
For historical reason, call the Fortran version.
Definition: constant.c:301
void unspaghettify_statement(statement)
The real entry point of unspaghettify:
type ImplicitType(entity e)
This function computes the Fortran implicit type of entity e.
Definition: declaration.c:1311
const char * module_name(const char *s)
Return the module part of an entity name.
Definition: entity_names.c:296
char * get_string_property(const char *)
#define gen_context_recurse(start, ctxt, domain_number, flt, rwt)
Definition: genC.h:285
#define STRING(x)
Definition: genC.h:87
#define gen_get_ancestor_type(i, o)
Definition: genC.h:276
void * malloc(YYSIZE_T)
void free(void *)
statement make_empty_block_statement(void)
Build an empty statement (block/sequence)
Definition: statement.c:625
statement make_block_with_stmt_if_not_already(statement)
Build a statement block from a statement if not already a statement block.
Definition: statement.c:768
void reset_current_module_entity(void)
Reset the current module entity.
Definition: static.c:97
void reset_current_module_statement(void)
Reset the current module statement.
Definition: static.c:221
statement set_current_module_statement(statement)
Set the current module statement.
Definition: static.c:165
statement get_current_module_statement(void)
Get the current module statement.
Definition: static.c:208
entity set_current_module_entity(entity)
static.c
Definition: static.c:66
entity get_current_module_entity(void)
Get the entity of the current module.
Definition: static.c:85
void gen_context_multi_recurse(void *o, void *context,...)
Multi-recursion with context function visitor.
Definition: genClib.c:3373
void gen_core(__attribute__((unused)) void *p)
Abort when called.
Definition: genClib.c:2822
bool gen_true2(__attribute__((unused)) gen_chunk *u1, __attribute__((unused)) void *u2)
Definition: genClib.c:2785
list gen_make_list(int domain,...)
Definition: list.c:851
list gen_nreverse(list cp)
reverse a list in place
Definition: list.c:304
#define NIL
The empty list (nil in Lisp)
Definition: newgen_list.h:47
#define CONS(_t_, _i_, _l_)
List element cell constructor (insert an element at the beginning of a list)
Definition: newgen_list.h:150
#define CAR(pcons)
Get the value of the first element of a list.
Definition: newgen_list.h:92
#define FOREACH(_fe_CASTER, _fe_item, _fe_list)
Apply/map an instruction block on all the elements of a list.
Definition: newgen_list.h:179
#define CDR(pcons)
Get the list less its first element.
Definition: newgen_list.h:111
list gen_full_copy_list(list l)
Copy a list structure with element copy.
Definition: list.c:535
string db_get_memory_resource(const char *rname, const char *oname, bool pure)
Return the pointer to the resource, whatever it is.
Definition: database.c:755
#define DB_PUT_MEMORY_RESOURCE(res_name, own_name, res_val)
conform to old interface.
Definition: pipsdbm-local.h:66
sequence statement_sequence(statement)
Get the sequence of a statement sequence.
Definition: statement.c:1328
loop statement_loop(statement)
Get the loop of a statement.
Definition: statement.c:1374
call statement_call(statement)
Get the call of a statement.
Definition: statement.c:1406
whileloop statement_whileloop(statement)
Get the whileloop of a statement.
Definition: statement.c:1383
forloop statement_forloop(statement)
Get the forloop of a statement.
Definition: statement.c:1426
bool empty_statement_or_continue_p(statement)
Return true if the statement is an empty instruction block or a continue or a recursive combination o...
Definition: statement.c:474
bool statement_sequence_p(statement)
Statement classes induced from instruction type.
Definition: statement.c:335
statement make_assign_statement(expression, expression)
Definition: statement.c:583
statement add_declaration_statement_at_beginning(statement, entity)
Definition: statement.c:2795
statement make_whileloop_statement(expression, statement, int, bool)
Build a while loop statement.
Definition: statement.c:1150
statement make_loop_statement(entity, expression, expression, expression, statement)
Build a loop statement.
Definition: statement.c:1181
bool return_statement_p(statement)
Test if a statement is a C or Fortran "return".
Definition: statement.c:172
void pop_generated_variable_commenter(void)
Definition: statement.c:2623
void insert_statement(statement, statement, bool)
This is the normal entry point.
Definition: statement.c:2570
bool assignment_statement_p(statement)
Test if a statement is an assignment.
Definition: statement.c:135
void insert_statement_no_matter_what(statement, statement, bool)
Break the IR consistency or, at the very least, do not insert new declarations at the usual place,...
Definition: statement.c:2581
bool statement_replace_in_root_statement(statement, statement, statement)
replace old_stat by new_stat in root_stat this pass does not free old_stat similar to replace_in_sequ...
Definition: statement.c:4235
statement add_declaration_statement(statement, entity)
Definition: statement.c:2790
bool empty_comments_p(const char *)
Definition: statement.c:107
statement make_test_statement(expression, statement, statement)
Definition: statement.c:1248
void push_generated_variable_commenter(string(*)(entity))
Definition: statement.c:2616
statement make_forloop_statement(expression, expression, expression, statement)
Definition: statement.c:1220
bool declaration_statement_p(statement)
Had to be optimized according to Beatrice Creusillet.
Definition: statement.c:224
bool expression_constant_p(expression)
HPFC module by Fabien COELHO.
Definition: expression.c:2453
static list indices
Definition: icm.c:204
#define debug_on(env)
Definition: misc-local.h:157
#define pips_debug
these macros use the GNU extensions that allow variadic macros, including with an empty list.
Definition: misc-local.h:145
#define pips_user_warning
Definition: misc-local.h:146
#define same_stringn_p(a, b, c)
Definition: misc-local.h:199
#define pips_assert(what, predicate)
common macros, two flavors depending on NDEBUG
Definition: misc-local.h:172
#define pips_internal_error
Definition: misc-local.h:149
#define debug_off()
Definition: misc-local.h:160
#define pips_user_error
Definition: misc-local.h:147
static statement mpic_make_mpi_irecv(expression buffer, int size, entity mpitype, int source, int tag, entity communicator, entity request, entity result)
generate statement: {result =} MPI_Irecv(&buffer, size, mpitype, source, tag, communicator,...
static type mpi_type_mpi_comm()
return the type for MPI communicator: MPI_Comm
static statement mpic_make_mpi_finalize(entity result)
generate statement: MPI_Finalize(); or result = MPI_Finalize();
static bool test_working_false(test t, ctx_conv_t *ctx)
This function update the receive statements for a test statement NB : This function can be put in sea...
bool mpi_conversion(const char *module_name)
PIPS pass.
static call mpic_make_generic_mpi_send_call(expression buffer, int size, entity mpitype, int dest, int tag, entity communicator, entity request, enum mpi_communication_mode mode)
static statement mpic_make_mpi_init(entity result, entity argc, entity argv)
argc and argv must be defined generate statement: MPI_Init(&argc, &argv); or result = MPI_Init(&argc,...
static string mpi_conversion_declaration_commenter(__attribute__((unused)) entity e)
Pass: MPI_CONVERSION Debug mode: MPI_GENERATION_DEBUG_LEVEL Properties used:
static statement mpic_make_mpi_comm_rank(entity communicator, entity rank, entity result)
generate statement: MPI_Comm_rank(communicator, &rank); or result = MPI_Comm_rank(communicator,...
static void initilization(statement module_statement, const ctx_conv_t ctx)
put initialize MPI functions at the beginning of the module_stateent (function): // Generated by Pass...
static statement mpi_send_ctx(const ctx_mpi_t ctx, expression buffer, int size, int dest, int tag, bool blocking)
static statement mpic_make_mpi_isend(expression buffer, int size, entity mpitype, int dest, int tag, entity communicator, entity request, entity result)
generate statement: {result =} MPI_Isend(&buffer, size, mpitype, dest, tag, communicator,...
static statement ctx_get_return_statement(const ctx_conv_t ctx)
static statement ctx_get_send_statement(ctx_conv_t *ctx)
static statement make_mpi_conversion(entity module, statement module_statement)
static void ctx_set_receive_statement(ctx_conv_t *ctx, statement receive, int for_cluster)
static statement mpic_make_mpi_comm_size(entity communicator, entity size, entity result)
Functions to generate standard MPI function statement Can maybe also make function to return MPI func...
static statement ctx_get_statement_work_on(const ctx_conv_t ctx)
static statement mpic_make_mpi_recv(expression buffer, int size, entity mpitype, int source, int tag, entity communicator, entity status, entity result)
TODO do the same for MPI_Rsend/Irsend/Bsend/Ibsend/Ssend/Issend.
static void finalization(statement module_statement, const ctx_conv_t ctx)
put finalize MPI functions at the end of the module_stateent (function), before the return: MPI_Final...
static type mpi_type_mpi_request()
return the type for MPI request: MPI_Request
static statement ctx_generate_new_statement_cluster_dependant(const ctx_conv_t ctx)
static ctx_conv_t conv_make_ctx(entity module, int nbr_cluster)
static statement generate_receive_from_statement(ctx_conv_t *ctx, statement stat)
mpi_communication_mode
@ mpi_communication_synchronous_mode
@ mpi_communication_buffered_mode
@ mpi_communication_ready_mode
@ mpi_communication_default_mode
static void make_send_receive_conversion(statement stat, ctx_conv_t *ctx)
Update statement that we work on by replace communication assignment by real MPI_send function and co...
static int ctx_get_tag(const ctx_conv_t ctx, int sender, int receiver)
static void ctx_inc_tag(ctx_conv_t *ctx, int sender, int receiver)
static int find_sender_cluster(ctx_conv_t *ctx, __attribute__((__unused__)) statement stat)
static bool is_distributed_comments(string comments)
static ctx_mpi_t mpi_make_ctx(entity module)
static type mpi_type_mpi_status()
return the type for MPI status: MPI_Status
static call mpic_make_generic_mpi_receive_call(expression buffer, int size, entity mpitype, int dest, int tag, entity communicator, entity status, entity request)
static void ctx_set_statement_work_on(ctx_conv_t *ctx, statement st)
static statement mpi_recv_ctx(const ctx_mpi_t ctx, expression buffer, int size, int source, int tag, bool blocking)
TODO do the same for Ssend, Rsend, Bsend.
static statement ctx_get_receive_statement(const ctx_conv_t ctx, int for_cluster)
static int find_receiver_cluster(__attribute__((__unused__)) ctx_conv_t *ctx, statement stat)
static statement mpi_init_ctx(const ctx_mpi_t ctx)
static bool sequence_working_false(sequence seq, ctx_conv_t *ctx)
This function update the receive statements for a sequential statement NB : This function can be put ...
static void ctx_set_return_statement(ctx_conv_t *ctx, statement rs)
static void replace_sender_entity_by_receiver_entity_in_reference(reference ref, int *receiv_cluster)
static statement mpi_comm_size_ctx(const ctx_mpi_t ctx)
static list mpic_make_args_mpi_send_or_receiv(expression buffer, int size, entity mpitype, int ds, int tag, entity communicator, entity status, entity request)
tatic statement mpifortran_make_mpi_finalize(entity result) { list args = CONS(EXPRESSION,...
static statement generate_send_from_statement(ctx_conv_t *ctx, statement stat)
static void ctx_init(ctx_conv_t *ctx)
static void mpi_free_ctx(__attribute__((__unused__)) ctx_mpi_t *ctx)
struct ctx_mpi ctx_mpi_t
return the type for MPI datatype (to make custom datatype for example): MPI_Datatype
static statement mpi_finalize_ctx(const ctx_mpi_t ctx)
static bool ctx_is_blocking(const ctx_conv_t ctx)
static bool search_copy_communication(statement stat, ctx_conv_t *ctx)
use as filter for gen_context_recurse check if the statement stat will be communication if so,...
static bool is_distributed_send_comments(string comments)
static statement mpi_comm_rank_ctx(const ctx_mpi_t ctx)
struct ctx_conv ctx_conv_t
static statement mpic_make_mpi_send(expression buffer, int size, entity mpitype, int dest, int tag, entity communicator, entity result)
generate statement: {result =} MPI_Send(&buffer, size, mpitype, dest, tag, communicator);
static void conv_free_ctx(ctx_conv_t *ctx)
static void ctx_set_send_statement(ctx_conv_t *ctx, statement send)
static bool is_distributed_receive_comments(string comments)
static entity rank
#define TOP_LEVEL_MODULE_NAME
Module containing the global variables in Fortran and C.
Definition: naming-local.h:101
#define STACK_AREA_LOCAL_NAME
Definition: naming-local.h:72
list strsplit(const char *, const char *)
Definition: string.c:318
string concatenate(const char *,...)
Return the concatenation of the given strings.
Definition: string.c:183
void * gen_find_tabulated(const char *, int)
Definition: tabulated.c:218
int tag
TAG.
Definition: newgen_types.h:92
hash_table set_ordering_to_statement(statement s)
To be used instead of initialize_ordering_to_statement() to make sure that the hash table ots is in s...
Definition: ordering.c:172
void reset_ordering_to_statement(void)
Reset the mapping from ordering to statement.
Definition: ordering.c:185
static char * module
Definition: pips.c:74
void print_entity_variable(entity e)
print_entity_variable(e)
Definition: entity.c:56
void print_syntax(syntax s)
Definition: expression.c:121
void print_expression(expression e)
no file descriptor is passed to make is easier to use in a debugging stage.
Definition: expression.c:58
void print_reference(reference r)
Definition: expression.c:142
string basic_to_string(basic)
Definition: type.c:87
void print_statement(statement)
Print a statement on stderr.
Definition: statement.c:98
static const char * prefix
bool module_reorder(statement body)
Reorder a module and recompute order to statement if any.
Definition: reorder.c:244
#define MPI_IBSEND_FUNCTION_NAME
#define MPI_RSEND_FUNCTION_NAME
#define MINUS_OPERATOR_NAME
#define MPI_IRSEND_FUNCTION_NAME
#define MPI_STATUS
PI types.
#define PLUS_OPERATOR_NAME
#define MPI_COMM
#define EQUAL_OPERATOR_NAME
#define STATEMENT_NUMBER_UNDEFINED
default values
#define MPI_SEND_FUNCTION_NAME
#define MPI_REQUEST
#define MPI_ISEND_FUNCTION_NAME
#define MPI_INIT_FUNCTION_NAME
PI calls.
#define call_to_statement(c)
#define MPI_RECV_FUNCTION_NAME
#define MPI_COMM_RANK_FUNCTION_NAME
#define MPI_COMM_SIZE_FUNCTION_NAME
#define MPI_BSEND_FUNCTION_NAME
#define MPI_IRECV_FUNCTION_NAME
#define MPI_SSEND_FUNCTION_NAME
#define not_expression(e)
#define MPI_ISSEND_FUNCTION_NAME
#define MPI_FINALIZE_FUNCTION_NAME
const char * entity_user_name(entity e)
Since entity_local_name may contain PIPS special characters such as prefixes (label,...
Definition: entity.c:487
entity FindEntity(const char *package, const char *name)
Retrieve an entity from its package/module name and its local name.
Definition: entity.c:1503
entity FindOrCreateEntity(const char *package, const char *local_name)
Problem: A functional global entity may be referenced without parenthesis or CALL keyword in a functi...
Definition: entity.c:1586
bool same_entity_p(entity e1, entity e2)
predicates on entities
Definition: entity.c:1321
entity module_name_to_entity(const char *mn)
This is an alias for local_name_to_top_level_entity.
Definition: entity.c:1479
static int init
Maximal value set for Fortran 77.
Definition: entity.c:320
const char * module_local_name(entity e)
Returns the module local user name.
Definition: entity.c:582
entity CreateIntrinsic(string name)
this function does not create an intrinsic function because they must all be created beforehand by th...
Definition: entity.c:1311
entity entity_intrinsic(const char *name)
FI: I do not understand this function name (see next one!).
Definition: entity.c:1292
bool expression_integer_value(expression e, intptr_t *pval)
Definition: eval.c:792
expression make_entity_expression(entity e, cons *inds)
Definition: expression.c:176
expression make_address_of_expression(expression e)
generate a newly allocated expression for &(e)
Definition: expression.c:3956
bool zero_expression_p(expression e)
Definition: expression.c:1217
expression expressions_to_operation(const list l_exprs, entity op)
take a list of expression and apply a binary operator between all of them and return it as an express...
Definition: expression.c:3544
int expression_to_int(expression exp)
================================================================
Definition: expression.c:2205
expression entity_to_expression(entity e)
if v is a constant, returns a constant call.
Definition: expression.c:165
expression MakeBinaryCall(entity f, expression eg, expression ed)
Creates a call expression to a function with 2 arguments.
Definition: expression.c:354
call expression_call(expression e)
Definition: expression.c:445
expression int_to_expression(_int i)
transform an int into an expression and generate the corresponding entity if necessary; it is not cle...
Definition: expression.c:1188
bool integer_constant_expression_p(expression e)
positive integer constant expression: call to a positive constant or to a sum of positive integer con...
Definition: expression.c:903
reference expression_reference(expression e)
Short cut, meaningful only if expression_reference_p(e) holds.
Definition: expression.c:1832
entity expression_to_entity(expression e)
just returns the entity of an expression, or entity_undefined
Definition: expression.c:3140
expression call_to_expression(call c)
Build an expression that call a function or procedure.
Definition: expression.c:309
extensions empty_extensions(void)
extension.c
Definition: extension.c:43
basic MakeBasic(int)
END_EOLE.
Definition: type.c:128
entity make_new_scalar_variable_with_prefix(const char *, entity, basic)
Create a new scalar variable of type b in the given module.
Definition: variable.c:592
type MakeTypeVariable(basic, cons *)
BEGIN_EOLE.
Definition: type.c:116
@ is_basic_string
Definition: ri.h:576
@ is_basic_float
Definition: ri.h:572
@ is_basic_int
Definition: ri.h:571
#define test_domain
newgen_entity_domain_defined
Definition: ri.h:418
#define expression_domain
newgen_execution_domain_defined
Definition: ri.h:154
#define forloop_initialization(x)
Definition: ri.h:1366
#define call_function(x)
Definition: ri.h:709
#define reference_variable(x)
Definition: ri.h:2326
#define range_upper(x)
Definition: ri.h:2290
#define forloop_increment(x)
Definition: ri.h:1370
#define ENTITY(x)
ENTITY.
Definition: ri.h:2755
#define test_false(x)
Definition: ri.h:2837
#define basic_tag(x)
Definition: ri.h:613
#define whileloop_evaluation(x)
Definition: ri.h:3166
#define type_variable(x)
Definition: ri.h:2949
#define entity_storage(x)
Definition: ri.h:2794
#define statement_domain
newgen_sizeofexpression_domain_defined
Definition: ri.h:362
#define range_increment(x)
Definition: ri.h:2292
#define EXPRESSION(x)
EXPRESSION.
Definition: ri.h:1217
#define type_undefined_p(x)
Definition: ri.h:2884
#define entity_undefined_p(x)
Definition: ri.h:2762
#define reference_domain
newgen_range_domain_defined
Definition: ri.h:338
#define entity_undefined
Definition: ri.h:2761
#define expression_undefined
Definition: ri.h:1223
@ is_instruction_goto
Definition: ri.h:1473
@ is_instruction_unstructured
Definition: ri.h:1475
@ is_instruction_whileloop
Definition: ri.h:1472
@ is_instruction_expression
Definition: ri.h:1478
@ is_instruction_test
Definition: ri.h:1470
@ is_instruction_multitest
Definition: ri.h:1476
@ is_instruction_call
Definition: ri.h:1474
@ is_instruction_sequence
Definition: ri.h:1469
@ is_instruction_forloop
Definition: ri.h:1477
@ is_instruction_loop
Definition: ri.h:1471
#define instruction_tag(x)
Definition: ri.h:1511
#define entity_name(x)
Definition: ri.h:2790
#define test_true(x)
Definition: ri.h:2835
#define sequence_statements(x)
Definition: ri.h:2360
#define reference_indices(x)
Definition: ri.h:2328
#define statement_extensions(x)
Definition: ri.h:2464
#define test_condition(x)
Definition: ri.h:2833
#define range_lower(x)
Definition: ri.h:2288
#define statement_declarations(x)
Definition: ri.h:2460
#define statement_instruction(x)
Definition: ri.h:2458
#define statement_comments(x)
Definition: ri.h:2456
#define instruction_call(x)
Definition: ri.h:1529
#define loop_range(x)
Definition: ri.h:1642
#define forloop_condition(x)
Definition: ri.h:1368
#define call_arguments(x)
Definition: ri.h:711
#define statement_undefined_p(x)
Definition: ri.h:2420
#define whileloop_condition(x)
Definition: ri.h:3160
#define entity_type(x)
Definition: ri.h:2792
#define expression_syntax(x)
Definition: ri.h:1247
#define sequence_domain
newgen_reference_domain_defined
Definition: ri.h:346
#define evaluation_before_p(x)
Definition: ri.h:1159
#define storage_undefined_p(x)
Definition: ri.h:2477
#define entity_domain
newgen_syntax_domain_defined
Definition: ri.h:410
#define loop_index(x)
Definition: ri.h:1640
#define variable_basic(x)
Definition: ri.h:3120
#define statement_undefined
Definition: ri.h:2419
#define STATEMENT(x)
STATEMENT.
Definition: ri.h:2413
char * strdup()
#define ifdebug(n)
Definition: sg.c:47
#define intptr_t
Definition: stdint.in.h:294
static size_t current
Definition: string.c:115
static string buffer
Definition: string.c:113
The structure used to build lists in NewGen.
Definition: newgen_list.h:41
int current_cluster
task current_task
int ** tag
ctx_mpi_t ctx_mpi
statement statement_work_on
statement return_statement
statement * statement_send_receive
return the type for MPI datatype (to make custom datatype for example): MPI_Datatype
entity rank
entity mpi_status
entity mpi_communicator
entity mpi_request
entity size
entity error
#define MPI_GENERATION_NBR_CLUSTER
#define MPI_COMM_WORLD_STRING
#define COMMENT_MPI_CONVERSION
#define MPI_GENERATION_PREFIX
task load_parallel_task_mapping(statement)
void set_parallel_task_mapping(statement_task)
void reset_parallel_task_mapping(void)
#define task_synchronization(x)
Definition: task_private.h:121
#define task_undefined
Definition: task_private.h:89
#define task_on_cluster(x)
Definition: task_private.h:119