PreviousUpNext

15.4.258  src/lib/compiler/back/low/intel32/code/treecode-extension-sext-compiler-intel32-g.pkg

## treecode-extension-sext-compiler-intel32-g.pkg
#
# Background comments may be found in:
#
#     src/lib/compiler/back/low/treecode/treecode-extension.api
#
# Emit code for extensions to the intel32 instruction set.

# Compiled by:
#     src/lib/compiler/back/low/intel32/backend-intel32.lib



# We are invoked from:
#
#     src/lib/compiler/back/low/main/intel32/treecode-extension-compiler-intel32-g.pkg

stipulate
    package lem =  lowhalf_error_message;                                               # lowhalf_error_message                         is from   src/lib/compiler/back/low/control/lowhalf-error-message.pkg
    package xx  = treecode_extension_sext_intel32;                                      # treecode_extension_sext_intel32               is from   src/lib/compiler/back/low/intel32/code/treecode-extension-sext-intel32.pkg
herein

    generic package   treecode_extension_sext_compiler_intel32_g   (
        #             ========================================
        #
        package mcf: Machcode_Intel32;                                                  # Machcode_Intel32                              is from   src/lib/compiler/back/low/intel32/code/machcode-intel32.codemade.api

        package tcs: Treecode_Codebuffer                                                # Treecode_Codebuffer                           is from   src/lib/compiler/back/low/treecode/treecode-codebuffer.api
                     where
                        tcf == mcf::tcf;                                                # "tcf" == "treecode_form".

        package mcg: Machcode_Controlflow_Graph                                         # Machcode_Controlflow_Graph                    is from   src/lib/compiler/back/low/mcg/machcode-controlflow-graph.api
                     where
                          pop == tcs::cst::pop                                          # "pop" == "pseudo_op".
                     also mcf == mcf;                                                   # "mcf" == "machcode_form" (abstract machine code).
    )
    : (weak) Treecode_Extension_Compiler_Intel32                                        # Treecode_Extension_Compiler_Intel32   is from   src/lib/compiler/back/low/intel32/code/treecode-extension-compiler-intel32.api
    {
        # Export to client packages:
        #
        package tcs =  tcs;                                                             # "tcs" == "treecode_stream".
        package mcg =  mcg;                                                             # "mcg" == "machcode_controlflow_graph".
        package mcf =  mcf;                                                             # "mcf" == "machcode_form" (abstract machine code).

        stipulate
            # Some local abbreviations:
            #
            package rgk =  mcf::rgk;                                                    # "rgk" == "registerkinds".
            package tcf =  tcs::tcf;                                                    # "tcf" == "treecode_form".
        herein

            Void_Expression
                =
                xx::Sext( tcf::Void_Expression, tcf::Int_Expression, tcf::Float_Expression, tcf::Flag_Expression ); 


            Reducer
               = 
               tcs::Reducer
                 (
                   mcf::Machine_Op,
                   rgk::Codetemplists,
                   mcf::Operand,
                   mcf::Addressing_Mode,
                   mcg::Machcode_Controlflow_Graph
                 );


            esp = rgk::esp;

            esp_operand = mcf::DIRECT (esp);


            fun error msg
                =
                lem::error("treecode_extension_sext_compiler_intel32_g", msg);


            stack_area = mcf::rgn::stack;


            fun compile_sext reducer { void_expression: Void_Expression, notes: List( tcf::Note ) }
                =
                {   reducer ->   tcs::REDUCER  { operand,
                                                 put_op,
                                                 reduce_float_expression,
                                                 codestream,
                                                 reduce_operand,
                                                 ...
                                               };
                        

                    codestream ->    { put_op=>put_i, ... };
                        

                    fun fstp (size, fstp_instr, float_expression)               # "fstp" might be "float-stack top"...?
                        = 
                        case float_expression
                            #
                            tcf::CODETEMP_INFO_FLOAT (size', f)
                                =>
                                if (size != size')   error "fstp: size";
                                else                 put_i (mcf::BASE_OP (fstp_instr (mcf::FDIRECT f)));
                                fi;
                            #
                            _ =>   error "fstp: float_expression";
                        esac;


                    case void_expression
                        #
                        xx::PUSHL (int_expression)   =>   put_op (mcf::pushl (operand int_expression), notes);
                        xx::POP (int_expression)     =>   put_op (mcf::pop (operand int_expression), notes);
                        #
                        xx::FSTPS (float_expression) =>   fstp (32, mcf::FSTPS, float_expression);
                        xx::FSTPL (float_expression) =>   fstp (64, mcf::FSTPL, float_expression);
                        xx::FSTPT (float_expression) =>   fstp (80, mcf::FSTPT, float_expression);
                        #
                        xx::LEAVE                    =>   put_op (mcf::leave, notes);
                        xx::RET (int_expression)     =>   put_op (mcf::ret (THE (operand int_expression)), notes);
                        #
                        xx::LOCK_CMPXCHGL (src, dst)
                            =>
                            #  src must in a register 
                            put_op (
                                mcf::cmpxchg
                                { lock =>  TRUE,
                                  size =>  mcf::INT1, 
                                  src  =>  mcf::DIRECT (reduce_operand (operand src)), 
                                  dst  =>  operand dst
                                },
                                notes
                            );
                    esac;
                };                                                      # fun compile_sext
        end;                                                            # stipulate
    };                                                                  # generic package   treecode_extension_sext_compiler_intel32_g
end;                                                                    # stipulate     

## COPYRIGHT (c) 2000 Bell Labs, Lucent Technologies
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2013,
## released per terms of SMLNJ-COPYRIGHT.


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext