prettyprintcray.c

Go to the documentation of this file.

/*
 
  $Id: prettyprintcray.c 23065 2016-03-02 09:05:50Z coelho $
 
  Copyright 1989-2016 MINES ParisTech
 
  This file is part of PIPS.
 
  PIPS is free software: you can redistribute it and/or modify it
  under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  any later version.
 
  PIPS is distributed in the hope that it will be useful, but WITHOUT ANY
  WARRANTY; without even the implied warranty of MERCHANTABILITY or
  FITNESS FOR A PARTICULAR PURPOSE.
 
  See the GNU General Public License for more details.
 
  You should have received a copy of the GNU General Public License
  along with PIPS.  If not, see <http://www.gnu.org/licenses/>.
 
*/
 
// is this really a transformation?
// do not compile unless required
#include "phases.h"
#ifdef BUILDER_PRINT_PARALLELIZEDCRAY_CODE
 
#ifdef HAVE_CONFIG_H
    #include "pips_config.h"
#endif
#include <stdio.h>
#include <string.h>
#include <limits.h>
 
#include "genC.h"
#include "linear.h"
 
#include "misc.h"
#include "properties.h"
#include "pipsdbm.h"
 
#include "ri.h"
#include "ri-util.h"
#include "workspace-util.h" // entity_minimal_name
 
#include "text.h"
#include "text-util.h" // used
 
#include "effects.h"
#include "effects-util.h"    // used
#include "effects-generic.h" // used
#include "effects-simple.h"  // used
 
#include "prettyprint.h" // make_text_resource
//#include "preprocessor.h" // entity_minimal_name
#include "expressions.h" // stmt_to_fx
 
#include "top-level.h" // PARALLEL_FORTRAN_EXT
 
 
/* returns a list of all entities which:
 * - are concerned with cumulated effects (cfx) of the loop_body
 * - and are member of loop_locals(lp)
 * makes sure the loop index is in the list
 */
static list real_loop_locals(loop lp, effects cfx)
{
    list rll= NIL;
 
    MAPL(ce, 
     { 
        effect 
            eff = EFFECT(CAR(ce));
        entity 
            ent = reference_variable(effect_any_reference(eff));
 
        if (!entity_in_list_p(ent, rll)
            && entity_in_list_p(ent,loop_locals(lp)) ) 
        {
            /* ent is a real loop local */
            debug(7, "real_loop_locals", "real loop local: %s\n",
                  entity_local_name(ent));
            rll = CONS(ENTITY, ent, rll);
        }
    }, effects_effects(cfx));
 
    if( !entity_in_list_p(loop_index(lp), rll) ) 
    {
        rll= CONS(ENTITY, loop_index(lp), rll);
    }
    return(rll);
}
 
/*
 * recursively concatenates all real loop locals of all enclosed loops.
 * filters redondant entities
 */
static list all_enclosed_scope_variables(statement stmt)
{
    instruction instr = statement_instruction(stmt);
    list ent_l= NIL;
 
    switch(instruction_tag(instr)) {
      case is_instruction_block :
        MAPL(stmt_l, {
            statement st=STATEMENT(CAR(stmt_l));
 
            ent_l= concat_new_entities(ent_l, all_enclosed_scope_variables(st));
        }, instruction_block(instr));
        break;
      case is_instruction_loop : {
          loop lp= instruction_loop(instr);
          statement lpb= loop_body(lp);
          effects cfx = stmt_to_fx(lpb, get_rw_effects() );
 
          pips_assert("all_enclosed_scope_variables", cfx != effects_undefined);
          ent_l= concat_new_entities(real_loop_locals(lp, cfx),
                                     all_enclosed_scope_variables(lpb));
          break;
      }
      case is_instruction_test : {
          test tst= instruction_test(instr);
          list l1, l2;
 
          l1= all_enclosed_scope_variables(test_true(tst));
          l2= all_enclosed_scope_variables(test_false(tst));
          ent_l= concat_new_entities(l1, l2);
 
          break;
      }  
      case is_instruction_whileloop : {
        whileloop lp= instruction_whileloop(instr);
        ent_l= all_enclosed_scope_variables(whileloop_body(lp));
        break;
      }
      case is_instruction_unstructured : {
          list blocs = NIL;
 
          CONTROL_MAP(ctl, {
              statement st = control_statement(ctl);
 
              ent_l= concat_new_entities(all_enclosed_scope_variables(st), 
                                         ent_l);        
          }, unstructured_control(instruction_unstructured(instr)), blocs);
 
          gen_free_list(blocs);
          break;
      }
      case is_instruction_call :
        break;
      case is_instruction_goto :
        default : 
        pips_internal_error("Bad instruction tag");
    }
    return(ent_l);
}
 
/* lp_stt must be a loop statement */
static text text_microtasked_loop(__attribute__((unused)) entity module,__attribute__((unused))  int margin, statement lp_stt)
{
    text txt;
    unformatted u;
    effects fx;
    list wordl;
    int np = 0;
    loop lp = instruction_loop(statement_instruction(lp_stt));
    cons *lp_shared = NIL;
    list ent_l= all_enclosed_scope_variables(lp_stt);
 
    /* initializations */
    txt = make_text(NIL);
 
    wordl = CHAIN_SWORD(NIL, "DO ALL ");
 
    fx = stmt_to_fx(loop_body(lp), get_rw_effects());
 
    /* generate arguments for PRIVATE */
    /* nb: ent_l should contain entities only ones. */
    wordl = CHAIN_SWORD(wordl, "PRIVATE(");
    np=0;
    MAPL( el, { 
        entity ent = ENTITY(CAR(el));
 
        /* What about arrays? nothing special?? */
        /* if (!ENDP(reference_indices(effect_any_reference(eff)))) */
 
        if (np>0)
            wordl = CHAIN_SWORD(wordl, ",");
        wordl = CHAIN_SWORD(wordl, entity_local_name(ent)) ;
        np++;
    }, ent_l);
 
    wordl = CHAIN_SWORD(wordl, ") ");
 
    ifdebug(6)
    {
        fprintf(stderr, 
                "[text_microtasked_loop] loop locals of %s: ",
                entity_minimal_name(loop_index(lp)));
 
        MAPL(ce,
         {
             fprintf(stderr, "%s ", entity_minimal_name(ENTITY(CAR(ce))));
         },
             loop_locals(lp));
 
        fprintf(stderr, "\nent_l content is: ");
        
        MAPL(ce,
         {
             fprintf(stderr, "%s ", entity_minimal_name(ENTITY(CAR(ce))));
         },
             ent_l);
 
        fprintf(stderr, "\n");
    }
 
    /* generate arguments for SHARED */
    wordl = CHAIN_SWORD(wordl, "SHARED(");
    np=0;
    MAPL(ce, 
     { 
        effect eff = EFFECT(CAR(ce));
        entity ent = reference_variable(effect_any_reference(eff));
 
/*      if(ENDP(ce)) user_log("ce is NIL !!\n");
        if(ENDP(CDR(ce))) user_log("CDR(ce) is NIL\n");
        else user_log("CDR(ce) is *not* NIL\n");
 */
        /* What about arrays? nothing special?? */
        /* if (!ENDP(reference_indices(effect_any_reference(eff)))) */
 
        /*
         * ent_l added, in order to use the newly computed << good >> effects, 
         * and to warrant the fact that no variables should be declared
         * at the same time private and shared.
         * same_entity_p added also, just in case.
         *
         * FC 28/09/93
         */
        if ((!entity_in_list_p(ent, loop_locals(lp))) &&
            (!entity_in_list_p(ent, ent_l)) &&
            (!same_entity_p(ent, loop_index(lp))) &&
            (!entity_in_list_p(ent, lp_shared)))
        {
            /* ent is a new shared entity */
            if (np>0)
                wordl = CHAIN_SWORD(wordl, ",");
            lp_shared = CONS(ENTITY, ent, lp_shared);
            wordl = CHAIN_SWORD(wordl, entity_local_name(ent)) ;
            np++;
        }
        /* What to do when no shared? */
            
    }, effects_effects(fx));
 
    wordl = CHAIN_SWORD(wordl, ") ");
 
    gen_free_list(lp_shared);
    gen_free_list(ent_l);
 
    u = make_unformatted("CMIC$", 0, 0, wordl) ;
 
    /* format u */
 
 
    ADD_SENTENCE_TO_TEXT(txt, make_sentence(is_sentence_unformatted, u));
    return(txt);
}
 
/* lp_stt must be a loop statement */
static text text_vectorized_loop(__attribute__((unused)) entity module,__attribute__((unused))  int margin,__attribute__((unused))  statement lp_stt)
{
    text txt;
    unformatted u;
    list wordl;
 
    txt = make_text(NIL);
 
    wordl = CHAIN_SWORD(NIL, "IVDEP ");
 
    u = make_unformatted("CDIR$", 0, 0, wordl) ;
 
    ADD_SENTENCE_TO_TEXT(txt, make_sentence(is_sentence_unformatted, u));
    return(txt);
}
 
 
static text text_cray(entity module, int margin, statement stat)
{
    text txt = text_undefined;
 
    if (instruction_loop_p(statement_instruction(stat))) {
        loop lp = instruction_loop(statement_instruction(stat));
        statement body = loop_body(lp);
 
        switch(execution_tag(loop_execution(lp))) {
          case (is_execution_sequential):
            txt = make_text(NIL);
            break;
          case (is_execution_parallel):
            if(instruction_assign_p(statement_instruction(body))) {
                /* vector loop */
                txt = text_vectorized_loop(module, margin, stat);
            }
            else {
                /* assumes that all loops are CMIC$ !! */
                txt = text_microtasked_loop(module, margin, stat);
            }
            break;
        }
    }
    else {
        txt = make_text(NIL);
    }
 
    return(txt);
}
 
 
bool print_parallelizedcray_code(char *mod_name)
{
    entity module = module_name_to_entity(mod_name);
    statement mod_stat = statement_undefined;
 
    /* push prettyprint style */
    string pp = strdup(get_string_property(PRETTYPRINT_PARALLEL));
    set_string_property(PRETTYPRINT_PARALLEL, "cray");
 
    set_current_module_entity(module);
    mod_stat = (statement)
        db_get_memory_resource(DBR_PARALLELIZED_CODE, mod_name, true);
    
    /* We need to recompute proper effects and cumulated effects */
    init_proper_rw_effects();
    rproper_effects_of_statement(mod_stat);
 
    init_rw_effects();
    rcumulated_effects_of_statement(mod_stat);
 
    debug_on("PRETTYPRINT_DEBUG_LEVEL");
 
    init_prettyprint(text_cray);
 
    make_text_resource(mod_name, 
                       DBR_PARALLELPRINTED_FILE, 
                       PARALLEL_FORTRAN_EXT, 
                       text_module(module, mod_stat) );
 
    close_prettyprint();
 
    /* free proper effects and cumulated effects 
     Je ne sais pas trop comment le free fonctionne avec statement_effects.
    bc.*/
    /* free_statement_effects( get_rw_effects() );
       free_statement_effects( get_proper_rw_effects() ); */
 
    reset_rw_effects();
    reset_proper_rw_effects();
    reset_current_module_entity();
 
    set_string_property(PRETTYPRINT_PARALLEL, pp);
    free(pp);
 
    debug_off();
 
    return true;
}
 
#endif // BUILDER_PRINT_PARALLELIZEDCRAY_CODE