PreviousUpNext

15.4.413  src/lib/compiler/back/low/tools/arch/lowhalf-types-g.pkg

## lowhalf-types-g.pkg -- derived from   ~/src/sml/nj/smlnj-110.60/MLRISC/Tools/ADL/mlrisc-types.sml
#
# lowhalf specific things are abstracted out here in this module.

# Compiled by:
#     src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages.lib



###                   "Virtue is harmony."
###
###                          -- Pythagoras 


stipulate
    package err =  adl_error;                                           # adl_error                                     is from   src/lib/compiler/back/low/tools/line-number-db/adl-error.pkg
    package spp =  simple_prettyprinter;                                # simple_prettyprinter                          is from   src/lib/prettyprint/simple/simple-prettyprinter.pkg
    package ard =  architecture_description;                            # architecture_description                      is from   src/lib/compiler/back/low/tools/arch/architecture-description.pkg
    package rrs =  adl_rewrite_raw_syntax_parsetree;                    # adl_rewrite_raw_syntax_parsetree              is from   src/lib/compiler/back/low/tools/adl-syntax/adl-rewrite-raw-syntax-parsetree.pkg
    package mtj =  adl_type_junk;                                       # adl_type_junk                                 is from   src/lib/compiler/back/low/tools/arch/adl-type-junk.pkg
    package raw =  adl_raw_syntax_form;                                 # adl_raw_syntax_form                           is from   src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-form.pkg
    package rkj =  registerkinds_junk;                                  # registerkinds_junk                            is from   src/lib/compiler/back/low/code/registerkinds-junk.pkg
    package rsu =  adl_raw_syntax_unparser;                             # adl_raw_syntax_unparser                       is from   src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-unparser.pkg
    package rsj =  adl_raw_syntax_junk;                                 # adl_raw_syntax_junk                           is from   src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-junk.pkg
herein

    generic package   lowhalf_types_g   (
        #             ===============
        #
        package rtl:   Treecode_Rtl;                                    # Treecode_Rtl                                  is from   src/lib/compiler/back/low/treecode/treecode-rtl.api
    )
    : (weak)   Lowhalf_Types                                            # Lowhalf_Types                                 is from   src/lib/compiler/back/low/tools/arch/lowhalf-types.api
    {
        # Export to client packages:
        #
        package rtl =  rtl;

        stipulate
            package tcf =  rtl::tcf;
            #
            include rsj;
            include err;
        herein

            t2s  =  spp::prettyprint_expression_to_string o rsu::type;
            e2s  =  spp::prettyprint_expression_to_string o rsu::expression;
        
            #  Does this type has special meaning in an instruction representation?  
            #
            fun is_special_rep_type  t
                =
                *found
                where
                    found =  REF FALSE;

                    fun is_special t
                        =
                        case (mtj::deref t)
                            #
                            raw::REGISTER_TYPE _                            => TRUE;    # Register types are special. (They come from   foo: $bar   syntax in the .adl file.)
                            raw::IDTY (raw::IDENT(_, "int"))         => TRUE;
                            raw::IDTY (raw::IDENT([], "operand"))    => TRUE;
                            raw::IDTY (raw::IDENT(_, "registerset")) => TRUE;
                            #
                            _                                        => FALSE;
                        esac;


                    fun rewrite_type_node _ t
                        =
                        {   if (is_special t)   found := TRUE;   fi;
                            t;
                        };


                    fns.rewrite_type_parsetree  t
                    where
                        fns =  rrs::make_raw_syntax_parsetree_rewriters [ rrs::REWRITE_TYPE_NODE rewrite_type_node ];
                    end;
                end;

            # Return the real representation type of an rtl argument:
            # 
            fun representation_of (rtl_name, arg, loc, type)
                =
                {   fun err ()
                        =
                        {   error_pos (loc,"'" + arg + "' in rtl " + rtl_name + " has an illegal type " + t2s type);
                            (0, "bits");
                        };

                    case (mtj::deref type)
                        #
                        raw::IDTY  (raw::IDENT([], "operand"))                    =>  (0, "operand");
                        raw::IDTY  (raw::IDENT([], "label"))                      =>  (0, "label");
                        raw::IDTY  (raw::IDENT([], "region"))                     =>  (0, "region");
                        raw::APPTY (raw::IDENT([], "operand"), [raw::INTVARTY n]) =>  (n, "operand");
                        raw::APPTY (raw::IDENT([], "bits"),    [raw::INTVARTY n]) =>  (n, "bits");
                        #
                        type                                                      =>  err ();
                    esac;
                };

            fun representation_of (rtl_name, arg, loc, type)
                =
                {   fun err ()
                        =
                        {   error_pos (loc, "'" + arg + "' in rtl " + rtl_name + " has an illegal type " + t2s type);
                            #
                            (0, "bits");
                        };

                    case (mtj::deref type)
                        #
                        raw::IDTY  (raw::IDENT([], "operand"))                    =>  (0, "operand");
                        raw::IDTY  (raw::IDENT(_, "label"))                       =>  (0, "label");
                        raw::IDTY  (raw::IDENT([], "region"))                     =>  (0, "region");
                        raw::APPTY (raw::IDENT([], "operand"), [raw::INTVARTY n]) =>  (n, "operand");
                        raw::APPTY (raw::IDENT([], "bits"),    [raw::INTVARTY n]) =>  (n, "register");
                        #
                        type                                                      =>  err ();
                    esac;
                };

            # Given the actual represention of an rtl argument, 
            # insert coercion if possible:
            #
            fun insert_rep_coercion (expression, type)
                = 
                case (expression, mtj::deref type)
                    #
                    (tcf::ARG(_, k, _), raw::IDTY (raw::IDENT([], "int")))       =>   k := tcf::REPX "int";
                    (tcf::ARG(_, k, _), raw::IDTY (raw::IDENT(_, "label")))      =>   k := tcf::REPX "label";
                    (tcf::ARG(_, k, _), raw::IDTY (raw::IDENT([], "operand")))   =>   k := tcf::REPX "operand";
                    (tcf::ATATAT(_, _, tcf::ARG(_, k, _)), raw::REGISTER_TYPE _) =>   k := tcf::REPX "register";                # REGISTER_TYPE s come from   foo: $bar   syntax in the .adl file.
                    #
                    _                                                          =>   ();
                esac;

            fun of_registerkind (tcf::ATATAT(_, k, _), raw::REGISTER_SET r)
                    =>
                    case (rkj::name_of_registerkind  k)
                        #
                        "REGISTERSET" =>  TRUE;
                        k             =>  k == r.name;
                    esac;

                of_registerkind (tcf::ARG _, raw::REGISTER_SET _) =>  FALSE;
                of_registerkind (_, _)                            =>  FALSE;
            end;



            # A database of all special types
            #
            Howto = HOWTO
                     { rep:             String,                 # Name of representation. 
                       is_ssa_value:    Bool,                   # Is it a value in SSA form? 
                       ml_type:         raw::Type,              # Type in ML.
                       is_const:        Bool,                   # If so, is it always a constant?
                       is_multi_valued: ard::Architecture_Description -> Bool           # If a value can it take more than one 
                     };

            howtos =   REF []:   Ref( List( Howto ) );

            fun find_rep r
                =
                case (list::find (fn HOWTO { rep, ... } =  rep == r) *howtos)
                    #
                    THE (HOWTO howto) =>  howto;
                    NULL              =>  fail("bug: representation " + r + " not known");
                esac;

            # ---------------------------------------------------------------------
            # 
            # Code generation magic
            #
            # ---------------------------------------------------------------------
            #
            fun is_const (tcf::REPX rep)
                =
                (find_rep rep).is_const;

            # ---------------------------------------------------------------------
            # 
            # Okay, now specify all the types that we have to handle.
            #
            # ---------------------------------------------------------------------
            fun no _ = FALSE;
            fun yes _ = TRUE;
            fun bug _ = fail("unimplemented");

                                                                            my _ =
            howtos :=
                [   HOWTO { rep             =>  "label",
                            is_ssa_value    =>  FALSE,
                            ml_type         =>  raw::IDTY (raw::IDENT(["Label"], "label")),
                            is_const        =>  TRUE,
                            is_multi_valued =>  no
                          },

                    HOWTO { rep             =>  "int",
                            is_ssa_value    =>  TRUE,
                            ml_type         =>  raw::IDTY (raw::IDENT([], "int")),
                            is_const        =>  TRUE,
                            is_multi_valued =>  no
                          },

                    HOWTO { rep             =>  "operand",
                            is_ssa_value    =>  TRUE,
                            ml_type         =>  raw::IDTY (raw::IDENT(["I"], "operand")),
                            is_const        =>  FALSE,
                            is_multi_valued =>  yes
                          },

                    HOWTO { rep             =>  "registerset",
                            is_ssa_value    =>  TRUE,
                            ml_type         =>  raw::IDTY (raw::IDENT(["C"], "registerset")),
                            is_const        =>  FALSE,
                            is_multi_valued =>  yes
                          }
                ];

            # ---------------------------------------------------------------------
            # 
            # Generate an expression for performing the appropriate conversion
            #
            # ---------------------------------------------------------------------
            #
            Conv = IGNORE
                 | CONV   String
                 | MULTI  String
                 ;

            package desc_map
                =
                red_black_map_g (
                    #
                    Key = String;
                    compare = string::compare;
                );

            fun get_opnd desc
                = 
                {   table = fold_backward
                                (fn ((rep, conv), table)
                                    =
                                    desc_map::set (table, rep, conv)
                                )
                                desc_map::empty desc;

                    fun mk_conv_fun (rep, conv)
                        = 
                        "fun get_" + rep + "(x, L) = "
                        +
                        case conv
                            #
                            IGNORE  =>         "L";
                            CONV  f =>  f + " . L";
                            MULTI f =>  f +   "@L";
                        esac;

                    fun mk_conv_fun0 (rep, conv)
                        = 
                        "fun get_" + rep + "'(x) = "
                        +
                        case conv
                            #
                            IGNORE  =>  "[]";
                            CONV  f =>  "[" + f + "]";
                            MULTI f =>   f;
                        esac;

                    decl =   raw::VERBATIM_CODE  (map  mk_conv_fun   desc
                                                  @
                                                  map  mk_conv_fun0  desc
                                                 );

                    fun apply (rep, this, rest)
                        =
                        app ("get_" + rep, raw::TUPLE_IN_EXPRESSION [this, rest]);

                    fun get_it (rep, this, rest)
                        = 
                        case (desc_map::get (table, rep), rest)
                            #
                            (NULL,         _) =>  fail ("get_opnd: " + rep + " is not defined");
                            (THE IGNORE,   _) =>  rest;
                            (THE (CONV _), _) =>  apply (rep, this, rest);
                            #
                            (THE (MULTI conv), raw::LIST_IN_EXPRESSION([], NULL)) => app ("get_" + rep + "'", this);
                            #
                            (THE (MULTI _), rest) => apply (rep, this, rest);
                        esac;

                    fun get (this, tcf::ATATAT(_, k, _), rest)
                            =>  
                            if (rkj::name_of_registerkind k == "REGISTERSET")   get_it("registerset", this, rest);
                            else                                                 get_it("register",    this, rest);
                            fi;

                        get (this, tcf::ARG(_, REF (tcf::REPX rep), _), rest) =>  get_it (rep, this, rest);
                        get (_, e, _)                                         =>  fail ("lowhalf_types::get: " + rtl::tcj::int_expression_to_string e);
                    end;

                    { decl, get };
                };
        end;                                                                    # stipulate
    };                                                                          # generic package   lowhalf_types_g
end;                                                                            # stipulate


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext