PreviousUpNext

15.4.321  src/lib/compiler/back/low/mcg/big-endian-pseudo-op-g.pkg

## big-endian-pseudo-ops-g.pkg

# Compiled by:
#     src/lib/compiler/back/low/lib/lowhalf.lib



# Subset of pseudo-ops functions that are little endian sensitive

# We get invoked from:
#
#     src/lib/compiler/back/low/pwrpc32/mcg/pseudo-ops-pwrpc32-osx-g.pkg
#     src/lib/compiler/back/low/pwrpc32/mcg/gas-pseudo-ops-pwrpc32-g.pkg
#     src/lib/compiler/back/low/sparc32/mcg/gas-pseudo-ops-sparc32-g.pkg

stipulate
    package lbl =  codelabel;                                           # codelabel             is from   src/lib/compiler/back/low/code/codelabel.pkg
    package lem =  lowhalf_error_message;                               # lowhalf_error_message is from   src/lib/compiler/back/low/control/lowhalf-error-message.pkg
    package unt =  unt;                                                 # unt                   is from   src/lib/std/unt.pkg
herein

    # This generic is invoked in:
    #
    #     src/lib/compiler/back/low/pwrpc32/mcg/gas-pseudo-ops-pwrpc32-g.pkg
    #     src/lib/compiler/back/low/pwrpc32/mcg/pseudo-ops-pwrpc32-osx-g.pkg
    #     src/lib/compiler/back/low/sparc32/mcg/gas-pseudo-ops-sparc32-g.pkg
    #
    generic package   big_endian_pseudo_op_g   (
        #             ======================
        #
        package tcf:  Treecode_Form;                                    # Treecode_Form         is from   src/lib/compiler/back/low/treecode/treecode-form.api

        package tce:  Treecode_Eval                                     # Treecode_Eval         is from   src/lib/compiler/back/low/treecode/treecode-eval.api
                      where
                          tcf == tcf;                                   # "tcf" == "treecode_form".

        icache_alignment:  Int;                                         # Cache line size 
        max_alignment:     Null_Or( Int );                              # Maximum alignment for internal labels 

        nop: { size: Int, en: one_word_unt::Unt };                              # Encoding for noop 
    )
    : (weak) Endian_Pseudo_Ops                                          # Endian_Pseudo_Ops     is from   src/lib/compiler/back/low/mcg/pseudo-op-endian.api
    {
        # Export to client packages:
        #
        package tcf =  tcf;                                             # Export generic arg for client packages.

        stipulate
            package lac =  tcf::lac;                                    # "lac" == "late_constant"
            package pb  =  pseudo_op_basis_type;                        # pseudo_op_basis_type  is from   src/lib/compiler/back/low/mcg/pseudo-op-basis-type.pkg
        herein

            Pseudo_Op(X)
                =
                pb::Pseudo_Op( tcf::Label_Expression, X ); 

            fun error msg =   lem::error ("big_endian_pseudo_ops.", msg);

            my (>>)  =  unt::(>>);
            my (>>>) =  unt::(>>>);
            my (&)   =  unt::bitwise_and;

            infix my  >>  >>>  & ;

            # Return loc aligned at boundary:
            # 
            fun align (loc, boundary)
                =
                {
                    mask = unt::from_int boundary - 0u1;
                    unt::to_int_x (unt::bitwise_and (unt::from_int loc + mask, unt::bitwise_not mask));
                };

            # Bytes of padding required:
            #
            fun padding (loc, boundary)
                =
                align (loc, boundary) - loc;

            fun pow2 (x, 0) => x;
                pow2 (x, n) => pow2 (x * 2, n - 1);
            end;

            fun bytes_in size
                =
                int::quot (size, 8);


            fun current_pseudo_op_size_in_bytes (pseudo_op, loc)
                = 
                case pseudo_op
                    #
                    pb::ALIGN_SIZE n => padding (loc, pow2 (1, n));
                    pb::ALIGN_ENTRY => padding (loc, icache_alignment);

                    pb::ALIGN_LABEL
                        =>
                        {
                            pad = padding (loc, icache_alignment);

                            case max_alignment 
                                NULL  =>   pad;
                                THE m =>   pad <= m  ??  pad
                                                     ::   0;
                            esac;
                     };

                    pb::INT { size, i }
                        =>
                        length i  *  bytes_in size;

                    pb::ASCII s  => string::length_in_bytes s; 
                    pb::ASCIIZ s => string::length_in_bytes s + 1;

                    pb::SPACE (size)  => size;

                    pb::FLOAT { size, f } => length (f) * bytes_in size;

                    pb::EXT _ => error "sizeOf: EXT";
                    _ => 0;
               esac;



            fun put_pseudo_op { pseudo_op, loc, put_byte }
                =
                {
                    itow   =  unt::from_int;

                    tount8 =  one_byte_unt::from_large_unt
                           o  unt::to_large_unt
                           o  itow;

                    fun put_byte' n                                             # Can 'emit' be just 'put'? XXX BUGGO FIXME
                        =
                        put_byte (one_byte_unt::from_large_unt (unt::to_large_unt n));

                    fun put_unt w
                        =
                        {   put_byte' ((w >> 0u8) & 0u255);
                            put_byte' (w & 0u255);
                        };

                    fun put_long_x n
                        =
                        {   w = itow n;
                            put_unt (w >>> 0u16);
                            put_unt (w & 0u65535);
                        };

                    stipulate 

                        my { size, en } = nop;
                        to_unt = unt::from_multiword_int o one_word_unt::to_multiword_int_x; 

                    herein
                        fun put_nop ()
                            = 
                            case size
                                #       
                                1 => put_byte' (to_unt en);
                                2 => put_unt (to_unt en);
                                4 => {   put_unt (to_unt (one_word_unt::bitwise_and (en, 0u65535))); 
                                         put_unt (to_unt (one_word_unt::(>>) (en, 0u16)));
                                     };
                                n => error ("put_nop:  size = " + int::to_string n);
                            esac;

                        fun insert_nops 0
                                =>
                                ();

                            insert_nops n
                                => 
                                if (n >= size)
                                    #
                                    put_nop ();
                                    insert_nops (n-size);
                                else
                                    error "insert_nops";
                                fi;
                        end;
                    end;

                    fun align (loc, boundary)
                        =
                        {
                            boundary =  unt::from_int boundary;
                            mask     =  boundary - 0u1;

                            case (unt::bitwise_and (itow (loc), mask))
                                #
                                0u0 => ();

                                w   => {   pad_size = (boundary - w);
                                           insert_nops (unt::to_int pad_size);
                                       };
                            esac;
                        };

                   (tce::make_evaluation_functions
                        {
                          late_constant_to_integer =>  multiword_int::from_int o lac::late_constant_to_int, 
                          label_to_int             =>  lbl::get_codelabel_address
                        })
                        ->
                        { evaluate_int_expression, ... };


                    case pseudo_op
                        #
                        pb::ALIGN_SIZE n =>  insert_nops (current_pseudo_op_size_in_bytes (pseudo_op, loc));
                        pb::ALIGN_ENTRY  =>  insert_nops (current_pseudo_op_size_in_bytes (pseudo_op, loc));
                        pb::ALIGN_LABEL  =>  insert_nops (current_pseudo_op_size_in_bytes (pseudo_op, loc));

                        pb::INT { size, i }
                            =>
                            {   ints =   map   (multiword_int::to_int o evaluate_int_expression)   i;

                                case size
                                    #                  
                                    8 =>  apply (put_byte' o itow)  ints;
                                   16 =>  apply (put_unt o itow)    ints;
                                   32 =>  apply  put_long_x         ints;
                                    #
                                    _ =>  error "put_pseudo_op: INT 64";
                                esac;
                            };

                        pb::ASCII  s
                            =>
                            apply
                                (put_byte o one_byte_unt::from_int o char::to_int)
                                (string::explode s);

                        pb::ASCIIZ s
                            =>
                            {   put_pseudo_op { pseudo_op=>pb::ASCII s, loc, put_byte };
                                put_byte 0u0;
                            };

                        pb::FLOAT { size, f } =>  error "put_pseudo_op: FLOAT - not implemented";
                        pb::EXT _             =>  error "put_pseudo_op: EXT";
                        pb::SPACE _           =>  error "put_pseudo_op: SPACE";

                        _ => ();
                    esac;
                };                                                                              # fun put_pseudo_op
        end;                                                                                    # stipulate
    };                                                                                          # generic package big_endian_pseudo_op_g
end;                                                                                            # stipulate

## COPYRIGHT (c) 2001 Lucent Technologies, Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext