PreviousUpNext

15.4.269  src/lib/compiler/back/low/intel32/treecode/translate-treecode-to-machcode-intel32-g.pkg

## translate-treecode-to-machcode-intel32-g.pkg
#
# CONTEXT:
#
#     The Mythryl compiler code representations used are, in order:
#
#     1)  Raw Syntax is the initial frontend code representation.
#     2)  Deep Syntax is the second and final frontend code representation.
#     3)  Lambdacode (polymorphically typed lambda calculus) is the first backend code representation, used only transitionally.
#     4)  Anormcode (A-Normal format) is the second backend code representation, and the first used for code speedups.
#     5)  Nextcode is the third and chief backend tophalf code representation.
#     6)  Treecode is the backend tophalf/lowhalf transitional code representation. It is typically slightly specialized for each target architecture, e.g. Intel32 (x86).
#     7)  Machcode abstracts the target architecture machine instructions. It gets specialized for each target architecture.
#     8)  Execode is absolute executable binary machine instructions for the target architecture.
#
# For general context, see
#
#     src/A.COMPILER.OVERVIEW
#
#
#
# This package implements translation from 
# mostly-architecture-independent treecode form,
# specifically treecode_form_intel32, to
# entirely-architecture-dependent abstract x86 machine code.
#
# There is nothing particularly subtle here;  we just
# grind through all the Treecode_Form cases and for
# each one construct a semantically equivalent sequence
# of x86 machine instructions.
#
# We use the Sethi-Ullman approach to linearize float
# expression-trees nearly optimally.
#
# This file is where we actually generate conditional branches
# to trap arithmetic overflow, when requested/appropriate.
#
# A lot of Intel32 machine instructions are restricted to
# specific registers (for example, for divides the divisor
# must be in edx:eax) so we do a lot of copying to such
# registers and then copying out to a temporary, to unpin;
# we hope the register allocator will vanish most of these
# move instructions.
#
# We do fold in a few low-level optimizations as we do
# the translation, mostly assembly-language tricks-of-the-trade
# type stuff like:
#   o Fast set-to-zero using XOR when in registers.
#   o Changing multiplies and divides to shifts where possible.
#   o Swapping args of commutative binary ops when it is legal and a win.
#   o Dropping explicit compare ops if preceding arithmetic
#     already set the needed condition flags.
#   o If architecture is not PENTIUM (i.e., PentiumPRO or better)
#     generate cmovcc instructions for jump-free conditionals.
#
#
# In more detail:
#
# The stock architecture-agnostic Treecode_Form is defined in:
#
#     src/lib/compiler/back/low/treecode/treecode-form.api
#
# Our mostly-architecture-independent Treecode_Form
# variant   treecode_form_intel32   is defined in:
#
#     src/lib/compiler/back/low/main/intel32/backend-lowhalf-intel32-g.pkg
#
# The intel32 architecture is described for the backend in
#
#     src/lib/compiler/back/low/intel32/one_word_int.architecture-description
#
# which then gets processed to produce various files,
# in particular the two defining our entirely-architecture-dependent
# abstract machine code:
#
#     src/lib/compiler/back/low/intel32/code/machcode-intel32.codemade.api
#     src/lib/compiler/back/low/intel32/code/machcode-intel32-g.codemade.pkg
#
# but also
#
#     src/lib/compiler/back/low/intel32/code/registerkinds-intel32.codemade.pkg
#     src/lib/compiler/back/low/intel32/emit/translate-machcode-to-asmcode-intel32-g.codemade.pkg
#
# Runtime invocation of our 'translate_treecode_to_machcode' entrypoint is from
#
#     src/lib/compiler/back/low/main/main/translate-nextcode-to-treecode-g.pkg
#
# A good place to begin reading in this file is:
#
#     fun do_void_expression'

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




# This is a revised version that takes into account of
# the extended intel32 instruction set, and has better handling of
# non-standard types.  I've factored out the integer/floating point 
# comparison code, added improvers for conditional moves. 
# The latter generates SETcc and CMOVcc instructions not
# present on PENTIUM -- Pentium Pro and later only. 
#
# To avoid problems, I have tried to incorporate as many
# of  Lal's original magic incantations as possible.
#
# Changes include:
#
#  1.  REMU/REMS are now supported 
#
#  2.  CONDITIONAL_LOAD is supported by generating SETcc and/or CMOVcc;
#      this may require at least a Pentium II to work.
#
#  3.  Division by a constant has been accellerated.
#      Division by a power of 2 generates SHRL or SARL.
#
#  4.  Better addressing mode selection has been implemented.
#      This should improve array indexing.
#
#  5.  Generate testl/testb instead of andl whenever appropriate.
#      This is recommended by the Intel Optimization Guide and seems to improve
#      boxity tests.
#
# More changes for floating point: 
#  A new mode is implemented which generates pseudo 3-address instructions
# for floating point.  These instructions are register allocated the
# normal way, with the virtual registers mapped onto a set of pseudo
# %fp registers.  These registers are then mapped onto the %st registers
# with a new postprocessing phase.
#
# -- Allen Leung


#DO set_control "compiler::trap_int_overflow" "TRUE";

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 lnt =  lowhalf_notes;                                               # lowhalf_notes                                 is from   src/lib/compiler/back/low/code/lowhalf-notes.pkg
    package rkj =  registerkinds_junk;                                          # registerkinds_junk                            is from   src/lib/compiler/back/low/code/registerkinds-junk.pkg
    package tcp =  treecode_pith;                                               # treecode_pith                                 is from   src/lib/compiler/back/low/treecode/treecode-pith.pkg
    package u32 =  one_word_unt;                                                # one_word_unt                                          is from   src/lib/std/one-word-unt.pkg
    #
    rewrite_ramreg    = TRUE;                                                   # Should we rewrite ramregs?
    enable_fast_fpmode = TRUE;                                                  # Set this to FALSE to disable "fast floting point" mode (== allocation of floating point registers on the hardware floating point stack).
herein

    # We are invoked from:
    #
    #     src/lib/compiler/back/low/main/intel32/backend-lowhalf-intel32-g.pkg
    #
    generic package translate_treecode_to_machcode_intel32_g (
        #
                                                                                # machcode_intel32_g                            is from   src/lib/compiler/back/low/intel32/code/machcode-intel32-g.codemade.pkg
        package mcf: Machcode_Intel32;                                          # Machcode_Intel32                              is from   src/lib/compiler/back/low/intel32/code/machcode-intel32.codemade.api

                                                                                # treecode_hashing_equality_and_display_g       is from   src/lib/compiler/back/low/treecode/treecode-hashing-equality-and-display-g.pkg
        package tcj: Treecode_Hashing_Equality_And_Display                      # Treecode_Hashing_Equality_And_Display         is from   src/lib/compiler/back/low/treecode/treecode-hashing-equality-and-display.api
                     where
                         tcf == mcf::tcf;                                       # "tcf" == "treecode_form".

                                                                                # treecode_extension_compiler_intel32_g         is from   src/lib/compiler/back/low/main/intel32/treecode-extension-compiler-intel32-g.pkg
        package txc: Treecode_Extension_Compiler                                # Treecode_Extension_Compiler                   is from   src/lib/compiler/back/low/treecode/treecode-extension-compiler.api
                     where mcf == mcf                                           # "mcf" == "machcode_form" (abstract machine code).
                     also  tcf == mcf::tcf;                                     # "tcf" == "treecode_form".

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

        Architecture = PENTIUM | PENTIUM_PRO | PENTIUM_II | PENTIUM_III;

        architecture:  Ref( Architecture );

        convert_int_to_float_in_registers
          :
          { type:       mcf::tcf::Int_Bitsize,                          # "rgk" == "registerkinds".
            src:        mcf::Operand,                                   # Source operand, guaranteed to be non-memory! 
            ref_notes:  Ref( note::Notes )                              # Notes on cccomponents.                        # "cccomponent" == "callgraph connectec component" (our nextcode unit of compilation).
          }
          -> 
          { ops:        List( mcf::Machine_Op ),                        # The machine instructions. 
            temp_mem:   mcf::Operand,                                   # Temporary for CONVERT_INT_TO_FLOAT 
            cleanup:    List( mcf::Machine_Op )                         # Cleanup code 
          };

        fast_floating_point:  Ref( Bool ); 
            #
            # When thisflag is set we allocate
            # floating point registers directly
            # on the floating point stack.
            #   
    )
    : (weak)
    api {
        include Translate_Treecode_To_Machcode;                                 # Translate_Treecode_To_Machcode                is from   src/lib/compiler/back/low/treecode/translate-treecode-to-machcode.api
        rewrite_ramreg:  Bool;
    }

    {
        # Export to client packages:
        #
        package tcs =  txc::tcs;                                                # "tcs" == "treecode_stream".
        package mcf =  mcf;                                                     # "mcf" == "machcode_form".
        package mcg =  txc::mcg;                                                # "mcg" == "machcode_controlflow_graph".

        stipulate
            package rgk =  mcf::rgk;            # "rgk" == "registerkinds".     # registerkinds_intel32                         is from   src/lib/compiler/back/low/intel32/code/registerkinds-intel32.codemade.pkg
            package mcf =  mcf;
            package tcf =  mcf::tcf;                                            # "tcf" == "treecode_form".

            package crm                                                         # "crm" == "compile_register_moves".
                =
                compile_register_moves_g (                                      # compile_register_moves_g                      is from   src/lib/compiler/back/low/code/compile-register-moves-g.pkg
                    mcf
                );
        herein

            Codebuffer
                =
                tcs::Treecode_Codebuffer
                  (
                    mcf::Machine_Op,
                    rgk::Codetemplists,
                    mcg::Machcode_Controlflow_Graph
                  ); 

            Treecode_Codebuffer
                =
                tcs::Treecode_Codebuffer
                  (
                    tcf::Void_Expression,
                    List( tcf::Expression ),
                    mcg::Machcode_Controlflow_Graph
                  );

            Kind = FLOAT | INTEGER;

            package tct                                                                 # Exported to client packages.
                =                                                                       # "tct" == "treecode_transforms".
                treecode_transforms_g (                                                 # treecode_transforms_g                 is from   src/lib/compiler/back/low/treecode/treecode-transforms-g.pkg
                    #
                    package tcf =  tcf;                                                 # "tcf" == "treecode_form".
                    package rgk =  rgk;                                                 # "rgk" == "registerkinds".
                    #
                    int_bitsize = 32;                                                   # 64-bit issue.
                    natural_widths = [32];                                              # 64-bit issue.
                    Rep = SE | ZE | NEITHER;
                    rep = NEITHER;
                );
            #
            fun error msg
                =
                lem::error("translate_treecode_to_machcode_intel32_g", msg);


            # Should we perform automatic ramreg translation?  
            # If this is on, we can avoid doing rewrite_pseudo phase entirely.
            #
            rewrite_ramreg = rewrite_ramreg;

            # The following hardcoded 
            #
            fun is_ramreg r                                                             # "remregs" are fake registers living in ram, needed on x86 because it is so register-starved.
                =
                rewrite_ramreg and 
                             { r = rkj::intrakind_register_id_of r;
                               r >= 8 and r < 32; 
                             };
            #
            fun is_framreg r                                                            # "framreg" is "floating-poing ram register".
                =
                if (enable_fast_fpmode and *fast_floating_point)
                    #
                    r = rkj::intrakind_register_id_of r;
                    r >= 8 and r < 32;
                else
                    TRUE;
                fi;

            is_any_framreg
                =
                list::exists
                    (fn r = {   r = rkj::intrakind_register_id_of  r;
                                #
                                r >= 8 and r < 32;
                            }
                    );


            st0 = rgk::st 0;                                                            # Top of floating-point stack -- used to return float results.
            st7 = rgk::st 7;                                                            # Last globally allocated float register -- float registers 0-7 are globally allocated, 8-32 are locally allocated.

            # On Intel32 every op comes in triplicate,
            # one version each for 8- 16 and 32-bit operations.                                                                       Logical      Arithmetic
            #               Increment       Decrement      Add            Subtract       Not            Negate         Shift-left     right-shift  right-shift      Of            And             Xor
            opcodes8  = { inc=>mcf::INCB, dec=>mcf::DECB, add=>mcf::ADDB, sub=>mcf::SUBB, notx=>mcf::NOTB, neg=>mcf::NEGB, shl=>mcf::SHLB, shr=>mcf::SHRB, sar=>mcf::SARB, orx=>mcf::ORB, andx=>mcf::ANDB, xor=>mcf::XORB };
            opcodes16 = { inc=>mcf::INCW, dec=>mcf::DECW, add=>mcf::ADDW, sub=>mcf::SUBW, notx=>mcf::NOTW, neg=>mcf::NEGW, shl=>mcf::SHLW, shr=>mcf::SHRW, sar=>mcf::SARW, orx=>mcf::ORW, andx=>mcf::ANDW, xor=>mcf::XORW };
            opcodes32 = { inc=>mcf::INCL, dec=>mcf::DECL, add=>mcf::ADDL, sub=>mcf::SUBL, notx=>mcf::NOTL, neg=>mcf::NEGL, shl=>mcf::SHLL, shr=>mcf::SHRL, sar=>mcf::SARL, orx=>mcf::ORL, andx=>mcf::ANDL, xor=>mcf::XORL };


            # Our main entrypoint.  We are called (only) from:
            #
            #     src/lib/compiler/back/low/main/main/translate-nextcode-to-treecode-g.pkg
            #
            fun make_treecode_to_machcode_codebuffer
                (
                    buf
                    #
                    # 'buf' is our interface to
                    #
                    #     src/lib/compiler/back/low/mcg/make-machcode-codebuffer-g.pkg
                    #
                    # which constructs a machine-code graph driven by our 'put commands:
                    # basically we do a lot of
                    #
                    #     buf.put_op 
                    #
                    # calls to construct the graph and then one
                    # 
                    #     resultgraph = buf.get_completed_cccomponent
                    #
                    # call to get the resulting machcode controlflow graph.
                )
                : Treecode_Codebuffer
                =
                { 
                    put_base_op =  buf.put_op o mcf::BASE_OP;

                    exception EA;

                    # Here we track the codelabel and machine
                    # instruction for our branch_on_overflow traps.
                    # We create these as-needed -- one per cccomponent:
                    #
                    branch_on_overflow_instruction_and_label
                        =
                        REF (NULL:  Null_Or ((mcf::Machine_Op, lbl::Codelabel)) );

                    # flag floating point generation 
                    #
                    floating_point_used = REF FALSE;

                    # Effective address of an integer register 
                    #
                    fun ea_of_int_reg   r =   if (is_ramreg  r)   mcf::RAMREG r;   else mcf::DIRECT r;   fi;
                    fun ea_of_float_reg r =   if (is_framreg r)   mcf::FDIRECT r;   else mcf::FPR    r;   fi;

                    fun put_branch_on_overflow ()
                        =
                        buf.put_op  branch_on_overflow
                        where
                            branch_on_overflow
                                =
                                case *branch_on_overflow_instruction_and_label
                                    #
                                    THE (branch_on_overflow, _) =>   branch_on_overflow;                                                                # Re-use existing branch instruction.

                                    NULL =>
                                        {   # This is the first overflow trap in this cccomponent.

                                            # Generate label for overflow traps to jump to:
                                            #
                                            label = lbl::make_codelabel_generator "trap" ();                                                            # Create, use and discard a codelabel generator.

                                            # Generate branch to that label which is conditional
                                            # on the OVERFLOW bit being set in the condition register:
                                            #
                                            branch_on_overflow
                                                =
                                                mcf::NOTE { op   =>  mcf::jcc { cond => mcf::OO, operand => mcf::IMMED_LABEL (tcf::LABEL label) },      # Branch on integer overflow.
                                                            note =>  lnt::BRANCH_PROBABILITY  probability::unlikely                                     # We hope overflows are rare!
                                                          };

                                            # Save both label and branch instruction for re-use:
                                            #
                                            branch_on_overflow_instruction_and_label
                                                :=
                                                THE (branch_on_overflow, label);

                                            branch_on_overflow;
                                        };
                                esac;
                        end;

                    make_int_codetemp_info   = rgk::make_int_codetemp_info;             # These are codetemps, of unlimited number.  We map them to
                    make_float_codetemp_info = rgk::make_float_codetemp_info;   # hardware registers later -- see src/lib/compiler/back/low/regor/solve-register-allocation-problems-by-iterated-coalescing-g.pkg
                    #
                    fun fsize 32 => mcf::FP32;
                        fsize 64 => mcf::FP64;
                        fsize 80 => mcf::FP80;
                        fsize _  => error "fsize";
                    end;

                    # Mark an expression with a list of annotations
                    # and then emit it:
                    #
                    fun annotate_and_emit_expression' (op,           []) =>  buf.put_op  op;
                        annotate_and_emit_expression' (op, note ! notes) =>  annotate_and_emit_expression'(mcf::NOTE { op, note }, notes);
                    end; 

                    # Annotate an expression and emit it 
                    #
                    fun annotate_and_emit_expression (i, notes)
                        =
                        annotate_and_emit_expression'  (mcf::BASE_OP  i,  notes);

                    put_ops = apply  buf.put_op;

                    # Emit parallel copies for integers .
                    # Translates parallel copies that involve memregs into 
                    # individual copies.
                    #
                    fun copy_ints ([], [], notes)
                            =>
                            ();

                        copy_ints (dst, src, notes)
                            => 
                           put_ops
                               (crm::compile_int_register_moves
                                   { mv_instr, ea => ea_of_int_reg }
                                   { tmp => THE (mcf::DIRECT (make_int_codetemp_info ())),
                                     dst,
                                     src
                                   }
                               )
                            where
                                fun mv_instr
                                      { dst as mcf::RAMREG rd,
                                        src as mcf::RAMREG rs
                                      }
                                        => 
                                        if (rkj::codetemps_are_same_color (rd, rs))
                                            [];
                                        else
                                            tmp_r = mcf::DIRECT (make_int_codetemp_info ());

                                            [ mcf::move { mv_op=>mcf::MOVL, src,        dst=>tmp_r },
                                              mcf::move { mv_op=>mcf::MOVL, src=>tmp_r, dst        }
                                            ];
                                        fi;

                                    mv_instr
                                      { dst=>mcf::DIRECT rd,
                                        src=>mcf::DIRECT rs
                                      }
                                        => 
                                        if (rkj::codetemps_are_same_color (rd, rs))
                                             []; 
                                        else [mcf::COPY { kind =>rkj::INT_REGISTER, size_in_bits=>32, dst => [rd], src => [rs], tmp => NULL } ];
                                        fi;

                                    mv_instr { dst, src }
                                        =>
                                        [mcf::move { mv_op=>mcf::MOVL, src, dst } ];
                                end;
                            end;
                    end;

                    # Conversions 
                    #
                    itow = unt::from_int;
                    wtoi = unt::to_int;
                    #
                    fun to_int1 i
                        =
                        tcf::mi::to_int1 (32, i);

                    w32toi32 =  one_word_unt::to_multiword_int_x; 
                    i32tow32 =  one_word_unt::from_multiword_int;

                    # One day, this is going to bite us
                    # when precision (large_int)>32                                     # XXX BUGGO FIXME 64-bit issue
                    #
                    fun w_to_int1 w
                        =
                        one_word_int::from_multiword_int  (one_word_unt::to_multiword_int_x  w);

                    # Some useful registers 
                    #
                    eax = mcf::DIRECT (rgk::eax);
                    ecx = mcf::DIRECT (rgk::ecx);
                    edx = mcf::DIRECT (rgk::edx);
                    #
                    fun immed_label lab
                        =
                        mcf::IMMED_LABEL (tcf::LABEL lab);

                    # Is the expression zero? 
                    #
                    fun expression_is_zero (tcf::LITERAL z)     =>   z == 0;
                        expression_is_zero (tcf::RNOTE (e, a))  =>   expression_is_zero e;
                        expression_is_zero _ => FALSE;
                    end;

                    # Does the expression affect the condition-register zero flag? 
                    # WARNING: we assume these things are not optimized out!
                    #
                    fun expression_affects_zero_flag (tcf::BITWISE_AND _)       =>  TRUE;
                        expression_affects_zero_flag (tcf::BITWISE_OR _)        =>  TRUE;
                        expression_affects_zero_flag (tcf::BITWISE_XOR _)       =>  TRUE;
                        expression_affects_zero_flag (tcf::RIGHT_SHIFT _)       =>  TRUE;
                        expression_affects_zero_flag (tcf::RIGHT_SHIFT_U _)     =>  TRUE;
                        expression_affects_zero_flag (tcf::LEFT_SHIFT _)        =>  TRUE;
                        expression_affects_zero_flag (tcf::SUB _)               =>  TRUE;
                        expression_affects_zero_flag (tcf::ADD_OR_TRAP _)               =>  TRUE;
                        expression_affects_zero_flag (tcf::SUB_OR_TRAP _)               =>  TRUE;
                        expression_affects_zero_flag (tcf::RNOTE (e, _))        =>  expression_affects_zero_flag e;
                        expression_affects_zero_flag _                          =>  FALSE;
                    end;
                    #
                    fun expression_affects_zero_flag2 (tcf::BITWISE_AND _)      =>  TRUE;
                        expression_affects_zero_flag2 (tcf::BITWISE_OR _)       =>  TRUE;
                        expression_affects_zero_flag2 (tcf::BITWISE_XOR _)      =>  TRUE;
                        expression_affects_zero_flag2 (tcf::RIGHT_SHIFT _)      =>  TRUE;
                        expression_affects_zero_flag2 (tcf::RIGHT_SHIFT_U _)    =>  TRUE;
                        expression_affects_zero_flag2 (tcf::LEFT_SHIFT _)       =>  TRUE;
                        expression_affects_zero_flag2 (tcf::ADD (32, _, _))     =>  TRUE; #  Can't use leal!                    # Probable 64-bit issue -- presumably 32 is bits-per-word.
                        expression_affects_zero_flag2 (tcf::SUB _)              =>  TRUE;
                        expression_affects_zero_flag2 (tcf::ADD_OR_TRAP _)              =>  TRUE;
                        expression_affects_zero_flag2 (tcf::SUB_OR_TRAP _)              =>  TRUE;
                        expression_affects_zero_flag2 (tcf::RNOTE (e, _))       =>  expression_affects_zero_flag2 e;
                        expression_affects_zero_flag2 _                         =>  FALSE;
                    end;

                    # Emit parallel copies for floating point -- normal version:
                    #
                    fun copy_floats'(fty, [], [], _)
                            =>
                            ();

                        copy_floats'(fty, dst as [_], src as [_], notes)
                            => 
                            annotate_and_emit_expression'(mcf::COPY { kind => rkj::FLOAT_REGISTER, size_in_bits=>fty, dst, src, tmp=>NULL }, notes);

                        copy_floats'(fty, dst, src, notes)
                            => 
                            annotate_and_emit_expression'(mcf::COPY { kind => rkj::FLOAT_REGISTER, size_in_bits=>fty, dst, src, tmp=>THE (mcf::FDIRECT (make_float_codetemp_info())) }, notes);
                    end;

                    # Emit parallel copies for floating point -- fast version.
                    # Translates parallel copies that involve memregs into 
                    # individual copies.
                    #
                    fun copy_floats''(fty, [], [], _)
                            =>
                            ();

                       copy_floats''(fty, dst, src, notes)
                            => 
                            if (TRUE or is_any_framreg dst or is_any_framreg src)

                                    fsize = fsize fty;
                                    #
                                    fun mv_instr { dst, src }
                                        =
                                        [ mcf::fmove { fsize, src, dst } ];

                                    put_ops (
                                        crm::compile_int_register_moves
                                            { mv_instr, ea=>ea_of_float_reg }
                                            { tmp=>case dst   
                                                   [_] => NULL;
                                                   _  => THE (mcf::FPR (make_int_codetemp_info ()));
                                                   esac,
                                              dst, src
                                            }
                                    );

                            else
                                annotate_and_emit_expression'
                                  ( mcf::COPY
                                      { kind         => rkj::FLOAT_REGISTER,
                                        size_in_bits => fty,
                                        dst,
                                        src,
                                        tmp=>case dst   
                                                 [_] =>  NULL;
                                                 _   =>  THE (mcf::FPR (make_float_codetemp_info ()));
                                             esac
                                       },
                                    notes
                                  );
                            fi;
                    end;
                    #
                    fun copy_floats x
                        =
                        if (enable_fast_fpmode and *fast_floating_point)
                             copy_floats'' x;
                        else copy_floats' x;
                        fi;

                    # Translate Treecode condition code
                    # to intel32 condition code:
                    #
                    fun cond tcf::LT => mcf::LT;  cond tcf::LTU => mcf::BB;
                        cond tcf::LE => mcf::LE;  cond tcf::LEU => mcf::BE;
                        cond tcf::EQ => mcf::EQ;  cond tcf::NE  => mcf::NE;
                        cond tcf::GE => mcf::GE;  cond tcf::GEU => mcf::AE;
                        cond tcf::GT => mcf::GT;  cond tcf::GTU => mcf::AA;
                        #
                        cond cc => error (cat ["cond(", tcp::cond_to_string cc, ")"]);
                    end;
                    #
                    fun zero dst
                        =
                        put_base_op (mcf::BINARY { bin_op=>mcf::XORL, src=>dst, dst } );

                    # Move and annotate:
                    #
                    fun move'(src as mcf::DIRECT s, dst as mcf::DIRECT d, notes)
                            =>
                            if (not (rkj::codetemps_are_same_color (s, d)))
                                #
                                annotate_and_emit_expression'(mcf::COPY { kind => rkj::INT_REGISTER, size_in_bits=>32, dst => [d], src => [s], tmp => NULL }, notes);
                            fi;

                       move'(mcf::IMMED 0, dst as mcf::DIRECT d, notes)
                            => 
                            annotate_and_emit_expression (mcf::BINARY { bin_op=>mcf::XORL, src=>dst, dst }, notes);     # XOR register with itself to clear it.

                       move'(src, dst, notes)
                            =>
                            annotate_and_emit_expression (mcf::MOVE { mv_op=>mcf::MOVL, src, dst }, notes);
                    end;


                    # Move only!
                    #
                    fun move (src, dst)
                        =
                        move'(src, dst, []);

                    readonly = mcf::rgn::readonly;


                    # Compute an effective address.  
                    #
                    fun address (ea, ramregion)
                        =
                        { 
                            # Keep building a bigger and bigger effective address expressions 
                            # The input is a list of trees
                            # b -- base
                            # i -- index
                            # s -- scale
                            # d -- immed displacement
                            #
                            fun do_ea ([], b, i, s, d)
                                    =>
                                    make_addressing_mode (b, i, s, d);

                                do_ea (t ! trees, b, i, s, d)
                                    =>
                                    case t    
                                        tcf::LITERAL n =>  do_eaimmed (trees, to_int1 n, b, i, s, d);
                                        tcf::LATE_CONSTANT   _ =>  do_ealabel (trees, t, b, i, s, d);
                                        tcf::LABEL   _ =>  do_ealabel (trees, t, b, i, s, d);
                                        tcf::LABEL_EXPRESSION le =>  do_ealabel (trees, le, b, i, s, d);

                                        tcf::ADD (32, t1, t2 as tcf::CODETEMP_INFO(_, r))
                                            => 
                                            if (is_ramreg r) do_ea (t2 ! t1 ! trees, b, i, s, d);
                                            else              do_ea (t1 ! t2 ! trees, b, i, s, d);
                                            fi;

                                        tcf::ADD (32, t1, t2)
                                            =>
                                            do_ea (t1 ! t2 ! trees, b, i, s, d);

                                        tcf::SUB (32, t1, tcf::LITERAL n)
                                            => 
                                            do_ea (t1 ! tcf::LITERAL (tcf::mi::neg (32, n)) ! trees, b, i, s, d);

                                        tcf::LEFT_SHIFT (32, t1, tcf::LITERAL n)
                                            =>
                                            {   n = tcf::mi::to_int (32, n);

                                                case n
                                                    0 => displace (trees, t1, b, i, s, d);
                                                    1 => indexed (trees, t1, t, 1, b, i, s, d);
                                                    2 => indexed (trees, t1, t, 2, b, i, s, d);
                                                    3 => indexed (trees, t1, t, 3, b, i, s, d);
                                                    _ => displace (trees, t, b, i, s, d);
                                                esac;
                                            };

                                        t => displace (trees, t, b, i, s, d);
                                    esac;
                            end  

                            # Add an immediate constant:
                            # 
                            also
                            fun do_eaimmed (trees, 0, b, i, s, d)
                                    =>
                                    do_ea (trees, b, i, s, d);

                                do_eaimmed (trees, n, b, i, s, mcf::IMMED m)
                                    => 
                                    do_ea (trees, b, i, s, mcf::IMMED (n+m));

                                do_eaimmed (trees, n, b, i, s, mcf::IMMED_LABEL le)
                                    => 
                                    do_ea (trees, b, i, s, 
                                         mcf::IMMED_LABEL (tcf::ADD (32, le, tcf::LITERAL (tcf::mi::from_int1 (32, n)))));

                                do_eaimmed (trees, n, b, i, s, _)
                                    =>
                                    error "do_eaimmed";
                            end 

                            # Add a label expression:
                            #
                            also
                            fun do_ealabel (trees, le, b, i, s, mcf::IMMED 0)
                                    => 
                                    do_ea (trees, b, i, s, mcf::IMMED_LABEL le);

                                do_ealabel (trees, le, b, i, s, mcf::IMMED m)
                                    => 
                                    do_ea (
                                        trees,
                                        b,
                                        i,
                                        s, 
                                        mcf::IMMED_LABEL (tcf::ADD (32, le, tcf::LITERAL (tcf::mi::from_int1 (32, m))))
                                        except
                                            OVERFLOW =  error "do_ealabel: constant too large"
                                    );

                                do_ealabel (trees, le, b, i, s, mcf::IMMED_LABEL le')
                                    => 
                                    do_ea (trees, b, i, s, mcf::IMMED_LABEL (tcf::ADD (32, le, le')));

                                do_ealabel (trees, le, b, i, s, _)
                                    =>
                                    error "doEALabel";
                            end 

                            also
                            fun make_addressing_mode (NULL, NULL, _, disp)
                                    =>
                                    disp;

                                make_addressing_mode (THE base, NULL, _, disp)
                                    => 
                                    mcf::DISPLACE { base, disp, ramregion };

                                make_addressing_mode (base, THE index, scale, disp)
                                    => 
                                    mcf::INDEXED { base, index, scale, disp, ramregion };
                            end 

                            # Generate code for tree and
                            # ensure that it is not in %esp 
                            #
                            also
                            fun expr_not_esp tree
                                =
                                {   r = expr tree;

                                    if (rkj::codetemps_are_same_color (r, rgk::esp))
                                        #
                                        tmp = make_int_codetemp_info ();
                                        move (mcf::DIRECT r, mcf::DIRECT tmp);
                                        tmp;
                                    else
                                        r;
                                    fi;
                                }

                            #  Add a base register 
                            also
                            fun displace (trees, t, NULL, i, s, d)   #  no base yet 
                                    =>
                                    do_ea (trees, THE (expr t), i, s, d);

                                displace (trees, t, b as THE base, NULL, _, d)   #  no index 
                                    =>
                                    #   Make t the index, but make sure that it is not %esp! 
                                    {   i = expr t;

                                        if (rkj::codetemps_are_same_color (i, rgk::esp) )
                                            #
                                            # Swap base and index:
                                            #
                                            if (rkj::codetemps_are_same_color (base, rgk::esp) )
                                                #
                                                do_ea (trees, THE i, b, 0, d);
                                            else
                                                # Base and index = %esp! 
                                                index = make_int_codetemp_info ();
                                                move (mcf::DIRECT i, mcf::DIRECT index);
                                                do_ea (trees, b, THE index, 0, d);
                                            fi;
                                        else
                                            do_ea (trees, b, THE i, 0, d);
                                        fi;
                                    };

                                displace (trees, t, THE base, i, s, d)  /* base and index */ 
                                    =>
                                    {   b = expr (tcf::ADD (32, tcf::CODETEMP_INFO (32, base), t));
                                        do_ea (trees, THE b, i, s, d);
                                    };
                            end 

                            #  Add an indexed register 
                            also
                            fun indexed (trees, t, t0, scale, b, NULL, _, d)                    #  no index yet 
                                    =>
                                    do_ea (trees, b, THE (expr_not_esp t), scale, d);

                                indexed (trees, _, t0, _, NULL, i, s, d)                        #  no base 
                                    =>
                                    do_ea (trees, THE (expr t0), i, s, d);

                                indexed (trees, _, t0, _, THE base, i, s, d)                    # Base and index
                                    =>
                                    {   b = expr (tcf::ADD (32, t0, tcf::CODETEMP_INFO (32, base)));
                                        do_ea (trees, THE b, i, s, d);
                                    };
                            end;

                            case (do_ea([ea], NULL, NULL, 0, mcf::IMMED 0))
                                #
                                mcf::IMMED _        =>  raise exception EA;
                                mcf::IMMED_LABEL le =>  mcf::LABEL_EA le;
                                ea                 =>  ea;
                            esac;
                        }                                                                       # fun address 

                    # Convert a tcf expression
                    #     to an mcf operand:
                    #
                    also
                    fun operand (     tcf::LITERAL i                    ) =>  mcf::IMMED (to_int1 (i)); 
                        #
                        operand (x as tcf::LATE_CONSTANT _              ) =>  mcf::IMMED_LABEL x;
                        operand (x as tcf::LABEL _                      ) =>  mcf::IMMED_LABEL x;
                        operand (     tcf::LABEL_EXPRESSION le          ) =>  mcf::IMMED_LABEL le;
                        #
                        operand (     tcf::CODETEMP_INFO  (_, r)                        ) =>  ea_of_int_reg r;
                        operand (     tcf::LOAD (32, ea, ramregion)     ) =>  address (ea, ramregion);
                        #
                        operand (t                                      ) =>  mcf::DIRECT (expr t);
                    end 

                    also
                    fun move_to_reg (operand)
                        =
                        {   dst = mcf::DIRECT (make_int_codetemp_info ());
                            move (operand, dst); dst;
                        }

                    also
                    fun reduce_operand (mcf::DIRECT r)
                            =>
                            r;

                        reduce_operand operand
                            =>
                            {   dst = make_int_codetemp_info ();
                                move (operand, mcf::DIRECT dst);
                                dst;
                            };
                    end 

                    # Ensure that the operand is
                    # either an immed or register:
                    #
                    also
                    fun immed_or_reg (operand as mcf::DISPLACE _) =>  move_to_reg  operand;
                        immed_or_reg (operand as mcf::INDEXED  _) =>  move_to_reg  operand;
                        immed_or_reg (operand as mcf::RAMREG   _) =>  move_to_reg  operand;
                        immed_or_reg (operand as mcf::LABEL_EA _) =>  move_to_reg  operand;
                        immed_or_reg operand  => operand;
                    end 

                    also
                    fun is_immediate (mcf::IMMED       _) =>  TRUE;
                        is_immediate (mcf::IMMED_LABEL _) =>  TRUE;
                        is_immediate _                  =>  FALSE;
                    end 

                    also
                    fun reg_or_mem  operand
                        =
                        if (is_immediate  operand)   move_to_reg  operand;
                        else                                      operand;
                        fi

                    also
                    fun is_mem_operand  operand
                        = 
                        case operand
                            #
                            mcf::DISPLACE _ =>  TRUE;
                            mcf::INDEXED  _ =>  TRUE; 
                            mcf::RAMREG   _ =>  TRUE; 
                            mcf::LABEL_EA _ =>  TRUE; 
                            mcf::FDIRECT f  =>  TRUE;
                            #
                            _               =>  FALSE;
                        esac



                    also
                    fun do_expression (expression, rd:  rkj::Codetemp_Info, notes)                              # "rd" == "destination int register".
                        = 
                        # Compute an integer expression and leave the
                        # result in  the destination register rd.  
                        #
                        {   rd_operand =  ea_of_int_reg  rd;
                            #
                            fun same_as_dest_reg (mcf::DIRECT r) =>  rkj::codetemps_are_same_color (r, rd);
                                same_as_dest_reg (mcf::RAMREG r) =>  rkj::codetemps_are_same_color (r, rd);
                                #
                                same_as_dest_reg _              =>  FALSE;
                            end;

                            # Emit a binary operator.  If the destination is
                            # a ramreg, do something smarter.
                            #
                            fun gen_binary (bin_op, operand1, operand2)
                                =
                                if (   is_ramreg rd
                                   and (is_mem_operand operand1 or is_mem_operand operand2)
                                   or  same_as_dest_reg  operand2
                                   )

                                     tmp_r = make_int_codetemp_info ();
                                     tmp  = mcf::DIRECT tmp_r;
                                     move (operand1, tmp);
                                     annotate_and_emit_expression (mcf::BINARY { bin_op, src=>operand2, dst=>tmp }, notes);
                                     move (tmp, rd_operand);
                                else
                                     move (operand1, rd_operand);
                                     annotate_and_emit_expression (mcf::BINARY { bin_op, src=>operand2, dst=>rd_operand }, notes);
                                fi;


                            #  Generate a binary operator; it may commute:
                            # 
                            fun binary_comm (bin_op, e1, e2)
                                = 
                                gen_binary (bin_op, operand1, operand2)
                                where
                                    my (operand1, operand2)
                                        = 
                                        case (operand e1, operand e2)
                                            #
                                            (x as mcf::IMMED       _, y) =>  (y, x);
                                            (x as mcf::IMMED_LABEL _, y) =>  (y, x);
                                            (x, y as mcf::DIRECT   _   ) =>  (y, x);
                                            (x, y)                      =>  (x, y);
                                        esac;
                                end;


                            # Generate a binary operator; non-commutative:
                            # 
                            fun binary (bin_op, e1, e2)
                                =
                                gen_binary (bin_op, operand e1, operand e2);


                            # Generate a unary operator:
                            #
                            fun unary (un_op, e)
                                = 
                                {   operand = operand e;
                                    #
                                    if (is_ramreg rd  and  is_mem_operand operand)
                                        #
                                        tmp = mcf::DIRECT (make_int_codetemp_info ());
                                        #
                                        move (operand, tmp);
                                        move (tmp, rd_operand);
                                    else
                                        move (operand, rd_operand);
                                    fi;
                                    annotate_and_emit_expression (mcf::UNARY { un_op, operand=>rd_operand }, notes);
                                };


                            # Generate shifts. The shift 
                            # amount must be a constant or in %ecx
                            #
                            fun shift (opcode, e1, e2)
                                =
                                {   operand1 =  operand e1;
                                    operand2 =  operand e2;

                                    case operand2    
                                        #
                                        mcf::IMMED _
                                            =>
                                            gen_binary (opcode, operand1, operand2);

                                        _ => 
                                            if (same_as_dest_reg  operand2) 
                                                #
                                                tmp_r = make_int_codetemp_info ();
                                                tmp  = mcf::DIRECT tmp_r;
                                                move (operand1, tmp);
                                                move (operand2, ecx);
                                                annotate_and_emit_expression (mcf::BINARY { bin_op=>opcode, src=>ecx, dst=>tmp }, notes);
                                                move (tmp, rd_operand);
                                            else
                                                move (operand1, rd_operand);
                                                move (operand2, ecx);
                                                annotate_and_emit_expression (mcf::BINARY { bin_op=>opcode, src=>ecx, dst=>rd_operand }, notes);
                                            fi;
                                   esac;
                                };

                            # Division or remainder -- same instruction on Intel32.
                            #   
                            # Intel32 requires that the divisor be in %edx:%eax regpair.
                            #   
                            # Intel32 leaves 
                            #     the quotient  in EAX,
                            #     the remainder in EDX.
                            #   
                            # Our 'result_reg' argument tells
                            # us which of the two to use.
                            #
                            # If 'overflow' is TRUE we append a branch_on_overflow instruction.
                            # If 'signed'   is TRUE we do signed division, otherwise unsigned:
                            #   
                            fun divrem (signed, overflow, e1, e2, result_reg)
                                =
                                {   my (operand1,   operand2  )
                                     = (operand e1, operand e2);

                                    # First we copy our 32-bit divisor into EAX and
                                    # then extend it to a 64-bit value in EDX:EAX:
                                    #   
                                    move (operand1, eax);
                                    #
                                    mult_div_op
                                        =
                                        if signed
                                            put_base_op  mcf::CDQ;                                                                      # Sign-extend eax into edx.
                                            mcf::IDIVL1;
                                        else
                                            zero edx;
                                            mcf::DIVL1;
                                        fi;

                                    # Do the actual un/signed divide instruction:
                                    #   
                                    annotate_and_emit_expression (mcf::MULTDIV { mult_div_op, src=>reg_or_mem operand2 }, notes);

                                    # Save either quotient or remainder,
                                    # per caller request:
                                    #   
                                    move (result_reg, rd_operand);                                                              # Move either quotient or remainder to rd_operand (result-to-use).

                                    if overflow  put_branch_on_overflow(); fi;
                                };


                            fun divinf0 (overflow, e1, e2)                                                                      # Division with rounding to negative infinity 
                                =                                                                                               # Intel hardware divide rounds to zero, so we have to fake it here.
                                {
                                    o1 = operand e1;
                                    o2 = operand e2;
                                    l = lbl::make_anonymous_codelabel ();

                                    move (o1, eax);                                                                             # Move 32-bit divisor to EAX.
                                    put_base_op  mcf::CDQ;                                                                              # Sign-extend to yield 64-bit divisor in EDX:EAX.

                                    annotate_and_emit_expression                                                                # Do actual divide.
                                      ( mcf::MULTDIV { mult_div_op => mcf::IDIVL1, src => reg_or_mem o2 },
                                        notes
                                      );

                                    if overflow  put_branch_on_overflow(); fi;

                                    apply put_base_op                                                                                   # Fake round-to-negative-infinity given rounded-to-zero result.
                                      [ mcf::CMPL { lsrc => edx, rsrc => mcf::IMMED 0 },
                                        mcf::JCC { cond => mcf::EQ, operand => immed_label l },
                                        mcf::BINARY { bin_op => mcf::XORL,
                                                     src => reg_or_mem o2,
                                                     dst => edx
                                                   },
                                        mcf::JCC { cond => mcf::GE, operand => immed_label l },
                                        mcf::UNARY { un_op => mcf::DECL, operand => eax }
                                      ];

                                    buf.put_private_label l;
                                    move (eax, rd_operand);
                                };

                            # Analyze for power-of-two-ness 
                            #
                            fun power_of_two_check i'                                                                           # i>0 is a power of two if ((i-1) & i) == 0
                                =                                                                                               # Put another way, adding 1 to a number will flip all existing 1 bits to zero
                                {                                                                                               # if-and-only-if they form an unbroken sequence starting at bit zero.
                                    i = to_int1 i';

                                    {   my  (isneg, a, w)
                                            =
                                            if (i >= 0)   (FALSE, i, tcf::mi::to_unt1 (32, i'));
                                            else          (TRUE, -i, tcf::mi::to_unt1 (32, tcf::mi::neg (32,  i')));
                                            fi;

                                        fun log2 (0u1, p) => p;                                                                 # Obviously a 'case' or other table-lookup would do nicely here.
                                            log2 (  w, p) => log2 (u32::(>>) (w, 0u1), p + 1);
                                        end;

                                        if (w > 0u1 and u32::bitwise_and (w - 0u1, w) == 0u0)
                                            #
                                            (i, THE (isneg, a, tcf::LITERAL (tcf::mi::from_int1 (32, log2 (w, 0)))));
                                        else
                                            (i, NULL);
                                        fi;
                                    }
                                    except
                                        _ = (i, NULL);
                                };

                            # Division by a power of two when rounding to neginf is the                                         # Usually we round to zero because that's what Intel hardware does.
                            # same as an arithmetic right shift:                                                                # But we could still use this if we could deduce a number must be nonnegative.
                            #
                            fun divinf (overflow, e1, e2 as tcf::LITERAL n')
                                    =>
                                    case (power_of_two_check n')
                                        #
                                        (_, NULL)
                                            =>
                                            divinf0 (overflow, e1, e2);

                                        (_, THE (FALSE, _, p))
                                            =>
                                            shift (mcf::SARL, tcf::CODETEMP_INFO (32, expr e1), p);

                                        (_, THE (TRUE, _, p))
                                            =>
                                            {   reg = expr e1;

                                                put_base_op (mcf::UNARY { un_op => mcf::NEGL, operand => mcf::DIRECT reg } );
                                                shift (mcf::SARL, tcf::CODETEMP_INFO (32, reg), p);
                                            };
                                    esac;

                                divinf (overflow, e1, e2)
                                    =>
                                    divinf0 (overflow, e1, e2);
                            end;
                            #
                            fun reminf0 (e1, e2)                                        # Remainder when roundint to negative infinity.
                                =                                                       # Intel hardware divide rounds to zero, so we have to fake it here.
                                {   o1 = operand e1;
                                    o2 = operand e2;
                                    l = lbl::make_anonymous_codelabel ();

                                    move (o1, eax);
                                    put_base_op mcf::CDQ;

                                    annotate_and_emit_expression (mcf::MULTDIV { mult_div_op => mcf::IDIVL1, src => reg_or_mem o2 },
                                          notes);



                                    # Now we fake round-to-negative-infinity given rounded-to-zero result.
                                    #
                                    apply put_base_op [ mcf::CMPL { lsrc => edx, rsrc => mcf::IMMED 0 },
                                                    mcf::JCC { cond => mcf::EQ, operand => immed_label l }
                                                  ];
                                    #   
                                    move (edx, eax);
                                    #
                                    apply put_base_op [ mcf::BINARY { bin_op => mcf::XORL, src => reg_or_mem o2, dst => eax },
                                                    mcf::JCC    { cond => mcf::GE, operand => immed_label l },
                                                    mcf::BINARY { bin_op => mcf::ADDL, src => reg_or_mem o2, dst => edx }
                                                  ];

                                    buf.put_private_label l;


                                    move (edx, rd_operand);
                                };

                            # n mod (power-of-2) corresponds to a bitmask (AND). 
                            # If the power is negative, then we must first negate
                            # the argument and then again negate the result.
                            #
                            fun reminf (e1, e2 as tcf::LITERAL n')
                                    =>
                                    case (power_of_two_check n')
                                        #
                                        (_, NULL)
                                            =>
                                            reminf0 (e1, e2);

                                        (_, THE (FALSE, a, _))
                                            =>
                                            binary_comm (mcf::ANDL, e1,
                                                                tcf::LITERAL (tcf::mi::from_int1 (32, a - 1)));

                                        (_, THE (TRUE, a, _))
                                            =>
                                            {   r1 = expr e1;
                                                o1 = mcf::DIRECT r1;

                                                put_base_op (mcf::UNARY { un_op => mcf::NEGL, operand => o1 } );

                                                put_base_op (mcf::BINARY { bin_op => mcf::ANDL,
                                                                      src => mcf::IMMED (a - 1),
                                                                      dst => o1
                                                                    }
                                                        );

                                                unary (mcf::NEGL, tcf::CODETEMP_INFO (32, r1));
                                            };
                                    esac;

                               reminf (e1, e2)
                                    =>
                                    reminf0 (e1, e2);
                            end;

                            # Improve the special case for division:
                            #
                            fun divide (signed, overflow, e1, e2 as tcf::LITERAL n')
                                    =>
                                    case (power_of_two_check n')   
                                        #
                                        (n, THE (isneg, a, p))
                                            =>
                                            if (not signed)
                                                #
                                                shift (mcf::SHRL, e1, p);
                                            else
                                                label = lbl::make_anonymous_codelabel ();
                                                reg1 = expr e1;
                                                operand1 = mcf::DIRECT reg1;

                                                if isneg                                 put_base_op (mcf::UNARY { un_op => mcf::NEGL, operand => operand1 } );
                                                elif (expression_affects_zero_flag e1)   ();
                                                else                                     put_base_op (mcf::CMPL { lsrc => operand1, rsrc => mcf::IMMED 0 } );
                                                fi;

                                                put_base_op (mcf::JCC { cond => mcf::GE, operand => immed_label label } );

                                                put_base_op
                                                      if (a == 2)       mcf::UNARY    { un_op   =>  mcf::INCL,
                                                                                        operand =>  operand1
                                                                                      };
                                                      else
                                                                        mcf::BINARY   { bin_op  =>  mcf::ADDL,
                                                                                        src     =>  mcf::IMMED (a - 1),
                                                                                        dst     =>  operand1
                                                                                      };
                                                      fi;

                                                buf.put_private_label  label;

                                                shift (mcf::SARL, tcf::CODETEMP_INFO (32, reg1), p);
                                            fi;

                                        (n, NULL)
                                            =>
                                            divrem (signed, overflow and (n == -1 or n == 0), e1, e2, eax);
                                   esac;

                               divide (signed, overflow, e1, e2)
                                   =>
                                   divrem (signed, overflow, e1, e2, eax);
                            end;

                            # rem never causes overflow 
                            #
                            fun rem (signed, e1, e2 as tcf::LITERAL n')
                                    =>
                                    case (power_of_two_check n')
                                        #
                                        (n, THE (isneg, a, _))
                                            =>
                                            if signed
                                                #
                                                # The following logic should work uniformly
                                                # for both isneg and not isneg.  It only uses
                                                # the absolute value (a) of the divisor.
                                                # Here is the formula:
                                                #    let p be a power of two and a = abs (p):
                                                #
                                                #    x % p = x - ((x < 0 ? x + a - 1:  x) & (-a))
                                                #
                                                # (That's what GCC seems to do.)
                                                #
                                                r1  = expr e1;
                                                o1  = mcf::DIRECT r1;
                                                #
                                                rt  = make_int_codetemp_info ();
                                                #
                                                tmp = mcf::DIRECT rt;
                                                l   = lbl::make_anonymous_codelabel ();

                                                move (o1, tmp);

                                                if (not (expression_affects_zero_flag e1))
                                                    #
                                                    put_base_op (mcf::CMPL { lsrc => o1,
                                                                        rsrc => mcf::IMMED 0
                                                                      }
                                                            );
                                                fi;

                                                put_base_op (mcf::JCC { cond => mcf::GE, operand => immed_label l } );

                                                put_base_op (mcf::BINARY { bin_op => mcf::ADDL,
                                                                      src    => mcf::IMMED (a - 1),
                                                                      dst    => tmp
                                                                    }
                                                       );

                                                buf.put_private_label l;

                                                put_base_op (mcf::BINARY { bin_op => mcf::ANDL,
                                                                      src    => mcf::IMMED (-a),
                                                                      dst    => tmp
                                                                    }
                                                       );

                                                binary (mcf::SUBL, tcf::CODETEMP_INFO (32, r1), tcf::CODETEMP_INFO (32, rt));

                                            elif isneg 

                                                # This is really strange... 
                                                divrem (FALSE, FALSE, e1, e2, edx);
                                            else
                                                binary_comm (mcf::ANDL, e1,
                                                            tcf::LITERAL (tcf::mi::from_int1 (32, n - 1)));
                                            fi;

                                        (_, NULL)
                                            =>
                                            divrem (signed, FALSE, e1, e2, edx);
                                   esac;

                               rem (signed, e1, e2)
                                   =>
                                   divrem (signed, FALSE, e1, e2, edx);
                            end;


                            # Make sure the destination is a register: 
                            #   
                            fun dst_must_be_reg f
                                = 
                                if (not (is_ramreg rd))
                                    #
                                    f (rd, rd_operand);
                                else
                                    tmp_r = make_int_codetemp_info ();
                                    tmp  = mcf::DIRECT (tmp_r);
                                    f (tmp_r, tmp);
                                    move (tmp, rd_operand);
                                fi;


                            # unsigned integer multiplication
                            # 
                            fun u_multiply0 (e1, e2)
                                = 
                                #  note e2 can never be (mcf::DIRECT edx) 
                                {   move (operand e1, eax);
                                    annotate_and_emit_expression (mcf::MULTDIV { mult_div_op=>mcf::MULL1, 
                                                src=>reg_or_mem (operand e2) }, notes);
                                    move (eax, rd_operand);
                                };

                            #
                            fun u_multiply (e1, e2 as tcf::LITERAL n')
                                    =>
                                    case (power_of_two_check n')
                                        #
                                        (_, THE (FALSE, _, p))
                                            =>
                                            shift (mcf::SHLL, e1, p);

                                        _   =>
                                            u_multiply0 (e1, e2);
                                    esac;

                                u_multiply (e1 as tcf::LITERAL _, e2) =>  u_multiply  (e2, e1);
                                u_multiply (e1, e2)                   =>  u_multiply0 (e1, e2);
                            end;


                            # signed integer multiplication: 
                            # The only forms that are allowed that also sets the 
                            # OF and CF flags are:
                            #
                            #          (dst)  (src1)  (src2)
                            #      imul r32, r32/m32, imm8
                            #          (dst)  (src) 
                            #      imul r32, imm8
                            #      imul r32, imm32
                            #      imul r32, r32/m32
                            # Note: destination must be a register!
                            #
                            fun multiply (e1, e2)
                                = 
                                dst_must_be_reg
                                    (fn (rd, rd_operand)
                                        =
                                        do_it (operand e1, operand e2)
                                        where
                                            fun do_it (i1 as mcf::IMMED _, i2 as mcf::IMMED _)
                                                    =>
                                                    {   move (i1, rd_operand);
                                                        annotate_and_emit_expression (mcf::BINARY { bin_op=>mcf::IMULL, dst=>rd_operand, src=>i2 }, notes);
                                                    };

                                                do_it (rm, i2 as mcf::IMMED _)
                                                    =>
                                                    do_it (i2, rm);

                                                do_it (imm as mcf::IMMED (i), rm)
                                                    =>
                                                    annotate_and_emit_expression (mcf::MUL3 { dst=>rd, src1=>rm, src2=>i }, notes);

                                                do_it (r1 as mcf::DIRECT _, r2 as mcf::DIRECT _)
                                                    =>
                                                    {   move (r1, rd_operand);
                                                        annotate_and_emit_expression (mcf::BINARY { bin_op=>mcf::IMULL, dst=>rd_operand, src=>r2 }, notes);
                                                    };

                                                do_it (r1 as mcf::DIRECT _, rm)
                                                    =>
                                                    {   move (r1, rd_operand);
                                                        annotate_and_emit_expression (mcf::BINARY { bin_op=>mcf::IMULL, dst=>rd_operand, src=>rm }, notes);
                                                    };

                                                do_it (rm, r as mcf::DIRECT _)
                                                    =>
                                                    do_it (r, rm);

                                                do_it (rm1, rm2)
                                                     =>
                                                     if (same_as_dest_reg  rm2)
                                                          tmp_r = make_int_codetemp_info ();
                                                          tmp   = mcf::DIRECT tmp_r;
                                                          move (rm1, tmp);
                                                          annotate_and_emit_expression (mcf::BINARY { bin_op=>mcf::IMULL, dst=>tmp, src=>rm2 }, notes);
                                                          move (tmp, rd_operand);
                                                     else
                                                          move (rm1, rd_operand);
                                                          annotate_and_emit_expression (mcf::BINARY { bin_op=>mcf::IMULL, dst=>rd_operand, src=>rm2 }, notes);
                                                     fi;
                                            end;
                                        end
                                );                      # fn
                            #
                            fun multiply_notrap (e1, e2 as tcf::LITERAL n')
                                    =>
                                    case (power_of_two_check n')
                                        #
                                        (_, THE (isneg, _, p))
                                            =>
                                            {
                                                r1 = expr e1;
                                                o1 = mcf::DIRECT r1;

                                                if isneg   put_base_op (mcf::UNARY { un_op => mcf::NEGL, operand => o1 } );   fi;

                                                shift (mcf::SHLL, tcf::CODETEMP_INFO (32, r1), p);
                                            };

                                        _   => multiply (e1, e2);
                                    esac;

                                multiply_notrap (e1 as tcf::LITERAL _, e2) =>  multiply_notrap (e2, e1);
                                multiply_notrap (e1,                   e2) =>  multiply (e1, e2);
                            end;

                            # Emit a load instruction; makes sure
                            # that the destination is a register:
                            #
                            fun gen_load (mv_op, ea, ramregion)
                                = 
                                dst_must_be_reg (fn (_, dst)
                                    =
                                    annotate_and_emit_expression (mcf::MOVE { mv_op, src=>address (ea, ramregion), dst }, notes));

                            # Generate zero-extended loads:
                            #
                            fun load8   (ea, ramregion) = gen_load (mcf::MOVZBL, ea, ramregion);
                            fun load16  (ea, ramregion) = gen_load (mcf::MOVZWL, ea, ramregion);
                            fun load8s  (ea, ramregion) = gen_load (mcf::MOVSBL, ea, ramregion);
                            fun load16s (ea, ramregion) = gen_load (mcf::MOVSWL, ea, ramregion);
                            fun load32  (ea, ramregion) = gen_load (mcf::MOVL,   ea, ramregion);


                            # Generate sign-extended loads.

                            # Generate setcc instruction:
                            #  semantics:  MOVE_INT (rd, CONDITIONAL_LOAD (_, tcf::CMP (type, cc, t1, t2), yes, no))
                            # Bug, if eax is either t1 or t2 then problem will occur!!!
                            # Note that we have to use eax as the destination of the
                            # setcc because it only works on the registers
                            # %al, %bl, %cl, %dl and %[abcd]h.  The last four registers
                            # are inaccessible in 32 bit mode.
                            #
                            fun setcc (type, cc, t1, t2, yes, no)
                                = 
                                {   my (cc, yes, no)
                                        = 
                                        if (yes > no)  (cc, yes, no);
                                        else           (tcp::negate_cond cc, no, yes);
                                        fi;

                                    # Clear the destination first because
                                    # SETcc only sets the low order byte:
                                    #
                                    case (yes, no, cc)   
                                        #
                                        (1, 0, tcf::LT)
                                            =>
                                            {   tmp = mcf::DIRECT (expr (tcf::SUB (32, t1, t2)));
                                                move (tmp, rd_operand);
                                                put_base_op (mcf::BINARY { bin_op=>mcf::SHRL, src=>mcf::IMMED 31, dst=>rd_operand } );
                                            };

                                        (1, 0, tcf::GT)
                                            =>
                                            {   tmp = mcf::DIRECT (expr (tcf::SUB (32, t1, t2)));
                                                put_base_op (mcf::UNARY { un_op=>mcf::NOTL, operand=>tmp } );
                                                move (tmp, rd_operand);
                                                put_base_op (mcf::BINARY { bin_op=>mcf::SHRL, src=>mcf::IMMED 31, dst=>rd_operand } );
                                            };

                                        (1, 0, _)        #  normal case
                                            => 
                                            {   cc = cmp (TRUE, type, cc, t1, t2, []); 
                                                annotate_and_emit_expression (mcf::SET { cond => cond cc, operand=>eax }, notes);
                                                put_base_op (mcf::BINARY { bin_op=>mcf::ANDL, src=>mcf::IMMED 255, dst=>eax } );
                                                move (eax, rd_operand);
                                            };

                                        (c1, c2, _)
                                            => 
                                            # general case; 
                                            # from the Intel optimization guide p3-5 
                                            #
                                            {   zero eax;
                                                cc = cmp (TRUE, type, cc, t1, t2, []); 
                                                #       
                                                fun c19 (base, scale)
                                                    =
                                                    {
                                                        address = mcf::INDEXED { base,
                                                                             index=>rgk::eax,
                                                                             scale,
                                                                             disp=>mcf::IMMED c2,
                                                                             ramregion=>readonly };
                                                        tmp_r = make_int_codetemp_info ();
                                                        tmp  = mcf::DIRECT tmp_r;
                                                        put_base_op (mcf::SET { cond=>cond cc, operand=>eax } ); 
                                                        annotate_and_emit_expression (mcf::LEA { r32=>tmp_r, address }, notes);
                                                        move (tmp, rd_operand);
                                                    };

                                                case (c1-c2)   
                                                    #
                                                    1 => c19 (NULL, 0);
                                                    2 => c19 (NULL, 1);
                                                    3 => c19 (THE rgk::eax, 1);
                                                    4 => c19 (NULL, 2);
                                                    5 => c19 (THE rgk::eax, 2);
                                                    8 => c19 (NULL, 3);
                                                    9 => c19 (THE rgk::eax, 3);

                                                    dd =>
                                                        {   put_base_op (mcf::SET { cond=>cond (tcp::negate_cond cc), operand=>eax } ); 

                                                            put_base_op (mcf::UNARY { un_op=>mcf::DECL, operand=>eax } );

                                                            put_base_op (mcf::BINARY { bin_op=>mcf::ANDL, src=>mcf::IMMED dd, dst=>eax } );

                                                            if (c2 == 0)
                                                                #
                                                                move (eax, rd_operand);
                                                            else
                                                                tmp_r = make_int_codetemp_info ();
                                                                tmp  = mcf::DIRECT tmp_r;

                                                                annotate_and_emit_expression (mcf::LEA { address=>
                                                                              mcf::DISPLACE {
                                                                                         base=>rgk::eax,
                                                                                         disp=>mcf::IMMED c2,
                                                                                         ramregion=>readonly },
                                                                              r32=>tmp_r }, notes);

                                                                move (tmp, rd_operand);
                                                            fi;
                                                        };
                                                esac;
                                            };
                                    esac;
                                };                      # fun setcc 

                            # Generate cmovcc instruction.
                            # on Pentium Pro and Pentium II only
                            #
                            fun cmovcc (type, cc, t1, t2, yes, no)
                                = 
                                dst_must_be_reg  gen_cmov
                                where
                                    fun gen_cmov (dst_r, _)
                                        = 
                                        {   do_expression (no, dst_r, []);                      # FALSE branch 

                                            cc = cmp (TRUE, type, cc, t1, t2, []);              # Compare 

                                            annotate_and_emit_expression
                                              (
                                                mcf::CMOV { cond =>  cond cc,
                                                            src  =>  reg_or_mem (operand yes),
                                                            dst  =>  dst_r
                                                          },
                                                notes
                                              ); 
                                        };
                                end;
                            #
                            fun unknown_expression expression
                                =
                                do_expression (tct::compile_int_expression  expression,  rd,  notes); 


                            # Add n to rd:
                            #
                            fun add_n n
                                =
                                {   n = operand n;

                                    src = if (is_ramreg rd)   immed_or_reg n;
                                          else                n;
                                          fi;

                                    annotate_and_emit_expression
                                      (
                                        mcf::BINARY   { bin_op =>  mcf::ADDL,
                                                        src,
                                                        dst    =>  rd_operand
                                                      },
                                        notes
                                      );
                                };


                            # Generate addition:
                            #
                            fun addition (e1, e2)
                                =
                                case e1   
                                    tcf::CODETEMP_INFO(_, rs) => if (rkj::codetemps_are_same_color (rs, rd))   add_n e2; 
                                                       else                                          addition1 (e1, e2);
                                                       fi;

                                   _ => addition1 (e1, e2);
                                esac

                            also
                            fun addition1 (e1, e2)
                                =
                                case e2
                                    #
                                    tcf::CODETEMP_INFO(_, rs) => if (rkj::codetemps_are_same_color (rs, rd))   add_n e1; 
                                                       else                                          addition2 (e1, e2);
                                                       fi;
                                    _ => addition2 (e1, e2);
                                esac 

                            also
                            fun addition2 (e1, e2)
                                =
                                dst_must_be_reg
                                    (fn (dst_r, _)
                                        =
                                        annotate_and_emit_expression
                                          (
                                            mcf::LEA { r32=>dst_r, address=>address (expression, readonly) },
                                            notes
                                          )
                                    )
                                except
                                    EA = binary_comm (mcf::ADDL, e1, e2);


                            case expression
                                #
                                tcf::CODETEMP_INFO(_, rs)
                                    => 
                                    if (is_ramreg rs and is_ramreg rd)
                                        #
                                        tmp = mcf::DIRECT (make_int_codetemp_info ());
                                        move'(mcf::RAMREG rs, tmp, notes);
                                        move'(tmp, rd_operand, []);
                                    else
                                        move'(ea_of_int_reg rs, rd_operand, notes);
                                    fi;

                                tcf::LITERAL z
                                    =>
                                    {
                                        n = to_int1 z;

                                        if (n != 0)
                                            #
                                            move'(mcf::IMMED (n), rd_operand, notes);
                                        else
                                            # As per Fermin's request, special speedup for rd := 0. 
                                            # Currently we don't bother with the size.
                                            #
                                            if (is_ramreg rd)
                                                #
                                                move'(mcf::IMMED 0, rd_operand, notes);
                                            else
                                                annotate_and_emit_expression
                                                  (
                                                    mcf::BINARY   { bin_op =>  mcf::XORL,
                                                                    src    =>  rd_operand,
                                                                    dst    =>  rd_operand
                                                                  },
                                                    notes
                                                  );
                                            fi;
                                        fi;
                                    };

                                (tcf::LATE_CONSTANT _ | tcf::LABEL _)
                                    => 
                                    move'(mcf::IMMED_LABEL expression, rd_operand, notes);

                                tcf::LABEL_EXPRESSION le
                                    =>
                                    move'(mcf::IMMED_LABEL le, rd_operand, notes);

                                # 32-bit addition 
                                #
                                tcf::ADD (32, e1, e2 as tcf::LITERAL n)
                                    =>
                                    {
                                        n = to_int1 n;

                                        case n 
                                            1 =>  unary (mcf::INCL, e1);
                                           -1 =>  unary (mcf::DECL, e1);
                                            _ =>  addition (e1, e2);
                                        esac;
                                    };

                                tcf::ADD (32, e1 as tcf::LITERAL n, e2)
                                    =>
                                    {
                                        n = to_int1 n;

                                        case n 
                                            1 =>  unary (mcf::INCL, e2);
                                           -1 =>  unary (mcf::DECL, e2);
                                            _ =>  addition (e1, e2);
                                        esac;
                                    };

                                tcf::ADD (32, e1, e2)
                                    =>
                                    addition (e1, e2);

                                # 32-bit addition but set the flag!
                                # This is a stupid hack for now.     XXX BUGGO FIXME
                                #
                                tcf::ADD (0, e, e1 as tcf::LITERAL n)
                                    =>
                                    {   n = tcf::mi::to_int (32, n);
                                        #
                                        if   (n ==  1)  unary       (mcf::INCL, e);
                                        elif (n == -1)  unary       (mcf::DECL, e);
                                        else            binary_comm (mcf::ADDL, e, e1);
                                        fi;
                                    };

                                tcf::ADD (0, e1 as tcf::LITERAL n, e)
                                    =>
                                    {   n = tcf::mi::to_int (32, n);
                                        #
                                        if   (n ==  1)  unary       (mcf::INCL, e);
                                        elif (n == -1)  unary       (mcf::DECL, e);
                                        else            binary_comm (mcf::ADDL, e1, e);
                                        fi;
                                    };

                                tcf::ADD (0, e1, e2)
                                    =>
                                    binary_comm (mcf::ADDL, e1, e2);

                                # 32-bit subtraction:
                                #
                                tcf::SUB (32, e1, e2 as tcf::LITERAL n)
                                    =>
                                    {   n = to_int1 n;

                                        case n
                                            #
                                            0 => do_expression (e1, rd, notes);
                                            1 => unary (mcf::DECL, e1);
                                           -1 => unary (mcf::INCL, e1);
                                            _ => binary (mcf::SUBL, e1, e2);
                                        esac;
                                    };

                                tcf::SUB (32, e1 as tcf::LITERAL n, e2)
                                    => 
                                    if (n == 0)  unary  (mcf::NEGL, e2);
                                    else         binary (mcf::SUBL, e1, e2);
                                    fi;

                                tcf::SUB (32, e1, e2) => binary (mcf::SUBL, e1, e2);

                                tcf::MULU (32, x, y) =>  u_multiply (x, y);
                                tcf::DIVU (32, x, y) =>  divide (FALSE, FALSE, x, y);
                                tcf::REMU (32, x, y) =>  rem (FALSE, x, y);

                                tcf::MULS (                         32, x, y) =>  multiply_notrap (x, y);
                                tcf::DIVS (tcf::d::ROUND_TO_ZERO,   32, x, y) =>  divide (TRUE, FALSE, x, y);           # d:: is a special rounding mode just for divide instructions.
                                tcf::DIVS (tcf::d::ROUND_TO_NEGINF, 32, x, y) =>  divinf (FALSE, x, y);                 # ROUND_TO_NEGINF is quite slow on Intel -- we must fake it in software.
                                tcf::REMS (tcf::d::ROUND_TO_ZERO,   32, x, y) =>  rem (TRUE, x, y);
                                tcf::REMS (tcf::d::ROUND_TO_NEGINF, 32, x, y) =>  reminf (x, y);                        # ROUND_TO_NEGINF is quite slow on Intel -- we must fake it in software.

                                tcf::ADD_OR_TRAP (32, x, y) => { binary_comm (mcf::ADDL, x, y);  put_branch_on_overflow (); };
                                tcf::SUB_OR_TRAP (32, x, y) => { binary      (mcf::SUBL, x, y);  put_branch_on_overflow (); };
                                tcf::MULS_OR_TRAP (32, x, y) => { multiply    (           x, y);  put_branch_on_overflow (); };

                                tcf::DIVS_OR_TRAP (tcf::d::ROUND_TO_ZERO,   32, x, y) => divide (TRUE, TRUE, x, y);
                                tcf::DIVS_OR_TRAP (tcf::d::ROUND_TO_NEGINF, 32, x, y) => divinf (TRUE, x, y);

                                tcf::BITWISE_AND (32, x, y) => binary_comm (mcf::ANDL, x, y);
                                tcf::BITWISE_OR  (32, x, y) => binary_comm (mcf::ORL,  x, y);
                                tcf::BITWISE_XOR (32, x, y) => binary_comm (mcf::XORL, x, y);
                                tcf::BITWISE_NOT (32, x)    => unary       (mcf::NOTL, x);

                                tcf::RIGHT_SHIFT   (32, x, y) =>  shift (mcf::SARL, x, y);
                                tcf::RIGHT_SHIFT_U (32, x, y) =>  shift (mcf::SHRL, x, y);
                                tcf::LEFT_SHIFT    (32, x, y) =>  shift (mcf::SHLL, x, y);

                                tcf::LOAD (8,  ea, ramregion) =>  load8  (ea, ramregion);
                                tcf::LOAD (16, ea, ramregion) =>  load16 (ea, ramregion);
                                tcf::LOAD (32, ea, ramregion) =>  load32 (ea, ramregion);

                                tcf::SIGN_EXTEND (32,  8, tcf::LOAD ( 8, ea, ramregion)) =>  load8s  (ea, ramregion);
                                tcf::SIGN_EXTEND (32, 16, tcf::LOAD (16, ea, ramregion)) =>  load16s (ea, ramregion);
                                #
                                tcf::ZERO_EXTEND (32,  8, tcf::LOAD ( 8, ea, ramregion)) =>  load8   (ea, ramregion);
                                tcf::ZERO_EXTEND (32, 16, tcf::LOAD (16, ea, ramregion)) =>  load16  (ea, ramregion);

                                tcf::CONDITIONAL_LOAD (32, tcf::CMP (type, cc, t1, t2), y as tcf::LITERAL yes, n as tcf::LITERAL no)
                                    =>
                                    case *architecture          #  PentiumPro and higher has CMOVcc 
                                        #
                                        PENTIUM =>   setcc (type, cc, t1, t2, to_int1 yes, to_int1 no);
                                        _       =>   cmovcc (type, cc, t1, t2, y, n);
                                    esac;

                                tcf::CONDITIONAL_LOAD (32, tcf::CMP (type, cc, t1, t2), yes, no)
                                    => 
                                    case *architecture          #  PentiumPro and higher has CMOVcc 
                                        #
                                        PENTIUM =>   unknown_expression expression;
                                        _       =>   cmovcc (type, cc, t1, t2, yes, no);
                                    esac;

                                tcf::LET   (s, e)               => { do_void_expression s; do_expression (e, rd, notes);};
                                tcf::RNOTE (e, lnt::MARKREG f)  => { f rd; do_expression (e, rd, notes);};

                                tcf::RNOTE (e, a) => do_expression (e, rd, a ! notes);
                                tcf::PRED  (e, c) => do_expression (e, rd, lnt::CONTROL_DEPENDENCY_USE c ! notes);

                                tcf::REXT e => txc::compile_rext (reducer()) { e, rd, notes }; 

                                # Simplify and try again:
                                #
                                expression => unknown_expression expression;
                            esac;
                        }                                                               # fun do_expression 



                    # Generate an expression and return its result register.
                    # If rewrite_pseudo is on, the result is guaranteed
                    # to be in a non-ramreg register:
                    #
                    also
                    fun expr (expression as tcf::CODETEMP_INFO(_, rd))
                            => 
                            if (is_ramreg rd)  gen_expr expression;
                            else                rd;
                            fi;

                        expr expression
                            =>
                            gen_expr expression;
                    end 

                    also
                    fun gen_expr expression
                        = 
                        {   rd = make_int_codetemp_info ();
                            do_expression (expression, rd, []);
                            rd;
                        }

                    # Compare an expression with zero.
                    # On the intel32, TEST is superior to AND for doing the same thing,
                    # since it doesn't need to write out the result in a register.
                    #
                    also
                    fun cmp_with_zero (cc as (tcf::EQ | tcf::NE), e as tcf::BITWISE_AND (type, a, b), notes)
                            => 
                            {   case type
                                    #
                                     8 =>  test (mcf::TESTB, a, b,  notes);
                                    16 =>  test (mcf::TESTW, a, b,  notes);
                                    32 =>  test (mcf::TESTL, a, b,  notes);
                                    #   
                                     _ =>  do_expression (e, make_int_codetemp_info (), notes);
                                esac; 

                                cc;
                            };  

                       cmp_with_zero (cc, e, notes)
                            => 
                            {   e = case e                                              #  hack to disable the lea tweak XXX 
                                        #
                                        tcf::ADD (_, a, b) =>   tcf::ADD (0, a, b);
                                        e                  =>   e;
                                    esac;

                                do_expression (e, make_int_codetemp_info (), notes);

                                cc;
                            };
                    end 

                    # Emit a test.
                    #   The available modes are
                    #      r/m, r
                    #      r/m, imm
                    # On selecting the right instruction: TESTL/TESTW/TESTB.   
                    # When anding an operand with a constant
                    # that fits within 8 (or 16) bits, it is possible to use TESTB,
                    # (or TESTW) instead of TESTL.   Because intel32 is little endian, 
                    # this works for memory operands too.  However, with TESTB, it is
                    # not possible to use registers other than 
                    # AL, CL, BL, DL, and AH, CH, BH, DH.  So, the best way is to
                    # perform register allocation first, and if the operand registers
                    # are one of EAX, ECX, EBX, or EDX, replace the TESTL instruction 
                    # by TESTB.
                    #
                    also
                    fun test (testopcode, a, b, notes)
                        = 
                        {   (maybe_commute_comparison (tcf::EQ, TRUE, a, b))
                                ->
                                (_, operand1, operand2);
                                

                            #  translate r, r/m => r/m, r
                            #
                            my (operand1, operand2)
                                = 
                                if (is_mem_operand operand2)  (operand2, operand1);
                                else                          (operand1, operand2);
                                fi;

                            annotate_and_emit_expression
                              (
                                testopcode { lsrc=>operand1, rsrc=>operand2 },
                                notes
                              );
                        }

                        #  %eflags <- src 

                    also
                    fun move_to_eflags src
                        =
                        if (not (rkj::codetemps_are_same_color (src, rgk::eflags)))
                            #
                            move (mcf::DIRECT src, eax);
                            put_base_op mcf::LAHF;
                        fi

                        # dst <- %eflags

                    also
                    fun move_from_eflags dst
                        =
                        if (not (rkj::codetemps_are_same_color (dst, rgk::eflags)))
                            #
                            put_base_op  mcf::SAHF;
                            move (eax, mcf::DIRECT dst);
                        fi

                    # Generate a condition code expression.
                    # The zero is for setting the condition code!  
                    # I have no idea why this is used.
                    #
                    also
                    fun do_flag_expression (tcf::CMP (type, cc, t1, t2), rd, notes)                     # flag expressions handle zero/parity/overflow/... flag stuff.
                            => 
                            {   cmp (FALSE, type, cc, t1, t2, notes); 
                                move_from_eflags rd;
                            }; 

                        do_flag_expression (tcf::CC (cond, rs), rd, notes)
                            => 
                            if (rkj::codetemps_are_same_color (rs, rgk::eflags)
                            or  rkj::codetemps_are_same_color (rd, rgk::eflags) )
                                #
                                move_to_eflags rs;
                                move_from_eflags rd;
                            else
                                move'(mcf::DIRECT rs, mcf::DIRECT rd, notes);
                            fi;

                        do_flag_expression (tcf::CCNOTE (e, lnt::MARKREG f), rd, notes)
                            =>
                            {   f rd;
                                do_flag_expression (e, rd, notes);
                            };

                        do_flag_expression (tcf::CCNOTE (e, a), rd, notes)
                            =>
                            do_flag_expression (e, rd, a ! notes);

                        do_flag_expression (tcf::CCEXT e, cd, notes)
                            => 
                            txc::compile_ccext (reducer()) { e, ccd=>cd, notes }; 

                        do_flag_expression _
                            =>
                            error "do_flag_expression";
                    end 

                    also
                    fun cc_expr e
                        =
                        error "cflag_expression"


                    # Generate a comparison and set the condition code;
                    # Return the actual cc used.
                    # If 'swappable' is TRUE we can reorder the operands. 
                    #
                    also
                    fun cmp (swappable, type, cc, t1, t2, notes)
                        = 
                        #  == and != can be always be reordered 
                        {
                            swappable =   swappable
                                      or  cc == tcf::EQ
                                      or  cc == tcf::NE;

                            # Sometimes the comparison
                            # is not necessary because
                            # the condition-register bits
                            # are already set.

                            if   (expression_is_zero             t1
                            and   expression_affects_zero_flag2  t2)
                                #
                                if swappable    cmp_with_zero (tcp::swap_cond cc, t2, notes);
                                else            gen_cmp (type, FALSE, cc, t1, t2, notes);               # Can't reorder the comparison.
                                fi;
                                #
                            elif (expression_is_zero             t2
                            and   expression_affects_zero_flag2  t1) 
                                #
                                cmp_with_zero (cc, t1, notes);
                                #
                            else
                                gen_cmp (type, swappable, cc, t1, t2, notes);
                            fi;
                        }

                    also
                    fun maybe_commute_comparison (cc, swappable, a, b)
                        = 
                        # Given a and b which are the operands to a comparison (or test),
                        # return the appropriate condition code and operands.
                        #   The available modes are:
                        #        r/m, imm
                        #        r/m, r
                        #        r,   r/m
                        {
                            operand1 =  operand a;
                            operand2 =  operand b;

                            # Try to fold in the operands whenever possible:

                            case ( is_immediate operand1,
                                   is_immediate operand2
                                 )
                                #       
                                (TRUE, TRUE)
                                    =>
                                    (cc, move_to_reg operand1, operand2);

                                (TRUE, FALSE)
                                    => 
                                    if swappable  (tcp::swap_cond cc, operand2, operand1);
                                    else          (cc, move_to_reg operand1, operand2);
                                    fi;

                                (FALSE, TRUE)
                                    =>
                                    (cc, operand1, operand2);

                                (FALSE, FALSE)
                                    => 
                                    case (operand1, operand2)
                                        #
                                        (_, mcf::DIRECT _) =>  (cc, operand1, operand2);
                                        (mcf::DIRECT _, _) =>  (cc, operand1, operand2);
                                        (_, _)             =>  (cc, move_to_reg operand1, operand2);
                                    esac;
                            esac;
                        } 

                    # Generate an actual comparison;
                    # return the actual cc used: 
                    #
                    also
                    fun gen_cmp (type, swappable, cc, a, b, notes)
                        = 
                        {   (maybe_commute_comparison (cc, swappable, a, b))
                                ->
                                (cc, operand1, operand2);

                            annotate_and_emit_expression (mcf::CMPL { lsrc=>operand1, rsrc=>operand2 }, notes);

                            cc; 
                        }

                    # Generate code for jumps:
                    #
                    also
                    fun do_goto (label_expression as tcf::LABEL (codelabel: lbl::Codelabel), _, notes)                                  # Simple and common case -- jump to single known destination.
                            => 
                            annotate_and_emit_expression (mcf::JMP (mcf::IMMED_LABEL label_expression, [codelabel]), notes);

                        do_goto (tcf::LABEL_EXPRESSION label_expression,  possible_destinations: List(lbl::Codelabel),  notes)          # possible_destinations will be empty if not known.
                            =>
                            annotate_and_emit_expression (mcf::JMP (mcf::IMMED_LABEL label_expression, possible_destinations), notes);

                        do_goto (ea, labs, notes)                                                                                               # Arbitrary computed goto.   "ea" == "effective address".
                            =>
                            annotate_and_emit_expression (mcf::JMP (operand ea, labs), notes);
                    end 

                    # Convert tcf::Expression to registerset:
                    #
                    also
                    fun tcfexpression_to_registerset expression
                        =
                        g (expression, rgk::empty_codetemplists)
                        where
                            add_ccreg = rkj::cls::add_codetemp_to_appropriate_kindlist;
                            #
                            fun g ([], acc) => acc;
                                g (tcf::INT_EXPRESSION   (tcf::CODETEMP_INFO(_, r)) ! regs, acc)  => g (regs, rgk::add_codetemp_info_to_appropriate_kindlist (r, acc));
                                g (tcf::FLOAT_EXPRESSION (tcf::CODETEMP_INFO_FLOAT(_, f)) ! regs, acc) => g (regs, rgk::add_codetemp_info_to_appropriate_kindlist (f, acc));
                                #
                                g (tcf::FLAG_EXPRESSION (tcf::CC (_, cc)) ! regs, acc)  => g (regs, add_ccreg (cc, acc));       # flag expressions handle zero/parity/overflow/... flag stuff.
                                g (tcf::FLAG_EXPRESSION (tcf::FCC(_, cc)) ! regs, acc)  => g (regs, add_ccreg (cc, acc));
                                g(_ ! regs, acc) => g (regs, acc);
                            end;
                        end

                    # Generate code for calls:
                    # 
                    also
                    fun do_call (ea, flow, def, uses, ramregion, cuts_to, notes, pops)
                        = 
                        annotate_and_emit_expression
                          (
                            mcf::CALL
                              {
                                operand => operand      ea,
                                #
                                defs    => tcfexpression_to_registerset  def,
                                uses    => tcfexpression_to_registerset  uses,
                                #
                                return  =>  return  (rgk::empty_codetemplists, notes),
                                #
                                cuts_to,
                                ramregion,
                                pops
                              },

                            notes
                          )
                        where
                            fun return (set, [])
                                    =>
                                    set;

                                return (set, a ! notes)
                                    =>
                                    case (lnt::return_arg.peek a)
                                        #
                                        THE r =>   return (rkj::cls::add_codetemp_to_appropriate_kindlist (r, set), notes);
                                        NULL  =>   return (set, notes);
                                    esac;
                            end;
                        end

                    # Generate code for integer stores; first move data to %eax 
                    # This is mainly because we can't allocate to registers like
                    # ah, dl, dx etc.
                    #
                    also
                    fun gen_store (mv_op, ea, d, ramregion, notes)
                        =
                        {   src = 
                               case (immed_or_reg (operand d))
                                    #
                                    src as mcf::DIRECT r
                                        =>
                                        if (rkj::codetemps_are_same_color (r, rgk::eax))
                                            #
                                            src;
                                        else
                                            move (src, eax);
                                            eax;
                                        fi;

                                    src => src;
                               esac;

                            annotate_and_emit_expression (mcf::MOVE { mv_op, src, dst=>address (ea, ramregion) }, notes);
                        }

                    # Generate code for 8-bit integer stores 
                    # movb has to use %eax as source. Stupid intel32! 
                    #
                    also
                    fun store8 (ea, d, ramregion, notes)
                        =
                        gen_store (mcf::MOVB, ea, d, ramregion, notes)


                    also
                    fun store16 (ea, d, ramregion, notes)
                        = 
                        annotate_and_emit_expression
                          (
                            mcf::MOVE
                              {
                                mv_op =>  mcf::MOVW,
                                src   =>  immed_or_reg (operand d),
                                dst   =>  address (ea, ramregion)
                              },
                            notes
                          )


                    also
                    fun store32 (ea, d, ramregion, notes)
                        = 
                        move'
                          ( immed_or_reg (operand d),
                            address (ea, ramregion),
                            notes
                          )

                    # Generate code for branching:
                    #
                    also
                    fun branch (tcf::CMP (type, cc, t1, t2), lab, notes)
                            =>
                            #  Allow reordering of operands: 
                            #
                            {   cc = cmp (TRUE, type, cc, t1, t2, []); 
                                #
                                annotate_and_emit_expression
                                  (
                                    mcf::JCC  {  cond => cond cc,  operand => immed_label lab  },
                                    notes
                                  );
                            };

                        branch (tcf::FCMP (fty, fcc, t1, t2), lab, notes)
                            => 
                            fbranch (fty, fcc, t1, t2, lab, notes);

                        branch (flag_expression, lab, notes)
                            =>
                            {   do_flag_expression (flag_expression, rgk::eflags, []);
                                #
                                annotate_and_emit_expression
                                  (
                                    mcf::JCC
                                      {
                                        cond    =>  cond (tct::cond_of flag_expression),
                                        operand =>  immed_label lab
                                      },
                                    notes
                                  );
                            };
                    end 


                    # Generate code for floating point
                    # compare and branch:
                    # 
                    also
                    fun fbranch (fty, fcc, t1, t2, lab, notes)
                        = 
                        {   fun j cc
                                =
                                annotate_and_emit_expression
                                  (
                                    mcf::JCC  {  cond => cc,  operand => immed_label lab  },
                                    notes
                                  );
                            #
                            fbranching (fty, fcc, t1, t2, j);
                        }

                    also
                    fun fbranching (fty, fcc, t1, t2, j)
                        = 
                        {   fun ignore_order (tcf::CODETEMP_INFO_FLOAT _) => TRUE;
                                ignore_order (tcf::FLOAD _) => TRUE;
                                ignore_order (tcf::FNOTE (e, _)) => ignore_order e;
                                ignore_order _ => FALSE;
                            end;

                            #
                            fun compare'()              #  Sethi-Ullman style
                                = 
                                {   if (   ignore_order t1
                                       or  ignore_order t2
                                       )

                                        reduce_float_expression (fty, t2, []);
                                        reduce_float_expression (fty, t1, []);
                                    else
                                        reduce_float_expression (fty, t1, []);
                                        reduce_float_expression (fty, t2, []); 
                                        put_base_op (mcf::FXCH { operand=>rgk::st (1) });
                                    fi;

                                    put_base_op  mcf::FUCOMPP;
                                    fcc;
                                };
                            #
                            fun compare''()
                                = 
                                # Direct style 
                                # Try to make lsrc the memory operand
                                #
                                {   lsrc = foperand (fty, t1);
                                    rsrc = foperand (fty, t2);
                                    fsize = fsize fty;
                                    #
                                    fun cmp (lsrc, rsrc, fcc)
                                        =
                                        {   i = *architecture != PENTIUM;    
                                            put_base_op (mcf::FCMP { i, fsize, lsrc, rsrc } );
                                            fcc;
                                        };

                                    case (lsrc, rsrc)
                                        #
                                        (mcf::FPR _, mcf::FPR _)
                                            =>
                                            cmp (lsrc, rsrc, fcc);

                                        (mcf::FPR _, mem)
                                            =>
                                            cmp (mem, lsrc, tcp::swap_fcond fcc);

                                        (mem, mcf::FPR _)
                                            =>
                                            cmp (lsrc, rsrc, fcc);

                                        (lsrc, rsrc)            #  Can't be both memory! 
                                            =>
                                            {   ftmp_r = make_float_codetemp_info();
                                                ftmp  = mcf::FPR ftmp_r;
                                                put_base_op (mcf::FMOVE { fsize, src=>rsrc, dst=>ftmp } );
                                                cmp (lsrc, ftmp, fcc);
                                            };
                                    esac;
                                };
                            #
                            fun compare ()
                                = 
                                if (enable_fast_fpmode  and  *fast_floating_point)
                                     #
                                     compare''();
                                else compare' ();
                                fi;
                            #
                            fun andil  i =  put_base_op (mcf::BINARY { bin_op=>mcf::ANDL, src=>mcf::IMMED (i), dst=>eax } );
                            fun testil i =  put_base_op (mcf::TESTL  { lsrc=>eax, rsrc=>mcf::IMMED (i) } );
                            fun xoril  i =  put_base_op (mcf::BINARY { bin_op=>mcf::XORL, src=>mcf::IMMED (i), dst=>eax } );
                            fun cmpil  i =  put_base_op (mcf::CMPL   { rsrc=>mcf::IMMED (i), lsrc=>eax } );
                            fun sahf  () =  put_base_op (mcf::SAHF);
                            #
                            fun branch fcc
                                =
                                case fcc
                                    #
                                    tcf::FEQ   => { andil 0x4400; xoril 0x4000; j (mcf::EQ);};
                                    tcf::FNEU  => { andil 0x4400; xoril 0x4000; j (mcf::NE);};
                                    tcf::FUO   => { sahf(); j (mcf::PP);};
                                    tcf::FGLE  => { sahf(); j (mcf::NP);};
                                    tcf::FGT   => { testil 0x4500;  j (mcf::EQ);};
                                    tcf::FLEU  => { testil 0x4500;  j (mcf::NE);};
                                    tcf::FGE   => { testil 0x500; j (mcf::EQ);};
                                    tcf::FLTU  => { testil 0x500; j (mcf::NE);};
                                    tcf::FLT   => { andil 0x4500; cmpil 0x100; j (mcf::EQ);};
                                    tcf::FGEU  => { andil 0x4500; cmpil 0x100; j (mcf::NE);};
                                    tcf::FLE   => { andil 0x4100; cmpil 0x100; j (mcf::EQ);
                                                    cmpil 0x4000; j (mcf::EQ);
                                                  };
                                    tcf::FGTU  => { sahf(); j (mcf::PP); testil 0x4100; j (mcf::EQ);};
                                    tcf::FNE   => { testil 0x4400; j (mcf::EQ);};
                                    tcf::FEQU  => { testil 0x4400; j (mcf::NE);};
                                    #
                                    _          => error (cat [
                                                  "fbranch(", tcp::fcond_to_string fcc, ")"
                                                ]);
                                esac;



                            #             P  Z  C
                            # x < y       0  0  1
                            # x > y       0  0  0
                            # x = y       0  1  0
                            # unordered   1  1  1
                            # When it's unordered, all three flags, P, Z, C are set.
                            #
                            fun fast_branch  fcc
                                =
                                case fcc
                                    #
                                    tcf::FEQ  =>  ordered_only (mcf::EQ);
                                    tcf::FNEU =>  { j (mcf::PP); j (mcf::NE);};
                                    tcf::FUO  =>  j (mcf::PP);
                                    tcf::FGLE =>  j (mcf::NP);
                                    tcf::FGT  =>  ordered_only (mcf::AA);
                                    tcf::FLEU =>  j (mcf::BE);
                                    tcf::FGE  =>  ordered_only (mcf::AE);
                                    tcf::FLTU =>  j (mcf::BB);
                                    tcf::FLT  =>  ordered_only (mcf::BB);
                                    tcf::FGEU =>  { j (mcf::PP); j (mcf::AE);};
                                    tcf::FLE  =>  ordered_only (mcf::BE);
                                    tcf::FGTU =>  { j (mcf::PP); j (mcf::AA);};
                                    tcf::FNE  =>  ordered_only (mcf::NE);
                                    tcf::FEQU =>  j (mcf::EQ);
                                    #
                                    _       =>  error (cat [
                                                  "fbranch(", tcp::fcond_to_string fcc, ")"
                                                ]);
                                esac

                            also
                            fun ordered_only fcc
                                =
                                {   label = lbl::make_anonymous_codelabel ();
                                    #
                                    put_base_op (mcf::JCC  {  cond => mcf::PP,  operand => immed_label label  } );
                                    #
                                    j fcc;
                                    #
                                    buf.put_private_label label;
                                };

                            fcc = compare ();

                            if (   *architecture != PENTIUM
                               and (enable_fast_fpmode and *fast_floating_point)
                               )

                                fast_branch  fcc;
                            else
                                put_base_op mcf::FNSTSW;   
                                branch  fcc;
                            fi;
                        }

                    # ========================================================
                    # Floating point code generation starts here.
                    # Some generic fp routines first.
                    # ========================================================

                    # Can this tree be folded into the src operand of a floating point
                    # operations?
                    #
                    also
                    fun foldable_float_expression (tcf::CODETEMP_INFO_FLOAT _) => TRUE;
                        foldable_float_expression (tcf::FLOAD _) => TRUE;
                        foldable_float_expression (tcf::INT_TO_FLOAT(_, (16 | 32), _)) => TRUE;
                        foldable_float_expression (tcf::FLOAT_TO_FLOAT(_, _, t)) => foldable_float_expression t;
                        foldable_float_expression (tcf::FNOTE (t, _)) => foldable_float_expression t;
                        foldable_float_expression _ => FALSE;
                    end 

                    # Move integer e of size type into a memory location.
                    # Returns a quadruple: 
                    # (INTEGER, return type, effect address of memory location, cleanup code) 
                    #
                    also
                    fun convert_int_to_float (type, e)
                        = 
                        {   operand = operand e; 

                            if (is_mem_operand operand and (type == 16 or type == 32))
                                #
                                (INTEGER, type, operand, []);
                            else 
                                (convert_int_to_float_in_registers { type, src=>operand, ref_notes => buf.get_notes() })
                                    ->
                                    { ops, temp_mem, cleanup };

                                put_ops  ops;

                                (INTEGER, 32, temp_mem, cleanup);
                            fi;
                        }


                    ##########################################################
                    # Sethi-Ullman based floating point code
                    # generation as implemented by Lal George
                    ##########################################################

                    also
                    fun fld (32, operand) =>  mcf::FLDS  operand;
                        fld (64, operand) =>  mcf::FLDL  operand;
                        fld (80, operand) =>  mcf::FLDT  operand;
                        fld _             =>  error "fld";
                    end 

                    also
                    fun fild (16, operand) =>  mcf::FILD   operand;
                        fild (32, operand) =>  mcf::FILDL  operand;
                        fild (64, operand) =>  mcf::FILDLL operand;
                        #
                        fild _             => error "fild";
                    end 

                    also
                    fun fxld (INTEGER, type, operand) =>  fild (type, operand);
                        fxld (FLOAT,   fty,  operand) =>  fld  (fty,  operand);
                    end 

                    also
                    fun fstp (32, operand) =>  mcf::FSTPS  operand;
                        fstp (64, operand) =>  mcf::FSTPL  operand;
                        fstp (80, operand) =>  mcf::FSTPT  operand;
                        #
                        fstp _             =>  error "fstp";
                    end 

                    # Generate code for floating point stores:
                    #
                    also
                    fun fstore'(fty, ea, d, ramregion, notes)
                        = 
                        {   case d
                                #
                                tcf::CODETEMP_INFO_FLOAT (fty, fs) =>   put_base_op (fld (fty, mcf::FDIRECT fs));
                                _                   =>   reduce_float_expression (fty, d, []);
                            esac;

                            annotate_and_emit_expression (fstp (fty, address (ea, ramregion)), notes);
                        }

                    # Generate code for floating point loads:
                    #
                    also
                    fun fload'(fty, ea, ramregion, fd, notes)
                        = 
                        {   ea = address (ea, ramregion);

                            annotate_and_emit_expression (fld (fty, ea), notes); 

                            if (rkj::codetemps_are_same_color (fd, st0))
                                #
                                put_base_op (fstp (fty, mcf::FDIRECT fd));
                            fi;
                        }

                    also
                    fun float_expression' e
                        =
                        {   reduce_float_expression (64, e, []);
                            rgk::st (0);
                        }

                    also                                                                                                # Compute value of expression to 'fty'-bit precision, leave result in 'to_reg'.
                    fun do_float_expression' (fty, tcf::CODETEMP_INFO_FLOAT(_, fs), to_reg, notes)                      # This is "slow" floating point -- for "fast" see:  do_float_expression''
                            => 
                            if (rkj::codetemps_are_same_color (fs, to_reg))                             # What happens if they are not the same color? -- 2011-06-02 CrT
                                #
                                annotate_and_emit_expression'
                                  (
                                    mcf::COPY
                                      { kind         =>  rkj::FLOAT_REGISTER,
                                        size_in_bits =>  64,                                                            # Ignoring all input size-in-bitss info!
                                        dst          => [to_reg],
                                        src          => [fs],
                                        tmp          => NULL
                                      },
                                    notes
                                  );
                            fi;

                        do_float_expression' (_, tcf::FLOAD (fty, ea, ramregion), to_reg, notes)
                            => 
                            fload' (fty, ea, ramregion, to_reg, notes);

                        do_float_expression' (fty, tcf::FEXT float_expression, to_reg, notes)
                            => 
                            {   txc::compile_fext (reducer()) { e=>float_expression, fd=>to_reg, notes };

                                if (not (rkj::codetemps_are_same_color (to_reg, st0)))
                                    #
                                    put_base_op (fstp (fty, mcf::FDIRECT to_reg));
                                fi;
                            };

                        do_float_expression' (fty, e, to_reg, notes)
                            =>
                            {   reduce_float_expression (fty, e, []);

                                if (rkj::codetemps_are_same_color (to_reg, st0))
                                    #
                                    annotate_and_emit_expression (fstp (fty, mcf::FDIRECT to_reg), notes);
                                fi;
                            };
                    end 


                    # Generate floating point expression using Sethi-Ullman's scheme:
                    # This function evaluates a floating point expression and leaves 
                    # the result in %ST (0) -- top of floating point stack.
                    #
                    # If you don't have a copy of the Dragon book you can refer to:
                    #
                    #     http://en.wikipedia.org/wiki/Sethi%E2%80%93Ullman_algorithm   
                    #
                    also
                    fun reduce_float_expression (fty, float_expression, notes) 
                        = 
                        {   st  =  mcf::ST (rgk::st 0);
                            st1 =  mcf::ST (rgk::st 1);

                            cleanup_code = REF [] : Ref(  List(  mcf::Machine_Op ) );

                            Su_Tree
                              = LEAF    (Int, tcf::Float_Expression, Ans)
                              | BINARY  (Int, tcf::Float_Bitsize, Fbinop, Su_Tree, Su_Tree, Ans)
                              | UNARY   (Int, tcf::Float_Bitsize, mcf::Fun_Op, Su_Tree, Ans)

                            also
                            Fbinop
                                =
                                FADD | FSUB | FMUL | FDIV | FIADD | FISUB | FIMUL | FIDIV
                            withtype Ans = note::Notes;
                            #
                            fun label (LEAF (n, _, _)) => n;
                                label (BINARY (n, _, _, _, _, _)) => n;
                                label (UNARY (n, _, _, _, _)) => n;
                            end;
                            #
                            fun annotate (LEAF (n, x, notes), a)  => LEAF (n, x, a ! notes);
                                annotate (BINARY (n, t, b, x, y, notes), a) => BINARY (n, t, b, x, y, a ! notes);
                                annotate (UNARY (n, t, u, x, notes), a) => UNARY (n, t, u, x, a ! notes);
                            end;

                            # Generate expression tree with sethi-ullman numbers:
                            # 
                            fun su (e as tcf::CODETEMP_INFO_FLOAT _)                      =>  LEAF (1, e, []);
                                su (e as tcf::FLOAD _)                    =>  LEAF (1, e, []);
                                su (e as tcf::INT_TO_FLOAT _)     =>  LEAF (1, e, []);

                                su (tcf::FLOAT_TO_FLOAT(_, _, t)) =>  su t;

                                su (tcf::FNOTE (t, a))       =>  annotate (su t, a);

                                su (tcf::FABS (fty, t))      =>  su_unary (fty, mcf::FABS, t);
                                su (tcf::FNEG (fty, t))      =>  su_unary (fty, mcf::FCHS, t);
                                su (tcf::FSQRT (fty, t))     =>  su_unary (fty, mcf::FSQRT, t);

                                su (tcf::FADD (fty, t1, t2)) =>  su_com_binary (fty, FADD, FIADD, t1, t2);
                                su (tcf::FMUL (fty, t1, t2)) =>  su_com_binary (fty, FMUL, FIMUL, t1, t2);

                                su (tcf::FSUB (fty, t1, t2)) =>  su_binary (fty, FSUB, FISUB, t1, t2);
                                su (tcf::FDIV (fty, t1, t2)) =>  su_binary (fty, FDIV, FIDIV, t1, t2);

                                su _ => error "su";
                            end 

                            # Try to fold the the memory operand
                            # or integer conversion:
                            #
                            also
                            fun su_fold (e as tcf::CODETEMP_INFO_FLOAT  _) =>  (LEAF (0, e, []),  FALSE);
                                su_fold (e as tcf::FLOAD _) =>  (LEAF (0, e, []),  FALSE);

                                su_fold (e as tcf::INT_TO_FLOAT(_, (16 | 32), _)) => (LEAF (0, e, []), TRUE);
                                su_fold (tcf::FLOAT_TO_FLOAT(_, _, t)) => su_fold t;

                                su_fold (tcf::FNOTE (t, a))
                                    => 
                                    {   my (t, integer) = su_fold t; 
                                        (annotate (t, a), integer);
                                    };

                                su_fold e
                                    =>
                                    (su e, FALSE);
                            end 

                            # Form unary tree:
                            #
                            also
                            fun su_unary (fty, funary, t)
                                = 
                                {   t = su t;
                                    UNARY (label t, fty, funary, t, []);
                                }

                            # Form binary tree:
                            #
                            also
                            fun su_binary (fty, binop, ibinop, t1, t2)
                                =
                                {   t1 = su t1;
                                    my (t2, integer) = su_fold t2;

                                    n1 = label t1;
                                    n2 = label t2;

                                    n  = if (n1==n2)  n1+1;
                                         else         int::max (n1, n2);
                                         fi;

                                    my_op =    integer ?? ibinop
                                                       ::  binop;

                                    BINARY (n, fty, my_op, t1, t2, []); 
                                }

                            # Try to fold in the operand if possible. 
                            # This only applies to commutative operations.
                            #
                            also
                            fun su_com_binary (fty, binop, ibinop, t1, t2)
                                =
                                {   my (t1, t2)
                                        =
                                        if (foldable_float_expression t2)
                                             (t1, t2);
                                        else (t2, t1);
                                        fi;

                                    su_binary (fty, binop, ibinop, t1, t2);
                                }

                            also
                            fun same_tree (LEAF(_, tcf::CODETEMP_INFO_FLOAT (t1, f1), []), 
                                         LEAF(_, tcf::CODETEMP_INFO_FLOAT (t2, f2), []))
                                    => 
                                    t1 == t2 and rkj::codetemps_are_same_color (f1, f2);

                                same_tree _
                                    =>
                                    FALSE;
                            end;



                            # Traverse tree and generate code 
                            #
                            fun gencode (LEAF(_, t, notes))
                                    =>
                                    annotate_and_emit_expression (fxld (leaf_ea t), notes);

                                gencode (BINARY(_, _, binop, x, t2 as LEAF (0, y, a1), a2))
                                    => 
                                    {   gencode x;

                                        (leaf_ea  y) ->   (_, fty, src);
                                        #
                                        fun gen (code)
                                            =
                                            annotate_and_emit_expression (code, a1 @ a2);

                                        #
                                        fun binary (oper32, oper64)
                                            =
                                            if (same_tree (x, t2))
                                                #
                                                gen (mcf::FBINARY { bin_op=>oper64, src=>st, dst=>st } );
                                            else
                                                op =    if (not (is_mem_operand  src))
                                                            #
                                                            oper64;
                                                        else
                                                            case fty
                                                                #
                                                                32 =>  oper32;
                                                                64 =>  oper64;
                                                                _  =>  error "gencode: BINARY";
                                                            esac;
                                                        fi;

                                                gen (mcf::FBINARY { bin_op=>op, src, dst=>st } );
                                            fi;
                                        #
                                        fun ibinary (oper16, oper32)
                                            =
                                            gen (mcf::FIBINARY { bin_op, src } )
                                            where
                                                bin_op =    case fty
                                                                #
                                                                16 => oper16; 
                                                                32 => oper32; 
                                                                #
                                                                 _ => error "gencode: IBINARY";
                                                            esac;
                                            end;

                                        case binop
                                            #
                                            FADD  =>   binary (mcf::FADDS,  mcf::FADDL); 
                                            FSUB  =>   binary (mcf::FDIVS,  mcf::FSUBL); 
                                            FMUL  =>   binary (mcf::FMULS,  mcf::FMULL); 
                                            FDIV  =>   binary (mcf::FDIVS,  mcf::FDIVL); 
                                            FIADD =>  ibinary (mcf::FIADDS, mcf::FIADDL); 
                                            FISUB =>  ibinary (mcf::FIDIVS, mcf::FISUBL); 
                                            FIMUL =>  ibinary (mcf::FIMULS, mcf::FIMULL); 
                                            FIDIV =>  ibinary (mcf::FIDIVS, mcf::FIDIVL);
                                        esac; 
                                    };  

                                gencode (BINARY(_, fty, binop, t1, t2, notes))
                                    => 
                                    {   fun do_it (t1, t2, op, oper_p, oper_rp)
                                            = 
                                            {   # op[P] =>  st (1) := st op st (1); [pop] 
                                                # operR[P] => st (1) := st (1) op st; [pop]

                                                n1 = label t1;
                                                n2 = label t2;

                                                if (n1 < n2 and n1 <= 7)
                                                    #
                                                    gencode t2;
                                                    gencode t1;
                                                    annotate_and_emit_expression (mcf::FBINARY { bin_op=>oper_p, src=>st, dst=>st1 }, notes);
                                                    #
                                                elif (n2 <= n1 and n2 <= 7)
                                                    #
                                                    gencode t1;
                                                    gencode t2;
                                                    annotate_and_emit_expression (mcf::FBINARY { bin_op=>oper_rp, src=>st, dst=>st1 }, notes);
                                                else 
                                                    #  Both labels > 7 
                                                    fs = mcf::FDIRECT (make_float_codetemp_info());
                                                    gencode t2;
                                                    put_base_op (fstp (fty, fs));
                                                    gencode t1;
                                                    annotate_and_emit_expression (mcf::FBINARY { bin_op=>op, src=>fs, dst=>st }, notes);
                                                fi;
                                           };

                                        case  binop
                                            #
                                            FADD => do_it (t1, t2, mcf::FADDL, mcf::FADDP, mcf::FADDP);
                                            FMUL => do_it (t1, t2, mcf::FMULL, mcf::FMULP, mcf::FMULP);
                                            FSUB => do_it (t1, t2, mcf::FSUBL, mcf::FSUBP, mcf::FSUBRP);
                                            FDIV => do_it (t1, t2, mcf::FDIVL, mcf::FDIVP, mcf::FDIVRP);
                                            #
                                            _ => error "gencode::BINARY";
                                        esac;
                                    };

                                gencode (UNARY(_, _, unary_op, su, notes))
                                    => 
                                    {   gencode (su);
                                        annotate_and_emit_expression (mcf::FUNARY (unary_op), notes);
                                    };
                            end 

                            # Generate code for a leaf.
                            # Returns the type and an effective address
                            #
                            also
                            fun leaf_ea (tcf::CODETEMP_INFO_FLOAT (fty, f))        => (FLOAT, fty, mcf::FDIRECT f);
                                leaf_ea (tcf::FLOAD (fty, ea, ramregion)) => (FLOAT, fty, address (ea, ramregion));

                                leaf_ea (tcf::INT_TO_FLOAT(_, 32, t)) => int2real (32, t);
                                leaf_ea (tcf::INT_TO_FLOAT(_, 16, t)) => int2real (16, t);
                                leaf_ea (tcf::INT_TO_FLOAT(_, 8, t))  => int2real (8, t);

                                leaf_ea _ => error "leafEA";
                            end 

                            also
                            fun int2real (type, e)
                                = 
                                {   (convert_int_to_float (type, e))
                                        ->
                                        (_, type, ea, cleanup);

                                    cleanup_code :=  *cleanup_code @ cleanup;

                                    (INTEGER, type, ea);
                                };

                            gencode (su float_expression);

                            put_ops *cleanup_code;
                        }                               # reduceFexp

                    # ========================================================
                    # This section generates 3-address style floating 
                    # point code.  
                    # ========================================================

                    also
                    fun isize 16 => mcf::INT16;
                        isize 32 => mcf::INT1;
                        isize _  => error "isize";
                    end 

                    also
                    fun fstore''(fty, ea, d, ramregion, notes)                                                          # "fast" floating point; for "slow" see:  fstore' 
                        = 
                        {   floating_point_used := TRUE;

                            annotate_and_emit_expression
                              (
                                mcf::FMOVE { fsize => fsize fty,
                                            dst   => address (ea, ramregion), 
                                            src   => foperand (fty, d)
                                          },
                                notes
                              );
                        }

                    also
                    fun fload''(fty, ea, ramregion, d, notes)
                        = 
                        {   floating_point_used := TRUE;

                            annotate_and_emit_expression (mcf::FMOVE { fsize=>fsize fty, src=>address (ea, ramregion), dst=>ea_of_float_reg d }, notes);
                        }

                    also
                    fun fiload''(ity, ea, d, notes)
                        = 
                        {   floating_point_used := TRUE;

                            annotate_and_emit_expression (mcf::FILOAD { isize=>isize ity, ea, dst=>ea_of_float_reg d }, notes);
                        }

                    also
                    fun float_expression''(e as tcf::CODETEMP_INFO_FLOAT(_, f))
                            => 
                            if (is_framreg f)  trans_float_expression e;
                            else                f;
                            fi;

                        float_expression'' e
                            =>
                            trans_float_expression e;
                    end 

                    also
                    fun trans_float_expression e
                        = 
                        {   to_reg = make_float_codetemp_info();
                            do_float_expression'' (64, e, to_reg, []);
                            to_reg;
                        }


                    # Process a floating point operand.
                    # Put operand in register when possible.
                    # The operand should match the given fty.
                    #
                    also
                    fun foperand (fty, e as tcf::CODETEMP_INFO_FLOAT (fty', f))
                            => 
                            if (fty == fty')   ea_of_float_reg f;
                            else               mcf::FPR (float_expression'' e);
                            fi;

                        foperand (fty, tcf::FLOAT_TO_FLOAT(_, _, e))
                            =>
                            foperand (fty, e); #  nop on the intel32 

                        foperand (fty, e as tcf::FLOAD (fty', ea, ramregion))
                            => 
                            # Fold operand when
                            # the precison matches:
                            #
                            if (fty == fty')   address (ea, ramregion);
                            else               mcf::FPR (float_expression'' e);
                            fi;

                        foperand (fty, e)
                            =>
                            mcf::FPR (float_expression'' e);
                    end 


                    # Process a floating point operand. 
                    # Try to fold in a memory operand or
                    # conversion from an integer:
                    #
                    also
                    fun fioperand (tcf::CODETEMP_INFO_FLOAT  (fty, f))      => (FLOAT, fty, ea_of_float_reg f, []);
                        fioperand (tcf::FLOAD (fty, ea, ramregion)) => (FLOAT, fty, address (ea, ramregion), []);
                        #
                        fioperand (tcf::FLOAT_TO_FLOAT(_, _,  e)) =>  fioperand e;                              # Nop on intel32.
                        fioperand (tcf::INT_TO_FLOAT(_, type, e)) =>  convert_int_to_float (type, e);
                        #
                        fioperand (tcf::FNOTE (e, notes)) => fioperand (e); #  XXX 
                        fioperand (e) => (FLOAT, 64, mcf::FPR (float_expression'' e), []);
                    end 

                    # Generate binary operator.
                    #
                    # Since the real binary operators
                    # do not take memory as destination,
                    # we must ensure this does not happen:
                    #
                    also
                    fun fbinop (target_fty, bin_op, bin_op_r, ibin_op, ibin_op_r, lsrc, rsrc, fd, notes)
                        = 
                        #  Put the mem operand in rsrc 
                        { 
                            fun is_mem_operand (tcf::CODETEMP_INFO_FLOAT(_, f)) =>  is_framreg f;

                                is_mem_operand (tcf::FLOAD _                ) => TRUE;
                                is_mem_operand (tcf::INT_TO_FLOAT(_, (16 | 32), _)) => TRUE;

                                is_mem_operand (tcf::FLOAT_TO_FLOAT(_, _, t)) => is_mem_operand t;
                                is_mem_operand (tcf::FNOTE (t, _)   ) => is_mem_operand t;

                                is_mem_operand _ => FALSE;
                            end;

                            my (bin_op, ibin_op, lsrc, rsrc)
                                = 
                                if (is_mem_operand lsrc)
                                     (bin_op_r, ibin_op_r, rsrc, lsrc);
                                else (bin_op, ibin_op, lsrc, rsrc);
                                fi;

                            lsrc = foperand (target_fty, lsrc);

                            my (kind, fty, rsrc, code)
                                =
                                fioperand  rsrc;
                            #
                            fun dst_must_be_freg f
                                =
                                if (target_fty == 64)
                                    #
                                    annotate_and_emit_expression (f(ea_of_float_reg fd), notes);
                                else
                                    tmp_r = make_float_codetemp_info(); 
                                    tmp  = mcf::FPR tmp_r;

                                    annotate_and_emit_expression (f tmp, notes); 

                                    put_base_op (mcf::FMOVE { fsize => fsize target_fty, 
                                                         src   => tmp,
                                                         dst   => ea_of_float_reg fd
                                                       }
                                           );

                                fi;

                            case kind
                                #
                                FLOAT => 
                                    dst_must_be_freg (fn dst
                                                         =
                                                         mcf::FBINOP { fsize  => fsize fty,
                                                                     bin_op, lsrc, rsrc, dst
                                                                   }
                                                     ); 
                                INTEGER => 
                                    {   dst_must_be_freg
                                            (fn dst =
                                                 mcf::FIBINOP { isize=>isize fty, bin_op=>ibin_op, 
                                                              lsrc, rsrc, dst
                                                            }
                                            );

                                        put_ops code;
                                    };
                            esac;
                        }

                    also
                    fun funop (fty, un_op, src, fd, notes)
                        = 
                        {   src = foperand (fty, src);

                            annotate_and_emit_expression (mcf::FUNOP { fsize=>fsize fty, un_op, src, dst=>ea_of_float_reg fd }, notes);
                        }

                    also
                    fun do_float_expression'' (fty, expression, to_reg, notes)                                  # Compute value of 'expression' to 'fty'-bit precision, leave result in 'to_reg'.
                        =                                                                                       # This is "fast" floating point (currently the norm) -- for "slow" (vanilla) floating point see:  do_float_expression'
                        {   floating_point_used := TRUE;

                            case expression
                                #
                                tcf::CODETEMP_INFO_FLOAT(_, fs)
                                    =>
                                    if (not (rkj::codetemps_are_same_color (fs, to_reg) ))
                                        #
                                        copy_floats'' (fty, [to_reg], [fs], notes);
                                    fi;

                                # Intel32 (x86) does everything as 80-bits internally. 

                                # Binary operators:
                                #
                                tcf::FADD (_, a, b) =>  fbinop (fty, mcf::FADDL, mcf::FADDL,  mcf::FIADDL, mcf::FIADDL,  a, b, to_reg, notes);
                                tcf::FSUB (_, a, b) =>  fbinop (fty, mcf::FSUBL, mcf::FSUBRL, mcf::FISUBL, mcf::FISUBRL, a, b, to_reg, notes);
                                tcf::FMUL (_, a, b) =>  fbinop (fty, mcf::FMULL, mcf::FMULL,  mcf::FIMULL, mcf::FIMULL,  a, b, to_reg, notes);
                                tcf::FDIV (_, a, b) =>  fbinop (fty, mcf::FDIVL, mcf::FDIVRL, mcf::FIDIVL, mcf::FIDIVRL, a, b, to_reg, notes);

                                # Unary operators:
                                #
                                tcf::FNEG  (_, a) =>  funop (fty, mcf::FCHS,  a, to_reg, notes);
                                tcf::FABS  (_, a) =>  funop (fty, mcf::FABS,  a, to_reg, notes);
                                tcf::FSQRT (_, a) =>  funop (fty, mcf::FSQRT, a, to_reg, notes);

                                # Load:
                                #
                                tcf::FLOAD (fty, ea, ramregion) => fload''(fty, ea, ramregion, to_reg, notes);

                                # Type conversions:
                                #
                                tcf::FLOAT_TO_FLOAT(_, _, e) => do_float_expression''(fty, e, to_reg, notes);
                                tcf::INT_TO_FLOAT(_, type, e)
                                    => 
                                    {   (convert_int_to_float (type, e))
                                            ->
                                            (_, type, ea, cleanup);

                                        fiload'' (type, ea, to_reg, notes); 

                                        put_ops cleanup;
                                    };

                                tcf::FNOTE (e, lnt::MARKREG f)
                                    =>
                                    {   f to_reg;
                                        #
                                        do_float_expression'' (fty, e, to_reg, notes);
                                    };

                                tcf::FNOTE (e, a) => do_float_expression''(fty, e, to_reg, a ! notes);
                                tcf::FPRED (e, c) => do_float_expression''(fty, e, to_reg, lnt::CONTROL_DEPENDENCY_USE c ! notes);

                                tcf::FEXT float_expression
                                    =>
                                    txc::compile_fext (reducer()) { e=>float_expression, fd=>to_reg, notes };

                                _ => error("doFexpr''");
                            esac;
                    }

                    ###################################################
                    # Tie the two styles of fp code generation together
                    ###################################################
                    also
                    fun fstore (fty, ea, d, ramregion, notes)
                        = 
                        if (enable_fast_fpmode and *fast_floating_point)   fstore''(fty, ea, d, ramregion, notes);
                        else                                               fstore' (fty, ea, d, ramregion, notes);
                        fi

                    also
                    fun fload (fty, ea, d, ramregion, notes)
                        = 
                        if (enable_fast_fpmode and *fast_floating_point)
                             fload''(fty, ea, d, ramregion, notes);
                        else fload' (fty, ea, d, ramregion, notes);
                        fi

                    also
                    fun float_expression e
                        = 
                        if  (enable_fast_fpmode
                        and *fast_floating_point)
                             float_expression'' e;
                        else float_expression'  e;
                        fi

                    also
                    fun do_float_expression (fty, e, to_reg, notes)
                        = 
                        if (enable_fast_fpmode and *fast_floating_point)   do_float_expression'' (fty, e, to_reg, notes);
                        else                                               do_float_expression'  (fty, e, to_reg, notes);
                        fi

                    ##################################################################
                    # Speedups for x := x op y 
                    # Special speedups: 
                    # Generate a binary operator, result must in memory.
                    # The source must not be in memory
                    ##################################################################
                    also
                    fun binary_mem (bin_op, src, dst, ramregion, notes)
                        =
                        annotate_and_emit_expression
                          (
                            mcf::BINARY
                              {
                                bin_op,
                                src => immed_or_reg (operand src),
                                dst => address (dst, ramregion)
                              },

                            notes
                          )
                    also
                    fun unary_mem (un_op, operand, ramregion, notes)
                        =
                        annotate_and_emit_expression (mcf::UNARY { un_op, operand=>address (operand, ramregion) }, notes)

                    also
                    fun is_one (tcf::LITERAL n)   =>   n == 1;
                        is_one _ => FALSE;
                    end 


                    # Perform speedups based on recognizing 
                    #    x := x op y    or
                    #    x := y op x 
                    # first.
                    #
                    also
                    fun store (type, ea, d, ramregion, notes, 
                              { inc, dec, add, sub, notx, neg, shl, shr, sar, orx, andx, xor },
                              do_store
                             )
                        = 
                        {   fun default ()
                                =
                                do_store (ea, d, ramregion, notes);
                            #
                            fun binary1 (t, t', unary, binary, ea', x)
                                =
                                if (t == type and t' == type)
                                    #
                                    if (tcj::same_int_expression (ea, ea'))
                                        #
                                        if (is_one x)   unary_mem  (unary,     ea, ramregion, notes);
                                        else            binary_mem (binary, x, ea, ramregion, notes);
                                        fi;
                                    else
                                        default ();
                                    fi;
                                else
                                    default ();
                                fi;
                            #
                            fun unary (t, un_op, ea')
                                = 
                                if (t == type
                                and tcj::same_int_expression (ea, ea')
                                )
                                    unary_mem (un_op, ea, ramregion, notes);
                                else
                                    default ();
                                fi; 
                            #
                            fun binary (t, t', bin_op, ea', x)
                                =
                                if (    t == type
                                   and  t' == type
                                   and  tcj::same_int_expression (ea, ea')
                                )     
                                    binary_mem (bin_op, x, ea, ramregion, notes);
                                else
                                    default ();
                                fi;
                            #
                            fun binary_com1 (t, un_op, bin_op, x, y)
                                = 
                                if (t != type)
                                    #
                                    default ();
                                else
                                    fun again ()
                                        =
                                        case y
                                            #
                                            tcf::LOAD (type', ea', _)
                                                =>
                                                if (type' == type
                                                and tcj::same_int_expression (ea, ea')
                                                )
                                                     if (is_one x)  unary_mem  ( un_op,    ea, ramregion, notes);
                                                     else           binary_mem (bin_op, x, ea, ramregion, notes);
                                                     fi;
                                                else default();
                                                fi;

                                            _ => default();
                                        esac;

                                    case x
                                        #
                                        tcf::LOAD (type', ea', _)
                                            =>
                                            if (type' == type
                                            and tcj::same_int_expression (ea, ea')
                                            )
                                                 if (is_one y)   unary_mem  ( un_op,    ea, ramregion, notes);
                                                 else            binary_mem (bin_op, y, ea, ramregion, notes);
                                                 fi;
                                            else again();
                                            fi;

                                        _ => again();
                                    esac;
                                fi;
                            #
                            fun binary_com (t, bin_op, x, y)
                                = 
                                if (t != type)
                                    #
                                    default();
                                else
                                    fun again ()
                                        =
                                        case y
                                           #
                                            tcf::LOAD (type', ea', _)
                                                =>
                                                if (type' == type
                                                and tcj::same_int_expression (ea, ea')
                                                )
                                                    binary_mem (bin_op, x, ea, ramregion, notes);
                                                else
                                                    default ();
                                                fi;

                                           _ => default ();
                                        esac;

                                    case x    
                                        tcf::LOAD (type', ea', _)
                                            =>
                                            if (type' == type
                                            and tcj::same_int_expression (ea, ea')
                                            )
                                                binary_mem (bin_op, y, ea, ramregion, notes);
                                            else
                                                again ();
                                            fi;

                                        _ => again ();
                                    esac;

                                fi;

                            case d
                                #
                                tcf::ADD (t, x, y)                      =>  binary_com1 (t, inc, add, x, y);
                                tcf::SUB (t, tcf::LOAD (t', ea', _), x) =>  binary1 (t, t', dec, sub, ea', x);

                                tcf::BITWISE_OR  (t, x, y) =>  binary_com (t, orx,  x, y);
                                tcf::BITWISE_AND (t, x, y) =>  binary_com (t, andx, x, y);
                                tcf::BITWISE_XOR (t, x, y) =>  binary_com (t, xor,  x, y);

                                tcf::LEFT_SHIFT    (t, tcf::LOAD (t', ea', _), x) =>  binary (t, t', shl, ea', x);
                                tcf::RIGHT_SHIFT_U (t, tcf::LOAD (t', ea', _), x) =>  binary (t, t', shr, ea', x);
                                tcf::RIGHT_SHIFT   (t, tcf::LOAD (t', ea', _), x) =>  binary (t, t', sar, ea', x);

                                tcf::NEG         (t, tcf::LOAD (t', ea', _)) =>  unary (t, neg,  ea');
                                tcf::BITWISE_NOT (t, tcf::LOAD (t', ea', _)) =>  unary (t, notx, ea');
                                _ => default();
                            esac;
                        }                               # fun store 

                    # Generate code for a statement.
                    #
                    also
                    fun do_void_expression' (tcf::LOAD_INT_REGISTER                    (_,    rd, e), notes) =>  do_expression       (     e,  rd, notes);      # "rd"  == "destination int   register".
                        do_void_expression' (tcf::LOAD_FLOAT_REGISTER                  (fty,  fd, e), notes) =>  do_float_expression (fty, e,  fd, notes);      # "fd"  == "destination float register".
                        do_void_expression' (tcf::LOAD_INT_REGISTER_FROM_FLAGS_REGISTER     (ccd, e), notes) =>  do_flag_expression  (     e, ccd, notes);      # "ccd" == "destination int   registr".
                        #
                        do_void_expression' (tcf::MOVE_INT_REGISTERS                   (_, dst, src), notes) =>  copy_ints              (dst, src, notes);      # Parallel copy of N sources to N destinations.
                        do_void_expression' (tcf::MOVE_FLOAT_REGISTERS               (fty, dst, src), notes) =>  copy_floats       (fty, dst, src, notes);      # Parallel copy of N sources to N destinations.
                        #
                        do_void_expression' ( tcf::GOTO ( destination:                  tcf::Int_Expression,                                                    # Typically just a tcf::LABEL.
                                                          possible_destinations:        List( lbl::Codelabel )                                                  # possible_distinations is empty if unknown.
                                                        ),
                                              notes
                                            )
                            =>
                            do_goto (destination, possible_destinations, notes);

                        do_void_expression' (tcf::CALL { funct, targets, defs, uses, region, pops, ... }, notes)
                            =>
                            do_call (funct, targets, defs, uses, region, [], notes, pops);

                        do_void_expression' (tcf::FLOW_TO (tcf::CALL { funct, targets, defs, uses, region, pops, ... }, cut_to), notes)
                            => 
                            do_call (funct, targets, defs, uses, region, cut_to, notes, pops);

                        do_void_expression' (tcf::RET _, notes)
                            =>
                            annotate_and_emit_expression (mcf::RET NULL, notes);

                        do_void_expression' (tcf::STORE_INT    ( 8, ea, d, ramregion), notes) =>   store (  8, ea, d, ramregion, notes, opcodes8,  store8);
                        do_void_expression' (tcf::STORE_INT    (16, ea, d, ramregion), notes) =>   store ( 16, ea, d, ramregion, notes, opcodes16, store16);
                        do_void_expression' (tcf::STORE_INT    (32, ea, d, ramregion), notes) =>   store ( 32, ea, d, ramregion, notes, opcodes32, store32);
                        do_void_expression' (tcf::STORE_FLOAT (fty, ea, d, ramregion), notes) =>  fstore (fty, ea, d, ramregion, notes);

                        do_void_expression' (tcf::IF_GOTO (cc, lab), notes)                   =>   branch (cc, lab, notes);
                        do_void_expression' (tcf::DEFINE l, _)                                =>   buf.put_private_label l;

                        do_void_expression' (tcf::LIVE s, notes) =>  annotate_and_emit_expression'(mcf::LIVE { regs=>tcfexpression_to_registerset s, spilled=>rgk::empty_codetemplists }, notes);
                        do_void_expression' (tcf::DEAD s, notes) =>  annotate_and_emit_expression'(mcf::DEAD { regs=>tcfexpression_to_registerset s, spilled=>rgk::empty_codetemplists }, notes);

                        do_void_expression' (tcf::NOTE (s, a), notes)
                            =>
                            do_void_expression' (s, a ! notes);

                        do_void_expression' (tcf::EXT s, notes)
                            =>
                            txc::compile_sext (reducer()) { void_expression=>s, notes }; 

                        do_void_expression' (s, _)
                            =>
                            do_void_expressions (tct::compile_void_expression  s);
                    end 

                    also
                    fun do_void_expression   s                                  # This is our external 'put_op' entrypoint, used (in particular) in  src/lib/compiler/back/low/main/main/translate-nextcode-to-treecode-g.pkg
                      = do_void_expression' (s, [])

                    also
                    fun do_void_expressions ss
                        =
                        apply do_void_expression ss

                    also
                    fun start_new_cccomponent' _
                        =
                        {   # Must be cleared by the client.
                            # if rewrite_ramreg    ramregs_used := 0u0;   fi;    # No obvious variant on "ramregs_used" exists in the codebase.

                            floating_point_used :=   FALSE;

                            branch_on_overflow_instruction_and_label :=   NULL; 

                            buf.start_new_cccomponent  0;                       # The '0' is a dummy here; in some contexts the argument is used to size the codesegment buffer.
                        }

                    also
                    fun get_completed_cccomponent' a
                        =
                        {   case *branch_on_overflow_instruction_and_label
                                #
                                THE (_, codelabel)
                                    =>
                                    {   buf.put_private_label  codelabel;
                                        #
                                        put_base_op  mcf::INTO;                 # 64-bit issue:  Intel64 architecture eliminates INTO instruction (changes that opcode into a new instruction prefix byte).
                                    };

                                NULL =>  ();
                            esac;

                            # If floating point has been used,
                            # allocate an extra codetemp just
                            # in case we didn't use any explicit
                            # codetemps:
                            #
                            if *floating_point_used   make_float_codetemp_info ();   ();   fi;

                            buf.get_completed_cccomponent  a;
                       }

                    also
                    fun reducer ()
                        = 
                        tcs::REDUCER
                          {
                            reduce_int_expression   =>  expr,
                            reduce_float_expression =>  float_expression,
                            reduce_flag_expression  =>  cc_expr,
                            reduce_void_expression  =>  do_void_expression',
                            operand,
                            reduce_operand,
                            address_of              =>  fn e =  address (e, mcf::rgn::memory),          # XXX
                            put_op                  =>  annotate_and_emit_expression',
                            codestream              =>  buf, 
                            treecode_stream         =>  self() 
                           }

                    also
                    fun self ()
                        =
                        {
                          start_new_cccomponent =>  start_new_cccomponent',
                          get_completed_cccomponent     =>  get_completed_cccomponent',
                          put_op                =>  do_void_expression,
                          #
                          put_pseudo_op         =>  buf.put_pseudo_op,
                          put_private_label     =>  buf.put_private_label,
                          put_public_label      =>  buf.put_public_label,
                          put_comment           =>  buf.put_comment,
                          put_bblock_note       =>  buf.put_bblock_note,
                          get_notes             =>  buf.get_notes,
                          #
                          put_fn_liveout_info  =>  fn tcf_expr =  buf.put_fn_liveout_info (tcfexpression_to_registerset tcf_expr)
                       }: Treecode_Codebuffer;

                    self ();
                };                              # fun translate_treecode_to_machcode
        end;                                    # stipulate
    };                                          # generic package translate_treecode_to_machcode_intel32_g
end;                                            # stipulate





Comments and suggestions to: bugs@mythryl.org

PreviousUpNext