PreviousUpNext

15.4.290  src/lib/compiler/back/low/main/main/translate-nextcode-to-treecode-g.pkg

## translate-nextcode-to-treecode-g.pkg --- translate nextcode to treecode (and then all the way on down to execode -- raw binary executable machine code).
#
# 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 (a polymorphically typed lambda-calculus format) is the first backend code representation, used only transitionally.
#     4)  Anormcode (A-Normal format, which preserves expression tree structure) is the second backend code representation, and the first used for optimization.
#     5)  Nextcode ("continuation-passing style", a single-assignment basic-block-graph form where call and return are essentially the same) 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-PASSES.OVERVIEW
#
# This package implements the transition from the
# machine-independent backend tophalf centered on

#     src/lib/compiler/back/top/main/backend-tophalf-g.pkg 

# to the machine-dependent backend lowhalf centered on

#     src/lib/compiler/back/low/main/main/backend-lowhalf-g.pkg

# The lowhalf started out as MLRISC, a compiler-agnostic backend,
# and consequently knows nothing of such Mythryl-specific details
# as Tagged_Int tagging and heap-record tagging and layout, so much of
# our work in this file consists of translating such constructs
# into the low-level load/store/add/branch/... machinecode idiom.
#
# In more concrete terms, this package implements the translation
# from frontend Nextcode (aka "continuation passing style") down
# to backend "Treecode" code format.
#
# Subsequent translation from Treecode down to machcode format is
# delegated to one of
#
#     src/lib/compiler/back/low/pwrpc32/treecode/translate-treecode-to-machcode-pwrpc32-g.pkg
#     src/lib/compiler/back/low/sparc32/treecode/translate-treecode-to-machcode-sparc32-g.pkg
#     src/lib/compiler/back/low/intel32/treecode/translate-treecode-to-machcode-intel32-g.pkg
#
#
#
# Specific tasks performed in this file include:
#
#  o  Convert fun bodies from linear-sequence-of-instructions
#     form to tree form, by entering each codetemp definition
#     into the appropriate one of
#         codetemp_to_tcf_int_expression__hashtable
#         codetemp_to_tcf_float_expression__hashtable
#     and then retrieving those tree fragments as we encounter
#     later parts of the expression. (nextcode-form necessarily
#     computes expressions from the leafs upward, so we will
#     always encounter the leafs of each subexpression before
#     the root.
#        This treeification lets us later use the Sethi-Ullman
#     algorithm to re-linearize the code in such a way as to
#     minimize register pressure, basically by, for each binary
#     math op, computing the more complex operand first -- see
#         src/lib/compiler/back/low/intel32/treecode/translate-treecode-to-machcode-intel32-g.pkg
#     We also use Sethi-Ullman in:
#         src/lib/compiler/back/low/intel32/regor/regor-intel32-g.pkg
#     The tophalf has a (broken, unused) version in:
#         src/lib/compiler/back/top/lambdacode/generalized-sethi-ullman-reordering.pkg
#
#  o  Generate code to log all boxed updates to heap_changelog.
#     The heap_changelog is essentially a list of CONS cells
#     recording all stores of pointers into the heap; the 
#     heapcleaner uses it to track all pointers from old
#     heap generations into younger ones -- multigeneration
#     heapcleaning ("garbage collection") is impossible without
#     this information. (See calls to log_boxed_update_to_heap_changelog.)
#
#  o  Expand abstract slot accesses into concrete sequence of
#     ram-read instructions.  In more detail:
#
#     We try to pack closures into registers, but some won't fit,
#     so in general a closure can be a heap record.  In fact, we
#     share parts of some closures, so a complete closure can be
#     a depth-two tree of heap records. A related set of closures
#     is then technically a depth-two "lattice", since each leaf
#     may be referenced by multiple root records.
#
#     Nextcode refers to closure slots abstractly, suppressing
#     the lattice structure, but Treecode knows nothing about our
#     closure structure, so as part of Nextcode -> Treecode translation
#     we must translate each closure-slot reference into a concrete
#     series of load and add instructions that do the right memory
#     fetches from the right record offsets to return the desired value.
#     Closures are read-only so we don't have to handle slot writes.
#     (Search for VIA_SLOT.)
#
#
#  o  Compile Tagged_Int arithmetic operations down into sequences
#     of vanilla 32-bit integer operations.  (See fun tagged_*...)
#
#
#
#  o  The Nextcode distinction between signed and unsigned
#     operands goes away in Treecode, so the un/signed-agnostic
#     Nextcode binary operators get replaced by Treecode binary
#     operators which are explicitly signed or unsigned. (See
#     to_tcf_unsigned_compare and friends.)
#
#
#
#
# Our compiletime generic invocation is from
#
#     src/lib/compiler/back/low/main/main/backend-lowhalf-g.pkg
#
# which in particular passes us the
#
#     translate_machcode_cccomponent_to_execode                                 # "machcode" == "(abstract) machine code"
#                                                                               # "cccomponent" == "callgraph connected-component" (we compile them one at a time).
# function which is our runtime entrypoint into the
# back end.
#
#
#
# Runtime invocation of our (sole)
#
#     translate_nextcode_to_execode
#
# entrypoint is from
#
#     src/lib/compiler/back/top/main/backend-tophalf-g.pkg
#
# via the short wrapper at the bottom of
#
#     src/lib/compiler/back/low/main/main/backend-lowhalf-g.pkg


# In terms of lines-of-code, this file is utterly dominated by
#
#     fun translate_nextcode_to_execode -- 3500 of 4000 line
#
# which in turn is internally dominated by
#
#     fun translate_nextcode_cccomponent_to_treecode               -- 3200 of 4000 lines.

# The core function, and perhaps the best place to start
# reading, is
#
#     translate_nextcode_ops_to_treecode
#
#     "This version of translate_nextcode_to_treecode_g also
#      injects heapcleaner ("garbage-collector") types into
#      the backend lowhalf.
#      I've also reorganized it a bit and added a few comments
#      so that I can understand it."
#                               -- Allen Leung (?)

# Compiled by:
#     src/lib/compiler/core.sublib







###                   "Do not say a little in many words,
###                    but a great deal in a few."
###
###                                 -- Pythagoras (582-497 BCE)



stipulate
    package ds  =  deep_syntax;                                                 # deep_syntax                                           is from   src/lib/compiler/front/typer-stuff/deep-syntax/deep-syntax.pkg
    package err =  error_message;                                               # error_message                                         is from   src/lib/compiler/front/basics/errormsg/error-message.pkg
    package ncf =  nextcode_form;                                               # nextcode_form                                         is from   src/lib/compiler/back/top/nextcode/nextcode-form.pkg
    package pcs =  per_compile_stuff;                                           # per_compile_stuff                                     is from   src/lib/compiler/front/typer-stuff/main/per-compile-stuff.pkg
herein

    api Translate_Nextcode_To_Treecode {
        #
        translate_nextcode_to_execode
          :
          { nextcode_functions:         List( ncf::Function ),
            err:                        err::Plaint_Sink,
            source_name:                String,                                         # Typically filename, something like "<stdin>" if compiling interactively.
            per_compile_stuff:          pcs::Per_Compile_Stuff( ds::Declaration ),

            fun_id__to__max_resource_consumption                                                # Given
                :                                                                               # a
                ncf::Codetemp                                                                   # fun_id
                ->                                                                              # return
                { max_possible_heapwords_allocated_before_next_heaplimit_check: Int,            # max possible words of heap memory allocated on any path through function body, and
                  max_possible_nextcode_ops_run_before_next_heaplimit_check:    Int             # max possible nextcode instructions executed on any path through function body.
                }
          }
          ->
          (Void -> Int);

         # The result is a thunk computing the machinecode bytevector
         # offset for entrypoint corresponding to the first function
         # in nextcode_functions.
         #
         # The client must call 'finish' before forcing it.
    };
end;


                                                                                # Machine_Properties                                    is from   src/lib/compiler/back/low/main/main/machine-properties.api
stipulate
    package chi =  per_codetemp_heapcleaner_info;                               # per_codetemp_heapcleaner_info                         is from   src/lib/compiler/back/low/main/nextcode/per-codetemp-heapcleaner-info.pkg
    package coc =  compiler_controls;                                           # compiler_controls                                     is from   src/lib/compiler/toplevel/main/compiler-controls.pkg
    package ctl =  global_controls;                                             # global_controls                                       is from   src/lib/compiler/toplevel/main/global-controls.pkg
    package ds  =  deep_syntax;                                                 # deep_syntax                                           is from   src/lib/compiler/front/typer-stuff/deep-syntax/deep-syntax.pkg
    package fbp =  guess_nextcode_branch_probabilities;                         # guess_nextcode_branch_probabilities                   is from   src/lib/compiler/back/low/main/nextcode/guess-nextcode-branch-probabilities.pkg
    package ffc =  find_nextcode_cccomponents;                                  # find_nextcode_cccomponents                            is from   src/lib/compiler/back/low/main/nextcode/find-nextcode-cccomponents.pkg
    package iht =  int_hashtable;                                               # int_hashtable                                         is from   src/lib/src/int-hashtable.pkg
    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 lhn =  lowhalf_notes;                                               # lowhalf_notes                                         is from   src/lib/compiler/back/low/code/lowhalf-notes.pkg
    package ncf =  nextcode_form;                                               # nextcode_form                                         is from   src/lib/compiler/back/top/nextcode/nextcode-form.pkg
    package pb  =  pseudo_op_basis_type;                                        # pseudo_op_basis_type                                  is from   src/lib/compiler/back/low/mcg/pseudo-op-basis-type.pkg
    package pby =  probability;                                                 # probability                                           is from   src/lib/compiler/back/low/library/probability.pkg
    package pcs =  per_compile_stuff;                                           # per_compile_stuff                                     is from   src/lib/compiler/front/typer-stuff/main/per-compile-stuff.pkg
    package pl  =  paired_lists;                                                # paired_lists                                          is from   src/lib/std/src/paired-lists.pkg
    package ppn =  prettyprint_nextcode;                                        # prettyprint_nextcode                                  is from   src/lib/compiler/back/top/nextcode/prettyprint-nextcode.pkg
    package pt  =  nextcode_ramregions::pt;                                     # nextcode_ramregions                                   is from   src/lib/compiler/back/low/main/nextcode/nextcode-ramregions.pkg
    package rgn =  nextcode_ramregions;                                         # nextcode_ramregions                                   is from   src/lib/compiler/back/low/main/nextcode/nextcode-ramregions.pkg
    package rkj =  registerkinds_junk;                                          # registerkinds_junk                                    is from   src/lib/compiler/back/low/code/registerkinds-junk.pkg
    package uvf =  use_virtual_framepointer_in_cccomponent;                     # use_virtual_framepointer_in_cccomponent               is from   src/lib/compiler/back/low/main/main/use-virtual-framepointer-in-cccomponent.pkg
herein

    # This generic is invoked from:
    #
    #     src/lib/compiler/back/low/main/main/backend-lowhalf-g.pkg
    #   
    generic package   translate_nextcode_to_treecode_g   (
        #             ================================
        #                                                                       # machine_properties_intel32                            is from   src/lib/compiler/back/low/main/intel32/machine-properties-intel32.pkg
        #                                                                       # machine_properties_pwrpc32                            is from   src/lib/compiler/back/low/main/pwrpc32/machine-properties-pwrpc32.pkg
        #                                                                       # machine_properties_sparc32                            is from   src/lib/compiler/back/low/main/sparc32/machine-properties-sparc32.pkg
        package mp:  Machine_Properties;                                        # Machine_Properties                                    is from   src/lib/compiler/back/low/main/main/machine-properties.api

        package trx: Treecode_Extension_Mythryl;                                # Treecode_Extension_Mythryl                            is from   src/lib/compiler/back/low/main/nextcode/treecode-extension-mythryl.api

                                                                                # platform_register_info_intel32                        is from   src/lib/compiler/back/low/main/intel32/backend-lowhalf-intel32-g.pkg
                                                                                # platform_register_info_pwrpc32                        is from   src/lib/compiler/back/low/main/pwrpc32/backend-lowhalf-pwrpc32.pkg
                                                                                # platform_register_info_sparc32                        is from   src/lib/compiler/back/low/main/sparc32/backend-lowhalf-sparc32.pkg
        package pri: Platform_Register_Info                                     # Platform_Register_Info                                is from   src/lib/compiler/back/low/main/nextcode/platform-register-info.api
                    where                                                       # "pri" == "nextcode_registers".
                         tcf::rgn == nextcode_ramregions                        # "rgn" == "region"
                    also tcf::lac == late_constant                              # late_constant                                         is from   src/lib/compiler/back/low/main/nextcode/late-constant.pkg
                    also tcf::trx == trx;                                       # "trx" == "treecode_extension".
                                                                                # "tcf" == "treecode_form".

        package cpo: Client_Pseudo_Ops_Mythryl;                                 # Client_Pseudo_Ops_Mythryl                             is from   src/lib/compiler/back/low/main/nextcode/client-pseudo-ops-mythryl.api
                                                                                # "cpo" == "client_pseudo_op".
        package pop: Pseudo_Ops                                                 # Pseudo_Ops                                            is from   src/lib/compiler/back/low/mcg/pseudo-op.api
                     where                                                      # "pop" == "pseudo_ops".
                          tcf == pri::tcf                                       # "tcf" == "treecode_form".
                     also cpo == cpo;                                           # "cpo" == "client_pseudo_ops".

                                                                                # translate_treecode_to_machcode_intel32_g              is from   src/lib/compiler/back/low/intel32/treecode/translate-treecode-to-machcode-intel32-g.pkg
        package t2m: Translate_Treecode_To_Machcode                             # Translate_Treecode_To_Machcode                        is from   src/lib/compiler/back/low/treecode/translate-treecode-to-machcode.api
                     where                                                      # "t2m" == "translate_treecode_to_machcode".
                          tcs::tcf == pri::tcf                                  # "tcf" == "treecode_form".
                     also tcs::cst::pop == pop;                                 # "pop" == "pseudo_op".

        package mkg                                                             # make_machcode_codebuffer_g                            is from   src/lib/compiler/back/low/mcg/make-machcode-codebuffer-g.pkg
              : Make_Machcode_Codebuffer                                        # Make_Machcode_Codebuffer                              is from   src/lib/compiler/back/low/mcg/make-machcode-codebuffer.api
                where
                     cst == t2m::tcs::cst                                       # "cst" == "codestream".
                also mcf == t2m::mcf                                            # "mcf" == "machcode_form" (abstract machine code).
                also mcg == t2m::mcg;                                           # "mcg" == "machcode_controlflow_graph".

                                                                                # put_treecode_heapcleaner_calls_g                      is from   src/lib/compiler/back/low/main/nextcode/emit-treecode-heapcleaner-calls-g.pkg
        package ihc: Emit_Treecode_Heapcleaner_Calls                            # Emit_Treecode_Heapcleaner_Calls                       is from   src/lib/compiler/back/low/main/nextcode/emit-treecode-heapcleaner-calls.api
                     where                                                      # "ihc" == "insert_treecode_heapcleaner_calls".
                          tcs == t2m::tcs                                       # "tcs" == "treecode_stream".
                     also mcg == mkg::mcg;                                      # "mcg" == "machcode_controlflow_graph".

        package rgk: Registerkinds;                                             # Registerkinds                                         is from   src/lib/compiler/back/low/code/registerkinds.api

        package cal: Ccalls                                                     # Ccalls                                                is from   src/lib/compiler/back/low/ccalls/ccalls.api
                where                                                           # "cal" == "ccalls".
                    tcf == pri::tcf;                                            # "tcf" == "treecode_form".

        translate_machcode_cccomponent_to_execode
            :
            pcs::Per_Compile_Stuff( ds::Declaration )
            ->
            mkg::mcg::Machcode_Controlflow_Graph
            ->
            Void;
    )
    : (weak) Translate_Nextcode_To_Treecode                                     # Defined above.
    {
        stipulate
            package tag =  mp::heap_tags;                                       # Mythryl heapchunk tagwords.
            package tcf =  pri::tcf;                                            # "tcf" == "treecode_form".
            package tcs =  t2m::tcs;                                            # "tcs" == "treecode_stream".

            package cfa                                                         # "cfs" == "convert fun arguments"
                =
                convert_nextcode_fun_args_to_treecode_g (                       # convert_nextcode_fun_args_to_treecode_g               is from   src/lib/compiler/back/low/main/nextcode/convert-nextcode-fun-args-to-treecode-g.pkg
                    #
                    package pri =  pri;                                         # "pri" == "platform register info".
                    package mp  =  mp;                                          # "mp"  == "machine_properties".
                );

            # Decompose a package ("compilation unit")
            # callgraph into connected components:
            #
            package nfs                                                         # "nfs" == "nextcode_function_stack".
                =
                nextcode_function_stack_g ( tcf );                              # nextcode_function_stack_g                             is from   src/lib/compiler/back/low/main/nextcode/nextcode-function-stack-g.pkg


            package ma                                                          # Memory aliasing 
                =
                memory_aliasing_g (                                             # memory_aliasing_g                                     is from   src/lib/compiler/back/low/main/nextcode/memory-aliasing-g.pkg
                    #
                    package rgk = rgk;                                          # "rgk" == "registerkinds". 
                );

            package fcc                                                         #  C-Calls handling 
                =
                nextcode_c_calls_g (                                            # nextcode_c_calls_g                                    is from   src/lib/compiler/back/low/main/nextcode/nextcode-ccalls-g.pkg
                    #
                    package mp  =  mp;                                          # "mp"  == "machine_properties".
                    package pri =  pri;                                         # "pri" == "nextcode_registers".
                    package t2m =  t2m;                                         # "t2m" == "translate_treecode_to_machcode".
                    package rgk =  rgk;                                         # "rgk" == "registerkinds". 
                    package cal =  cal;                                         # "cal" == "ccalls".
                );
        herein
            #
            fun error msg
                =
                lem::error("translate_nextcode_to_treecode_g", msg);

            #  Debugging: 
            #
            fun print_nextcode_fun  nextcode_fn
                =
                {   ctl::print::say "*********************************************** \n";
                    ppn::print_nextcode_function nextcode_fn;
                    ctl::print::say "*********************************************** \n";
                    ctl::print::flush();
                };

            print =   ctl::print::say;

        


            ####################################################################
            # Heapcleaner ("garbage collection") safety.
            # This stuff matters only if
            #   lowhalf_track_heapcleaner_type_info
            # is TRUE, which it currently never is:

            package hr
                =                                                                       # How to annotate heapcleaner (garbage collector) information.
                codetemps_with_heapcleaner_info_g (                                     # codetemps_with_heapcleaner_info_g             is from   src/lib/compiler/back/low/heapcleaner-safety/codetemps-with-heapcleaner-info-g.pkg
                    #
                    package rgk =   rgk;                                                # "rgk" == "registerkinds".
                    package chi =  chi;                                                 # "chi" == "per_codetemp_heapcleaner_info".
                );


            no_opt = [lhn::no_optimization.x_to_note ()];

            #
            fun same_reg_as  x  y
                =
                rkj::same_id (x, y);

            ptr_type =  lhn::mark_reg.x_to_note (\\ r = hr::set_heapcleaner_info_on_codetemp_info (r, chi::ptr_type));                          # Boxed chunks 
            i32_type =  lhn::mark_reg.x_to_note (\\ r = hr::set_heapcleaner_info_on_codetemp_info (r, chi::i32_type));                          # untagged integers 
            i31_type =  lhn::mark_reg.x_to_note (\\ r = hr::set_heapcleaner_info_on_codetemp_info (r, chi::i31_type));                          # tagged integers 
            f64_type =  lhn::mark_reg.x_to_note (\\ r = hr::set_heapcleaner_info_on_codetemp_info (r, chi::f64_type));                          # untagged floats 
            #
            fun ncftype_to_note ncf::typ::INT     =>  i31_type; 
                ncftype_to_note ncf::typ::INT1    =>  i32_type; 
                ncftype_to_note ncf::typ::FLOAT64 =>  f64_type; 
                ncftype_to_note _                 =>  ptr_type;
            end; 

            # Convert kind+bitsize to heapcleaner type.
            # Kind is INT/UNT/FLOAT:
            #
            fun kind_and_size_to_heapcleaner_type (ncf::p::INT 31) =>  chi::i31_type;                                                                   # 64-bit issue: '31' is bits-per-tagged-int.
                kind_and_size_to_heapcleaner_type (ncf::p::UNT 31) =>  chi::i31_type;                                                                   # 64-bit issue: '31' is bits-per-tagged-unt.
                kind_and_size_to_heapcleaner_type (ncf::p::INT 32) =>  chi::i32_type;                                                                   # 64-bit issue: '31' is bits-per-tagged-int.
                kind_and_size_to_heapcleaner_type (ncf::p::UNT 32) =>  chi::i32_type;                                                                   # 64-bit issue: '31' is bits-per-tagged-unt.
                #
                kind_and_size_to_heapcleaner_type (_             ) =>  error "kind_and_size_to_heapcleaner_type";
            end; 
            #
            fun ncftype_to_heapcleaner_type (ncf::typ::FLOAT64) =>  chi::f64_type;
                ncftype_to_heapcleaner_type (ncf::typ::INT    ) =>  chi::i31_type;
                ncftype_to_heapcleaner_type (ncf::typ::INT1   ) =>  chi::i32_type;
                ncftype_to_heapcleaner_type _                   =>  chi::ptr_type;
            end;

            # Make a heapcleaner livein/liveout annotation. 
            # This is a list of  (register_id, heapcleaner_type) pairs:
            #   
            fun make_heapcleaner_liveinliveout_note
                  (
                    an,
                    args,                       # Formal args (i.e., parameters).
                    ncftypes                    # Types of formal args -- this list will always be same length as 'args'.
                  )
                =
                an (collect (args, ncftypes, []))
                where
                    fun collect   (  tcf::INT_EXPRESSION ( tcf::CODETEMP_INFO(_, r)) ! args,   ncftype ! ncftypes,   results) =>    collect  (args,  ncftypes,   (r, ncftype_to_heapcleaner_type ncftype) ! results);
                        collect   (tcf::FLOAT_EXPRESSION (tcf::CODETEMP_INFO_FLOAT(_, r)) ! args,   ncftype ! ncftypes,   results) =>    collect  (args,  ncftypes,   (r, ncftype_to_heapcleaner_type ncftype) ! results);

                        collect (_ ! args, _ ! ncftypes,   results)
                            =>
                            collect (args, ncftypes,      results);

                        collect ([], [],   results)
                            =>
                            results;

                        collect _ =>   error "make_heapcleaner_liveinliveout_note";
                    end;
                end;

            # These are the type widths of Mythryl.
            # They are hardwired for now.
            #
            ptr_bitsize = 32;   # Size of Mythryl's pointer             XXX SUCKO FIXME     64-BIT ISSUE
            int_bitsize = 32;   # Size of Mythryl's integer             XXX SUCKO FIXME     64-BIT ISSUE
            flt_bitsize = 64;   # Size of Mythryl's real number 

            zero = tcf::LITERAL 0;
            one  = tcf::LITERAL 1;
            two  = tcf::LITERAL 2;

            tagged_zero =  one;
            offp0       =  ncf::SLOT 0; 
            #
            fun int i =  tcf::LITERAL (tcf::mi::from_int   (int_bitsize, i));           # "li" == "int-literal".
            fun unt u =  tcf::LITERAL (tcf::mi::from_unt1 (int_bitsize, u));            # "lu" == "unt-literal".

            const_base_pointer_reg_offset
                =
                int  mp::const_base_pointer_reg_offset;


            # The heap allocation pointer -- we allot
            # heap memory just by advancing this pointer.
            # It must be in a true hardware register:                                                                           # i.e., not in an Intel32 ramreg -- a stack slot used as a workaround for the register shortage on that architecture.
            # 
            heap_allocation_pointer_register
                =
                case pri::heap_allocation_pointer
                    #
                    tcf::CODETEMP_INFO (_, heap_allocation_pointer_register) =>  heap_allocation_pointer_register;
                    _                                              =>  error "heap_allocation_pointer_register";
                esac;


            global_registers                                                                                                    # Global registers allocated statically by hand. 
                =
                map  (\\ r = tcf::INT_EXPRESSION   (tcf::CODETEMP_INFO  (int_bitsize, r))) pri::global_int_registers            # On intel32 this is ESP and EDI.
                @ 
                map  (\\ f = tcf::FLOAT_EXPRESSION (tcf::CODETEMP_INFO_FLOAT (flt_bitsize, f))) pri::global_float_registers;    # On intel32 there are no globally allocated float registers -- they are all available to the register allocator.


            global_registers                                                                                                    # On sparc32 and pwrpc32 we also globally dedicate a condition code register to heaplimit checks.
                = 
                case pri::heap_is_exhausted__test
                    #
                    THE cc => tcf::FLAG_EXPRESSION cc ! global_registers;                                                       # "cc" is "condition code" -- zero/parity/overflow/... flag stuff.
                    NULL   =>                           global_registers; 
                esac;


            do_extra_lowhalf_optimizations                                                                                      # This flag controls whether extra lowhalf optimizations should be performed.  Defaults to FALSE.
                =                                                                                                               # XXX BUGGO FIXME icky thread-hostile global mutable state.
                ctl::lowhalf::make_bool                                                                                         # 
                  ( "do_extra_lowhalf_optimizations",
                    "whether to do lowhalf optimizations"
                  );


            track_types_for_heapcleaner                                                                                         # XXX BUGGO FIXME icky thread-hostile global mutable state.
                =
                ctl::lowhalf::make_bool                                                                                         # Defaults to FALSE.
                  ( "track_types_for_heapcleaner",
                    "whether to track heapcleaner type info"
                  );                                                                                                            # If this flag is TRUE then annotate the
                                                                                                                                # codetemps with heapcleaner type info;
                                                                                                                                # otherwise use the default behavior.
                                                                                                                                #
                                                                                                                                # This flag is always FALSE;  I think
                                                                                                                                # this is another unfinished project.
                                                                                                                                # The relevant files appear to be:
                                                                                                                                #
                                                                                                                                #     src/lib/compiler/back/low/heapcleaner-safety/per-codetemp-heapcleaner-info-template.api
                                                                                                                                #     src/lib/compiler/back/low/main/nextcode/per-codetemp-heapcleaner-info.api
                                                                                                                                #     src/lib/compiler/back/low/main/nextcode/per-codetemp-heapcleaner-info.pkg
                                                                                                                                #     src/lib/compiler/back/low/heapcleaner-safety/codetemps-with-heapcleaner-info.api
                                                                                                                                #     src/lib/compiler/back/low/heapcleaner-safety/codetemps-with-heapcleaner-info-g.pkg


            lowhalf_optimize_before_making_heapcleaner_code                                                                     # XXX BUGGO FIXME icky thread-hostile global mutable state.
                =
                ctl::lowhalf::make_bool                                                                                         # Defaults to FALSE.
                  ( "lowhalf_optimize_before_making_heapcleaner_code",
                    "whether to optimize before generating heapcleaner code"
                  );                                                                                                            # If this flag is on then we do optimizations before generating heapcleaner code.
                                                                                                                                # If this flag is on then track_types_for_heapcleaner must also be turned on!
                                                                                                                                # Otherwise use the default behavior.


            split_entry_block                                                                                                   # XXX BUGGO FIXME icky thread-hostile global mutable state.
                =
                ctl::lowhalf::make_bool                                                                                         # Defaults to FALSE.
                  ( "split_entry_block",
                    "whether to split entry block"
                  );                                                                                                            # If this flag is on then split the entry block.
                                                                                                                                # This should be on for SSA optimizations. 


            empty_block    =  lhn::empty_block.x_to_note ();                                                                    # Dummy annotation used to get an empty block.

            tagword_to_int =  large_unt::to_int;                                                                                # Converts heap-record tagword to int. 


                                                                                                                                #  The main code generation function.
                                                                                                                                #
                                                                                                                                #  This represents the major entrypoint into
                                                                                                                                #  the machine-dependent backend lower half
                                                                                                                                #  from the machine-independent upper half.
                                                                                                                                #  
                                                                                                                                #  We are called from   translate_anormcode_to_execode   in
                                                                                                                                #  
                                                                                                                                #      src/lib/compiler/back/top/main/backend-tophalf-g.pkg
            fun translate_nextcode_to_execode
                  {
                    nextcode_functions:         List( ncf::Function ),                                                          # All the functions for a complete package ("compilation unit").

                    fun_id__to__max_resource_consumption                                                                        # Given
                        :                                                                                                       # a
                        ncf::Codetemp                                                                                           # fun_id
                        ->                                                                                                      # return
                        { max_possible_heapwords_allocated_before_next_heaplimit_check: Int,                                    # max possible words of heap memory allocated before next heaplimit check, and
                          max_possible_nextcode_ops_run_before_next_heaplimit_check:    Int                                     # max possible nextcode instructions executed before next heaplimit check.
                        },
                    err,
                    source_name,                                                                                                # Typically sourcefile name, something like "<stdin>" if compiling interactively.
                    per_compile_stuff
                  }
                =
                {   apply  note_entrypoint_label_and_type   nextcode_functions;
                    #
                    cccomponents =  ffc::find_nextcode_cccomponents  nextcode_functions;                                        # Break the 'nextcode_functions' callgraph up into connected components.

                    apply  translate_nextcode_cccomponent_to_treecode    cccomponents;                                          # This is where all the work is...

                    finish_compilation_unit  source_name;
                                                                                                                                # Here we construct and return to caller a thunk which computes the
                                                                                                                                # entrypoint offset into the machinecode bytevector.  (This is the
                                                                                                                                # address which at linktime will be called with a table of all loaded
                                                                                                                                # packages; the package will note all needed resources and return
                                                                                                                                # its own list of exported functions and other values.)
                                                                                                                                #
                                                                                                                                # The idea is that in principle this address could be anywhere in the
                                                                                                                                # compiled code, and the address might not be fixed until the sizes of
                                                                                                                                # span-depdendent instructions (i.e., pc-relative jumps) has been decided,
                                                                                                                                # so our caller should finish code generation before calling this thunk.
                                                                                                                                #
                                                                                                                                # In practice the entrypoint is always zero, and this whole charade
                                                                                                                                # could and maybe should be dispensed with.

                    get_entrypoint_offset_of_first_function  nextcode_functions;                                                # A (Void -> Int) thunk returning entrypoint offset into machinecode bytevector.
                }                                                                                                               # (In practice this is currently always zero.)
                where
                        

                    max_possible_heapwords_allocated_before_next_heaplimit_check
                        =
                        .max_possible_heapwords_allocated_before_next_heaplimit_check  o  fun_id__to__max_resource_consumption;


                    split_entry_block   =   *split_entry_block;

                    
                    # These functions generate new codetemps and
                    # mark expressions with their heapcleaner types.
                    #
                    # When the heapcleaner-safety feature is turned on,
                    # we'll use the versions of make_int_codetemp_info that automatically
                    # update the heapcleaner-map.
                    #
                    # Otherwise, we'll just use the normal version.

                    track_types_for_heapcleaner =   *track_types_for_heapcleaner;

                    my  ( make_int_codetemp_info,
                          make_int_codetemp_info_with_ncftype,
                          make_int_codetemp_info_with_kind_and_size,
                          make_float_codetemp_info
                        )
                        = 
                        if (not track_types_for_heapcleaner)                                                                    # Currently track_types_for_heapcleaner is ALWAYS FALSE.
                            #
                            ( rgk::make_int_codetemp_info,                                                                              # We're not tracking heapcleaner types for the backend lowhalf, so no extra work to do here.
                              rgk::make_int_codetemp_info,
                              rgk::make_int_codetemp_info,
                              rgk::make_float_codetemp_info
                            );

                        else
                            # We're tracking heapcleaner types for the backend lowhalf,
                            # so redefine our make-codetemp fns to track heapcleaner info:
                            #
                            make_int_codetemp_info   =   hr::make_codetemp_info_of_kind  rkj::INT_REGISTER;                     # Currying is important here for efficiency -- make_codetemp_info_of_kind is slow,
                            make_float_codetemp_info =   hr::make_codetemp_info_of_kind  rkj::FLOAT_REGISTER;                   # but make_int_codetemp_info is fast.
                            #
                            fun make_int_codetemp_info_with_ncftype  ncftype
                                =
                                make_int_codetemp_info (ncftype_to_heapcleaner_type  ncftype);
                            #
                            fun make_int_codetemp_info_with_kind_and_size  kind_and_size
                                =
                                make_int_codetemp_info (kind_and_size_to_heapcleaner_type  kind_and_size);

                            ( make_int_codetemp_info,
                              make_int_codetemp_info_with_ncftype,
                              make_int_codetemp_info_with_kind_and_size,
                              make_float_codetemp_info
                            );
                        fi;

                    # Maybe wrap heapcleaner type around ptr/i32/flt:
                    #
                    fun hc_ptr e =   if track_types_for_heapcleaner  tcf::RNOTE  (e, ptr_type);    else e;   fi;
                    fun hc_i32 e =   if track_types_for_heapcleaner  tcf::RNOTE  (e, i32_type);    else e;   fi;
                    fun hc_flt e =   if track_types_for_heapcleaner  tcf::FNOTE  (e, f64_type);    else e;   fi;
                    #
                    fun maybe_note_type_for_heapcleaner (e, ncftype)
                        =
                        track_types_for_heapcleaner   ??   tcf::RNOTE (e, ncftype_to_note  ncftype)
                                                      ::   e;
                    #
                    fun mark_nothing e
                        =
                        e;

                    # Private ("all-callers-known") functions have
                    # parameters passed in fresh temporaries. 
                    #   
                    # We (may) also annotate the heapcleaner types of these temporaries:
                    #
                    fun translate_function_formal_args_from_nextcode_to_treecode_form  (ncftype ! rest)
                            =>
                            case ncftype
                                #
                                ncf::typ::FLOAT64 =>   tcf::FLOAT_EXPRESSION (tcf::CODETEMP_INFO_FLOAT (flt_bitsize, make_float_codetemp_info  chi::f64_type));
                                #
                                ncf::typ::INT     =>   tcf::INT_EXPRESSION   (tcf::CODETEMP_INFO  (int_bitsize, make_int_codetemp_info    chi::i31_type));
                                ncf::typ::INT1    =>   tcf::INT_EXPRESSION   (tcf::CODETEMP_INFO  (int_bitsize, make_int_codetemp_info    chi::i32_type));
                                _                 =>   tcf::INT_EXPRESSION   (tcf::CODETEMP_INFO  (ptr_bitsize, make_int_codetemp_info    chi::ptr_type));
                            esac
                            !
                            translate_function_formal_args_from_nextcode_to_treecode_form  rest;

                        translate_function_formal_args_from_nextcode_to_treecode_form  []
                            =>
                            [];
                    end;

                    # fun_id__to__codelabel__hashtable maps function ids
                    # (ncf::lvars -- in practice, ints) to the codelabels
                    # for those functions.
                    #
                    # If the flag   split_entry_block   is on we also
                    # distinguish between public and privatel labels,
                    # making sure that no branches go directly to the
                    # public labels. 

                    exception LABEL_BIND;
                    exception TYPE_TABLE;

                    stipulate
                        my fun_id__to__codelabel__hashtable:   iht::Hashtable ( lbl::Codelabel )
                                                           =   iht::make_hashtable  { size_hint => 32,  not_found_exception => LABEL_BIND };
                    herein
                        get_codelabel_for_fun_id =   iht::get   fun_id__to__codelabel__hashtable;
                        set_codelabel_for_fun_id =   iht::set   fun_id__to__codelabel__hashtable;
                    end;


                    #
                    stipulate
                        ncflvar_to_ncftype  =   iht::make_hashtable  { size_hint => 32,  not_found_exception => TYPE_TABLE }    # ncflvar_to_ncftype is a mapping of ncf::lvars to nextcode types
                                            :   iht::Hashtable ( ncf::Type );
                    herein
                        set_ncftype_for_codetemp =  iht::set  ncflvar_to_ncftype;
                        get_ncftype_for_codetemp =  iht::get  ncflvar_to_ncftype;                                               # This maps nextcode value expressions to nextcode types.
                    end;

                    #
                    fun note_entrypoint_label_and_type  (callers_info, fun_id, _, _, _)                                         # define the labels and ncftype for all nextcode functions.
                        =
                        {   set_codelabel_for_fun_id (fun_id, lbl::make_anonymous_codelabel());                                 # Private label.
                            #
                            if split_entry_block                                                                                # Public  label.
                                #
                                case callers_info
                                    #
                                    (ncf::FATE_FN | ncf::PUBLIC_FN)
                                        => 
                                        set_codelabel_for_fun_id
                                          (
                                            -fun_id - 1,                                                                        # This -fun_id - 1 crap could be simplified to just -f if we just guaranteed that all valid labels are nonzero. XXX SUCKO FIXME.
                                            lbl::make_codelabel_generator (int::to_string fun_id) ()
                                          );
                                                                                                                                
                                    _ => ();
                                esac;
                            fi;

                            case callers_info
                                #
                                ncf::FATE_FN =>   set_ncftype_for_codetemp (fun_id, ncf::typ::FATE);
                                _            =>   set_ncftype_for_codetemp (fun_id, ncf::bogus_pointer_type);
                            esac;
                        };                                                                                                      # fun note_entrypoint_label_and_type

                    #   
                    fun_id__to__branch_probability
                        =
                        fbp::guess_nextcode_branch_probabilities  nextcode_functions                                            # Compute probabilities, stash them in a hashtable, return lookup function.
                        :
                        ncf::Codetemp -> Null_Or(pby::Probability);

                    #
                    fun branch_with_probability (branch, THE probability) =>   tcf::NOTE  (branch,  lhn::branch_probability.x_to_note probability);
                        branch_with_probability (branch, NULL           ) =>   branch;
                    end;


                    # A nextcode register may be implemented as a physical 
                    # register or a memory location.  This function moves
                    # a value v into a register or a memory location.                                                           # "rreg" == "reg_or_ramreg".
                    #
                    fun set_rreg (tcf::CODETEMP_INFO (type, r),        v) =>  tcf::LOAD_INT_REGISTER (type, r, v);
                        set_rreg (tcf::LOAD (type, ea, mem), v) =>  tcf::STORE_INT (type, ea, v, mem);
                        set_rreg _                              =>  error "set_rreg";
                    end;


                    # Translate one nextcode cccomponent to                                                                     # "cccomponent" == "callgraph connected-component".
                    # treecode (and thence immediately to machcode):
                    #
                    fun translate_nextcode_cccomponent_to_treecode
                        #
                        (cccomponent:   List( ncf::Function ))
                        #
                        : Void                                                                                                  # Void because results are side-effected :-( onto   dataseg_list   and   textseg_list   in
                        #                                                                                                       #
                        #                                                                                                       #     src/lib/compiler/back/low/jmp/squash-jumps-and-write-code-to-code-segment-buffer-intel32-g.pkg
                        #                                                                                                       #     src/lib/compiler/back/low/jmp/squash-jumps-and-write-code-to-code-segment-buffer-pwrpc32-g.pkg
                        =                                                                                                       #     src/lib/compiler/back/low/jmp/squash-jumps-and-write-code-to-code-segment-buffer-sparc32-g.pkg
                        {   if *ctl::debugging
                                #
                                apply
                                    ppn::print_nextcode_function
                                    cccomponent;                                                                                # cccomponent is just a List( ncf::Function ).
                            fi;

                            (t2m::make_treecode_to_machcode_codebuffer  (mkg::make_machcode_codebuffer ()))                     # make_machcode_codebuffer              is from   src/lib/compiler/back/low/mcg/make-machcode-codebuffer-g.pkg
                                ->
                                buf;

                                                                                                                                # The above constructs the wrapped codebuffer which
                                                                                                                                # translates treecode to machine code and then holds
                                                                                                                                # the resulting machcode until asked to regurgitate it.
                                                                                                                                #
                                                                                                                                # We're going to do lots of
                                                                                                                                #
                                                                                                                                #     buf.put_op( treecode_expression ) 
                                                                                                                                #
                                                                                                                                # calls to construct our machine-code controlflow
                                                                                                                                # graph (while simultaneously translating from treecode
                                                                                                                                # to machcode) and then one
                                                                                                                                #
                                                                                                                                #     result =  buf.get_completed_cccomponent ...
                                                                                                                                #
                                                                                                                                # call to retrieve the resulting controlflow graph.
                                                                                                                                #
                                                                                                                                # The treecode_expression is translated to abstract machinecode by one of
                                                                                                                                #
                                                                                                                                #     src/lib/compiler/back/low/intel32/treecode/translate-treecode-to-machcode-intel32-g.pkg
                                                                                                                                #     src/lib/compiler/back/low/pwrpc32/treecode/translate-treecode-to-machcode-pwrpc32-g.pkg
                                                                                                                                #     src/lib/compiler/back/low/sparc32/treecode/translate-treecode-to-machcode-sparc32-g.pkg
                                                                                                                                #
                                                                                                                                # which in turn use put_* commands which drive
                                                                                                                                #
                                                                                                                                #     src/lib/compiler/back/low/mcg/make-machcode-codebuffer-g.pkg 
                                                                                                                                #
                                                                                                                                # to construct an actual machine code controlflow graph, i.e. an instance of one of
                                                                                                                                #
                                                                                                                                #     machcode_controlflow_graph_intel32   from   src/lib/compiler/back/low/main/intel32/backend-lowhalf-intel32-g.pkg
                                                                                                                                #     machcode_controlflow_graph_pwrpc32   from   src/lib/compiler/back/low/main/pwrpc32/backend-lowhalf-pwrpc32.pkg
                                                                                                                                #     machcode_controlflow_graph_sparc32   from   src/lib/compiler/back/low/main/sparc32/backend-lowhalf-sparc32.pkg
                                                                                                                                #
                                                                                                                                # all of which are generated by
                                                                                                                                #
                                                                                                                                #     src/lib/compiler/back/low/mcg/machcode-controlflow-graph-g.pkg
                                                                                                                                # per src/lib/compiler/back/low/mcg/machcode-controlflow-graph.api


                            # If ncf::RAW_C_CALL is present we need
                            # to use the virtual frame pointer:
                            #
                            stipulate
                                #
                                fun has_raw_c_call  ((_, _, _, _, cexp) ! rest)                         # There HAS to be a better way of tracking this information than
                                        =>                                                              # doing a complete code pass here to get one bit of information.  XXX SUCKO FIXME.
                                        ncf::has_raw_c_call  cexp
                                        or
                                        has_raw_c_call  rest;

                                    has_raw_c_call  [] =>   FALSE;
                                end;

                            herein

                                use_virtual_framepointer
                                    =
                                    not  mp::framepointer_never_virtual
                                    and
                                    has_raw_c_call  cccomponent;

                            end;

                            uvf::use_virtual_framepointer                                               # This gets read (only) one place -- fun stack_basepointer ()
                                :=                                                                      # in   src/lib/compiler/back/low/main/intel32/backend-lowhalf-intel32-g.pkg
                                use_virtual_framepointer;


                            heap_is_exhausted__test
                                =
                                # This is the
                                #
                                #     heap_allocation_pointer > heap_allocation_limit
                                #
                                # comparison test used -- when this is TRUE, it is time to
                                # run the heapcleaner ("garbage collector").
                                #       
                                # We have a per-platform choice of signed vs unsigned comparisons.
                                # 
                                # This usually doesn't matter, but some
                                # architectures work better one way or
                                # the other, so we are given a choice here.
                                #
                                tcf::CMP (
                                    #
                                    ptr_bitsize,

                                    pri::use_signed_heaplimit_check
                                        ??  tcf::GT
                                        ::  tcf::GTU, 

                                    pri::heap_allocation_pointer,

                                    pri::heap_allocation_limit  use_virtual_framepointer
                                );



                            #############################################################
                            # Per-cccomponent tables 

                            exception   INT_REGISTER_MAP;
                            exception FLOAT_REGISTER_MAP;
                            exception GEN_TABLE;



                            stipulate
                                my  fun_id__to__callers_info__hashtable:  iht::Hashtable( nfs::Callers_Info )
                                    =
                                    iht::make_hashtable  { size_hint => length cccomponent,  not_found_exception => GEN_TABLE };
                                    #
                                    # Used to retrieve the arg passing convention
                                    # once a function has been compiled.
                            herein
                                set__callers_info__for__fun_id =   iht::set  fun_id__to__callers_info__hashtable;
                                get__callers_info__for__fun_id =   iht::get  fun_id__to__callers_info__hashtable;
                            end;        

                            # { fp, gp } RegTable -- mapping of lvars to registers  


                            codetemp_to_tcf_float_expression__hashtable
                                #
                                = iht::make_hashtable  { size_hint => 2,  not_found_exception => FLOAT_REGISTER_MAP }
                                : iht::Hashtable( tcf::Float_Expression );


                            codetemp_to_tcf_int_expression__hashtable
                                #
                                =  iht::make_hashtable  { size_hint => 32,  not_found_exception => INT_REGISTER_MAP }
                                :  iht::Hashtable( tcf::Int_Expression );


                            set_int_def_for_codetemp =   iht::set  codetemp_to_tcf_int_expression__hashtable;

                            #
                            fun set_int_def_for_codetemp' (codetemp, r)
                                =
                                set_int_def_for_codetemp (codetemp, tcf::CODETEMP_INFO (int_bitsize, r));


# PRODUCTION VERSION:
#                           set_float_def_for_codetemp
#                               =
#                               iht::set  codetemp_to_tcf_float_expression__hashtable;
# TEMPORARY DEBUG VERSION:
                            fun set_float_def_for_codetemp (arg as (x, t))
                                =
                                {
if *log::debugging
    printf "set_float_def_for_codetemp (%d, ...)\n" x;
fi;
                                    iht::set  codetemp_to_tcf_float_expression__hashtable  arg;
                                };


                            # The following function looks up
                            # the Treecode expression associated
                            # with a floating point value expression:
                            #
#                           get_tcf_float_expression_for_codetemp
#                               =
#                               iht::get   codetemp_to_tcf_float_expression__hashtable;

                            fun get_tcf_float_expression_for_codetemp x
                                =
                                {
if *log::debugging
    printf "get_tcp_float_expression_for_codetemp %d\n" x;
fi;
                                    iht::get   codetemp_to_tcf_float_expression__hashtable  x;
                                };

                            #
                            fun def_for_float_codetemp (ncf::CODETEMP v) =>   get_tcf_float_expression_for_codetemp v;
                                def_for_float_codetemp _                 =>   error "def_for_float_codetemp";
                            end;



                            # To do Sethi-Ullman register-use minimization  -- see
                            #
                            #     src/lib/compiler/back/low/intel32/treecode/translate-treecode-to-machcode-intel32-g.pkg
                            #
                            # -- we now need to convert our linear
                            # code blocks into expression trees.
                            # To do this, we first classify each subexpression
                            # according to the number of times its value is used:
                            #
                            Codetemp_Use_Frequency
                              #
                              = NO_USES                 # Codetemp is never used -- it can be discarded if pure.
                              | ONE_USE                 # Codetemp is used exactly once -- we will inline the expression at its use point.
                              | MULTIPLE_USES           # Codetemp is used two or more times -- we will to leave it in place.
                              | ONE_USE_AND_INLINED     # Codetemp is ONE_USE and has been (or will be) inlined at its use point.
                              ;

                            # The following function is used to translate nextcode into
                            # larger trees.  Definitions marked ONE_USE can be forward
                            # propagated to their (only) use.   This can drastically
                            # reduce register pressure.

                            stipulate
                                exception CODETEMP_USE_FREQUENCY_HASHTABLE;
                            herein
                                my codetemp_use_frequency_hashtable:  iht::Hashtable( Codetemp_Use_Frequency )
                                                                   =  iht::make_hashtable  { size_hint => 32,  not_found_exception => CODETEMP_USE_FREQUENCY_HASHTABLE };
                            end;

                            #
                            fun get_codetemp_use_frequency i
                                =
                                the_else (iht::find  codetemp_use_frequency_hashtable  i,   NO_USES);


                            set_codetemp_use_frequency
                                =
                                iht::set  codetemp_use_frequency_hashtable;

                            #
                            fun set_codetemp_use_frequency_to__one_use_and_inlined r
                                =
                                set_codetemp_use_frequency (r, ONE_USE_AND_INLINED);

                            # Reset the register and expression-usage hashtables:
                            #
                            fun clear_hashtables ()
                                =
                                {   iht::clear  codetemp_to_tcf_int_expression__hashtable; 
                                    iht::clear  codetemp_to_tcf_float_expression__hashtable; 
                                    iht::clear  codetemp_use_frequency_hashtable;
                                };

                            # Memory disambiguation uses
                            # the new register counters, 
                            # so those must be reset here.

                            rgk::reset_codetemp_id_allocation_counters ();

                            mem_disambig
                                =
                                ma::analyze_memory_aliasing_of_nextcode_functions  cccomponent;

                            # Points-to analysis projection.
                            #
                            fun projection (x as REF (pt::TOP _), _)
                                    =>
                                    x;

                                projection (x, i)
                                    =>
                                    pt::ith_projection (x, i);
                            end;

                            stipulate
                                must_disambiguate_memory                        # Normally FALSE.
                                    =
                                    *coc::disambiguate_memory;
                            herein
                                #
                                fun get_ramregion  e
                                    = 
                                    if must_disambiguate_memory
                                        #
                                        case e
                                            ncf::CODETEMP v =>  mem_disambig v;
                                            _               =>  rgn::readonly;
                                        esac;
                                    else
                                        rgn::memory;
                                    fi;

                                #
                                fun get_ramregion_projection (e, i)
                                    =
                                    if must_disambiguate_memory
                                        #
                                        case e
                                            ncf::CODETEMP v =>  projection (mem_disambig v, i);
                                            _               =>  rgn::readonly;
                                        esac;
                                    else
                                        rgn::memory;
                                    fi;
                            end;
        
                            #
                            fun get_dataptr_ramregion v
                                =
                                get_ramregion_projection (v, 0);


                            # fun get_rw_vector_ramregion (x as REF (pt::TOP _)) =>  x;
                            #     get_rw_vector_ramregion  x                     =>  pt::weak_subscript x;
                            # end;
                            #
                            # For safety, let's assume it's
                            # the global memory right now: 
                            #
                            fun get_rw_vector_ramregion _
                                =
                                rgn::memory;

                            # This keeps track of the accumulated advances of the
                            # heap_allocation_pointer since the start of the nextcode fn.
                            # This is important for generating the correct address offset
                            # for newly allocated records.
                            #
                            advanced_heap_ptr =   REF 0;

                            # Return the nextcode type for
                            # a nextcode value expression:
                            #
                            fun ncftype_of (ncf::CODETEMP v) =>  get_ncftype_for_codetemp v;
                                ncftype_of (ncf::LABEL    v) =>  get_ncftype_for_codetemp v;
                                #
                                ncftype_of (ncf::INT      _) =>  ncf::typ::INT;
                                ncftype_of (ncf::INT1     _) =>  ncf::typ::INT1;
                                ncftype_of (ncf::TRUEVOID  ) =>  ncf::typ::FLOAT64;                     # What?? -- 2011-08-16 CrT ncf::TRUEVOID comes only from a line in src/lib/compiler/back/top/closures/make-nextcode-closures-g.pkg
                                #
                                ncftype_of _                 =>  ncf::bogus_pointer_type;
                            end;

                            # 'base_pointer' contains the start address
                            # of the entire  compilation unit.
                            #
                            # Here we generate the address of a label that
                            # is embedded in the same compilation unit.
                            # The generated address is relative to 'base_pointer'.
                            #
                            # For heapcleaner safety, we consider
                            # this to be a chunk reference.
                            #
                            fun make_code_for_label_address (codelabel, k)
                                =
                                hc_ptr e
                                where
                                    e =   tcf::ADD (                                                    # base_pointer + (codelabel + (k - mp::const_base_pointer_reg_offset))
                                              pri::address_width,
                                              pri::base_pointer  use_virtual_framepointer,
                                              tcf::LABEL_EXPRESSION (
                                                  tcf::ADD (
                                                      pri::address_width,
                                                      tcf::LABEL codelabel, 
                                                      tcf::LITERAL (
                                                          multiword_int::from_int
                                                              (k - mp::const_base_pointer_reg_offset)
                                          )   )   )   );
                                end;

                            # The following function looks up the Treecode expression
                            # associated with a general purpose value expression. 
                            #
                            get_int_def_for_codetemp
                                =
                                iht::get   codetemp_to_tcf_int_expression__hashtable;

                            #
                            fun resolve_heap_ptr_offset   (tcf::LATE_CONSTANT  absolute_heap_ptr_offset)
                                    =>
                                    # Here we resolve address computations of the form
                                    #
                                    #     tcf::LATE_CONSTANT k
                                    #
                                    # where offset is a reference to the kth byte allocated
                                    # since the beginning of the nextcode fn.
                                    #
                                    {   tmp_r =   make_int_codetemp_info  chi::ptr_type;
                                        #
                                        offset =   absolute_heap_ptr_offset - *advanced_heap_ptr;

                                        buf.put_op                                      # tmp_r :=  heap_allocation_pointer + offset;
                                            (tcf::LOAD_INT_REGISTER
                                              (
                                                ptr_bitsize,
                                                tmp_r,
                                                tcf::ADD
                                                  (
                                                    pri::address_width,
                                                    pri::heap_allocation_pointer,
                                                    int  offset
                                            ) )   );

                                        tcf::CODETEMP_INFO (ptr_bitsize, tmp_r);
                                    };

                                resolve_heap_ptr_offset  e
                                    =>
                                    e;
                            end;

                            #
                            fun resolve_heap_ptr_offset'  (tcf::LATE_CONSTANT  absolute_heap_ptr_offset)
                                    => 
                                    # As above, but here we generate the address but do not store it into
                                    # a register (codetemp); this allows use in more complex subexpressions:
                                    #
                                    {   offset =  absolute_heap_ptr_offset - *advanced_heap_ptr;
                                        #
                                        hc_ptr (tcf::ADD (pri::address_width, pri::heap_allocation_pointer, int offset));               # heap_allocation_pointer + offset
                                    };

                                resolve_heap_ptr_offset'  other
                                    =>
                                    other;
                            end;

                            #
                            fun def_for_int_codetemp (ncf::CODETEMP v) =>  resolve_heap_ptr_offset (get_int_def_for_codetemp v);
                                def_for_int_codetemp (ncf::INT      i) =>  int (i+i+1);                                                 # Convert to tagged int format by leftshifting and setting low bit.
                                def_for_int_codetemp (ncf::INT1     u) =>  unt u;                                                       # XXX SUCKO FIXME: should have an explicit fn for converting to tagged int.

                                def_for_int_codetemp (ncf::LABEL    v)
                                    => 
                                    make_code_for_label_address (get_codelabel_for_fun_id (split_entry_block ?? -v - 1 :: v), 0);

                                def_for_int_codetemp _ =>   error "def_for_int_codetemp";
                            end;



                            #
                            fun def_for_int_codetemp' (ncf::CODETEMP v) =>  resolve_heap_ptr_offset' (get_int_def_for_codetemp  v);     # The only line that differs from above fun.
                                def_for_int_codetemp' (ncf::INT      i) =>  int (i+i+1);                                                # Convert to tagged int format by leftshifting and setting low bit.
                                def_for_int_codetemp' (ncf::INT1     u) =>  unt u;                                                      # XXX SUCKO FIXME: should have an explicit fn for converting to tagged int.

                                def_for_int_codetemp' (ncf::LABEL    v)
                                    => 
                                    make_code_for_label_address (get_codelabel_for_fun_id (split_entry_block ?? -v - 1 :: v), 0);

                                def_for_int_codetemp' _ =>   error "def_for_int_codetemp'";
                            end;


                            # On entry to a function the args are in
                            # standardized registers. The function-body
                            # code immediately copies the args to fresh
                            # codetemps. This frees the argument values
                            # to move elsewhere and is critical in avoiding
                            # artificial codetemp interferences:
                            #
                            fun copy_args_to_arg_codetemps (rl, vl, tl)                         # == (args, codetemps, types) -- we're copying 'args' to 'codetemps'.
                                = 
                                {   (e_copy (vl, rl, [], [], [], []))                           # == (codetemps, args, destregs, srcregs, codetemps', args')
                                        ->
                                        (vl', rl');

                                    e_fcopy (e_other (vl', rl', [], []));

                                    pl::apply  set_ncftype_for_codetemp  (vl, tl);
                                }
                                where
                                    fun e_copy([], [], [], [], xs', rl')
                                            =>
                                            (xs', rl');                                         # Done.

                                        e_copy (x ! xs, tcf::INT_EXPRESSION (tcf::CODETEMP_INFO(_, r)) ! rl, rds, rss, xs', rl')                # "rds" = "dst registers";   "rss" == "src registers".
                                            => 
                                            {   t = make_int_codetemp_info  chi::ptr_type;
                                                #
                                                set_int_def_for_codetemp' (x, t); 
                                                #
                                                e_copy   (xs,  rl,   t ! rds,  r ! rss,   xs',  rl');
                                            };

                                        e_copy  (x ! xs,  r ! rl,  rds,  rss,  xs',  rl')
                                            => 
                                            e_copy  (xs,  rl,  rds,  rss,  x ! xs',  r ! rl');

                                        e_copy([], [], rds, rss, xs', rl')
                                            => 
                                            {   buf.put_op (tcf::MOVE_INT_REGISTERS (int_bitsize, rds, rss));
                                                (xs', rl');
                                            };

                                        e_copy (([], _ ! _, _, _, _, _) | (_ ! _, [], _, _, _, _))
                                            =>
                                            error "e_copy";
                                    end;

                                    #
                                    fun e_other([], [], xs, rl)
                                            =>
                                            (xs, rl);

                                        e_other  (x ! xs,  (tcf::INT_EXPRESSION r) ! rl,  xs', rl')
                                            => 
                                            {   t =  make_int_codetemp_info  chi::ptr_type;
                                                #
                                                set_int_def_for_codetemp' (x, t);

                                                buf.put_op (tcf::LOAD_INT_REGISTER (int_bitsize, t, r)); 

                                                e_other (xs, rl, xs', rl');
                                            };

                                        e_other  (x ! xs,  (tcf::FLOAT_EXPRESSION (tcf::CODETEMP_INFO_FLOAT(_, f))) ! rl,  xs', rl')
                                            => 
                                            e_other (xs, rl,  x ! xs',  f ! rl');

                                        e_other (_, tcf::FLOAT_EXPRESSION _ ! _, _, _)
                                            =>
                                            error "e_other: FPR but not FREG";

                                        e_other (_, tcf::FLAG_EXPRESSION _ ! _, _, _)
                                            =>
                                            error "e_other: FLAG_EXPRESSION";

                                        e_other (([], _ ! _, _, _) | (_ ! _, [], _, _))
                                            =>
                                            error "e_other";
                                    end;

                                    #
                                    fun e_fcopy ([], [])
                                            =>
                                            ();

                                        e_fcopy (xs, rl)
                                            => 
                                            {   fs =   map (\\ _ =  make_float_codetemp_info  chi::f64_type)
                                                           xs;

                                                pl::apply 
                                                    (\\ (x, f) =  set_float_def_for_codetemp  (x,  tcf::CODETEMP_INFO_FLOAT (flt_bitsize, f)))
                                                    (xs, fs);

                                                buf.put_op (tcf::MOVE_FLOAT_REGISTERS (flt_bitsize, fs, rl));
                                            };
                                    end;
                                end;


                            #############################################################################
                            # Nomenclature: "hap_offset" == "heap_allocation_pointer_offset".
                            #
                            # Motivation:
                            # On x86 heap_allocation_pointer permanently owns the EDI register -- see
                            #
                            #     src/lib/compiler/back/low/main/intel32/backend-lowhalf-intel32-g.pkg
                            # 
                            # (Other platforms are similar.)
                            # 
                            # Conceptually we allot heapspace by sequences like
                            # 
                            #     *heap_allocation_pointer_offset++ = record_tagword;
                            #     *heap_allocation_pointer_offset++ = field_1;
                            #     *heap_allocation_pointer_offset++ = field_2;
                            #      ...
                            #     *heap_allocation_pointer_offset++ = field_n;
                            #
                            # In practice that is too slow -- the pointer-increments take ALU resources,
                            # and also introduce data dependencies which inhibit multiple instruction
                            # issue (on-the-fly parallelism) on modern microprocessors, so it is better to do
                            #
                            #     heap_allocation_pointer_offset[0] = record_tagword;
                            #     heap_allocation_pointer_offset[1] = field_1;
                            #     heap_allocation_pointer_offset[2] = field_2;
                            #      ...
                            #     heap_allocation_pointer_offset[n] = field_n;
                            #     heap_allocation_pointer_offset += n+1;
                            #
                            # If the different fields are being generated by a complex of functions,
                            # the latter approach requires that we keep track of how much heapspace
                            # has been allocated since the last update to the heap_allocation_pointer.
                            # That is the function of the 'hap_offet' values used in this package.
                            #############################################################################

                            #   
                            fun update_heap_allocation_pointer  hap_offset                                                      # "hap_offset" == "heap_allocation_pointer offset".
                                = 
                                # We've allocated a number of words of heap memory;
                                # now it is time to wrap up the allocation burst and
                                # bring heap_allocation_pointer up to date by doing     
                                #
                                #     heap_allocation_pointer += hap_offset;
                                #
                                # We keep heap_allocation_pointer aligned on odd 32-bit
                                # boundary so that after allocating a 32-bit tagword we
                                # will be correctly aligned for 64-bit data.
                                #
                                # (We have accounted for the extra space this eats up
                                # in pkg pick_nextcode_fns_for_heaplimit_checks.)                                               # pick_nextcode_fns_for_heaplimit_checks        is from   src/lib/compiler/back/low/main/nextcode/pick-nextcode-fns-for-heaplimit-checks.pkg
                                #
                                if (hap_offset != 0)
                                    #
                                    if (unt::bitwise_and (unt::from_int hap_offset, 0u4) != 0u0)   advance_by (hap_offset+4);   # 64-bit issue: '4' is 'wordbytes' -- and this alignment is not needed on 64-bit implementations anyhow.
                                    else                                                           advance_by (hap_offset  );
                                    fi;
                                fi
                                where
                                    fun advance_by  hap_offset
                                        = 
                                        {   advanced_heap_ptr := *advanced_heap_ptr + hap_offset;
                                            #
                                            buf.put_op  (tcf::LOAD_INT_REGISTER                                                 # heap_allocation_pointer_register += hap_offset;
                                                          (
                                                            ptr_bitsize,
                                                            heap_allocation_pointer_register,
                                                            tcf::ADD
                                                              ( pri::address_width,
                                                                pri::heap_allocation_pointer,
                                                                int hap_offset
                                                        ) )   );
                                        };
                                end;

                            #
                            fun maybe_test_heap_allocation_limit  hap_offset                                                    # "hap_offset" == "heap_allocation_pointer offset".
                                = 
                                {   update_heap_allocation_pointer  hap_offset;

                                    # This next is a nop on Intel32; on Pwrpc32 and Sparc32
                                    # it loads a register with bits from a status register
                                    # loaded by a previous (delay-slot) comparison
                                    #
                                    #     heaplimit_allocation_pointer > heaplimit_allocation_limit
                                    #                                                                                           # heap_is_exhausted__test       def in   src/lib/compiler/back/low/main/sparc32/backend-lowhalf-sparc32.pkg
                                    case pri::heap_is_exhausted__test                                                           # heap_is_exhausted__test       def in   src/lib/compiler/back/low/main/pwrpc32/backend-lowhalf-pwrpc32.pkg
                                        #
                                        THE cc =>  assign_cc (cc, heap_is_exhausted__test);                                     # "cc" == "condition-code" -- the ZERO/OVERFLOW/... status-register bits.
                                        #
                                        NULL   =>  ();                                                                          # The Intel32 case.
                                    esac
                                    where
                                        fun assign_cc  (tcf::CC (_, cc),  v)
                                                =>
                                                buf.put_op  (tcf::LOAD_INT_REGISTER_FROM_FLAGS_REGISTER  (cc, v));

                                            assign_cc _ =>   error "maybe_test_heap_allocation_limit::assign_cc";
                                        end;
                                    end;
                                };


                            # r+n;
                            #   
                            fun ea (r, 0) =>  r;
                                ea (r, n) =>  tcf::ADD  (pri::address_width, r, int n);
                            end;

                            # r + 4*n;
                            #
                            fun index_ea (r, 0) =>  r;
                                index_ea (r, n) =>  tcf::ADD  (pri::address_width, r, int (n*4));                                                               # 64-bit issue -- '4' is presumably 'wordbytes' here.
                            end;

                            # Function to heap-allot an integer record
                            #
                            #   x <- [tagword, field_values... ]
                            #
                            # at heap_allocation_pointer + hap_offset:
                            #
                            fun allot_record (hc_wrapfn, mem, tagword, field_values, hap_offset)
                                =  
                                {   buf.put_op (tcf::STORE_INT (int_bitsize, ea (pri::heap_allocation_pointer, hap_offset), tagword, projection (mem, -1)));    # Store tagword at start of new record.
                                    #
                                    store_fields (field_values, hap_offset+4, 0);                                                                               # 64-bit issue: '4' is 'wordbytes'.
                                    #
                                    hap_offset + 4;                                                                                                             # 64-bit issue: '4' is 'wordbytes'.
                                }
                                where
                                    fun get_field_address (v, record, ncf::SLOT 0    ) =>  record;
                                        get_field_address (v, record, ncf::SLOT index) =>  tcf::ADD (pri::address_width, record, int (4*index));                # 64-bit issue: '4' is 'wordbytes'.
                                        get_field_address (v, record, path           ) =>  get_path (get_ramregion v, record, path);
                                    end 

                                    also
                                    fun get_path (mem, record, ncf::SLOT index)
                                            =>
                                            index_ea (record, index);

                                        get_path (mem, record, ncf::VIA_SLOT (index, ncf::SLOT 0))
                                            =>
                                            hc_wrapfn (tcf::LOAD (int_bitsize, index_ea (record, index), projection (mem, index)));

                                        get_path (mem, record, ncf::VIA_SLOT (index, path))
                                            =>
                                            {   mem =   projection (mem, index);
                                                #
                                                get_path  (mem,  hc_ptr (tcf::LOAD (int_bitsize, index_ea (record, index), mem)),  path);
                                            };
                                    end;
                                    #
                                    fun store_fields ([], hap_offset, element)
                                            =>
                                            hap_offset;

                                        store_fields ((record, path) ! field_values, hap_offset, element)
                                            =>  
                                            {   buf.put_op                                                                                                      # heap_allocation_pointer[ hap_offset ] = v.p (?);
                                                    (tcf::STORE_INT
                                                      (
                                                        int_bitsize,
                                                        tcf::ADD (pri::address_width, pri::heap_allocation_pointer, int hap_offset),                            # Where to store: heap_allocation_pointer + hap_offset;
                                                        get_field_address (record, def_for_int_codetemp' record, path),                                         # What to store. 'path' can be a simple slot number, or a true path.
                                                        projection (mem, element)
                                                      )
                                                    );
                                                #
                                                store_fields (field_values, hap_offset+4, element+1);                                                           # 64-bit issue: '4' is 'wordbytes'.
                                            };
                                    end;
                                end;




                            # Same as above, except for floating point instead of int record:
                            #
                            #   x <- [tagword, field_values... ]
                            #
                            fun allot_frecord (mem, tagword, field_values, hap_offset)
                                = 
                                {   buf.put_op  (tcf::STORE_INT  (int_bitsize,  ea (pri::heap_allocation_pointer, hap_offset),  tagword,  projection (mem, -1)));
                                    #
                                    fstore_fields  (field_values,  hap_offset+4,  0);                                                                           # 64-bit issue: '4' is 'wordbytes'.
                                    #
                                    hap_offset+4;                                                                                                               # 64-bit issue: '4' is 'wordbytes'.
                                }
                                where
                                    fun fea (r, 0) =>  r;
                                        fea (r, n) =>  tcf::ADD (pri::address_width, r, int (n*8));
                                    end;

                                    #
                                    fun fget_field (v, ncf::SLOT 0) =>  def_for_float_codetemp v;
                                        fget_field (v, ncf::SLOT _) =>  error "allot_frecord::fget_field";
                                        fget_field (v, p          ) =>  fget_path (get_ramregion v, def_for_int_codetemp' v, p);
                                    end 


                                    also
                                    fun fget_path (mem, e, ncf::SLOT _)
                                            =>
                                            error "allot_frecord::fget_path";

                                        fget_path (mem, e, ncf::VIA_SLOT (n, ncf::SLOT 0))
                                            =>
                                            hc_flt (tcf::FLOAD (flt_bitsize, fea (e, n), projection (mem, n)));

                                        fget_path (mem, e, ncf::VIA_SLOT (n, p))
                                            =>
                                            {   mem =   projection (mem, n);

                                                fget_path (mem, hc_ptr (tcf::LOAD (int_bitsize, index_ea (e, n), mem)), p);
                                            };
                                    end;

                                    #
                                    fun fstore_fields ([], hap_offset, element)
                                            =>
                                            hap_offset;

                                        fstore_fields((v, p) ! field_values, hap_offset, element)
                                            =>  
                                            {   buf.put_op
                                                    (tcf::STORE_FLOAT
                                                      (
                                                        flt_bitsize,
                                                        tcf::ADD (pri::address_width, pri::heap_allocation_pointer, int hap_offset),
                                                        fget_field (v, p),
                                                        projection (mem, element)
                                                    ) );

                                                fstore_fields (field_values, hap_offset+8, element+1);
                                            };
                                    end;
                                end;



                            # Allocate a header pair for vector or rw_vector:
                            #
                            #     heap_allocation_pointer[ hap_offset     ] =  hdr_tagword;
                            #     heap_allocation_pointer[ hap_offset + 4 ] =  data_ptr;
                            #     heap_allocation_pointer[ hap_offset + 8 ] =  length_in_slots;
                            #
                            fun allocate_vector_header (hdr_tagword, mem, data_ptr, length_in_slots, hap_offset)
                                =
                                {   buf.put_op (tcf::STORE_INT (int_bitsize, ea (pri::heap_allocation_pointer, hap_offset), int hdr_tagword, projection (mem,-1)));

                                    buf.put_op (tcf::STORE_INT (int_bitsize, ea (pri::heap_allocation_pointer, hap_offset+4),                                                   # 64-bit issue: '4' is 'wordbytes'.
                                                 tcf::CODETEMP_INFO (int_bitsize, data_ptr), projection (mem, 0)));

                                    buf.put_op  (tcf::STORE_INT
                                                  (
                                                    int_bitsize,
                                                    ea (pri::heap_allocation_pointer, hap_offset+8),                                                                            # 64-bit issue: '8' is '2*wordbytes'.
                                                    int (length_in_slots+length_in_slots+1),                    # len+len+1: == ((len<<1)|1) -- Unt1 to Tagged_Unt tagged-int form.
                                                    projection (mem, 1)
                                                ) );

                                    hap_offset+4;       # '+4' not '+12' because our caller wants a pointer to post-tagword part of record, not to next-word-to-allot.  # 64-bit issue: '4' is 'wordbytes'.
                                };




                            #####################################################################       
                            # Tagged_Int-arithmetic implementation.
                            #
                            # We store Tagged_Int values in-pointer, marked
                            # by having the low bit set to 1.
                            #
                            # (We keep all heap values word-aligned, so all valid
                            # heap pointers will always have the low two bits zero.
                            # Consequently the heapcleaner can always distinguish
                            # Tagged_Int values from valid pointers when processing a
                            # heapchunk, allowing it to ignore Tagged_Int values rather
                            # than treat them as valid pointers and maybe segfault.)
                            #
                            # The low-bit tagging of Tagged_Int values
                            # means that to naively do (say)
                            #
                            #     k = i + j;
                            #
                            # on Tagged_Int values we must actually do
                            #
                            #     k = (((i >> 1) + (j >> 1))   <<   1) + 1;
                            #
                            # In practice, in specific situations, we can
                            # often find equivalent expressions with fewer
                            # shifts.  For example, the above is arithmetically
                            # equal to:
                            #
                            #     k = (i - 1) + j;
                            #
                            #####################################################################       
                            #
                            fun add_tagged_int_tag   value =   tcf::ADD        (int_bitsize, value, one);                               # Set the lowbit tag on a value which is already left-shifted one bit.
                            fun or_tagged_int_tag    value =   tcf::BITWISE_OR (int_bitsize, value, one);                               # Same as above, except it is a safe no-op if the lowbit is already set.
                            fun strip_tagged_int_tag value =   tcf::SUB        (int_bitsize, value, one);                               # Subtract one to clear the lowbit tag on a 31-bit tagged int.
                            #
                            fun tag (FALSE, value) => tag_unsigned value; 
                                tag (TRUE,  value) => tag_signed   value;
                            end 

                            also
                            fun tag_unsigned e                                                                                          # Tag unsigned value 'e' as an tagged_int.
                                = 
                                {   fun double r
                                        =
                                        tcf::ADD (int_bitsize, r, r);

                                    case e 
                                        #
                                        tcf::CODETEMP_INFO _
                                            =>
                                            add_tagged_int_tag (double e);                                                              # e = (e << 1) + 1;

                                       _ => {   tmp =   make_int_codetemp_info  chi::ptr_type;                                          #  XXX ??? 

                                                tcf::LET  ( tcf::LOAD_INT_REGISTER (int_bitsize, tmp, e),                               # tmp = (e << 1) + 1;
                                                            #
                                                            add_tagged_int_tag (double (tcf::CODETEMP_INFO (int_bitsize, tmp)))
                                                          );
                                            };
                                    esac;
                                }

                            also
                            fun tag_signed e                                                                                            # Same as above, but with int OVERFLOW CHECKING.
                                = 
                                {   fun double r
                                        =
                                        if *coc::trap_int_overflow   tcf::ADD_OR_TRAP (int_bitsize, r, r);
                                        else                         tcf::ADD         (int_bitsize, r, r);
                                        fi;

                                    case e 
                                        #
                                        tcf::CODETEMP_INFO _
                                            =>
                                            add_tagged_int_tag (double e);                                                              # e = (e << 1) + 1;     WITH OVERFLOW TRAPPING.

                                        _ => {  tmp =   make_int_codetemp_info chi::ptr_type;                                           #  XXX ??? 

                                                tcf::LET  ( tcf::LOAD_INT_REGISTER (int_bitsize, tmp, e),                               # tmp = (e << 1) + 1;   WITH OVERFLOW CHECKING
                                                            #
                                                            add_tagged_int_tag (double (tcf::CODETEMP_INFO (int_bitsize, tmp)))
                                                          );
                                            };
                                    esac;
                                };
                            #
                            fun untag { signed => TRUE,  value } =>  untag_signed    value; 
                                untag { signed => FALSE, value } =>  untag_unsigned  value;
                            end 

                            also
                            fun untag_unsigned (ncf::INT i) =>  int i;                                                                  # ncf::INT val is untagged, doesn't need the rightshift. 
                                untag_unsigned v            =>  tcf::RIGHT_SHIFT_U (int_bitsize, def_for_int_codetemp v, one);          # v >> 1;       # Without sign extension.
                            end 

                            also
                            fun untag_signed   (ncf::INT i) =>  int i;                                                                  # ncf::INT val is untagged, doesn't need the rightshift. 
                                untag_signed   v            =>  tcf::RIGHT_SHIFT   (int_bitsize, def_for_int_codetemp v, one);          # v >> 1;       # With   sign extension.
                            end;



                            #########################################
                            # Tagged_Int-arithmetic ops.
                            #
                            fun tagged_intadd (add_op, ncf::INT k, w     ) =>  add_op (int_bitsize, int (k+k), def_for_int_codetemp w); # w + (k+k)     ncf::INT is untagged, the 'k+k' leftshifts it to match tagged values.
                                tagged_intadd (add_op, w, v as ncf::INT _) =>  tagged_intadd (add_op, v, w);                            # Swap args and handle via previous line.
                                tagged_intadd (add_op, v, w              ) =>  add_op  ( int_bitsize,                                   # v + (w - 1)
                                                                                         def_for_int_codetemp  v,                       # By clearing low bit of v but not w we ensure that v+w will have low-bit tagged_int tag set.
                                                                                         strip_tagged_int_tag (def_for_int_codetemp  w)
                                                                                       );
                            end;

                            #
                            fun tagged_intsub (sub_op, ncf::INT k, w) =>  sub_op (int_bitsize, int (k+k+2), def_for_int_codetemp w);    # ncf::INT is untagged, 'k+k' leftshifts it to match tagged values.
                                #                                                                                                       # The '+2' leaves low bit set after subtracting a lowbit-tagged int.
                                tagged_intsub (sub_op, v, ncf::INT k) =>  sub_op (int_bitsize, def_for_int_codetemp v, int (k+k));      # ncf::INT is untagged, 'k+k' leftshifts it to match tagged values.
                                #                                                                                                       # Subtracting this from a lowbit-tagged int will leave the lowbit set, hence a valid tagged value.
                                tagged_intsub (sub_op, v, w         ) =>  add_tagged_int_tag (sub_op ( int_bitsize,                     # Subtract two lowbit-tagged values, then add 1 to set the low bit again.
                                                                                                       def_for_int_codetemp v,
                                                                                                       def_for_int_codetemp w
                                                                                             )       );
                            end;

                            #
                            fun tagged_intxor (ncf::INT k, w     ) =>  tcf::BITWISE_XOR (int_bitsize, int (k+k), def_for_int_codetemp w);       # ncf::INT is untagged, 'k+k' leftshifts it to match tagged values; XOR then leaves lowbit tag set.
                                tagged_intxor (w, v as ncf::INT _) =>  tagged_intxor (v, w);                                                    # Reduce to above case, then apply above line.
                                tagged_intxor (v, w              ) =>  add_tagged_int_tag (tcf::BITWISE_XOR ( int_bitsize,                      # XOR two lowbit-tagged values: the XOR clears the lowbit tag, so we then add one to set it again.
                                                                                                              def_for_int_codetemp  v,
                                                                                                              def_for_int_codetemp  w
                                                                                          )                 );
                            end;

                            #
                            fun tagged_intmul (signed, mul_op, v, w)
                                = 
                                {   fun f (ncf::INT k, ncf::INT j) =>   (int (k+k), int j);                                             # ncf::INT is untagged; We need ((k*j)<<1)|1 == ((2*k)*j)|1 == ((k+k)*j)|1; the |1 is done below.
                                        f (ncf::INT k, w)          =>   (untag { signed, value => w }, int (k+k));                      # The 'untag' rightshifts, reducing to above case.
                                        f (v, w as ncf::INT _)     =>   f (w, v);                                                       # Swap args, reducing to above case.
                                        f (v, w)                   =>   ( strip_tagged_int_tag (def_for_int_codetemp v),                # Rightshift one arg and strip lowbit tag from other arg, reducing in essence to first case.
                                                                          untag { signed, value => w }
                                                                        );
                                    end;

                                    (f (v, w)) ->   (v, w);

                                    add_tagged_int_tag (mul_op (int_bitsize, v, w));                                                    # Do the multiply, then set the low bit to make a valid tagged_int tagged integers.
                                };

                            #
                            fun tagged_intdiv (signed, drm, v, w)
                                = 
                                {   my  (v, w)
                                        = 
                                        case (v, w)
                                            #
                                            (ncf::INT k, ncf::INT j) =>   (int k, int j);                                               # ncf::INT is untagged.
                                            (ncf::INT k, w)          =>   (int k, untag { signed, value => w });                        # ncf::INT is untagged.
                                            #
                                            (v, ncf::INT k)          =>   (untag { signed, value => v }, int k);                        # ncf::INT is untagged.
                                            (v, w)                   =>   (untag { signed, value => v }, untag { signed, value => w });
                                        esac;

                                    # The only way a 31-bit div can overflow
                                    # is when the result gets retagged so
                                    # we can use tcf::DIVS instead of tcf::DIVS_OR_TRAP:
                                    #
                                    tag ( signed, 
                                          signed  ??  tcf::DIVS (drm, int_bitsize, v, w)
                                                  ::  tcf::DIVU (     int_bitsize, v, w)
                                        );
                                };
                            #
                            fun tagged_intrem (signed, drm, v, w)
                                =
                                {   my  (v, w)
                                        =
                                        case (v, w)
                                            #
                                            (ncf::INT k, ncf::INT j) =>   (int k, int j);                                               # ncf::INT is untagged.
                                            (ncf::INT k, w)          =>   (int k, untag { signed, value => w });                        # ncf::INT is untagged.
                                            #
                                            (v, ncf::INT k)          =>   (untag { signed, value => v }, int k);                        # ncf::INT is untagged.
                                            (v, w)                   =>   (untag { signed, value => v }, untag { signed, value => w });
                                        esac;

                                    # Will not overflow, so
                                    # we tag like unsigned:
                                    #
                                    tag ( FALSE,
                                          signed  ??  tcf::REMS (drm, int_bitsize, v, w)
                                                  ::  tcf::REMU (int_bitsize, v, w)
                                        );
                                };
                            #
                            fun tagged_intlshift (ncf::INT k, w)                                                                        # ncf::INT is untagged.
                                    =>
                                    add_tagged_int_tag (tcf::LEFT_SHIFT (int_bitsize, int (k+k), untag_unsigned w));

                               tagged_intlshift (v, ncf::INT k)                                                                         # ncf::INT is untagged.
                                    => 
                                    add_tagged_int_tag (tcf::LEFT_SHIFT (int_bitsize, strip_tagged_int_tag (def_for_int_codetemp v), int k));

                               tagged_intlshift (v, w)
                                    => 
                                    add_tagged_int_tag (tcf::LEFT_SHIFT (int_bitsize, strip_tagged_int_tag (def_for_int_codetemp v), untag_unsigned w));
                            end;

                            #
                            fun tagged_intrshift (rshift_op, v, ncf::INT k)                                                             # ncf::INT is untagged.
                                    =>  
                                    or_tagged_int_tag (rshift_op (int_bitsize, def_for_int_codetemp v, int k));

                                tagged_intrshift (rshift_op, v, w)
                                    =>
                                    or_tagged_int_tag (rshift_op (int_bitsize, def_for_int_codetemp v, untag_unsigned w));
                            end;



                            ###########################################################################
                            # Heapchunk tags and related support.
                            # For tagword definitions see   src/c/h/heap-tags.h
                            ###########################################################################
                            #
                            fun get_heapchunk_tagword v                                                         # return v[-1];
                                = 
                                tcf::LOAD ( int_bitsize,
                                            tcf::SUB (ptr_bitsize, def_for_int_codetemp v, int 4),              # 64-bit issue: '4' is 'wordbytes'.
                                            get_ramregion_projection (v, -1)
                                          );

                            # Compare to   GET_LENGTH_IN_WORDS_FROM_TAGWORD   from   src/c/h/heap-tags.h
                            # Here we are also fetching the tagword:
                            #
                            fun get_heapchunk_length_as_tagged_int  v                                           # Length-in-words, I think.
                                = 
                                or_tagged_int_tag
                                    (tcf::RIGHT_SHIFT_U
                                      (
                                        int_bitsize,
                                        get_heapchunk_tagword v,
                                        int (tag::tag_width - 1)                                                # "-1": This leaves a garbage bit at the bottom; the above or_tagged_int_tag then produces a valid Tagged_Int value.
                                    ) );


                            #
                            fun set_up_args_for_fn_call (formal_args, actual_args)
                                = 
                                # Here we generate code to execute immediately before
                                # jumping to the entrypoint for a function.
                                #
                                # We're given the formal argument list -- what the callee expects to get -- 
                                # and also the actual argument list -- what the caller actually has.
                                # 
                                # Our task here is to construct copies from the
                                # codetemps currently holding them to the registers
                                # the caller wants them in.  (Later on the register
                                # allocator will attempt to eliminate as many as possible
                                # of these copies by appropriate assignement of codetemps
                                # to registers, but that is not our concern here.)
                                # 
                                # Note that
                                #
                                #     formal_args  intersect  actual_args
                                #
                                # is always empty because our formal args are
                                # immediately copied to fresh codetemps:
                                #
                                gather
                                  ( formal_args,
                                    actual_args,
                                    [], [],                     # dst regs, src regs:  In these two we accumulate args for a tcf::MOVE_INT_REGISTERS parallel register-copy.
                                    [],                         # In this one we accumulate args for a tcf::MOVE_FLOAT_REGISTERS parallel register-copy.
                                    [],                         # In this one we construct a "tree-ified" ... (something).
                                    []                          # In this one we accumulate loads from ram (as opposed to the preceding reg-to-reg copies).
                                  )
                                where
                                    #
                                    fun is_inlined (ncf::CODETEMP r) =>   get_codetemp_use_frequency r  ==  ONE_USE_AND_INLINED;
                                        is_inlined _                 =>   FALSE;
                                    end;
                                    #
                                    fun gather ([], [], cp_rd, cp_rs, float_copies, treeified, loads)
                                            => 
                                            {   apply  buf.put_op  treeified;

                                                case (cp_rd, cp_rs) 
                                                    #
                                                    ([],[]) =>   (); 

                                                    _ =>   buf.put_op (tcf::MOVE_INT_REGISTERS (int_bitsize, cp_rd, cp_rs));
                                                esac;

                                                case float_copies
                                                    #
                                                    [] =>  (); 
                                                    _  =>  buf.put_op (tcf::MOVE_FLOAT_REGISTERS (flt_bitsize, map #1 float_copies, map #2 float_copies));
                                                esac;

                                                apply  buf.put_op  loads;
                                            };

                                        gather ( tcf::INT_EXPRESSION (tcf::CODETEMP_INFO (type, rd))  !  formal_args,
                                                                                          actual_arg  !  actual_args,
                                                 cp_rd, cp_rs,
                                                 float_copies,
                                                 treeified,
                                                 loads
                                               )
                                            => 
                                            case (def_for_int_codetemp  actual_arg)
                                                #
                                                tcf::CODETEMP_INFO (_, rs)
                                                    =>
                                                    gather (formal_args, actual_args,   rd ! cp_rd,   rs ! cp_rs,   float_copies,  treeified,  loads);

                                                e => if (is_inlined  actual_arg)
                                                          #
                                                          gather (formal_args, actual_args,   cp_rd, cp_rs, float_copies,    tcf::LOAD_INT_REGISTER (type, rd, e) ! treeified,                                          loads);
                                                     else gather (formal_args, actual_args,   cp_rd, cp_rs, float_copies,                                           treeified,   tcf::LOAD_INT_REGISTER (type, rd, e) ! loads);
                                                     fi;
                                             esac;

                                        gather ( tcf::INT_EXPRESSION (tcf::LOAD (type, ea, r))   !   formal_args,
                                                                                    actual_arg   !   actual_args,
                                                 cp_rd, cp_rs,
                                                 float_copies,
                                                 treeified,
                                                 loads
                                               )
                                            =>
                                            # Always store them early!
                                            # 
                                            gather ( formal_args, actual_args,
                                                     cp_rd, cp_rs,
                                                     float_copies,
                                                     tcf::STORE_INT (type, ea, def_for_int_codetemp actual_arg, r)   !   treeified,
                                                     loads
                                                   );

                                        gather ( tcf::FLOAT_EXPRESSION (tcf::CODETEMP_INFO_FLOAT (type, fd))   !   formal_args,
                                                                                   actual_arg   !   actual_args,
                                                 cp_rd, cp_rs,
                                                 float_copies,
                                                 treeified,
                                                 loads
                                               )
                                            => 
                                            case (def_for_float_codetemp  actual_arg)
                                                #
                                                tcf::CODETEMP_INFO_FLOAT (_, fs)
                                                    => 
                                                    gather (formal_args, actual_args,   cp_rd, cp_rs,   (fd, fs) ! float_copies,  treeified,  loads);

                                                e => 
                                                    if (is_inlined  actual_arg)
                                                        gather (formal_args, actual_args,   cp_rd, cp_rs,   float_copies,   tcf::LOAD_FLOAT_REGISTER (type, fd, e) ! treeified,                                            loads);
                                                    else
                                                        gather (formal_args, actual_args,   cp_rd, cp_rs,   float_copies,                                            treeified,   tcf::LOAD_FLOAT_REGISTER (type, fd, e) ! loads);
                                                    fi;
                                             esac;


                                        gather _
                                            =>
                                            error "set_up_args_for_fn_call/gather";
                                    end;
                                end;



                            #############################################################################
                            # Scale-and-add -- return   a + i*k   for k = 1,4,8.
                            # These are (were?) important because the Intel32
                            # effective address logic is hardwired to compute them,
                            # and independently because we use them a lot to load
                            # byte, word and float values from heap records.

                            #
                            fun add_ix1 (a, ncf::INT 0) =>  a;                                                                                                  # ncf::INT is untagged.
                                add_ix1 (a, ncf::INT k) =>  tcf::ADD (int_bitsize, a, int k);                                                                   # ncf::INT is untagged.
                                add_ix1 (a, i         ) =>  tcf::ADD (int_bitsize, a, untag_signed i);
                            end;
                            #
                            fun add_ix4 (a, ncf::INT 0) =>  a;                                                                                                  # ncf::INT is untagged.
                                add_ix4 (a, ncf::INT i) =>  tcf::ADD (int_bitsize, a, int (i*4));                                                               # ncf::INT is untagged.
                                add_ix4 (a, i         ) =>  tcf::ADD (int_bitsize, a, tcf::LEFT_SHIFT (int_bitsize, untag_signed i, two));
                            end;
                            #
                            fun add_ix8 (a, ncf::INT 0) =>  a;                                                                                                  # ncf::INT is untagged.
                                add_ix8 (a, ncf::INT i) =>  tcf::ADD (int_bitsize, a, int (i*8));                                                               # ncf::INT is untagged.
                                add_ix8 (a, i         ) =>  tcf::ADD (int_bitsize, a, tcf::LEFT_SHIFT (int_bitsize, strip_tagged_int_tag (def_for_int_codetemp i), int 2));
                            end;



                            ###################################################################
                            # Zero-extend and sign-extend:
                            #
                            fun zero_extend_32 (size, value)
                                =
                                tcf::ZERO_EXTEND (32, size, value);

                                #  tcf::RIGHT_SHIFT_U (32, tcf::LEFT_SHIFT (32, value, int (32 - size)), int (32 - size)) 
                            #
                            fun sign_extend_32 (size, value)
                                =
                                tcf::SIGN_EXTEND (32, size, value);

                                #  tcf::RIGHT_SHIFT (32, tcf::LEFT_SHIFT (32, value, int (32 - size)), int (32 - size)) 


                            #
                            fun log_boxed_update_to_heap_changelog (updated_address, hap_offset)
                                =
                                # Add to the heap changelog the address
                                # where a boxed update has occurred.
                                #
                                # The heap changelog is basically a
                                # a list of CONS cells, to which we
                                # are prepending a new cell.
                                #
                                # We generate code equivalent to:
                                #
                                #     heap_allocation_pointer[0] =  updated_address;
                                #     heap_allocation_pointer[4] =  heap_changelog_pointer;
                                #
                                #     heap_changelog_pointer     =  heap_allocation_pointer;
                                #
                                {   buf.put_op (tcf::STORE_INT (ptr_bitsize, tcf::ADD (pri::address_width, pri::heap_allocation_pointer, int hap_offset),
                                                                 updated_address, rgn::heap_changelog));                                                                                        # 

                                    buf.put_op (tcf::STORE_INT (ptr_bitsize, tcf::ADD (pri::address_width, pri::heap_allocation_pointer, int (hap_offset+4)),           # 64-bit issue -- '4' is 'wordbytes'.
                                                           pri::heap_changelog_pointer  use_virtual_framepointer, rgn::heap_changelog));

                                    buf.put_op (set_rreg (pri::heap_changelog_pointer  use_virtual_framepointer, tcf::ADD (pri::address_width, pri::heap_allocation_pointer, int hap_offset)));
                                };



                            #########################################################
                            #    Nextcode-to-Treecode COMPARE OP translation.
                            #
                            # Nextcode compare operators are un/signed agnostic;
                            # in Nextcode un/signed type information is carried
                            # by the operands.  In Treecode operands carry no   
                            # unsigned information; instead binary operators are
                            # explicitly divided into signed and unsigned flavors.
                            # Here we implement the translation:
                            #########################################################

                            #
                            fun to_tcf_unsigned_compare  op
                                = 
                                case op
                                    ncf::p::GT  => tcf::GTU;   ncf::p::GE  => tcf::GEU; 
                                    ncf::p::LT  => tcf::LTU;   ncf::p::LE  => tcf::LEU;
                                    ncf::p::EQL => tcf::EQ;    ncf::p::NEQ => tcf::NE;
                                esac;

                            #
                            fun to_tcf_signed_compare  op
                                = 
                                case op
                                    ncf::p::GT  => tcf::GT;   ncf::p::GE  => tcf::GE;   
                                    ncf::p::LT  => tcf::LT;   ncf::p::LE  => tcf::LE;
                                    ncf::p::NEQ => tcf::NE;   ncf::p::EQL => tcf::EQ;
                                esac;

                            #
                            fun float64cmp (op, v, w)
                                = 
                                tcf::FCMP (64, fcond, def_for_float_codetemp v, def_for_float_codetemp w)
                                where
                                    fcond = case op
                                                ncf::p::f::EQ  =>  tcf::FEQ;                    # XXX BUGGO FIXME We should make these name sets identical (do we need both?)
                                                ncf::p::f::ULG =>  tcf::FNEU;                   # (I presume this is just a relic of when SML/NJ and MLRISC were separate codebases.)
                                                ncf::p::f::UN  =>  tcf::FUO;   
                                                ncf::p::f::LEG =>  tcf::FGLE; 
                                                ncf::p::f::GT  =>  tcf::FGT;   
                                                ncf::p::f::GE  =>  tcf::FGE;  
                                                ncf::p::f::UGT =>  tcf::FGTU; 
                                                ncf::p::f::UGE =>  tcf::FGEU; 
                                                ncf::p::f::LT  =>  tcf::FLT;   
                                                ncf::p::f::LE  =>  tcf::FLE;  
                                                ncf::p::f::ULT =>  tcf::FLTU; 
                                                ncf::p::f::ULE =>  tcf::FLEU; 
                                                ncf::p::f::LG  =>  tcf::FNE;  
                                                ncf::p::f::UE  =>  tcf::FEQU;
                                            esac ;
                                end;

                            #
                            fun go_to_label  label
                                =
                                tcf::GOTO (tcf::LABEL label, []);



                            # Trapping int overflows is expensive,
                            # so we do it only if requested:
                            #
                            add_or_trap  =  *coc::trap_int_overflow ?? tcf::ADD_OR_TRAP  :: tcf::ADD;
                            sub_or_trap  =  *coc::trap_int_overflow ?? tcf::SUB_OR_TRAP  :: tcf::SUB;
                            #
                            muls_or_trap =  *coc::trap_int_overflow ?? tcf::MULS_OR_TRAP :: tcf::MULS;
                            divs_or_trap =  *coc::trap_int_overflow ?? tcf::DIVS_OR_TRAP :: tcf::DIVS;


                            ##############################################################
                            # Here begins the recursive function set.
                            ##############################################################

                            #
                            fun translate_nextcode_function_to_treecode (fun_label, fun_kind, fun_id, arg_codetemps, args, arg_types, fun_body)
                                = 
                                {   generate_function_prolog (fun_label, fun_kind, fun_id, arg_codetemps, args, arg_types, fun_body);
                                    #
                                    advanced_heap_ptr := 0;
                                    #
                                    translate_nextcode_ops_to_treecode (fun_body, 0);
                                }                                                                       # fun translate_nextcode_function_to_treecode

                            also
                            fun generate_function_prolog (fun_label, fun_kind, fun_id, arg_codetemps, args, arg_types, fun_body)
                                = 
                                # Here we generate the function prolog,
                                # which in particular copies arguments from
                                # their fixed arg-passing registers into fresh
                                # local codetemps.  Our tasks here include:
                                #
                                #     1. Record types for each codetemp definition.
                                #        This is used to determine the arg-passing
                                #        convention for public functions.
                                #
                                #     2. Count the number of uses of each codetemp,
                                #        on a scale of "zero, one, many".
                                #        This is used in the forward propagation logic.
                                #
                                #     3. Set  need_base_pointer  TRUE iff the base_pointer is needed.  
                                #          It is needed iff 
                                #           a.  There is a reference to ncf::LABEL
                                #           b.  It uses ncf::JUMPTABLE -- the jumptable requires base_pointer.
                                #
                                #     4. Generate the heapcleaner tests for PUBLIC and PRIVATE functions.
                                #
                                #     5. If we're doing any floating point allocation (i.e.,
                                #        any heap allocation which needs to be 64-bit aligned)
                                #        we must align heap_allocation_pointer.
                                #
                                {
                                    ####################################################################
                                    # Survey pass.
                                    #
                                    # We start by doing a pass over the code to:
                                    #  
                                    #   1. See if any doubleword allocations are done.                          # E.g. 64-bit float allocations on 32-bit machine.
                                    #      If so, we set   needs_doubleword_alignment := TRUE  to remind
                                    #      us to later make sure heap_allocation_pointer is correctly
                                    #      aligned for doubleword allocations.                                  # 64-bit issue: Not(?) needed in 64-bit code.
                                    #  
                                    #   2. See if base_pointer is needed.
                                    #      If so, we set need_base_pointer := TRUE.
                                    #
                                    #   3. Compute for each codetemp whether it is 'use'd zero, one or many times.
                                    ####################################################################

                                    needs_doubleword_alignment  =   REF FALSE;                                  # Begin by assuming no doubleword allocations.
                                    need_base_pointer           =   REF FALSE;                                  # Begin by assuming no need for base_pointer.

                                    stipulate
                                        fun count_use  codetemp                                                 # Here is where we count "zero, one, many."
                                            =
                                            case (get_codetemp_use_frequency  codetemp)
                                                #
                                                NO_USES       =>  set_codetemp_use_frequency (codetemp, ONE_USE);
                                                ONE_USE       =>  set_codetemp_use_frequency (codetemp, MULTIPLE_USES);
                                                MULTIPLE_USES =>  ();
                                                #
                                                _       =>  error "count_use";
                                            esac;


                                        #
                                        fun check_value (ncf::CODETEMP codetemp) =>   count_use  codetemp; 
                                            check_value (ncf::LABEL _)           =>   need_base_pointer := TRUE;
                                            check_value _                        =>   ();
                                        end;

                                        #
                                        fun check_values []                        =>  ();
                                            check_values (ncf::CODETEMP v  ! rest) =>  { count_use v;                   check_values rest; };
                                            check_values (ncf::LABEL _     ! rest) =>  { need_base_pointer := TRUE;     check_values rest; };
                                            check_values (_                ! rest) =>  {                                check_values rest; };
                                        end;

                                        #
                                        fun check_record_values []
                                                =>
                                                ();

                                            check_record_values ((ncf::CODETEMP v, _)  !  rest)
                                                =>
                                                {   count_use  v;
                                                    #
                                                    check_record_values  rest;
                                                };

                                            check_record_values ((ncf::LABEL v, _)  !  rest)
                                                => 
                                                {   need_base_pointer := TRUE;
                                                    #
                                                    check_record_values  rest;
                                                };

                                            check_record_values (_  !  rest)
                                                =>
                                                check_record_values  rest;
                                        end;
                                    herein
                                        #
                                        fun note_doubleword_allocations_and_base_pointer_uses_and_uses_per_codetemp  fun_body
                                            =
                                            loop fun_body
                                            where
                                                # This one is very simple:  We mostly just loop
                                                # over all ops in the function body updating
                                                #
                                                #    needs_doubleword_alignment
                                                #    need_base_pointer
                                                #    codetemp_use_frequency
                                                #
                                                # in the obvious manner.  The one weirdness is
                                                # that we abuse the codetemp use frequency counts
                                                # to keep float-reads from moving past float-writes:
                                                #
                                                fun loop  (ncf::DEFINE_RECORD r)
                                                        => 
                                                        {   case r.kind
                                                                #
                                                                ncf::rk::FLOAT64_FATE_FN =>   needs_doubleword_alignment := TRUE;
                                                                ncf::rk::FLOAT64_BLOCK   =>   needs_doubleword_alignment := TRUE;
                                                                #
                                                                _                        =>   ();
                                                            esac;

                                                            check_record_values  r.fields;

                                                            set_ncftype_for_codetemp (r.to_temp, ncf::bogus_pointer_type);

                                                            loop  r.next;
                                                        };

                                                    loop  (ncf::GET_FIELD_I   { record, to_temp, type, next, ... })
                                                        =>
                                                        {   check_value  record;
                                                            #
                                                            set_ncftype_for_codetemp  (to_temp, type);

                                                            loop  next;
                                                        };

                                                    loop  (ncf::GET_ADDRESS_OF_FIELD_I { record, to_temp, next, ... })
                                                        =>
                                                        {   check_value  record;
                                                            #
                                                            set_ncftype_for_codetemp  (to_temp, ncf::bogus_pointer_type);

                                                            loop  next;
                                                        };

                                                    loop  (ncf::JUMPTABLE { i, nexts, ... })
                                                        => 
                                                        {   need_base_pointer := TRUE;
                                                            #
                                                            check_value  i;

                                                            apply  loop  nexts;
                                                        };

                                                    loop  (ncf::STORE_TO_RAM { args, next, ... })
                                                        =>
                                                        {   check_values  args;
                                                            #   
                                                            loop  next;
                                                        };

                                                    loop  (ncf::FETCH_FROM_RAM { op, args, to_temp, type, next })
                                                        => 
                                                        {   check_values  args;

                                                            # A float-read cannot move past a float-write.              # Why is this a float problem but not an int problem? -- 2011-08-19 CrT
                                                            # For now read operations cannot be treeified.
                                                            # This is hacked by making it (falsely) used 
                                                            # more than once.                                           # XXX SUCKO FIXME  There is a suggestion we need barriers in such cases...?

                                                            case op
                                                                #
                                                                ( ncf::p::GET_VECSLOT_NUMERIC_CONTENTS { kind_and_size => ncf::p::FLOAT _ }
                                                                | ncf::p::GET_FROM_NONHEAP_RAM         { kind_and_size => ncf::p::FLOAT _ }
                                                                )
                                                                    =>
                                                                    set_codetemp_use_frequency (to_temp, MULTIPLE_USES);

                                                                _   => ();
                                                            esac;

                                                            set_ncftype_for_codetemp  (to_temp, type);

                                                            loop  next;
                                                        };

                                                    loop  (ncf::ARITH { args, to_temp, type, next, ... })
                                                        =>
                                                        {   check_values  args;
                                                            #
                                                            set_ncftype_for_codetemp  (to_temp, type);

                                                            loop  next;
                                                        };

                                                    loop  (ncf::RAW_C_CALL { args, to_ttemps, next, ... })
                                                        =>
                                                        {   check_values  args;
                                                            #
                                                            apply  set_ncftype_for_codetemp  to_ttemps;

                                                            loop  next;
                                                        };

                                                    loop  (ncf::PURE { op, args, to_temp, type, next })
                                                        => 
                                                        {   case op     ncf::p::WRAP_FLOAT64 =>  needs_doubleword_alignment := TRUE;
                                                                        _                    =>  ();
                                                            esac;

                                                            check_values  args;

                                                            set_ncftype_for_codetemp  (to_temp, type);

                                                            loop   next;
                                                        };

                                                    loop  (ncf::IF_THEN_ELSE r)
                                                        =>
                                                        {   check_values  r.args;
                                                            #
                                                            loop         r.then_next;
                                                            loop         r.else_next;
                                                        };

                                                    loop  (ncf::TAIL_CALL r)
                                                        =>
                                                        {   check_value   r.fn;
                                                            check_values  r.args;
                                                        };

                                                    loop _ =>   error "translate_nextcode_function_to_treecode";
                                                end;                                                                                    # fun loop
                                            end;                                                                                        # where
                                    end;                                                                                                # fun note_doubleword_allocations_and_base_pointer_uses_and_uses_per_codetemp

                                    if *coc::printit
                                        #
                                        print_nextcode_fun (fun_kind, fun_id, arg_codetemps, arg_types, fun_body);                      # Print debugging information.
                                    fi;


                                    # Copy args to fresh codetemps:
                                    #
                                    case fun_kind
                                        #
                                        ncf::PRIVATE_FN
                                            =>
                                            {   buf.put_private_label  fun_label;
                                                #
                                                note_doubleword_allocations_and_base_pointer_uses_and_uses_per_codetemp
                                                    #
                                                    fun_body;

                                                copy_args_to_arg_codetemps  (args, arg_codetemps, arg_types);
                                            };

                                        ncf::PRIVATE_FN_WHICH_NEEDS_HEAPLIMIT_CHECK
                                            =>
                                            {   buf.put_private_label  fun_label;

                                                # heapcleaner test 

                                                put_heaplimit_check
                                                    =
                                                    if (*do_extra_lowhalf_optimizations
                                                    and *lowhalf_optimize_before_making_heapcleaner_code)   ihc::put_heaplimit_check_and_push_heapcleaner_call_spec_for_optimized_private_fn;
                                                    else                                                    ihc::put_heaplimit_check_and_push_heapcleaner_call_spec_for_unoptimized_private_fn;
                                                    fi;

                                                put_heaplimit_check
                                                    #
                                                    buf
                                                    #
                                                    { max_possible_heapbytes_allocated_before_next_heaplimit_check => 4 * (max_possible_heapwords_allocated_before_next_heaplimit_check fun_id),  # 64-bit issue: '4' is 'wordbytes'.
                                                      # 
                                                      live_registers        =>  args,
                                                      live_register_types   =>  arg_types,
                                                      # 
                                                      return                =>  go_to_label  fun_label
                                                    };

                                                note_doubleword_allocations_and_base_pointer_uses_and_uses_per_codetemp
                                                    #
                                                    fun_body;

                                                copy_args_to_arg_codetemps (args, arg_codetemps, arg_types);
                                            };

                                        _ =>
                                            # Public function:
                                            #
                                            {   regformals = args;
                                                #
                                                my (linkreg, regformals_tail)
                                                    =
                                                    case args
                                                        #
                                                        (tcf::INT_EXPRESSION linkreg ! regformals_tail)
                                                            =>
                                                            (linkreg, regformals_tail);

                                                        _ => error "no linkreg for public function";
                                                    esac;



                                                entry_label
                                                    = 
                                                    split_entry_block
                                                        ??   get_codelabel_for_fun_id (-fun_id - 1)
                                                        ::   fun_label;

                                                if (not split_entry_block)
                                                    #
                                                    buf.put_public_label   fun_label;
                                                else 
                                                    buf.put_public_label   entry_label; 
                                                    buf.put_bblock_note    empty_block;
                                                    buf.put_private_label  fun_label;
                                                fi;

                                                clear_hashtables ();

                                                note_doubleword_allocations_and_base_pointer_uses_and_uses_per_codetemp
                                                    fun_body;

                                                if *need_base_pointer
                                                    #
                                                    baseval                                                                     # baseval = linkreg + (const_base_pointer_reg_offset - entry_label)
                                                        = 
                                                        tcf::ADD
                                                          ( pri::address_width,
                                                            linkreg, 
                                                            tcf::LABEL_EXPRESSION
                                                              ( tcf::SUB
                                                                  ( pri::address_width,
                                                                    const_base_pointer_reg_offset,
                                                                    tcf::LABEL  entry_label
                                                                  )
                                                              )
                                                          );

                                                    buf.put_op (set_rreg (pri::base_pointer  use_virtual_framepointer, baseval));               # base_pointer = linkreg + (const_base_pointer_reg_offset - entry_label)
                                                fi;


                                                ihc::put_heaplimit_check_and_push_heapcleaner_call_spec_for_public_fn
                                                    #
                                                    buf
                                                    #
                                                    { max_possible_heapbytes_allocated_before_next_heaplimit_check => 4 * (max_possible_heapwords_allocated_before_next_heaplimit_check fun_id),    # 64-bit issue -- '4' is wordbytes
                                                      #
                                                      live_registers      =>  regformals, 
                                                      live_register_types =>  arg_types,
                                                      #
                                                      return   => tcf::GOTO (linkreg,[])
                                                    };

                                                copy_args_to_arg_codetemps
                                                  (
                                                    regformals_tail,
                                                    tail  arg_codetemps,
                                                    tail  arg_types
                                                  );
                                            };
                                    esac;

                                    # If needed, align heap_allocation_pointer
                                    # correctly for doubleword allocation.                              # On 32-bit machines we need doubleword alignment for 64-bit values, mainly 64-bit floats.
                                    #
                                    # ("Correctly" means such that we'll be 64-bit
                                    # aligned after allocating  a 32-bit tagword.)
                                    #
                                    if *needs_doubleword_alignment
                                        #
                                        buf.put_op
                                            (tcf::LOAD_INT_REGISTER                                     # heap_allocation_pointer |=  4;
                                              (
                                                ptr_bitsize,
                                                heap_allocation_pointer_register,
                                                tcf::BITWISE_OR
                                                  (
                                                    ptr_bitsize,
                                                    pri::heap_allocation_pointer,
                                                    int 4                                               # 64-bit issue -- 4 is "bytes_per_word".
                                            ) )   );                                                    # 64-bit issue -- this alignment is not needed (or correct) for 64-bit code.
                                    fi;
                                }                                                                       # fun translate_nextcode_function_to_treecode

                            also
                            fun define_and_load' (to_temp, to_temp_info, value, next, hap_offset)       # Define to_temp as to_tempinfo, then generate code for   to_tempinfo := value;   next
                                = 
                                {   set_int_def_for_codetemp' (to_temp, to_temp_info);
                                    #
                                    buf.put_op (tcf::LOAD_INT_REGISTER (int_bitsize, to_temp_info, value));  
                                    #
                                    translate_nextcode_ops_to_treecode (next, hap_offset);
                                }
                                                                                                        # "hc_info" == heapcleaner_info -- see Heapcleaner_Info in src/lib/compiler/back/low/main/nextcode/per-codetemp-heapcleaner-info.api

                            also fun define_and_load                    (to_temp, hc_info,       value, next, hap_offset) =   define_and_load' (to_temp, make_int_codetemp_info                    hc_info,       value, next, hap_offset)
                            also fun define_and_load_with_ncftype       (to_temp, ncftype,       value, next, hap_offset) =   define_and_load' (to_temp, make_int_codetemp_info_with_ncftype       ncftype,       value, next, hap_offset)
                            also fun define_and_load_with_kind_and_size (to_temp, kind_and_size, value, next, hap_offset) =   define_and_load' (to_temp, make_int_codetemp_info_with_kind_and_size kind_and_size, value, next, hap_offset)

                            also fun define_and_load_tagged_int         (to_temp,                value, next, hap_offset) =   define_and_load (to_temp, chi::i31_type, value, next, hap_offset)
                            also fun define_and_load_int1               (to_temp,                value, next, hap_offset) =   define_and_load (to_temp, chi::i32_type, value, next, hap_offset)
                            also fun define_and_load_boxed              (to_temp,                value, next, hap_offset) =   define_and_load (to_temp, chi::ptr_type, value, next, hap_offset)

                            also
                            fun def_and_load_or_inline (to_temp, value, ncftype, next, hap_offset)
                                = 
                                case (get_codetemp_use_frequency  to_temp)
                                    #
                                    MULTIPLE_USES => define_and_load_with_ncftype (to_temp, ncftype, value, next, hap_offset);                  # Define to_temp as new to_temp_info and generate code for (to_temp_info := value; next

                                    ONE_USE =>  {   set_codetemp_use_frequency_to__one_use_and_inlined   to_temp;                               # This flag is checked two places by is_inlined() in gather().
                                                    #                                                                                           # Note that we generate no tcf::LOAD_INT_REGISTER op in this case -- or any code at all;
                                                    #                                                                                           # We are deferring that to point-of-use to reduce register pressure.
                                                    #
                                                    set_int_def_for_codetemp  (to_temp, maybe_note_type_for_heapcleaner (value, ncftype));      # Define to_temp as simply 'value'. Here and treeify_allot() are the only places where
                                                    #                                                                                           # a codetemp can acquire a non-CODETEMP_INFO definition.
                                                    translate_nextcode_ops_to_treecode  (next, hap_offset);
                                                };

                                    NO_USES    => translate_nextcode_ops_to_treecode (next, hap_offset);

                                    _       => error "def_and_load_or_inline";
                                esac

                            # Generate code for
                            #
                            #    to_temp := heap_allocation_pointer + offset;  next
                            #
                            # where offset is the address offset of a newly allocated record.
                            # If codetemp is only used once, we try to propagate that to its use.
                            #
                            also
                            fun define_and_allot (to_temp, offset, next, hap_offset)
                                = 
                                define_and_load_boxed
                                  (
                                    to_temp,
                                    tcf::ADD  (pri::address_width,  pri::heap_allocation_pointer,  int offset),
                                    next,
                                    hap_offset
                                  )


                            # Generate code for
                            #    to_temp := heap_allocation_pointer + offset;
                            #    next
                            # Forward propagate until it is used.
                            #
                            also
                            fun treeify_allot (to_temp, offset, next, hap_offset)
                                = 
                                case (get_codetemp_use_frequency  to_temp)
                                    #
                                    MULTIPLE_USES => define_and_allot (to_temp, offset, next, hap_offset);

                                    ONE_USE
                                        =>
                                        # We don't mark this as treeified
                                        # because it has low register pressure:
                                        #
                                        {   absolute_alloc_offset =   offset + *advanced_heap_ptr;
                                            #
                                            set_int_def_for_codetemp  (to_temp,  tcf::LATE_CONSTANT absolute_alloc_offset);                     # Define codetemp as LATE_CONSTANT. Here and def_and_load_or_inline are the only places where
                                                                                                                                                # a codetemp can acquire a non-CODETEMP_INFO definition.
                                            translate_nextcode_ops_to_treecode  (next,  hap_offset);
                                        };

                                    NO_USES => translate_nextcode_ops_to_treecode (next, hap_offset);

                                    _    =>  error "treeify_allot";
                                esac

                            also
                            fun define_and_load_float64 (to_temp, value, next, hap_offset)
                                =
                                {   f =   make_float_codetemp_info  chi::f64_type;
                                    #
                                    set_float_def_for_codetemp (to_temp, tcf::CODETEMP_INFO_FLOAT (flt_bitsize, f));

                                    buf.put_op (tcf::LOAD_FLOAT_REGISTER (flt_bitsize, f, value));

                                    translate_nextcode_ops_to_treecode (next, hap_offset);
                                }

                            also
                            fun def_and_load_or_inline_float64 (to_temp, value, next, hap_offset)                               #   to_temp <- e   where e contains a floating-point value
                                = 
                                case (get_codetemp_use_frequency to_temp)
                                    #
                                    NO_USES => translate_nextcode_ops_to_treecode (next, hap_offset);

                                    ONE_USE =>  {   set_codetemp_use_frequency_to__one_use_and_inlined  to_temp;
                                                    #
                                                    set_float_def_for_codetemp (to_temp, value);

                                                    translate_nextcode_ops_to_treecode (next, hap_offset);
                                                };

                                    MULTIPLE_USES => define_and_load_float64 (to_temp, value, next, hap_offset);

                                    _       => error "def_and_load_or_inline_float64";
                                esac

                            also
                            fun nop (to_temp, arg, value, hap_offset)
                                =
                                define_and_load_tagged_int (to_temp, def_for_int_codetemp arg, value, hap_offset)

                            also
                            fun copy  (hc_info, to_temp, arg,  next, hap_offset)
                                = 
                                {   dst =   make_int_codetemp_info  hc_info;
                                    #
                                    set_int_def_for_codetemp' (to_temp, dst);

                                    case (def_for_int_codetemp arg)
                                        #
                                        tcf::CODETEMP_INFO (_, src)
                                            =>
                                            buf.put_op (tcf::MOVE_INT_REGISTERS (int_bitsize, [dst], [src]));

                                        e =>  buf.put_op (tcf::LOAD_INT_REGISTER (int_bitsize, dst, e));
                                    esac;

                                    translate_nextcode_ops_to_treecode (next, hap_offset);
                                }

                            also
                            fun copy_m (31, to_temp, arg, next, hap_offset)  =>  copy (chi::i31_type, to_temp, arg, next, hap_offset);
                                copy_m ( _, to_temp, arg, next, hap_offset)  =>  copy (chi::i32_type, to_temp, arg, next, hap_offset);
                            end 

#                           also                                                                                        # Commented out because it is never used.   -- 2011-08-20 CrT
#                           fun same_val (ncf::CODETEMP x,   ncf::CODETEMP y) =>   x == y; 
#                               same_val (ncf::LABEL    x,   ncf::LABEL    y) =>   x == y; 
#                               same_val (ncf::INT      x,   ncf::INT      y) =>   x == y;                              # ncf::INT is untagged.
#                               #
#                               same_val _                                    =>   FALSE;
#                           end     

                            also
                            fun branch (fun_id, compare, [ arg1, arg2 ], yes, no, hap_offset)                           #  normal branches 
                                    => 
                                    {   true_label =   lbl::make_anonymous_codelabel ();
                                        #
                                        #     "Is single assignment great or what!"
                                        #
                                        buf.put_op
                                            (branch_with_probability
                                              (
                                                tcf::IF_GOTO  (tcf::CMP  (32,  compare,  def_for_int_codetemp arg1,  def_for_int_codetemp arg2),  true_label), 
                                                #
                                                fun_id__to__branch_probability  fun_id
                                              )
                                            );

                                        do_next (no, hap_offset);

                                        put_private_label (true_label, yes, hap_offset);
                                    };

                               branch _ =>   error "branch";
                            end 


                            also
                            fun branch_if_boxed (fun_id, arg, yes, no, hap_offset)                                               # Branch if x is boxed    (x & 1  ==  0)
                                = 
                                {   label =   lbl::make_anonymous_codelabel ();
                                    #
                                    compare =   tcf::CMP  (32,  tcf::NE,  tcf::BITWISE_AND (int_bitsize, def_for_int_codetemp arg, one),  zero);

                                    buf.put_op  (branch_with_probability  (tcf::IF_GOTO (compare, label),  fun_id__to__branch_probability fun_id));

                                    do_next (yes, hap_offset);

                                    put_private_label (label, no, hap_offset);
                                }


                            also
                            fun branch_streq (len, string1, string2, yes, no, hap_offset)
                                =
                                # Branch if string1,string2 are identical strings of length 'len'.
                                # Note that 'len' is fixed at compile-time.
                                # For speed, we compare a word at a time instead of a byte at a time. 
                                #
                                # We implement the string comparison as
                                #
                                #     if (string1[0] == string2[0])  goto false_label;                                          # NB: string1[] and string2[] are arrays of words, not bytes.
                                #     if (string1[1] == string2[1])  goto false_label;
                                #     if (string1[2] == string2[2])  goto false_label;
                                #        ...
                                #     yes-stuff;
                                #     false_label:
                                #
                                {   len' =   ((len+3) / 4) * 4;                                                                 # Round up to integral number of words.         # 64-bit issue: both '4's are wordbytes, '3' is wordbytes-1 
                                    #
                                    false_label =   lbl::make_anonymous_codelabel ();

                                    r1 =   make_int_codetemp_info  chi::i32_type;
                                    r2 =   make_int_codetemp_info  chi::i32_type;

                                    buf.put_op  (tcf::LOAD_INT_REGISTER  (int_bitsize,  r1,  tcf::LOAD  (int_bitsize,  def_for_int_codetemp string1,  rgn::readonly)));
                                    buf.put_op  (tcf::LOAD_INT_REGISTER  (int_bitsize,  r2,  tcf::LOAD  (int_bitsize,  def_for_int_codetemp string2,  rgn::readonly)));
                                    #
                                    unroll 0
                                    where
                                        #
                                        fun compare_word i
                                            = 
                                            tcf::CMP
                                              ( 32,                                                                                     # 64-bit issue: '32' is wordbits.
                                                tcf::NE, 
                                                tcf::LOAD (int_bitsize, tcf::ADD (int_bitsize, tcf::CODETEMP_INFO (int_bitsize, r1), i), rgn::readonly), 
                                                tcf::LOAD (int_bitsize, tcf::ADD (int_bitsize, tcf::CODETEMP_INFO (int_bitsize, r2), i), rgn::readonly)
                                              );
                                        #
                                        fun unroll i
                                            = 
                                            if (i != len')
                                                #
                                                buf.put_op (tcf::IF_GOTO (compare_word (int i), false_label));
                                                #
                                                unroll (i+4);                                                                           # 64-bit issue: '4' is wordbytes.
                                            fi;
                                    end;

                                    do_next (yes, hap_offset);

                                    put_private_label (false_label, no, hap_offset);
                                }


                            also
                            fun conditional_move (op, args, codetemp, ncftype, next, hap_offset)                                        # Conditional move.
                                = 
                                # A conditional move lets us compute an expression like
                                #
                                #     foo = mumble ?? bar :: zot;
                                #
                                # without any jumps or branches, via a sequence like
                                #
                                #    load reg0, zot
                                #    compare mumble
                                #    conditional_move reg0, bat
                                #
                                # Using a branch-free alternative like conditional_move
                                # is a big win on modern deeply-pipelined CPU architectures
                                # because a mispredicted branch can cost us many cycles
                                # while the pipeline dumps and reloads.
                                #
                                {   fun   signed (op, arg1, arg2) =   tcf::CMP  (32,    to_tcf_signed_compare  op,  def_for_int_codetemp arg1,  def_for_int_codetemp arg2);     # 64-bit issue: The '32's all through here must be something like wordbits...?
                                    fun unsigned (op, arg1, arg2) =   tcf::CMP  (32,  to_tcf_unsigned_compare  op,  def_for_int_codetemp arg1,  def_for_int_codetemp arg2);
                                    #   
                                    fun    equal     (arg1, arg2) =   tcf::CMP  (32,  tcf::EQ,                      def_for_int_codetemp arg1,  def_for_int_codetemp arg2);
                                    fun notequal     (arg1, arg2) =   tcf::CMP  (32,  tcf::NE,                      def_for_int_codetemp arg1,  def_for_int_codetemp arg2);
                                    #
                                    fun   boxed             arg   =   tcf::CMP  (32,  tcf::EQ, tcf::BITWISE_AND (int_bitsize, def_for_int_codetemp arg, one),  zero);
                                    fun unboxed             arg   =   tcf::CMP  (32,  tcf::NE, tcf::BITWISE_AND (int_bitsize, def_for_int_codetemp arg, one),  zero);

                                    my (compare, a, b)
                                        = 
                                        case (op, args)
                                            #
                                            (ncf::p::COMPARE { op, kind_and_size=>ncf::p::INT 31 },[v, w, a, b]) =>  (  signed (op, v, w), a, b);
                                            (ncf::p::COMPARE { op, kind_and_size=>ncf::p::UNT 31 },[v, w, a, b]) =>  (unsigned (op, v, w), a, b);

                                            (ncf::p::COMPARE { op, kind_and_size=>ncf::p::INT 32 },[v, w, a, b]) =>  (  signed (op, v, w), a, b);
                                            (ncf::p::COMPARE { op, kind_and_size=>ncf::p::UNT 32 },[v, w, a, b]) =>  (unsigned (op, v, w), a, b);

                                            (ncf::p::POINTER_EQL,                             [v, w, a, b]) =>  (  equal      (v, w), a, b);
                                            (ncf::p::POINTER_NEQ,                             [v, w, a, b]) =>  (notequal     (v, w), a, b);

                                            (ncf::p::IS_BOXED,                                [v,    a, b]) =>  (  boxed       v,     a, b);
                                            (ncf::p::IS_UNBOXED,                              [v,    a, b]) =>  (unboxed       v,     a, b);

                                            (ncf::p::COMPARE_FLOATS { op, size=>64 },         [v, w, a, b]) =>  (float64cmp (op, v, w), a, b);

                                           _ => error "conditional_move";
                                       esac;

                                    case ncftype
                                        #
                                        ncf::typ::FLOAT64 =>  define_and_load_float64      (codetemp,          tcf::FCONDITIONAL_LOAD (64, compare, def_for_float_codetemp a, def_for_float_codetemp b), next, hap_offset);
                                        _                 =>  define_and_load_with_ncftype (codetemp, ncftype,  tcf::CONDITIONAL_LOAD (32, compare, def_for_int_codetemp   a, def_for_int_codetemp   b), next, hap_offset);
                                    esac;
                                }

                            also
                            fun arith (hc_info, op, arg1, arg2, to_temp, next, hap_offset)
                                = 
                                define_and_load (to_temp, hc_info, op (int_bitsize, def_for_int_codetemp arg1, def_for_int_codetemp arg2), next, hap_offset)

                            also
                            fun arith32 (op, arg1, arg2, codetemp, next, hap_offset)
                                = 
                                arith (chi::i32_type, op, arg1, arg2, codetemp, next, hap_offset) 

                            also
                            fun logical (hc_info, op, arg1, arg2, to_temp, next, hap_offset)
                                = 
                                define_and_load (to_temp, hc_info, op (int_bitsize, def_for_int_codetemp arg1, untag_unsigned arg2), next, hap_offset)

                            also
                            fun logical31 (op, arg1, arg2, codetemp, next, hap_offset)
                                = 
                                logical (chi::i31_type, op, arg1, arg2, codetemp, next, hap_offset) 

                            also
                            fun logical32 (op, arg1, arg2, codetemp, next, hap_offset)
                                = 
                                logical (chi::i32_type, op, arg1, arg2, codetemp, next, hap_offset) 

                            also
                            fun do_next (next, hap_offset)
                                = 
                                {   save =   *advanced_heap_ptr;
                                    #
                                    translate_nextcode_ops_to_treecode (next, hap_offset);

                                    advanced_heap_ptr := save;
                                }

                            also
                            fun put_private_label (label, next, hap_offset)
                                =
                                {   buf.put_private_label  label;
                                    #
                                    translate_nextcode_ops_to_treecode (next, hap_offset);
                                }

                            also
                            fun put_private_label_and_do_next (label, next, hap_offset)
                                =
                                {   buf.put_private_label  label;
                                    #
                                    do_next (next, hap_offset);
                                }


                            also
                            fun make_record (field_values, to_temp, next, hap_offset)            #  Allocate a normal record 
                                = 
                                {   len =   length  field_values;
                                    #
                                    tagword =   tagword_to_int (tag::make_tagword (len, tag::pairs_and_records_btag));

                                    treeify_allot
                                      (
                                        to_temp, 
                                        allot_record  (hc_ptr,  mem_disambig to_temp,  int tagword,  field_values,  hap_offset), 
                                        next,
                                        hap_offset + 4 + len*4                                                                                                                  # 64-bit issue: '4' is 'wordbytes'.
                                      );
                                }


                            also
                            fun make_i32block (field_values, w, next, hap_offset)                #  Allocate a record with I32 components 
                                = 
                                {   len  =   length  field_values;
                                    #
                                    tagword =   tagword_to_int (tag::make_tagword (len, tag::four_byte_aligned_nonpointer_data_btag));

                                    treeify_allot (
                                        w,
                                        allot_record (hc_i32, mem_disambig w, int tagword, field_values, hap_offset),
                                        next,
                                        hap_offset + 4 + len*4                                                                                                                  # 64-bit issue: '4' is 'wordbytes'.
                                    );
                                }


                            also
                            fun make_fblock (field_values, w, next, hap_offset)                  #  Allocate a floating point record 
                                =
                                {   len =   list::length  field_values;
                                    #
                                    tagword =   tagword_to_int (tag::make_tagword (len+len, tag::eight_byte_aligned_nonpointer_data_btag));

                                    # At initialization the allocation pointer is aligned on
                                    # an odd-word boundary (so that allocating a 4-byte tagword
                                    # will leave us correctly aligned for 8-byte data), and the
                                    # heap offset set to zero.
                                    #
                                    # If an odd number of words have been allocated then the
                                    # heap pointer is misaligned for this record creation.
                                    #
                                    hap_offset
                                        =
                                        unt::bitwise_and (unt::from_int hap_offset, 0u4) != 0u0                                                                                 # 64-bit issue: this isn't needed or correct in 64-bit code.
                                          ??  hap_offset + 4                                                                                                                    # 64-bit issue: '4' is presumably 'wordbytes'.
                                          ::  hap_offset;


                                    # The components are floating point 
                                    #
                                    treeify_allot (
                                        w,
                                        allot_frecord (mem_disambig w, int tagword, field_values, hap_offset),
                                        next,
                                        hap_offset + 4 + len*8                                                                                                                  # 64-bit issue: '4' is 'wordbytes'.
                                    );
                                }


                            also
                            fun make_vector (slot_values, w, next, hap_offset)                   #  Allocate a vector 
                                = 
                                {   length_in_slots =   length  slot_values;
                                    #
                                    hdr_tagword     =   tagword_to_int  tag::typeagnostic_ro_vector_tagword;
                                    data_tagword    =   tagword_to_int (tag::make_tagword (length_in_slots, tag::ro_vector_data_btag));

                                    data_ptr  =  make_int_codetemp_info  chi::ptr_type;
                                    mem       =  mem_disambig  w;
                                    hap_offset' =  hap_offset + 4 + length_in_slots*4;                                                                                          # 64-bit issue: '4' is 'wordbytes'.

                                    # The components are boxed. 
                                    # Allocate the data:

                                    allot_record (hc_ptr, mem, int data_tagword, slot_values, hap_offset);

                                    buf.put_op (tcf::LOAD_INT_REGISTER (ptr_bitsize, data_ptr, ea (pri::heap_allocation_pointer, hap_offset+4)));                               # 64-bit issue: '4' is 'wordbytes'.

                                    # Now allot the header pair:
                                    #
                                    treeify_allot (
                                        w, 
                                        allocate_vector_header  (hdr_tagword,  mem,  data_ptr,  length_in_slots,  hap_offset + 4 + length_in_slots*4),                          # 64-bit issue: '4' is 'wordbytes'.
                                        next,
                                        hap_offset'+12                                                                                                                          # 64-bit issue: '12' is '3*wordbytes'.
                                    );
                                }

                            also
                            fun fselect (index, vector, to_temp, next, hap_offset)              # Fetch contents of a slot in a float vector/block.
                                = 
                                # Floating point select:  Fetch vector[ index ];
                                #
                                def_and_load_or_inline_float64 (
                                    to_temp, 
                                    tcf::FLOAD (flt_bitsize, add_ix8 (def_for_int_codetemp vector, ncf::INT index), rgn::float),                                                # ncf::INT is untagged.
                                    next,
                                    hap_offset
                                )

                            also
                            fun select (index, vector, to_temp, ncftype, next, hap_offset)      # Fetch contents of a slot in an int vector/block.
                                =
                                # Non-floating point select:  Fetch vector[ index ];
                                #
                                def_and_load_or_inline (
                                    to_temp, 
                                    tcf::LOAD (int_bitsize, add_ix4 (def_for_int_codetemp vector, ncf::INT index), get_ramregion_projection (vector, index)),                   # ncf::INT is untagged.         # 64-bit issue: Need add_ix4 -> add_ix8
                                    ncftype,
                                    next,
                                    hap_offset
                                )

                            also
                            fun funny_select (index, k, to_temp, ncftype, next, hap_offset)
                                =
                                #    "Funny select; I don't know what this does."
                                #
                                # o 'index' is never used.
                                #
                                # o This fn is called only when for selects with
                                #   ncf::GET_FIELD_I.record == ncf::INT k -- that is,
                                #   when the field's "record" is in fact an int.
                                #   Raising the question of when/if we would do that.
                                #
                                # o This fn is never called during compilation of the complete codebase. -- 2011-08-20 CrT
                                #
                                {   unboxed_floats =   mp::unboxed_floats;                                                                                                      # This appears to be always TRUE currently.  -- 2011-08-20 CrT
                                    #
                                    #
                                    fun is_float ncftype
                                        = 
                                        if (not unboxed_floats)
                                            #
                                            FALSE;
                                        else
                                            case ncftype    ncf::typ::FLOAT64 =>  TRUE;
                                                      _                       =>  FALSE;
                                            esac;
                                        fi;
                                    #
                                    fun falloc_sp (to_temp, next, hap_offset)
                                        =
                                        {   set_float_def_for_codetemp  (to_temp,  tcf::CODETEMP_INFO_FLOAT  (flt_bitsize,  make_float_codetemp_info  chi::f64_type));
                                            #
                                            translate_nextcode_ops_to_treecode (next, hap_offset);
                                        };

                                    # WARNING: the following generated code should never be executed!
                                    # It is semantic nonsense! XXX BUGGO FIXME
                                    #
                                    if (is_float ncftype)   falloc_sp     (to_temp,        next, hap_offset);
                                    else                    define_and_load_int1  (to_temp, int k, next, hap_offset);           #  BOGUS 
                                    fi;                                 
                                }


                            also
                            fun call_public_fn (fun_id, actual_args, hap_offset)
                                = 
                                {   ncftypes_for_args =   map  ncftype_of  actual_args;                                 # "actual_args" is where the argument values currently are.
                                    #
                                    formal_args                                                                         # "formal_args" is where callee expects to find the argument values.
                                        =
                                        cfa::convert_nextcode_public_fun_args_to_treecode
                                          {
                                            use_virtual_framepointer,
                                            ncftype_for_fun => get_ncftype_for_codetemp  fun_id,
                                            ncftypes_for_args
                                          };

                                    dest =  case formal_args                                                            # 'link' ...?
                                                #
                                                (tcf::INT_EXPRESSION dest ! _)
                                                    =>
                                                    dest;

                                                _   => error "call_public_fn: dest";
                                            esac;


                                    set_up_args_for_fn_call (formal_args, actual_args);                                 # Copy argument values from where they are to where caller expects to find them.


                                    if track_types_for_heapcleaner
                                        #
                                        buf.put_bblock_note
                                            (
                                                make_heapcleaner_liveinliveout_note
                                                  (
                                                    hr::heapcleaner_liveout.x_to_note, 
                                                    formal_args,
                                                    ncftypes_for_args
                                                  )
                                            );
                                    fi;

                                    maybe_test_heap_allocation_limit  hap_offset;                                       # This is a no-op on Intel; on risc it introduces some pipelining by doing the compare early.

                                    buf.put_op (tcf::GOTO (dest, []));                                                  # [] is the might-branch-to labels list.

                                    buf.put_fn_liveout_info (formal_args @ global_registers);                           # Remember which registers are 'live' at the GOTO (== end of bblock).
                                }


                            also
                            fun call_private_fn  (fun_id,  actual_args,  hap_offset)
                                = 
                                case (get__callers_info__for__fun_id  fun_id)
                                    #
                                    nfs::PRIVATE_FN (REF (nfs::FN_PARAMETERS_IN_TREECODE_FORM formal_args))
                                        => 
                                        {   update_heap_allocation_pointer  hap_offset;
                                            #
                                            set_up_args_for_fn_call (formal_args, actual_args); 

                                            buf.put_op (go_to_label (get_codelabel_for_fun_id  fun_id));
                                        };

                                   nfs::PRIVATE_FN (r as REF (nfs::FN_IN_NEXTCODE_FORM (fun_id, fun_formal_args, ncftypes_for_args, fun_body)))
                                        => 
                                        {   formal_args_in_treecode_form
                                                =
                                                translate_function_formal_args_from_nextcode_to_treecode_form
                                                    #
                                                    ncftypes_for_args;

                                            fun_label =  get_codelabel_for_fun_id  fun_id;

                                            r :=  nfs::FN_PARAMETERS_IN_TREECODE_FORM  formal_args_in_treecode_form;

                                            update_heap_allocation_pointer  hap_offset;

                                            set_up_args_for_fn_call (formal_args_in_treecode_form, actual_args);

                                            translate_nextcode_function_to_treecode
                                              (
                                                fun_label,
                                                ncf::PRIVATE_FN,
                                                fun_id,
                                                fun_formal_args,
                                                formal_args_in_treecode_form,
                                                ncftypes_for_args,
                                                fun_body
                                              );
                                        };

                                   nfs::PRIVATE_FN_WHICH_NEEDS_HEAPLIMIT_CHECK (fn_info as REF (nfs::FN_IN_NEXTCODE_FORM (fun_id, fun_formal_args, ncftypes_for_args, fun_body)))
                                        => 
                                        {   formal_args_in_treecode_form
                                                = 
                                                mp::fixed_arg_passing           # fixed_arg_passing is apparently currently always FALSE.   -- 2011-08-20 CrT
                                                  ##
                                                  ??  cfa::convert_fixed_nextcode_fun_args_to_treecode { ncftypes_for_args, use_virtual_framepointer }
                                                  ::  translate_function_formal_args_from_nextcode_to_treecode_form  ncftypes_for_args;

                                            fun_label =  get_codelabel_for_fun_id  fun_id;

                                            fn_info :=  nfs::FN_PARAMETERS_IN_TREECODE_FORM  formal_args_in_treecode_form;

                                            set_up_args_for_fn_call  (formal_args_in_treecode_form, actual_args);

                                            maybe_test_heap_allocation_limit  hap_offset;

                                            translate_nextcode_function_to_treecode
                                              (
                                                fun_label,
                                                ncf::PRIVATE_FN_WHICH_NEEDS_HEAPLIMIT_CHECK,
                                                fun_id,
                                                fun_formal_args,
                                                formal_args_in_treecode_form,
                                                ncftypes_for_args,
                                                fun_body
                                              );
                                        };

                                   nfs::PRIVATE_FN_WHICH_NEEDS_HEAPLIMIT_CHECK (REF (nfs::FN_PARAMETERS_IN_TREECODE_FORM formal_args_in_treecode_form))
                                        => 
                                        {   set_up_args_for_fn_call (formal_args_in_treecode_form, actual_args); 
                                            #
                                            maybe_test_heap_allocation_limit  hap_offset;
                                            #
                                            buf.put_op (go_to_label (get_codelabel_for_fun_id  fun_id));
                                        };

                                   nfs::PUBLIC_FN { parameter_types, ... }
                                        => 
                                        {   formal_args_in_treecode_form
                                                =
                                                cfa::convert_nextcode_public_fun_args_to_treecode
                                                  {
                                                    ncftype_for_fun   => get_ncftype_for_codetemp  fun_id,
                                                    ncftypes_for_args => parameter_types,
                                                    use_virtual_framepointer
                                                  };

                                            set_up_args_for_fn_call (formal_args_in_treecode_form, actual_args);

                                            maybe_test_heap_allocation_limit  hap_offset;

                                            buf.put_op (go_to_label (get_codelabel_for_fun_id  fun_id));
                                        };
                                esac

                            also
                            fun rawload ((ncf::p::INT 32 | ncf::p::UNT 32), i, codetemp, next, hap_offset)                              # 64-bit issue: '32' is 'wordbits'.
                                    =>
                                    define_and_load_int1 (codetemp, tcf::LOAD (32, i, rgn::memory), next, hap_offset);                          # 64-bit issue: '32' is 'wordbits'.

                                rawload (ncf::p::INT (size as (8 | 16)), i, codetemp, next, hap_offset)
                                    =>
                                    define_and_load_int1 (codetemp, sign_extend_32 (size, tcf::LOAD (size, i, rgn::memory)), next, hap_offset);

                                rawload (ncf::p::UNT (size as (8 | 16)), i, codetemp, next, hap_offset)
                                    =>
                                    define_and_load_int1 (codetemp, zero_extend_32 (size, tcf::LOAD (size, i, rgn::memory)), next, hap_offset);

                                rawload ((ncf::p::UNT size | ncf::p::INT size), _, _, _, _)
                                    =>
                                    error ("rawload: unsupported size: " + int::to_string size);

                                rawload (ncf::p::FLOAT 64, i, codetemp, next, hap_offset)
                                    =>
                                    def_and_load_or_inline_float64 (codetemp, tcf::FLOAD (64, i, rgn::memory), next, hap_offset);

                                rawload (ncf::p::FLOAT 32, i, codetemp, next, hap_offset)
                                    =>
                                    def_and_load_or_inline_float64 (codetemp, tcf::FLOAT_TO_FLOAT (64, 32, tcf::FLOAD (32, i, rgn::memory)), next, hap_offset);

                                rawload (ncf::p::FLOAT size, _, _, _, _)
                                    =>
                                    error ("rawload: unsupported float size: " + int::to_string size);
                            end 

                            also
                            fun rawstore ( ( ncf::p::UNT (size as (8 | 16 | 32))
                                           | ncf::p::INT (size as (8 | 16 | 32))
                                           ),
                                           i,
                                           codetemp
                                         )
                                    =>
                                    # Both address and value are 32-bit values;
                                    # only 'size' bits of the value are being stored:
                                    #
                                    buf.put_op (tcf::STORE_INT (size, i, def_for_int_codetemp codetemp, rgn::memory));

                                rawstore ((ncf::p::UNT size | ncf::p::INT size), _, _)
                                    =>
                                    error ("rawstore: unsupported int size: " + int::to_string size);

                                rawstore (ncf::p::FLOAT (size as (32 | 64)), i, codetemp)
                                    =>
                                    buf.put_op (tcf::STORE_FLOAT (size, i, def_for_float_codetemp codetemp, rgn::memory));

                                rawstore (ncf::p::FLOAT size, _, _)
                                    =>
                                    error ("rawstore: unsupported float size: " + int::to_string size);
                            end 



                            # Generate code 



                            # ncf::DEFINE_RECORD
                            also
                            fun translate_nextcode_ops_to_treecode (ncf::DEFINE_RECORD { kind => ncf::rk::FLOAT64_FATE_FN, fields, to_temp, next }, hap_offset)   =>   make_fblock   (fields, to_temp, next, hap_offset);
                                translate_nextcode_ops_to_treecode (ncf::DEFINE_RECORD { kind => ncf::rk::FLOAT64_BLOCK,          fields, to_temp, next }, hap_offset)   =>   make_fblock   (fields, to_temp, next, hap_offset);
                                translate_nextcode_ops_to_treecode (ncf::DEFINE_RECORD { kind => ncf::rk::VECTOR,         fields, to_temp, next }, hap_offset)   =>   make_vector   (fields, to_temp, next, hap_offset);
                                translate_nextcode_ops_to_treecode (ncf::DEFINE_RECORD { kind => ncf::rk::INT1_BLOCK,     fields, to_temp, next }, hap_offset)   =>   make_i32block (fields, to_temp, next, hap_offset);
                                translate_nextcode_ops_to_treecode (ncf::DEFINE_RECORD { kind => _,                       fields, to_temp, next }, hap_offset)   =>   make_record   (fields, to_temp, next, hap_offset);



                                ###############################
                                # ncf::GET_FIELD_I:                                     # NB: ncf::INT is untagged.

                                translate_nextcode_ops_to_treecode (ncf::GET_FIELD_I { i, record => ncf::INT k, to_temp, type,                       next }, hap_offset)   =>   funny_select (i, k,      to_temp, type, next, hap_offset);
                                translate_nextcode_ops_to_treecode (ncf::GET_FIELD_I { i, record,               to_temp, type => ncf::typ::FLOAT64,  next }, hap_offset)   =>   fselect      (i, record, to_temp,       next, hap_offset);
                                translate_nextcode_ops_to_treecode (ncf::GET_FIELD_I { i, record,               to_temp, type,                       next }, hap_offset)   =>   select       (i, record, to_temp, type, next, hap_offset);



                                ###############################
                                # ncf::GET_ADDRESS_OF_FIELD_I:

                                translate_nextcode_ops_to_treecode (ncf::GET_ADDRESS_OF_FIELD_I { i, record, to_temp, next }, hap_offset)
                                    =>
                                    define_and_load_boxed (to_temp, add_ix4 (def_for_int_codetemp record, ncf::INT i), next, hap_offset);                       # ncf::INT is untagged.      # 64-bit issue: Need add_ix4 -> add_ix8 on 64-bit architectures.



                                ###############################
                                # ncf::TAIL_CALL:

                                translate_nextcode_ops_to_treecode (ncf::TAIL_CALL { fn => ncf::INT      k, args }, hap_offset) =>  update_heap_allocation_pointer  hap_offset;                 # ncf::INT is untagged.
                                translate_nextcode_ops_to_treecode (ncf::TAIL_CALL { fn => ncf::CODETEMP f, args }, hap_offset) =>  call_public_fn  (f, args, hap_offset);
                                translate_nextcode_ops_to_treecode (ncf::TAIL_CALL { fn => ncf::LABEL    f, args }, hap_offset) =>  call_private_fn (f, args, hap_offset);



                                ###############################
                                # ncf::JUMPTABLE:

                                translate_nextcode_ops_to_treecode (ncf::JUMPTABLE { i => ncf::INT _, ... }, hap_offset)        
                                    =>
                                    error "JUMPTABLE";  # Jumptables keying on a constant should have been optimized out in   src/lib/compiler/back/top/improve-nextcode/clean-nextcode-g.pkg

                                translate_nextcode_ops_to_treecode (ncf::JUMPTABLE { i, nexts, ... }, hap_offset)
                                    => 
                                    {   label  =   lbl::make_anonymous_codelabel ();
                                        labels =   map  (\\ _ = lbl::make_anonymous_codelabel())  nexts;

                                        tmp_r =   make_int_codetemp_info chi::i32_type;
                                        tmp  =   tcf::CODETEMP_INFO (int_bitsize, tmp_r);

                                        buf.put_op (tcf::LOAD_INT_REGISTER (int_bitsize, tmp_r, make_code_for_label_address (label, 0)));

                                        buf.put_op
                                            (tcf::GOTO
                                                (tcf::ADD
                                                  ( pri::address_width,
                                                    tmp,
                                                    tcf::LOAD  (ptr_bitsize,  add_ix4 (tmp, i),  rgn::readonly)                 # 64-bit issue: Need add_ix4 -> add_ix8 on 64-bit architectures.
                                                  ),
                                                labels
                                            )   );

                                        buf.put_pseudo_op  pb::DATA_READ_ONLY;
                                        buf.put_pseudo_op (pb::EXT (cpo::JUMPTABLE { base=>label, targets=>labels } ));
                                        buf.put_pseudo_op  pb::TEXT;

                                        pl::apply
                                            (\\ (label, next) = put_private_label_and_do_next (label, next, hap_offset))
                                            (labels, nexts);
                                    };


                                ###############################
                                # ncf::PURE:

                                translate_nextcode_ops_to_treecode
                                    (
                                      ncf::PURE   { op   =>  ncf::p::CONVERT_FLOAT { from=>ncf::p::INT 31, to=>ncf::p::FLOAT 64 },      # 64-bit issue...
                                                    args =>  [ arg ],
                                                    to_temp,
                                                    next,
                                                    ...
                                                  },
                                      hap_offset
                                    )
                                    =>  def_and_load_or_inline_float64 (to_temp, tcf::INT_TO_FLOAT (flt_bitsize, int_bitsize, untag_signed arg), next, hap_offset);


                                translate_nextcode_ops_to_treecode
                                    ( ncf::PURE   { op   =>  ncf::p::CONVERT_FLOAT { from=>ncf::p::INT 32, to=>ncf::p::FLOAT 64 },      # 64-bit issue...
                                                    args =>  [ arg ],
                                                    to_temp,
                                                    next,
                                                    ...
                                                  },
                                      hap_offset
                                    )
                                    =>
                                    def_and_load_or_inline_float64 (to_temp, tcf::INT_TO_FLOAT (flt_bitsize, int_bitsize, def_for_int_codetemp arg), next, hap_offset);


                                translate_nextcode_ops_to_treecode
                                    ( ncf::PURE   { op   =>  ncf::p::PURE_ARITH  {  op,  kind_and_size => ncf::p::FLOAT 64  },
                                                    args =>  [ arg ],
                                                    to_temp,
                                                    next,
                                                    ...
                                                  },
                                      hap_offset
                                    )
                                    =>
                                    {   r =  def_for_float_codetemp  arg;
                                        #
                                        case op
                                            #
                                            ncf::p::NEGATE =>   def_and_load_or_inline_float64 (to_temp, tcf::FNEG  (flt_bitsize,               r), next, hap_offset);
                                            ncf::p::ABS    =>   def_and_load_or_inline_float64 (to_temp, tcf::FABS  (flt_bitsize,               r), next, hap_offset);
                                            ncf::p::FSQRT  =>   def_and_load_or_inline_float64 (to_temp, tcf::FSQRT (flt_bitsize,               r), next, hap_offset);
                                            #
                                            ncf::p::FSIN   =>   define_and_load_float64                (to_temp, tcf::FEXT  (flt_bitsize, trx::FSINE    r), next, hap_offset);
                                            ncf::p::FCOS   =>   define_and_load_float64                (to_temp, tcf::FEXT  (flt_bitsize, trx::FCOSINE  r), next, hap_offset);
                                            ncf::p::FTAN   =>   define_and_load_float64                (to_temp, tcf::FEXT  (flt_bitsize, trx::FTANGENT r), next, hap_offset);
                                            #
                                            _ => error "unexpected baseop in pure unary float64";
                                        esac;
                                    };

                                translate_nextcode_ops_to_treecode
                                    (
                                      ncf::PURE   { op   =>  ncf::p::PURE_ARITH { op, kind_and_size=>ncf::p::FLOAT 64 },
                                                    args =>  [ arg1, arg2 ],
                                                    to_temp,
                                                    next,
                                                    ...
                                                  },
                                      hap_offset
                                    )
                                    => 
                                    {   arg1 =  def_for_float_codetemp  arg1; 
                                        arg2 =  def_for_float_codetemp  arg2;

                                        value = case op
                                                    #
                                                    ncf::p::ADD      =>  tcf::FADD (flt_bitsize, arg1, arg2);
                                                    ncf::p::MULTIPLY =>  tcf::FMUL (flt_bitsize, arg1, arg2);
                                                    ncf::p::SUBTRACT =>  tcf::FSUB (flt_bitsize, arg1, arg2);
                                                    ncf::p::DIVIDE   =>  tcf::FDIV (flt_bitsize, arg1, arg2);
                                                    #
                                                    _ => error "unexpected baseop in pure binary float64";
                                                esac;

                                        def_and_load_or_inline_float64 (to_temp, value, next, hap_offset);
                                    };


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::PURE_ARITH { op=>ncf::p::BITWISE_OR, kind_and_size },  args => [arg1, arg2],  to_temp, next, ... }, hap_offset)
                                    => 
                                    define_and_load_with_kind_and_size (to_temp, kind_and_size, tcf::BITWISE_OR (int_bitsize, def_for_int_codetemp arg1, def_for_int_codetemp arg2), next, hap_offset);


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::PURE_ARITH { op=>ncf::p::BITWISE_AND, kind_and_size },  args => [arg1, arg2],  to_temp, next, ... }, hap_offset)
                                    => 
                                    define_and_load_with_kind_and_size (to_temp, kind_and_size, tcf::BITWISE_AND (int_bitsize, def_for_int_codetemp arg1, def_for_int_codetemp arg2), next, hap_offset);


                                translate_nextcode_ops_to_treecode
                                      (
                                        ncf::PURE { op   =>  ncf::p::PURE_ARITH { op, kind_and_size },
                                                    args =>  [arg1, arg2],
                                                    to_temp,
                                                    type,
                                                    next
                                                  },
                                        hap_offset
                                      )
                                    => 
                                    case kind_and_size
                                        #
                                        ncf::p::INT 31
                                            =>
                                            case op
                                                ncf::p::BITWISE_XOR => define_and_load_tagged_int (to_temp, tagged_intxor    (                  arg1, arg2), next, hap_offset);
                                                ncf::p::LSHIFT      => define_and_load_tagged_int (to_temp, tagged_intlshift (                  arg1, arg2), next, hap_offset);
                                                ncf::p::RSHIFT      => define_and_load_tagged_int (to_temp, tagged_intrshift (tcf::RIGHT_SHIFT, arg1, arg2), next, hap_offset);

                                                ncf::p::ADD         => define_and_load_tagged_int (to_temp, tagged_intadd (      tcf::ADD,      arg1, arg2), next, hap_offset);
                                                ncf::p::SUBTRACT    => define_and_load_tagged_int (to_temp, tagged_intsub (      tcf::SUB,      arg1, arg2), next, hap_offset);
                                                ncf::p::MULTIPLY    => define_and_load_tagged_int (to_temp, tagged_intmul (TRUE, tcf::MULS,     arg1, arg2), next, hap_offset);

                                                _ => error "translate_nextcode_ops_to_treecode: ncf::PURE ncf::INT 31";
                                            esac;

                                        ncf::p::INT 32
                                            =>
                                            case op   
                                                ncf::p::BITWISE_XOR  => arith32   (tcf::BITWISE_XOR,  arg1, arg2, to_temp, next, hap_offset);
                                                ncf::p::LSHIFT       => logical32 (tcf::LEFT_SHIFT,   arg1, arg2, to_temp, next, hap_offset);
                                                ncf::p::RSHIFT       => logical32 (tcf::RIGHT_SHIFT,  arg1, arg2, to_temp, next, hap_offset);

                                                _ => error "translate_nextcode_ops_to_treecode: ncf::PURE ncf::INT 32";
                                            esac;

                                        ncf::p::UNT 31
                                            =>
                                            case op   
                                                ncf::p::ADD      => define_and_load_tagged_int (to_temp, tagged_intadd (       tcf::ADD,  arg1, arg2), next, hap_offset);
                                                ncf::p::SUBTRACT => define_and_load_tagged_int (to_temp, tagged_intsub (       tcf::SUB,  arg1, arg2), next, hap_offset);
                                                ncf::p::MULTIPLY => define_and_load_tagged_int (to_temp, tagged_intmul (FALSE, tcf::MULU, arg1, arg2), next, hap_offset);

                                                ncf::p::DIVIDE   => # This is not really a pure 
                                                                    # operation -- oh well:
                                                                    #
                                                                    {   update_heap_allocation_pointer hap_offset;
                                                                        define_and_load_tagged_int (to_temp, tagged_intdiv (FALSE, tcf::d::ROUND_TO_ZERO, arg1, arg2), next, 0);
                                                                    };

                                                ncf::p::REM =>      #  Neither is this -- oh well 
                                                                    #
                                                                    {   update_heap_allocation_pointer hap_offset;
                                                                        define_and_load_tagged_int (to_temp, tagged_intrem (FALSE, tcf::d::ROUND_TO_ZERO, arg1, arg2), next, 0);
                                                                    };

                                                ncf::p::BITWISE_XOR => define_and_load_tagged_int (to_temp, tagged_intxor (                       arg1, arg2), next, hap_offset);
                                                ncf::p::LSHIFT      => define_and_load_tagged_int (to_temp, tagged_intlshift (                    arg1, arg2), next, hap_offset);

                                                ncf::p::RSHIFT      => define_and_load_tagged_int (to_temp, tagged_intrshift (tcf::RIGHT_SHIFT,   arg1, arg2), next, hap_offset);
                                                ncf::p::RSHIFTL     => define_and_load_tagged_int (to_temp, tagged_intrshift (tcf::RIGHT_SHIFT_U, arg1, arg2), next, hap_offset);
                                                #
                                                _ => error "translate_nextcode_ops_to_treecode: ncf::PURE UINT 31";
                                            esac;

                                        ncf::p::UNT 32
                                            =>
                                            case op   
                                                ncf::p::ADD       => arith32 (tcf::ADD,  arg1, arg2, to_temp, next, hap_offset);
                                                ncf::p::SUBTRACT  => arith32 (tcf::SUB,  arg1, arg2, to_temp, next, hap_offset);
                                                ncf::p::MULTIPLY  => arith32 (tcf::MULU, arg1, arg2, to_temp, next, hap_offset);

                                                ncf::p::DIVIDE    => {  update_heap_allocation_pointer hap_offset; 
                                                                        arith32 (tcf::DIVU, arg1, arg2, to_temp, next, 0);
                                                                     };

                                                ncf::p::REM       => {  update_heap_allocation_pointer hap_offset;
                                                                        arith32 (tcf::REMU, arg1, arg2, to_temp, next, 0);
                                                                     };

                                                ncf::p::BITWISE_XOR => arith32   (tcf::BITWISE_XOR,   arg1, arg2, to_temp, next, hap_offset);
                                                ncf::p::LSHIFT      => logical32 (tcf::LEFT_SHIFT,    arg1, arg2, to_temp, next, hap_offset);

                                                ncf::p::RSHIFT      => logical32 (tcf::RIGHT_SHIFT,   arg1, arg2, to_temp, next, hap_offset);
                                                ncf::p::RSHIFTL     => logical32 (tcf::RIGHT_SHIFT_U, arg1, arg2, to_temp, next, hap_offset);

                                                _ => error "translate_nextcode_ops_to_treecode: ncf::PURE UINT 32";
                                            esac;

                                        _ => error "unexpected numkind in pure binary arithop";
                                    esac;


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::PURE_ARITH { op=>ncf::p::BITWISE_NOT, kind_and_size }, args => [ arg ], to_temp, next, ... }, hap_offset)
                                    =>
                                    case kind_and_size 
                                        #
                                        (ncf::p::UNT 32 | ncf::p::INT 32)
                                            =>
                                            define_and_load_int1 (to_temp, tcf::BITWISE_XOR (int_bitsize, def_for_int_codetemp arg,  unt 0uxFFFFFFFF), next, hap_offset);

                                        (ncf::p::UNT 31 | ncf::p::INT 31)
                                            =>
                                            define_and_load_tagged_int (to_temp, tcf::SUB (int_bitsize, zero, def_for_int_codetemp arg), next, hap_offset);

                                        _ =>   error "unexpected numkind in pure bitwise_not arithop";

                                    esac;


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::PURE_ARITH { op=>ncf::p::NEGATE, kind_and_size }, args => [ arg ], to_temp, next, ... }, hap_offset)
                                    =>
                                    case kind_and_size   
                                        #
                                        ( ncf::p::UNT 32
                                        | ncf::p::INT 32
                                        )
                                            =>
                                            define_and_load_int1 (to_temp, tcf::SUB (int_bitsize, zero, def_for_int_codetemp arg), next, hap_offset);

                                        ( ncf::p::UNT 31
                                        | ncf::p::INT 31
                                        )
                                            =>
                                            define_and_load_tagged_int (to_temp, tcf::SUB (int_bitsize, int 2, def_for_int_codetemp arg), next, hap_offset);

                                        _ => error "unexpected numkind in pure ~ baseop";
                                    esac;


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::COPY ft, args => [ arg ], to_temp, next, ... }, hap_offset)
                                    =>
                                    case ft   
                                        #
                                       (31, 32) =>   define_and_load_int1 (to_temp, tcf::RIGHT_SHIFT_U (int_bitsize, def_for_int_codetemp arg, one), next, hap_offset);
                                       ( 8, 32) =>   define_and_load_int1 (to_temp, tcf::RIGHT_SHIFT_U (int_bitsize, def_for_int_codetemp arg, one), next, hap_offset);

                                       ( 8, 31) =>   copy (chi::i31_type, to_temp, arg, next, hap_offset);


                                       (n, m) => if (n == m)   copy_m (m, to_temp, arg, next, hap_offset); 
                                                 else          error "translate_nextcode_ops_to_treecode: ncf::PURE: copy";
                                                 fi;
                                    esac;


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::COPY_TO_INTEGER _, ... }, hap_offset)
                                    =>
                                    error "translate_nextcode_ops_to_treecode: ncf::PURE: copy_inf";


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::STRETCH ft, args => [ arg ], to_temp, next, ... }, hap_offset)
                                    => 
                                    case ft   
                                        (8, 31) => define_and_load_tagged_int (to_temp, tcf::RIGHT_SHIFT (int_bitsize, tcf::LEFT_SHIFT (int_bitsize, def_for_int_codetemp arg, int 23), int 23), next, hap_offset);
                                        (8, 32) => define_and_load_int1       (to_temp, tcf::RIGHT_SHIFT (int_bitsize, tcf::LEFT_SHIFT (int_bitsize, def_for_int_codetemp arg, int 23), int 24), next, hap_offset);
                                       (31, 32) => define_and_load_int1       (to_temp, tcf::RIGHT_SHIFT (int_bitsize,                               def_for_int_codetemp arg,             one), next, hap_offset);

                                       (n, m) => if (n == m)  copy_m (m, to_temp, arg, next, hap_offset); 
                                                 else         error "translate_nextcode_ops_to_treecode: ncf::PURE: extend";
                                                 fi;
                                    esac;


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::STRETCH_TO_INTEGER _, ... }, hap_offset)
                                    =>
                                    error "translate_nextcode_ops_to_treecode: ncf::PURE: extend_inf";


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::CHOP ft, args => [ arg ], to_temp, next, ... }, hap_offset)
                                    => 
                                    case ft
                                        #
                                        (32, 31) =>  define_and_load_tagged_int (to_temp,               tcf::BITWISE_OR  (int_bitsize, tcf::LEFT_SHIFT (int_bitsize, def_for_int_codetemp arg, one),       one), next, hap_offset);
                                        (31,  8) =>  define_and_load_int1       (to_temp,               tcf::BITWISE_AND (int_bitsize,                               def_for_int_codetemp arg,       int 0x1ff), next, hap_offset);
                                        (32,  8) =>  define_and_load_int1       (to_temp, tag_unsigned (tcf::BITWISE_AND (int_bitsize,                               def_for_int_codetemp arg,       int 0xff)), next, hap_offset);

                                       (n, m) => if (n == m)  copy_m (m, to_temp, arg, next, hap_offset); 
                                                 else         error "translate_nextcode_ops_to_treecode: ncf::PURE: trunc";
                                                 fi;
                                    esac;


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::CHOP_INTEGER _, ... }, hap_offset)
                                    =>
                                    error "translate_nextcode_ops_to_treecode: ncf::PURE: trunc_inf";


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::HEAPCHUNK_LENGTH_IN_WORDS, args => [ arg ], to_temp, next, ... }, hap_offset)
                                    => 
                                    define_and_load_tagged_int (to_temp, get_heapchunk_length_as_tagged_int arg, next, hap_offset);


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::VECTOR_LENGTH_IN_SLOTS, args => [ arg ], to_temp, type, next }, hap_offset)
                                    =>
                                    select (1, arg, to_temp, type, next, hap_offset);


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::RO_VECTOR_GET, args => [ arg, ncf::INT i ], to_temp, next, ... }, hap_offset)                             # ncf::INT is untagged.
                                    => 
                                    {   # Get data pointer:
                                        #
                                        mem  = get_dataptr_ramregion arg;
                                        a    = hc_ptr (tcf::LOAD (int_bitsize, def_for_int_codetemp arg, mem));
                                        mem' = get_rw_vector_ramregion mem;

                                        define_and_load_boxed (to_temp, tcf::LOAD (int_bitsize, add_ix4 (a, ncf::INT i), mem'), next, hap_offset);                                                              # ncf::INT is untagged.
                                    };


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::RO_VECTOR_GET, args => [ arg1, arg2 ], to_temp, next, ... }, hap_offset)
                                    => 
                                    {   # Get data pointer:
                                        # 
                                        mem  = get_dataptr_ramregion arg1;
                                        a    = hc_ptr (tcf::LOAD (int_bitsize, def_for_int_codetemp arg1, mem));
                                        mem' = get_rw_vector_ramregion mem;

                                        define_and_load_boxed (to_temp, tcf::LOAD (int_bitsize, add_ix4 (a, arg2), mem'), next, hap_offset);
                                    };


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::PURE_GET_VECSLOT_NUMERIC_CONTENTS { kind_and_size=>ncf::p::INT 8 }, args => [ vector, index ], to_temp, next, ... }, hap_offset)
                                    =>
                                    {   # Get data pointer:
                                        #
                                        mem  = get_dataptr_ramregion vector;
                                        a    = hc_ptr (tcf::LOAD (int_bitsize, def_for_int_codetemp vector, mem));
                                        mem' = get_rw_vector_ramregion mem;

                                        define_and_load_tagged_int (to_temp, tag_unsigned (tcf::LOAD (8, add_ix1 (a, index), mem')), next, hap_offset);
                                    };


                                translate_nextcode_ops_to_treecode (ncf::PURE { op => ncf::p::GET_BATAG_FROM_TAGWORD, args => [ arg ], to_temp, next, ... }, hap_offset)
                                    => 
                                    define_and_load_tagged_int (to_temp, tag_unsigned (tcf::BITWISE_AND (int_bitsize, get_heapchunk_tagword arg, int (tag::pow_tag_width - 1))), next, hap_offset);
                                        #
                                        # tag_width       is  7 -- five bits of b-tag and&n