"James K. Lowden" <jklow...@schemamania.org> writes:
> From 5d53920602e234e4d99ae2d502e662ee3699978e 4 Oct 2024 12:01:22 -0400
> From: "James K. Lowden" <jklow...@symas.com>
> Date: Sat 15 Feb 2025 12:50:53 PM EST
> Subject: [PATCH] 3 new 'cobol' FE files
>
> gcc/cobol/ChangeLog
> * gengen.cc: New file.
> * genmath.cc: New file.
> * genutil.cc: New file.
>
> ---
> gcc/cobol/gengen.cc |
> ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++
>
> +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++
>
> +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++
>
> +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
> gcc/cobol/genmath.cc |
> +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++
>
> +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
> gcc/cobol/genutil.cc |
> +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++
>
> +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
++
>
> ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
> 3 files changed, 7857 insertions(+), 3 deletions(-)
> diff --git a/gcc/cobol/gengen.cc b/gcc/cobol/gengen.cc
> new file mode 100644
> index 00000000000..b84c3fa0fc9
> --- /dev/null
> +++ b/gcc/cobol/gengen.cc
> @@ -0,0 +1,3477 @@
> +/*
> + * Copyright (c) 2021-2025 Symas Corporation
> + *
> + * Redistribution and use in source and binary forms, with or without
> + * modification, are permitted provided that the following conditions are
> + * met:
> + *
> + * * Redistributions of source code must retain the above copyright
> + * notice, this list of conditions and the following disclaimer.
> + * * Redistributions in binary form must reproduce the above
> + * copyright notice, this list of conditions and the following disclaimer
> + * in the documentation and/or other materials provided with the
> + * distribution.
> + * * Neither the name of the Symas Corporation nor the names of its
> + * contributors may be used to endorse or promote products derived from
> + * this software without specific prior written permission.
> + *
> + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
> + * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
> + * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
> + * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
> + * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
> + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
> + * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
> + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
> + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
> + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
> + * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
> + */
> +/* The compilation process consists of
> +
> + 1) lexing
> + 2) parsing
> + 3) generation of the GENERIC abstract syntax tree
> + 4) reduction
> + 5) generation of machine code
> +
> + For your sins, you have wandered into the code that accepts information
> from
> + the parser about what the COBOL source code wants done.
> +
> + Specifically, the routines in this module, which run at compile time,
> generate
> + the GENERIC tags that describe the equivalent of the COBOL. They are
> rathernnn
> + low level routines, ultimately used for pretty much everything.
> Specifically,
> + they run at compile-time, and they generate the GENERIC tags that
> control what
> + ultimately happens at run-time.
> +
> + It *is* confusing.
> +
> + I'll try to collect things in a logical way, and name them in a logical
> way,
> + and I'll try to comment them well enough so that you have some hope of
> + understanding what the heck is going on.
> +
> + There is some information in the GCC internals document, but it was
> written by
> + people who live and breathe this stuff, and they don't remember what it
> was like
> + to know nothing.
> +
> + I suspect that those who have tried and failed to create GCC front ends
> have foundered because
> + they just couldn't figure out what it was they needed to do. I
> certainly floundered
> + for several days before I hit on the means to figure it out. I created
> the
> + rjd_print_tree() routine, which spits out a text listing of all the nodes
> + connected to the specified starting node. (Keep in mind that the
> GENERIC graph
> + is cyclic, and consequently there is no real ordering, except that the
> starting
> + node you specify is NodeNumber0. rjd_print_tree follows all links, but
> it prints
> + out each unique node exactly once.)
> +
> + I then built into GCC a call to rjd_print_tree right at the point where
> the GENERIC tree
> + is complete and about to be reduced.
> +
> + And that gave me the ability to create simple C programs and see the
> resulting GENERIC
> + tree. It took a while to sort out what I was seeing, but ultimately
> things started
> + to make sense. The inherent difficulty may start to become clear when
> you realize that
> + the program
> +
> + void foo()
> + {
> + }
> +
> + is implemented by a GENERIC tree with fifty-six nodes.
> +
> + I can't try to write a whole manual here. But hopefully there will be
> enough examples
> + throughout the code for you to learn how to do things on a highish
> level, and you can
> + look at the low -level routines to see how it is accomplished.
> +
> + That said, I will try to comment things well enough to be meaningful at
> least to me
> + when I run across them at some time in the future. Because I fear that
> whatever
> + I do here, the world will little note, and *I* will not long remember,
> what it was!
> + */
> +
> +#include "cobol-system.h"
> +#include "coretypes.h"
> +#include "tree.h"
> +#include "tree-iterator.h"
> +#include "stringpool.h"
> +#include "cgraph.h"
> +#include "toplev.h"
> +#include "function.h"
> +#include "fold-const.h"
> +#define HOWEVER_GCC_DEFINES_TREE 1
> +#include "ec.h"
> +#include "common-defs.h"
> +#include "util.h"
> +#include "cbldiag.h"
> +#include "symbols.h"
> +#include "gengen.h"
> +
> +// We are limiting the programmer to functions with 512 or fewer arguments.
> +// Don't like it? Cry me a river.
> +static const int ARG_LIMIT = 512;
> +
> +static int sv_current_line_number;
> +
> +// These are globally useful constants
> +tree char_nodes[256];
> +
> +tree pvoid_type_node;
> +tree integer_minusone_node;
> +tree integer_two_node;
> +tree integer_eight_node;
> +tree size_t_zero_node;
> +tree int128_zero_node;
> +tree int128_five_node;
> +tree int128_ten_node;
> +tree char_ptr_type_node;
> +tree uchar_ptr_type_node;
> +tree wchar_ptr_type_node;
> +tree long_double_ten_node;
> +tree sizeof_size_t;
> +tree sizeof_pointer;
> +
> +tree bool_true_node;
> +tree bool_false_node;
> +
> +// This is the global translation unit structure; it contains everything
> needed
> +// to compile one file that you might otherwise be tempted to instantiate as
> +// global variables:
> +
> +struct cbl_translation_unit_t gg_trans_unit;
> +
> +void
> +gg_build_translation_unit(const char *filename)
> + {
> + // The translation_unit_decl gets declared once for each processing source
> + // input file. It serves as an anchor for each function. And the
> + // block referred to by its "initial" member is the anchor for any
> + // variables whose scope is file.
> +
> + gg_trans_unit.trans_unit_decl
> + = build_translation_unit_decl(get_identifier(filename));
> +
> + gg_trans_unit.filename = filename;
> +
> + tree tree_block = make_node(BLOCK);
> + BLOCK_SUPERCONTEXT(tree_block)
> + = gg_trans_unit.trans_unit_decl;
> + TREE_USED(tree_block) = 1;
> + DECL_INITIAL(gg_trans_unit.trans_unit_decl) = tree_block;
> + }
> +
> +// Explanation of context. There is a plate of spaghetti that represents
> +// a chain of contexts.
> +
> +// The deconstructed dinner: The function_decl "initial" points to a block
> +// The block points to the first of a chained set of var_decl, one for each
> +// variable in the block. The function "saved_tree" entry points to a
> +// bind_expr. The bind_expr vars member points to the same chain of
> var_decl.
> +// The bind_expr block member points to the block. And the bind_expr body
> +// member points to the statement_list for the context.
> +
> +// Those four tags constitute the context. To push the context, a new block
> +// is chained to the first blocks SUBCHAIN member. A new bind_expr is
> created
> +// and put on the statement_list of the enclosing block. And a new list of
> +// var_decls is set up for the new block and the new bind_expr.
> +
> +// And that's how subcontexts are made.
> +
> +static void
> +gg_chain_onto_block_vars(tree block, tree var)
> + {
> + // In order to use a variable in a context, the var_decl has to go
> + // onto the chain that starts with the "vars" entry of a block
> +
> + // Upon discovering that chainon has O(N-squared) complexity because it
> walks
> + // the entire chain looking for the final member, Dubner put in this map.
> + static std::unordered_map<tree, tree>blocks;
> + if( !BLOCK_VARS(block) )
> + {
> + // This is the first variable:
> + BLOCK_VARS(block) = var;
> + blocks[block] = var;
> + }
> + else
> + {
> + //chainon(BLOCK_VARS(block), var);
> + // What follows is the quicker equivalent of calling chainon()
> + TREE_CHAIN(blocks[block]) = var;
> + blocks[block] = var;
> + }
> + }
> +
> +void
> +gg_append_var_decl(tree var_decl)
> + {
> + // The var_decl has to be chained onto the appropriate block.
> +
> + if( SCOPE_FILE_SCOPE_P(DECL_CONTEXT(var_decl)) )
> + {
> + tree context = gg_trans_unit.trans_unit_decl;
> + tree block = DECL_INITIAL(context);
> +
> + gg_chain_onto_block_vars(block, var_decl);
> +
> + rest_of_decl_compilation (var_decl, true, false);
> +
> + // With global variables, it is probably necessary to do something with
> + // wrapup_global_declarations. At this writing, I have not yet
> + // investigated that. The advice from g...@gcc.gnu.org came from
> + // David Malcolm:
> + /*
> + You might find libgccjit's gcc/jit/jit-playback.cc helpful for this, as
> + it tends to contain minimal code to build trees (generally
> + simplified/reverse-engineered from the C frontend).
> +
> + playback::context::global_new_decl makes the VAR_DECL node, and such
> + trees are added to the jit playback::context's m_globals.
> + In playback::context::replay, we have:
> +
> + / * Finalize globals. See how FORTRAN 95 does it in gfc_be_parse_file()
> + for a simple reference. * /
> + FOR_EACH_VEC_ELT (m_globals, i, global)
> + rest_of_decl_compilation (global, true, true);
> +
> + wrapup_global_declarations (m_globals.address(), m_globals.length());
> + */
> +
> + // Stash this var_decl in a map so it can be found elsewhere:
> + //fprintf(stderr, "Stashing %s\n",
> IDENTIFIER_POINTER(DECL_NAME(var_decl)));
> + gg_trans_unit.trans_unit_var_decls
> + [IDENTIFIER_POINTER(DECL_NAME(var_decl))] = var_decl;
> + }
> + else
> + {
> + // For function-level variables, we use a stack of blocks to keep track
> + // of which block is active for the current context:
> +
> + // fprintf(stderr, "%s(): %30s Function Scope\n", __func__, id_name);
> + tree bind_expr = current_function->bind_expr_stack.back();
> + tree block = BIND_EXPR_BLOCK(bind_expr);
> +
> + gg_chain_onto_block_vars(block, var_decl);
> +
> + // If saved_tree.bind_expr.vars is null, then var_decl is the very
> + // first variable in the block, and it must be set in bind_expr as well
> + if( !BIND_EXPR_VARS(bind_expr) )
> + {
> + BIND_EXPR_VARS(bind_expr) = var_decl;
> + }
> + }
> + }
> +
> +location_t
> +location_from_lineno()
> + {
> + location_t loc;
> + loc = linemap_line_start(line_table, sv_current_line_number, 0);
> + return loc;
> + }
> +
> +void
> +gg_append_statement(tree stmt)
> + {
> + // Likewise, we have a stack of statement_lists, with the current one
> + // at the back. (The statement_list stack can get deeper than the block
> + // stack, because you can create a separate statement list for the insides
> + // of, say, a WHILE statement without creating a whole context for it)
> +
> + // This statement list thing looks innocent enough, but it is the general
> + // way of actually having a GENERIC tree generate executing code. What
> goes
> + // onto a statement list is an expression. A = B is implemented with a
> + // modify_expr
> +
> + // Actually instantiating a variable requires a var_expr
> +
> + // A subroutine call is effected by putting a call_expr onto the statement
> + // list.
> +
> + // It's not the only way; you can have a modify_expr that takes a var_decl
> + // as a destination, and uses a call_expr as a source. This requires that
> + // the type of the var_decl be the same as the type of the function being
> + // called.
> +
> + // And so on. Just keep in mind that you have types, and declarations, and
> + // expressions, among other things.
> +
> + // When trying to figure out location_t, take a look at
> + // ./libcpp/include/line-map.h
> + // ./libcpp/location-example.txt
> +
> + gcc_assert( gg_trans_unit.function_stack.size() );
> +
> + TREE_SIDE_EFFECTS(stmt) = 1; // If an expression has no side effects,
> + // // it won't generate code.
> + TREE_SIDE_EFFECTS(current_function->statement_list_stack.back()) = 1;
> + append_to_statement_list( stmt,
> &(current_function->statement_list_stack.back()) );
> + }
> +
> +tree
> +gg_float(tree floating_type, tree integer_var)
> + {
> + // I don't know why, but this fails if 'var' is an INT128
> + return build1(FLOAT_EXPR, floating_type, integer_var);
> + }
> +
> +tree
> +gg_trunc(tree integer_type, tree floating_var)
> + {
> + /* Conversion of real to fixed point by truncation. */
> + return build1(FIX_TRUNC_EXPR, integer_type, floating_var);
> + }
> +
> +tree
> +gg_cast(tree type, tree var)
> + {
> + return fold_convert(type, var);
> + }
> +
> +static bool saw_pointer;
> +
> +static
> +tree
> +adjust_for_type(tree type)
> + {
> + tree retval;
> +
> + switch( TREE_CODE(type) )
> + {
> + case POINTER_TYPE:
> + saw_pointer = true;
> + retval = adjust_for_type(TREE_TYPE(type));
> + break;
> +
> + case COMPONENT_REF:
> + case ADDR_EXPR:
> + case ARRAY_TYPE:
> + case VAR_DECL:
> + case FUNCTION_TYPE:
> + retval = adjust_for_type(TREE_TYPE(type));
> + break;
> + case RECORD_TYPE:
> + default:
> + retval = type;
> + break;
> + }
> +
> + return retval;
> + }
> +
> +static
> +char *
> +show_type(tree type)
> + {
> + if( !type )
> + {
> + cbl_internal_error("The given type is not NULL, and that's just not
> fair");
> + }
> +
> + if( DECL_P(type) )
> + {
> + type = TREE_TYPE(type);
> + }
> + if( !TYPE_P(type) )
> + {
> + cbl_internal_error("The given type is not a DECL or a TYPE");
> + }
> +
> + static char ach[1024];
> + switch( TREE_CODE(type) )
> + {
> + case VOID_TYPE:
> + sprintf(ach, "VOID");
> + break;
> +
> + case BOOLEAN_TYPE:
> + sprintf(ach, "BOOL");
> + break;
> +
> + case RECORD_TYPE:
> + sprintf(ach, "RECORD");
> + break;
> +
> + case REAL_TYPE:
> + sprintf(ach,
> + "%3ld-bit REAL",
> + TREE_INT_CST_LOW(TYPE_SIZE(type)));
> + break;
> +
> + case INTEGER_TYPE:
> + sprintf(ach,
> + "%3ld-bit %s INT",
> + TREE_INT_CST_LOW(TYPE_SIZE(type)),
> + (TYPE_UNSIGNED(type) ? "unsigned" : " signed"));
> + break;
> +
> + case FUNCTION_TYPE:
> + sprintf(ach, "FUNCTION");
> +// sprintf(ach,
> +// "%3ld-bit %s INT",
> +// TREE_INT_CST_LOW(TYPE_SIZE(type)),
> +// (TYPE_UNSIGNED(type) ? "unsigned" : " signed"));
> + break;
> +
> + default:
> + cbl_internal_error("Unknown type %d", TREE_CODE(type));
> + }
> +
> + return ach;
> + }
> +
> +void
> +gg_assign(tree dest, const tree source)
> + {
> + // This does the equivalent of a C/C++ "dest = source". When X1 is set, it
> + // does some checking for conditions that can result in inefficient code,
> so
> + // that is useful during development when even an astute programmer might
> + // need an assist with keeping variable types straight.
> +
> + // This routine also provides for the possibility that the assignment is
> + // for a source that is a function invocation, as in
> + // "dest = function_call()"
> +
> + saw_pointer = false;
> + tree dest_type = adjust_for_type(TREE_TYPE(dest));
> + bool p1 = saw_pointer;
> + saw_pointer = false;
> + tree source_type = adjust_for_type(TREE_TYPE(source));
> + bool p2 = saw_pointer;
> +
> + if( getenv("X2") )
> + {
Leftover debugging code.
> + fprintf(stderr, "dest is %s%s;", show_type(dest_type), p1 ? "_P" :
> "");
> + fprintf(stderr, " source is %s%s\n", show_type(source_type), p2 ? "_P" :
> "");
> + }
> +
> + bool okay = dest_type == source_type;
> +
> + if( !okay )
> + {
> + if( TREE_CODE(dest_type) == INTEGER_TYPE
> + && TREE_CODE(source_type) == INTEGER_TYPE
> + && TREE_INT_CST_LOW(TYPE_SIZE(dest_type)) ==
> TREE_INT_CST_LOW(TYPE_SIZE(source_type))
> + && TYPE_UNSIGNED(dest_type) == TYPE_UNSIGNED(source_type) )
> + {
> + okay = true;
> + }
> + }
> +
> + if( okay )
> + {
> + tree stmt = build2_loc( location_from_lineno(),
> + MODIFY_EXPR,
> + TREE_TYPE(dest),
> + dest,
> + source);
> + gg_append_statement(stmt);
> + }
> + else
> + {
> + if( true || getenv("X1") )
Debugging code.
