From 5f1d99180a6ab901a89599a214dad1b354fdda69 Mon Sep 17 00:00:00 2001 From: David Malcolm Date: Tue, 25 Nov 2025 12:43:52 -0500 Subject: [PATCH 001/373] analyzer: add logging to deref_before_check::emit gcc/analyzer/ChangeLog: * sm-malloc.cc (deref_before_check::emit): Add logging of the various conditions for late-rejection of a -Wanalyzer-deref-before-check warning. Signed-off-by: David Malcolm --- gcc/analyzer/sm-malloc.cc | 52 +++++++++++++++++++++++++++++++++------ 1 file changed, 44 insertions(+), 8 deletions(-) diff --git a/gcc/analyzer/sm-malloc.cc b/gcc/analyzer/sm-malloc.cc index 8ce771062ca6..88bfc74888c6 100644 --- a/gcc/analyzer/sm-malloc.cc +++ b/gcc/analyzer/sm-malloc.cc @@ -1612,19 +1612,34 @@ class deref_before_check : public malloc_diagnostic bool emit (diagnostic_emission_context &ctxt) final override { + LOG_SCOPE (ctxt.get_logger ()); + logger *logger = ctxt.get_logger (); + /* Don't emit the warning if we can't show where the deref and the check occur. */ if (!m_deref_enode) - return false; + { + if (logger) + logger->log ("rejecting: no deref enode"); + return false; + } if (!m_check_enode) - return false; + { + if (logger) + logger->log ("rejecting: no check enode"); + return false; + } /* Only emit the warning for intraprocedural cases. */ const program_point &deref_point = m_deref_enode->get_point (); const program_point &check_point = m_check_enode->get_point (); if (!program_point::effectively_intraprocedural_p (deref_point, check_point)) - return false; + { + if (logger) + logger->log ("rejecting: not effectively intraprocedural"); + return false; + } /* Reject the warning if the check occurs within a macro defintion. This avoids false positives for such code as: @@ -1661,7 +1676,11 @@ class deref_before_check : public malloc_diagnostic a source of real bugs; see e.g. PR 77425. */ location_t check_loc = m_check_enode->get_point ().get_location (); if (linemap_location_from_macro_definition_p (line_table, check_loc)) - return false; + { + if (logger) + logger->log ("rejecting: check occurs within macro definition"); + return false; + } /* Reject warning if the check is in a loop header within a macro expansion. This rejects cases like: @@ -1676,16 +1695,29 @@ class deref_before_check : public malloc_diagnostic would just be noise if we reported it. */ if (loop_header_p (m_check_enode->get_point ()) && linemap_location_from_macro_expansion_p (line_table, check_loc)) - return false; + { + if (logger) + logger->log + ("rejecting: check occurs in loop header macro expansion"); + return false; + } /* Reject if m_deref_expr is sufficiently different from m_arg for cases where the dereference is spelled differently from the check, which is probably two different ways to get the same svalue, and thus not worth reporting. */ if (!m_deref_expr) - return false; + { + if (logger) + logger->log ("rejecting: no deref_expr"); + return false; + } if (!sufficiently_similar_p (m_deref_expr, m_arg)) - return false; + { + if (logger) + logger->log ("rejecting: not sufficiently similar to arg"); + return false; + } /* Reject the warning if the deref's BB doesn't dominate that of the check, so that we don't warn e.g. for shared cleanup @@ -1697,7 +1729,11 @@ class deref_before_check : public malloc_diagnostic if (!dominated_by_p (CDI_DOMINATORS, m_check_enode->get_supernode ()->m_bb, m_deref_enode->get_supernode ()->m_bb)) - return false; + { + if (logger) + logger->log ("rejecting: deref doesn't dominate the check"); + return false; + } return ctxt.warn ("check of %qE for NULL after already" " dereferencing it", From 06f094958161f8c31746b33164a35820eecef4ee Mon Sep 17 00:00:00 2001 From: David Malcolm Date: Tue, 25 Nov 2025 12:44:10 -0500 Subject: [PATCH 002/373] testsuite: fix issues in gcc.dg/analyzer/strchr-1.c seen with C23 libc Simplify this test case in the hope of avoiding an error seen with glibc-2.42.9000-537-gcd748a63ab1 in CI with "Implement C23 const-preserving standard library macros". gcc/testsuite/ChangeLog: * gcc.dg/analyzer/strchr-1.c: Drop include of , and use __builtin_strchr throughout rather than strchr to avoid const correctness issues when the header implements strchr with a C23 const-preserving macro. Drop "const" from two vars. Signed-off-by: David Malcolm --- gcc/testsuite/gcc.dg/analyzer/strchr-1.c | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/gcc/testsuite/gcc.dg/analyzer/strchr-1.c b/gcc/testsuite/gcc.dg/analyzer/strchr-1.c index 181f1829724f..5cc5fe55734f 100644 --- a/gcc/testsuite/gcc.dg/analyzer/strchr-1.c +++ b/gcc/testsuite/gcc.dg/analyzer/strchr-1.c @@ -1,4 +1,3 @@ -#include #include "analyzer-decls.h" const char* test_literal (int x) @@ -14,28 +13,28 @@ const char* test_literal (int x) return p; } -void test_2 (const char *s, int c) +void test_2 (char *s, int c) { char *p = __builtin_strchr (s, c); /* { dg-message "when '__builtin_strchr' returns NULL" } */ *p = 'A'; /* { dg-warning "dereference of NULL 'p'" "null deref" } */ } -void test_3 (const char *s, int c) +void test_3 (char *s, int c) { - char *p = strchr (s, c); /* { dg-message "when 'strchr' returns NULL" } */ + char *p = __builtin_strchr (s, c); /* { dg-message "when '__builtin_strchr' returns NULL" } */ *p = 'A'; /* { dg-warning "dereference of NULL 'p'" "null deref" } */ } void test_unterminated (int c) { char buf[3] = "abc"; - strchr (buf, c); /* { dg-warning "stack-based buffer over-read" } */ - /* { dg-message "while looking for null terminator for argument 1 \\('&buf'\\) of 'strchr'..." "event" { target *-*-* } .-1 } */ + __builtin_strchr (buf, c); /* { dg-warning "stack-based buffer over-read" } */ + /* { dg-message "while looking for null terminator for argument 1 \\('&buf'\\) of '__builtin_strchr'..." "event" { target *-*-* } .-1 } */ } void test_uninitialized (int c) { char buf[16]; - strchr (buf, c); /* { dg-warning "use of uninitialized value 'buf\\\[0\\\]'" } */ - /* { dg-message "while looking for null terminator for argument 1 \\('&buf'\\) of 'strchr'..." "event" { target *-*-* } .-1 } */ + __builtin_strchr (buf, c); /* { dg-warning "use of uninitialized value 'buf\\\[0\\\]'" } */ + /* { dg-message "while looking for null terminator for argument 1 \\('&buf'\\) of '__builtin_strchr'..." "event" { target *-*-* } .-1 } */ } From 48f58eb854ece652241cc27e80534f02a7c7aded Mon Sep 17 00:00:00 2001 From: Jonathan Wakely Date: Mon, 24 Nov 2025 14:54:07 +0000 Subject: [PATCH 003/373] libstdc++: Bump libtool_VERSION for GCC 16 This should have been done in r16-995-gda9b2ea04c084d (or any of the later changes that added new symbols to trunk). libstdc++-v3/ChangeLog: * acinclude.m4 (libtool_VERSION): Bump version. * configure: Regenerate. --- libstdc++-v3/acinclude.m4 | 2 +- libstdc++-v3/configure | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libstdc++-v3/acinclude.m4 b/libstdc++-v3/acinclude.m4 index d68dbf7bcd42..e4eb773144af 100644 --- a/libstdc++-v3/acinclude.m4 +++ b/libstdc++-v3/acinclude.m4 @@ -4081,7 +4081,7 @@ changequote([,])dnl fi # For libtool versioning info, format is CURRENT:REVISION:AGE -libtool_VERSION=6:34:0 +libtool_VERSION=6:35:0 # Everything parsed; figure out what files and settings to use. case $enable_symvers in diff --git a/libstdc++-v3/configure b/libstdc++-v3/configure index 3509947753ad..b1e1275c47f4 100755 --- a/libstdc++-v3/configure +++ b/libstdc++-v3/configure @@ -51242,7 +51242,7 @@ $as_echo "$as_me: WARNING: === Symbol versioning will be disabled." >&2;} fi # For libtool versioning info, format is CURRENT:REVISION:AGE -libtool_VERSION=6:34:0 +libtool_VERSION=6:35:0 # Everything parsed; figure out what files and settings to use. case $enable_symvers in From 56889bfec25e467deedb2750bdae7ec456a8f92c Mon Sep 17 00:00:00 2001 From: Rainer Orth Date: Tue, 25 Nov 2025 22:25:48 +0100 Subject: [PATCH 004/373] build: Save/restore CXXFLAGS for zstd tests I recently encountered a bootstrap failure on trunk caused by the fact that an older out-of-tree version of ansidecl.h was found before the in-tree one in $top_srcdir/include, so some macros from that header that are used in gcc weren't defined. The out-of-tree version was located in $ZSTD_INC (-I/vol/gcc/include) which caused that directory to be included in gcc's CXXFLAGS like CXXFLAGS='-g -O2 -fchecking=1 -I/vol/gcc/include' causing it to be searched before $srcdir/../include. I could trace this to the zstd.h test in gcc/configure.ac which sets CXXFLAGS and LDFLAGS before the actual test, but doesn't reset them afterwards. So this patch does just that. Bootstrapped without regressions on i386-pc-solaris2.11 and x86_64-pc-linux-gnu. 2025-10-22 Rainer Orth gcc: * configure.ac (gcc_cv_header_zstd_h): Save, restore CXXFLAGS, LDFLAGS. * configure: Regenerate. --- gcc/configure | 9 +++++++-- gcc/configure.ac | 5 +++++ 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/gcc/configure b/gcc/configure index eba199a85262..d7074355e42b 100755 --- a/gcc/configure +++ b/gcc/configure @@ -10492,6 +10492,8 @@ if test "x$ZSTD_LIB" != x \ ZSTD_LDFLAGS=-L$ZSTD_LIB fi +saved_CXXFLAGS="$CXXFLAGS" +saved_LDFLAGS="$LDFLAGS" CXXFLAGS="$CXXFLAGS $ZSTD_CPPFLAGS" LDFLAGS="$LDFLAGS $ZSTD_LDFLAGS" @@ -10600,6 +10602,9 @@ elif test "x$with_zstd" != x; then fi fi +CXXFLAGS="$saved_CXXFLAGS" +LDFLAGS="$saved_LDFLAGS" + for ac_func in times clock kill getrlimit setrlimit atoq \ @@ -21872,7 +21877,7 @@ else lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext <<_LT_EOF -#line 21875 "configure" +#line 21880 "configure" #include "confdefs.h" #if HAVE_DLFCN_H @@ -21978,7 +21983,7 @@ else lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext <<_LT_EOF -#line 21981 "configure" +#line 21986 "configure" #include "confdefs.h" #if HAVE_DLFCN_H diff --git a/gcc/configure.ac b/gcc/configure.ac index 598c09761cbc..b6d9608d5994 100644 --- a/gcc/configure.ac +++ b/gcc/configure.ac @@ -1502,6 +1502,8 @@ if test "x$ZSTD_LIB" != x \ ZSTD_LDFLAGS=-L$ZSTD_LIB fi +saved_CXXFLAGS="$CXXFLAGS" +saved_LDFLAGS="$LDFLAGS" CXXFLAGS="$CXXFLAGS $ZSTD_CPPFLAGS" LDFLAGS="$LDFLAGS $ZSTD_LDFLAGS" @@ -1533,6 +1535,9 @@ elif test "x$with_zstd" != x; then fi fi +CXXFLAGS="$saved_CXXFLAGS" +LDFLAGS="$saved_LDFLAGS" + dnl Disabled until we have a complete test for buggy enum bitfields. dnl gcc_AC_C_ENUM_BF_UNSIGNED From 5be67e843c577e322d23885776d0de3ee6d66bd1 Mon Sep 17 00:00:00 2001 From: "lenny.chiadmi-delage" Date: Wed, 15 Oct 2025 15:07:05 +0000 Subject: [PATCH 005/373] gccrs: fix segfault in clone_pattern w macro Check if parser throw an error to avoid cloning nullptr Fixes Rust-GCC#4140 gcc/rust/ChangeLog: * expand/rust-macro-expand.cc (transcribe_expression): Check if parser didn't fail. (transcribe_type): Likewise. (transcribe_pattern): Likewise. Signed-off-by: lenny.chiadmi-delage --- gcc/rust/expand/rust-macro-expand.cc | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/gcc/rust/expand/rust-macro-expand.cc b/gcc/rust/expand/rust-macro-expand.cc index 52f8e2b10e33..b47e43afd764 100644 --- a/gcc/rust/expand/rust-macro-expand.cc +++ b/gcc/rust/expand/rust-macro-expand.cc @@ -962,12 +962,10 @@ transcribe_expression (Parser &parser) auto attrs = parser.parse_outer_attributes (); auto expr = parser.parse_expr (std::move (attrs)); - if (expr == nullptr) - { - for (auto error : parser.get_errors ()) - error.emit (); - return AST::Fragment::create_error (); - } + for (auto error : parser.get_errors ()) + error.emit (); + if (!expr) + return AST::Fragment::create_error (); // FIXME: make this an error for some edititons if (parser.peek_current_token ()->get_id () == SEMICOLON) @@ -997,6 +995,8 @@ transcribe_type (Parser &parser) auto type = parser.parse_type (true); for (auto err : parser.get_errors ()) err.emit (); + if (!type) + return AST::Fragment::create_error (); auto end = lexer.get_offs (); @@ -1018,6 +1018,9 @@ transcribe_pattern (Parser &parser) for (auto err : parser.get_errors ()) err.emit (); + if (!pattern) + return AST::Fragment::create_error (); + auto end = lexer.get_offs (); return AST::Fragment ({std::move (pattern)}, From c12f9f19a7356fb88293ee95c432c48786b4b2f9 Mon Sep 17 00:00:00 2001 From: "lenny.chiadmi-delage" Date: Mon, 10 Nov 2025 16:00:29 +0000 Subject: [PATCH 006/373] gccrs: adds tests from issue 4140 Adds tests for testsuite. Fixes Rust-GCC#4140 gcc/testsuite/ChangeLog: * rust/compile/issue-4140-1.rs: New test. * rust/compile/issue-4140-2.rs: Likewise. Signed-off-by: lenny.chiadmi-delage --- gcc/testsuite/rust/compile/issue-4140-1.rs | 18 ++++++++++++++++++ gcc/testsuite/rust/compile/issue-4140-2.rs | 11 +++++++++++ 2 files changed, 29 insertions(+) create mode 100644 gcc/testsuite/rust/compile/issue-4140-1.rs create mode 100644 gcc/testsuite/rust/compile/issue-4140-2.rs diff --git a/gcc/testsuite/rust/compile/issue-4140-1.rs b/gcc/testsuite/rust/compile/issue-4140-1.rs new file mode 100644 index 000000000000..48aa98bc318c --- /dev/null +++ b/gcc/testsuite/rust/compile/issue-4140-1.rs @@ -0,0 +1,18 @@ +pub enum TypeCtor { + Slice, + Array, +} +pub struct B(T); + +macro_rules! ty_app { + ($_a:pat) => { + ApplicationTy($ctor) // { dg-error "unexpected token '$' in typle struct items" "4140" { target *-*-* } . } + // { dg-error "failed to parse typle struct items" "4140" { target *-*-*} .-1 } + }; +} + +pub fn foo(ty: ApplicationTy) { // { dg-error "could not resolve type path 'ApplicationTy'" "4140" { target *-*-* } .-1 } + match ty { + ty_app!(bean::Array) => {} + } +} diff --git a/gcc/testsuite/rust/compile/issue-4140-2.rs b/gcc/testsuite/rust/compile/issue-4140-2.rs new file mode 100644 index 000000000000..507cf2aba389 --- /dev/null +++ b/gcc/testsuite/rust/compile/issue-4140-2.rs @@ -0,0 +1,11 @@ +macro_rules! ty_app { + ($_a:pat) => { + ($ctor) // { dg-error "unrecognised token '$' in grouped or tuple pattern after first pattern" "4140" { target *-*-* } . } + }; +} + +pub fn foo() { + match ty { // { dg-error "Cannot find path 'ty' in this scope" "4140" { target *-*-* } .-1 } + ty_app!(bean::Array) => {} + } +} From a9598bd3581b9349ccfe83e338fb18dbfd1aa1d1 Mon Sep 17 00:00:00 2001 From: "lenny.chiadmi-delage" Date: Wed, 12 Nov 2025 10:10:54 +0000 Subject: [PATCH 007/373] gccrs: fixes previously added tests Fixes previously added tests. Fixes Rust-GCC#4140 gcc/testsuite/ChangeLog: * rust/compile/issue-4140-1.rs: Fixes test. * rust/compile/issue-4140-2.rs: Likewise. Signed-off-by: lenny.chiadmi-delage --- gcc/testsuite/rust/compile/issue-4140-1.rs | 6 +++--- gcc/testsuite/rust/compile/issue-4140-2.rs | 7 ++++--- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/gcc/testsuite/rust/compile/issue-4140-1.rs b/gcc/testsuite/rust/compile/issue-4140-1.rs index 48aa98bc318c..8b68b3e2d8b5 100644 --- a/gcc/testsuite/rust/compile/issue-4140-1.rs +++ b/gcc/testsuite/rust/compile/issue-4140-1.rs @@ -6,12 +6,12 @@ pub struct B(T); macro_rules! ty_app { ($_a:pat) => { - ApplicationTy($ctor) // { dg-error "unexpected token '$' in typle struct items" "4140" { target *-*-* } . } - // { dg-error "failed to parse typle struct items" "4140" { target *-*-*} .-1 } + ApplicationTy($ctor) // { dg-error "unexpected token" } + // { dg-error "failed to parse tuple struct items" "" { target *-*-* } .-1 } }; } -pub fn foo(ty: ApplicationTy) { // { dg-error "could not resolve type path 'ApplicationTy'" "4140" { target *-*-* } .-1 } +pub fn foo(ty: ApplicationTy) { // { dg-error "could not resolve type path 'ApplicationTy'" } match ty { ty_app!(bean::Array) => {} } diff --git a/gcc/testsuite/rust/compile/issue-4140-2.rs b/gcc/testsuite/rust/compile/issue-4140-2.rs index 507cf2aba389..bcccddb3329e 100644 --- a/gcc/testsuite/rust/compile/issue-4140-2.rs +++ b/gcc/testsuite/rust/compile/issue-4140-2.rs @@ -1,11 +1,12 @@ macro_rules! ty_app { ($_a:pat) => { - ($ctor) // { dg-error "unrecognised token '$' in grouped or tuple pattern after first pattern" "4140" { target *-*-* } . } + ($ctor) }; } pub fn foo() { - match ty { // { dg-error "Cannot find path 'ty' in this scope" "4140" { target *-*-* } .-1 } - ty_app!(bean::Array) => {} + match ty { + // { dg-error "Cannot find path" "4140" { target *-*-* } 0 } + ty_app!(bean::Array) => {} // { dg-error "unrecognised token" "4140" { target *-*-* } 0 } } } From b03ebbb77dd4385048ef2df808445d8312e9246f Mon Sep 17 00:00:00 2001 From: Owen Avery Date: Fri, 27 Jun 2025 21:44:01 -0400 Subject: [PATCH 008/373] gccrs: Create LocalVariable This should make it easier for us to move away from leaking pointers to Bvariable everywhere. Since LocalVariable has a single field of type tree, it should be the same size as a pointer to Bvariable, making the switch to LocalVariable wherever possible strictly an improvement. gcc/rust/ChangeLog: * backend/rust-compile-expr.cc (CompileExpr::visit): Implicitly convert LocalVariable to pointer to Bvariable. * rust-backend.h (local_variable): Return LocalVariable. (parameter_variable): Likewise. (static_chain_variable): Likewise. (temporary_variable): Likewise. * rust-gcc.cc (local_variable): Likewise. (parameter_variable): Likewise. (static_chain_variable): Likewise. (temporary_variable): Likewise. (LocalVariable::get_tree): New function. (LocalVariable::error_variable): Likewise. * rust-gcc.h (class LocalVariable): New class. Signed-off-by: Owen Avery --- gcc/rust/backend/rust-compile-expr.cc | 4 +-- gcc/rust/rust-backend.h | 18 ++++++------ gcc/rust/rust-gcc.cc | 41 +++++++++++++++++++-------- gcc/rust/rust-gcc.h | 24 ++++++++++++++++ 4 files changed, 64 insertions(+), 23 deletions(-) diff --git a/gcc/rust/backend/rust-compile-expr.cc b/gcc/rust/backend/rust-compile-expr.cc index 0a627f353524..6404825b02f7 100644 --- a/gcc/rust/backend/rust-compile-expr.cc +++ b/gcc/rust/backend/rust-compile-expr.cc @@ -175,7 +175,7 @@ CompileExpr::visit (HIR::ArithmeticOrLogicalExpr &expr) } auto receiver_tmp = NULL_TREE; - auto receiver + Bvariable *receiver = Backend::temporary_variable (ctx->peek_fn ().fndecl, NULL_TREE, TREE_TYPE (lhs), lhs, true, expr.get_locus (), &receiver_tmp); @@ -214,7 +214,7 @@ CompileExpr::visit (HIR::CompoundAssignmentExpr &expr) if (ctx->in_fn () && !ctx->const_context_p ()) { auto tmp = NULL_TREE; - auto receiver + Bvariable *receiver = Backend::temporary_variable (ctx->peek_fn ().fndecl, NULL_TREE, TREE_TYPE (lhs), lhs, true, expr.get_locus (), &tmp); diff --git a/gcc/rust/rust-backend.h b/gcc/rust/rust-backend.h index 95ca7a9fe46d..99496e69d5f5 100644 --- a/gcc/rust/rust-backend.h +++ b/gcc/rust/rust-backend.h @@ -349,18 +349,18 @@ void global_variable_set_init (Bvariable *, tree); // the function, as otherwise the variable would be on the heap). // LOCATION is where the variable is defined. For each local variable // the frontend will call init_statement to set the initial value. -Bvariable *local_variable (tree function, GGC::Ident name, tree type, - Bvariable *decl_var, location_t location); +LocalVariable local_variable (tree function, GGC::Ident name, tree type, + Bvariable *decl_var, location_t location); // Create a function parameter. This is an incoming parameter, not // a result parameter (result parameters are treated as local // variables). The arguments are as for local_variable. -Bvariable *parameter_variable (tree function, GGC::Ident name, tree type, - location_t location); +LocalVariable parameter_variable (tree function, GGC::Ident name, tree type, + location_t location); // Create a static chain parameter. This is the closure parameter. -Bvariable *static_chain_variable (tree function, GGC::Ident name, tree type, - location_t location); +LocalVariable static_chain_variable (tree function, GGC::Ident name, tree type, + location_t location); // Create a temporary variable. A temporary variable has no name, // just a type. We pass in FUNCTION and BLOCK in case they are @@ -373,9 +373,9 @@ Bvariable *static_chain_variable (tree function, GGC::Ident name, tree type, // variable, and may not be very useful. This function should // return a variable which can be referenced later and should set // *PSTATEMENT to a statement which initializes the variable. -Bvariable *temporary_variable (tree fndecl, tree bind_tree, tree type, - tree init, bool address_is_taken, - location_t location, tree *pstatement); +LocalVariable temporary_variable (tree fndecl, tree bind_tree, tree type, + tree init, bool address_is_taken, + location_t location, tree *pstatement); // Labels. diff --git a/gcc/rust/rust-gcc.cc b/gcc/rust/rust-gcc.cc index 8f950d176f29..750c392e5928 100644 --- a/gcc/rust/rust-gcc.cc +++ b/gcc/rust/rust-gcc.cc @@ -83,6 +83,23 @@ Bvariable::error_variable () return new Bvariable (error_mark_node); } +// Get the tree of a variable for use as an expression +tree +LocalVariable::get_tree (location_t location) const +{ + if (error_operand_p (t)) + return error_mark_node; + + TREE_USED (t) = 1; + return t; +} + +LocalVariable +LocalVariable::error_variable () +{ + return LocalVariable (error_mark_node); +} + // This file implements the interface between the Rust frontend proper // and the gcc IR. This implements specific instantiations of // abstract classes defined by the Rust frontend proper. The Rust @@ -2014,12 +2031,12 @@ global_variable_set_init (Bvariable *var, tree expr_tree) // Make a local variable. -Bvariable * +LocalVariable local_variable (tree function, GGC::Ident name, tree type_tree, Bvariable *decl_var, location_t location) { if (error_operand_p (type_tree)) - return Bvariable::error_variable (); + return LocalVariable::error_variable (); tree decl = build_decl (location, VAR_DECL, name.as_tree (), type_tree); DECL_CONTEXT (decl) = function; @@ -2029,33 +2046,33 @@ local_variable (tree function, GGC::Ident name, tree type_tree, SET_DECL_VALUE_EXPR (decl, decl_var->get_decl ()); } rust_preserve_from_gc (decl); - return new Bvariable (decl); + return LocalVariable (decl); } // Make a function parameter variable. -Bvariable * +LocalVariable parameter_variable (tree function, GGC::Ident name, tree type_tree, location_t location) { if (error_operand_p (type_tree)) - return Bvariable::error_variable (); + return LocalVariable::error_variable (); tree decl = build_decl (location, PARM_DECL, name.as_tree (), type_tree); DECL_CONTEXT (decl) = function; DECL_ARG_TYPE (decl) = type_tree; rust_preserve_from_gc (decl); - return new Bvariable (decl); + return LocalVariable (decl); } // Make a static chain variable. -Bvariable * +LocalVariable static_chain_variable (tree fndecl, GGC::Ident name, tree type_tree, location_t location) { if (error_operand_p (type_tree)) - return Bvariable::error_variable (); + return LocalVariable::error_variable (); tree decl = build_decl (location, PARM_DECL, name.as_tree (), type_tree); DECL_CONTEXT (decl) = fndecl; DECL_ARG_TYPE (decl) = type_tree; @@ -2076,12 +2093,12 @@ static_chain_variable (tree fndecl, GGC::Ident name, tree type_tree, DECL_STATIC_CHAIN (fndecl) = 1; rust_preserve_from_gc (decl); - return new Bvariable (decl); + return LocalVariable (decl); } // Make a temporary variable. -Bvariable * +LocalVariable temporary_variable (tree fndecl, tree bind_tree, tree type_tree, tree init_tree, bool is_address_taken, location_t location, tree *pstatement) @@ -2091,7 +2108,7 @@ temporary_variable (tree fndecl, tree bind_tree, tree type_tree, tree init_tree, || error_operand_p (fndecl)) { *pstatement = error_mark_node; - return Bvariable::error_variable (); + return LocalVariable::error_variable (); } tree var; @@ -2141,7 +2158,7 @@ temporary_variable (tree fndecl, tree bind_tree, tree type_tree, tree init_tree, || TREE_TYPE (init_tree) == void_type_node)) *pstatement = compound_statement (init_tree, *pstatement); - return new Bvariable (var); + return LocalVariable (var); } // Make a label. diff --git a/gcc/rust/rust-gcc.h b/gcc/rust/rust-gcc.h index b3f032527008..1ff7c5b4f2af 100644 --- a/gcc/rust/rust-gcc.h +++ b/gcc/rust/rust-gcc.h @@ -59,4 +59,28 @@ class Bvariable tree orig_type_; }; +// like Bvariable, but orig_type_ == nullptr always holds +// could be any variable which isn't a zero-sized global +class LocalVariable +{ +public: + LocalVariable (tree t) : t (t) {} + + // Get the tree for use as an expression. + tree get_tree (location_t) const; + + // Get the actual decl; + tree get_decl () const { return t; } + + // Create an error variable. This is used for cases which should + // not occur in a correct program, in order to keep the compilation + // going without crashing. + static LocalVariable error_variable (); + + operator Bvariable * () const { return new Bvariable (t); } + +private: + tree t; +}; + #endif // RUST_GCC From 6ff1a62209a1e62665af9b8013d19bde7fe3c226 Mon Sep 17 00:00:00 2001 From: Lucas Ly Ba Date: Thu, 6 Nov 2025 15:37:52 +0000 Subject: [PATCH 009/373] gccrs: fix cfg attribute without parentheses error gcc/rust/ChangeLog: * ast/rust-ast.cc (Attribute::check_cfg_predicate): Make error when attribute has no input. gcc/testsuite/ChangeLog: * rust/compile/issue-4262.rs: New test. Signed-off-by: Lucas Ly Ba --- gcc/rust/ast/rust-ast.cc | 16 ++++------------ gcc/testsuite/rust/compile/issue-4262.rs | 3 +++ 2 files changed, 7 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/rust/compile/issue-4262.rs diff --git a/gcc/rust/ast/rust-ast.cc b/gcc/rust/ast/rust-ast.cc index f3ad2fe5da05..d8713071c4c3 100644 --- a/gcc/rust/ast/rust-ast.cc +++ b/gcc/rust/ast/rust-ast.cc @@ -4163,16 +4163,10 @@ Attribute::check_cfg_predicate (const Session &session) const auto string_path = path.as_string (); /* assume that cfg predicate actually can exist, i.e. attribute has cfg or * cfg_attr path */ - if (!has_attr_input () - || (string_path != Values::Attributes::CFG - && string_path != Values::Attributes::CFG_ATTR)) + if (!has_attr_input ()) { - // DEBUG message - rust_debug ( - "tried to check cfg predicate on attr that either has no input " - "or invalid path. attr: '%s'", - as_string ().c_str ()); - + rust_error_at (path.get_locus (), "%qs is not followed by parentheses", + string_path.c_str ()); return false; } @@ -4181,9 +4175,7 @@ Attribute::check_cfg_predicate (const Session &session) const return false; auto &meta_item = static_cast (*attr_input); - if (meta_item.get_items ().empty () - && (string_path == Values::Attributes::CFG - || string_path == Values::Attributes::CFG_ATTR)) + if (meta_item.get_items ().empty ()) { rust_error_at (path.get_locus (), "malformed %<%s%> attribute input", string_path.c_str ()); diff --git a/gcc/testsuite/rust/compile/issue-4262.rs b/gcc/testsuite/rust/compile/issue-4262.rs new file mode 100644 index 000000000000..2ce1cb49afae --- /dev/null +++ b/gcc/testsuite/rust/compile/issue-4262.rs @@ -0,0 +1,3 @@ +#[cfg] +// { dg-error ".cfg. is not followed by parentheses" "" { target *-*-* } .-1 } +fn a() {} From 23a20908e414a64d283d6b8e727c8f503e8c01b4 Mon Sep 17 00:00:00 2001 From: Owen Avery Date: Sun, 17 Aug 2025 14:15:35 -0400 Subject: [PATCH 010/373] gccrs: Improve feature handling This includes a program, written using flex and bison, to extract information on unstable features from rustc source code and save it to a header file. The script does fetch files from https://github.com/rust-lang/rust (the official rustc git repository), which should be alright, as it's only intended to be run by maintainers. See https://doc.rust-lang.org/unstable-book/ for information on unstable features. gcc/rust/ChangeLog: * checks/errors/feature/rust-feature-gate.cc (FeatureGate::gate): Handle removal of Feature::create. (FeatureGate::visit): Refer to AUTO_TRAITS as OPTIN_BUILTIN_TRAITS. * checks/errors/feature/rust-feature.cc (Feature::create): Remove. (Feature::feature_list): New static member variable. (Feature::name_hash_map): Use "rust-feature-defs.h" to define. (Feature::lookup): New member function definition. * checks/errors/feature/rust-feature.h (Feature::State): Add comments. (Feature::Name): Use "rust-feature-defs.h" to define. (Feature::as_string): Make const. (Feature::name): Likewise. (Feature::state): Likewise. (Feature::issue): Likewise. (Feature::description): Remove member function declaration. (Feature::create): Remove static member function declaration. (Feature::lookup): New member function declarations. (Feature::Feature): Adjust arguments. (Feature::m_rustc_since): Rename to... (Feature::m_rust_since): ...here. (Feature::m_description): Remove. (Feature::m_reason): New member variable. (Feature::feature_list): New static member variable. * checks/errors/feature/rust-feature-defs.h: New file. * checks/errors/feature/contrib/parse.y: New file. * checks/errors/feature/contrib/scan.l: New file. * checks/errors/feature/contrib/.gitignore: New file. * checks/errors/feature/contrib/Makefile: New file. * checks/errors/feature/contrib/fetch: New file. * checks/errors/feature/contrib/regen: New file. * checks/errors/feature/contrib/copyright-stub.h: New file. * checks/errors/feature/contrib/README: New file. Signed-off-by: Owen Avery --- .../checks/errors/feature/contrib/.gitignore | 1 + .../checks/errors/feature/contrib/Makefile | 59 ++ gcc/rust/checks/errors/feature/contrib/README | 3 + .../errors/feature/contrib/copyright-stub.h | 19 + gcc/rust/checks/errors/feature/contrib/fetch | 30 + .../checks/errors/feature/contrib/parse.y | 143 +++++ gcc/rust/checks/errors/feature/contrib/regen | 23 + gcc/rust/checks/errors/feature/contrib/scan.l | 55 ++ .../checks/errors/feature/rust-feature-defs.h | 600 ++++++++++++++++++ .../errors/feature/rust-feature-gate.cc | 4 +- .../checks/errors/feature/rust-feature.cc | 125 ++-- gcc/rust/checks/errors/feature/rust-feature.h | 68 +- 12 files changed, 1030 insertions(+), 100 deletions(-) create mode 100644 gcc/rust/checks/errors/feature/contrib/.gitignore create mode 100644 gcc/rust/checks/errors/feature/contrib/Makefile create mode 100644 gcc/rust/checks/errors/feature/contrib/README create mode 100644 gcc/rust/checks/errors/feature/contrib/copyright-stub.h create mode 100755 gcc/rust/checks/errors/feature/contrib/fetch create mode 100644 gcc/rust/checks/errors/feature/contrib/parse.y create mode 100755 gcc/rust/checks/errors/feature/contrib/regen create mode 100644 gcc/rust/checks/errors/feature/contrib/scan.l create mode 100644 gcc/rust/checks/errors/feature/rust-feature-defs.h diff --git a/gcc/rust/checks/errors/feature/contrib/.gitignore b/gcc/rust/checks/errors/feature/contrib/.gitignore new file mode 100644 index 000000000000..796b96d1c402 --- /dev/null +++ b/gcc/rust/checks/errors/feature/contrib/.gitignore @@ -0,0 +1 @@ +/build diff --git a/gcc/rust/checks/errors/feature/contrib/Makefile b/gcc/rust/checks/errors/feature/contrib/Makefile new file mode 100644 index 000000000000..7c828abd34d2 --- /dev/null +++ b/gcc/rust/checks/errors/feature/contrib/Makefile @@ -0,0 +1,59 @@ +# Copyright (C) 2025 Free Software Foundation, Inc. + +# This file is part of GCC. + +# GCC is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3, or (at your option) +# any later version. + +# GCC is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +OUT = ../rust-feature-defs.h + +all: $(OUT) + +mk-build-dir: + mkdir -p build + +build/parse.c: parse.y mk-build-dir + $(YACC) $(YFLAGS) -o $@ --defines=build/parse.h $< + +build/parse.h: build/parse.c; + +build/scan.c: scan.l + $(LEX) $(LFLAGS) -o $@ -Ca --header-file=build/scan.h $< + +build/scan.h: build/scan.c; + +build/%.o: build/%.c build/parse.h build/scan.h + $(CC) $(CFLAGS) -c -Ibuild -o $@ $< + +build/feature-extract: build/parse.o build/scan.o + $(CC) $(LDFLAGS) $(LDLIBS) -o $@ $^ + +build/download.rs: fetch + ./$< $@ + +$(OUT): build/feature-extract build/download.rs + # add copyright header + newline + echo | \ + cat copyright-stub.h - | \ + sed "s/YYYY/$$(date +%Y)/" > build/rust-feature-defs.h + cat build/download.rs | ./$< >> build/rust-feature-defs.h + clang-format -i build/rust-feature-defs.h \ + --style=file:../../../../../../contrib/clang-format + mv build/rust-feature-defs.h $(OUT) + +clean: + $(RM) -r build + +clean-all: clean + $(RM) $(OUT) diff --git a/gcc/rust/checks/errors/feature/contrib/README b/gcc/rust/checks/errors/feature/contrib/README new file mode 100644 index 000000000000..e85fe0964a5d --- /dev/null +++ b/gcc/rust/checks/errors/feature/contrib/README @@ -0,0 +1,3 @@ +This program is intended for use in generating rust-feature-defs.h + +To use, run `./regen` diff --git a/gcc/rust/checks/errors/feature/contrib/copyright-stub.h b/gcc/rust/checks/errors/feature/contrib/copyright-stub.h new file mode 100644 index 000000000000..1a5f52c5d574 --- /dev/null +++ b/gcc/rust/checks/errors/feature/contrib/copyright-stub.h @@ -0,0 +1,19 @@ +// Copyright (C) YYYY Free Software Foundation, Inc. + +// This file is part of GCC. + +// GCC is free software; you can redistribute it and/or modify it under +// the terms of the GNU General Public License as published by the Free +// Software Foundation; either version 3, or (at your option) any later +// version. + +// GCC is distributed in the hope that it will be useful, but WITHOUT ANY +// WARRANTY; without even the implied warranty of MERCHANTABILITY or +// FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +// for more details. + +// You should have received a copy of the GNU General Public License +// along with GCC; see the file COPYING3. If not see +// . + +// AUTO-GENERATED -- SEE LOCAL contrib SUBDIRECTORY diff --git a/gcc/rust/checks/errors/feature/contrib/fetch b/gcc/rust/checks/errors/feature/contrib/fetch new file mode 100755 index 000000000000..b26ed3c9dc69 --- /dev/null +++ b/gcc/rust/checks/errors/feature/contrib/fetch @@ -0,0 +1,30 @@ +#!/bin/sh + +# Copyright (C) 2025 Free Software Foundation, Inc. + +# This file is part of GCC. + +# GCC is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3, or (at your option) +# any later version. + +# GCC is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +RUST_VERSION="1.49.0" + +[ $# = 1 ] || exit 1 + +# Fetches files from the official rustc git repository + +URL_PREFIX='https://raw.githubusercontent.com/rust-lang/rust/refs/tags' +URL_TEMPLATE="$URL_PREFIX/$RUST_VERSION/compiler/rustc_feature/src" + +wget -O $1 "$URL_TEMPLATE"/{accepted,active,removed}.rs diff --git a/gcc/rust/checks/errors/feature/contrib/parse.y b/gcc/rust/checks/errors/feature/contrib/parse.y new file mode 100644 index 000000000000..34c0138595b8 --- /dev/null +++ b/gcc/rust/checks/errors/feature/contrib/parse.y @@ -0,0 +1,143 @@ +/* Copyright (C) 2025 Free Software Foundation, Inc. + +This file is part of GCC. + +GCC is free software; you can redistribute it and/or modify it under +the terms of the GNU General Public License as published by the Free +Software Foundation; either version 3, or (at your option) any later +version. + +GCC is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with GCC; see the file COPYING3. If not see +. */ + +%{ + +#include +#include +#include + +int yylex (void); +void yyerror (char const *); + +#include "scan.h" + +// expands to three %s parameters +#define UNWRAP_OPT_STR(prefix, s) (s ? prefix "_SOME (" : prefix "_NONE"), (s ? s : ""), (s ? ")" : "") + +%} + +%union +{ + char *str; +}; + +%token IDENT STR NUM +%token SCOPE +%token K_SOME K_NONE +%token K_ACTIVE K_ACCEPTED K_REMOVED K_STABLE_REMOVED +%token K_E_START K_E_2018 + +%type issue +%type edition +%type reason + +%% + +multi_database: multi_database database +| database +; + +database: '(' entry_list ')'; + +entry_list: entry_list entry ',' +| entry ',' +; + +entry: '(' K_ACTIVE ',' IDENT ',' STR ',' issue ',' edition ')' { + char *ident_upper = strdup ($4); + for (size_t i = 0; ident_upper[i]; i++) + ident_upper[i] = toupper (ident_upper[i]); + printf ("FEATURE_ACTIVE (\"%s\", %s, %s, %s%s%s, EDITION_%s)\n", $4, ident_upper, $6, UNWRAP_OPT_STR ("ISSUE", $8), $10 ? $10 : "NONE"); + free ($4); + free (ident_upper); + free ($6); + free ($8); +} +| '(' K_ACCEPTED ',' IDENT ',' STR ',' issue ',' K_NONE ')' { + char *ident_upper = strdup ($4); + for (size_t i = 0; ident_upper[i]; i++) + ident_upper[i] = toupper (ident_upper[i]); + printf ("FEATURE_ACCEPTED (\"%s\", %s, %s, %s%s%s)\n", $4, ident_upper, $6, UNWRAP_OPT_STR ("ISSUE", $8)); + free ($4); + free (ident_upper); + free ($6); + free ($8); +} +| '(' K_REMOVED ',' IDENT ',' STR ',' issue ',' K_NONE ',' reason ')' { + char *ident_upper; + // HACK: convert no_debug to F_NO_DEBUG instead + // since NO_DEBUG is used as an unrelated macro + if (!strcmp ($4, "no_debug")) + { + ident_upper = strdup ("F_NO_DEBUG"); + } + else + { + ident_upper = strdup ($4); + for (size_t i = 0; ident_upper[i]; i++) + ident_upper[i] = toupper (ident_upper[i]); + } + printf ("FEATURE_REMOVED (\"%s\", %s, %s, %s%s%s, %s%s%s)\n", $4, ident_upper, $6, UNWRAP_OPT_STR ("ISSUE", $8), UNWRAP_OPT_STR ("REASON", $12)); + free ($4); + free (ident_upper); + free ($6); + free ($8); + free ($12); +} +| '(' K_STABLE_REMOVED ',' IDENT ',' STR ',' issue ',' K_NONE ')' { + char *ident_upper = strdup ($4); + for (size_t i = 0; ident_upper[i]; i++) + ident_upper[i] = toupper (ident_upper[i]); + printf ("FEATURE_STABLE_REMOVED (\"%s\", %s, %s, %s%s%s)\n", $4, ident_upper, $6, UNWRAP_OPT_STR ("ISSUE", $8)); + free ($4); + free (ident_upper); + free ($6); + free ($8); +} +; + +issue: K_SOME '(' NUM ')' { $$ = $3; } +| K_NONE { $$ = NULL; } +; + +/* TODO: expand this as needed */ +edition: K_NONE { $$ = NULL; } +| K_SOME '(' K_E_START SCOPE K_E_2018 ')' { $$ = "2018"; } +; + +reason: K_SOME '(' STR ')' { $$ = $3; } +| K_NONE { $$ = NULL; } +; + +%% + +void yyerror (const char *msg) +{ + fprintf (stderr, "%s\n", msg); +} + +int yywrap (void) +{ + return 1; +} + +int main (void) +{ + return yyparse (); +} diff --git a/gcc/rust/checks/errors/feature/contrib/regen b/gcc/rust/checks/errors/feature/contrib/regen new file mode 100755 index 000000000000..0dc6cc53a1fe --- /dev/null +++ b/gcc/rust/checks/errors/feature/contrib/regen @@ -0,0 +1,23 @@ +#!/bin/sh + +# Copyright (C) 2025 Free Software Foundation, Inc. + +# This file is part of GCC. + +# GCC is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3, or (at your option) +# any later version. + +# GCC is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +cd "$(dirname "$0")" +rm -f ../rust-feature-defs.h +make all diff --git a/gcc/rust/checks/errors/feature/contrib/scan.l b/gcc/rust/checks/errors/feature/contrib/scan.l new file mode 100644 index 000000000000..768f4c7f02cc --- /dev/null +++ b/gcc/rust/checks/errors/feature/contrib/scan.l @@ -0,0 +1,55 @@ +/* Copyright (C) 2025 Free Software Foundation, Inc. + +This file is part of GCC. + +GCC is free software; you can redistribute it and/or modify it under +the terms of the GNU General Public License as published by the Free +Software Foundation; either version 3, or (at your option) any later +version. + +GCC is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with GCC; see the file COPYING3. If not see +. */ + +%{ + +#include "parse.h" + +static int p_count = 0; + +%} + +%x INSIDE COMMENT + +%% + +declare_features! BEGIN (INSIDE); +.|\n /* ignore */ + +\( p_count++; return '('; +\) if (!--p_count) { BEGIN (0); } return ')'; +, return ','; +:: return SCOPE; +Some return K_SOME; +None return K_NONE; +active return K_ACTIVE; +accepted return K_ACCEPTED; +removed return K_REMOVED; +stable_removed return K_STABLE_REMOVED; +Edition return K_E_START; +Edition2018 return K_E_2018; + +[A-Za-z_][A-Za-z0-9_]* yylval.str = strdup (yytext); return IDENT; +[1-9][0-9]* yylval.str = strdup (yytext); return NUM; +\"[^"]+\" yylval.str = strdup (yytext); return STR; +"/""/" BEGIN (COMMENT); +[ \n] /* ignore */ +. { fprintf (stderr, "unrecognized character %u\n", (unsigned int) yytext[0]); exit (1); } + +. /* skip */ +\n BEGIN (INSIDE); diff --git a/gcc/rust/checks/errors/feature/rust-feature-defs.h b/gcc/rust/checks/errors/feature/rust-feature-defs.h new file mode 100644 index 000000000000..d8514e1820e7 --- /dev/null +++ b/gcc/rust/checks/errors/feature/rust-feature-defs.h @@ -0,0 +1,600 @@ +// Copyright (C) 2025 Free Software Foundation, Inc. + +// This file is part of GCC. + +// GCC is free software; you can redistribute it and/or modify it under +// the terms of the GNU General Public License as published by the Free +// Software Foundation; either version 3, or (at your option) any later +// version. + +// GCC is distributed in the hope that it will be useful, but WITHOUT ANY +// WARRANTY; without even the implied warranty of MERCHANTABILITY or +// FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +// for more details. + +// You should have received a copy of the GNU General Public License +// along with GCC; see the file COPYING3. If not see +// . + +// AUTO-GENERATED -- SEE LOCAL contrib SUBDIRECTORY + +FEATURE_ACCEPTED ("issue_5723_bootstrap", ISSUE_5723_BOOTSTRAP, "1.0.0", + ISSUE_NONE) +FEATURE_ACCEPTED ("test_accepted_feature", TEST_ACCEPTED_FEATURE, "1.0.0", + ISSUE_NONE) +FEATURE_ACCEPTED ("associated_types", ASSOCIATED_TYPES, "1.0.0", ISSUE_NONE) +FEATURE_ACCEPTED ("default_type_params", DEFAULT_TYPE_PARAMS, "1.0.0", + ISSUE_NONE) +FEATURE_ACCEPTED ("globs", GLOBS, "1.0.0", ISSUE_NONE) +FEATURE_ACCEPTED ("macro_rules", MACRO_RULES, "1.0.0", ISSUE_NONE) +FEATURE_ACCEPTED ("slicing_syntax", SLICING_SYNTAX, "1.0.0", ISSUE_NONE) +FEATURE_ACCEPTED ("struct_variant", STRUCT_VARIANT, "1.0.0", ISSUE_NONE) +FEATURE_ACCEPTED ("tuple_indexing", TUPLE_INDEXING, "1.0.0", ISSUE_NONE) +FEATURE_ACCEPTED ("if_let", IF_LET, "1.0.0", ISSUE_NONE) +FEATURE_ACCEPTED ("while_let", WHILE_LET, "1.0.0", ISSUE_NONE) +FEATURE_ACCEPTED ("no_std", NO_STD, "1.6.0", ISSUE_NONE) +FEATURE_ACCEPTED ("augmented_assignments", AUGMENTED_ASSIGNMENTS, "1.8.0", + ISSUE_SOME (28235)) +FEATURE_ACCEPTED ("braced_empty_structs", BRACED_EMPTY_STRUCTS, "1.8.0", + ISSUE_SOME (29720)) +FEATURE_ACCEPTED ("deprecated", DEPRECATED, "1.9.0", ISSUE_SOME (29935)) +FEATURE_ACCEPTED ("type_macros", TYPE_MACROS, "1.13.0", ISSUE_SOME (27245)) +FEATURE_ACCEPTED ("question_mark", QUESTION_MARK, "1.13.0", ISSUE_SOME (31436)) +FEATURE_ACCEPTED ("dotdot_in_tuple_patterns", DOTDOT_IN_TUPLE_PATTERNS, + "1.14.0", ISSUE_SOME (33627)) +FEATURE_ACCEPTED ("item_like_imports", ITEM_LIKE_IMPORTS, "1.15.0", + ISSUE_SOME (35120)) +FEATURE_ACCEPTED ("more_struct_aliases", MORE_STRUCT_ALIASES, "1.16.0", + ISSUE_SOME (37544)) +FEATURE_ACCEPTED ("static_in_const", STATIC_IN_CONST, "1.17.0", + ISSUE_SOME (35897)) +FEATURE_ACCEPTED ("field_init_shorthand", FIELD_INIT_SHORTHAND, "1.17.0", + ISSUE_SOME (37340)) +FEATURE_ACCEPTED ("static_recursion", STATIC_RECURSION, "1.17.0", + ISSUE_SOME (29719)) +FEATURE_ACCEPTED ("pub_restricted", PUB_RESTRICTED, "1.18.0", + ISSUE_SOME (32409)) +FEATURE_ACCEPTED ("windows_subsystem", WINDOWS_SUBSYSTEM, "1.18.0", + ISSUE_SOME (37499)) +FEATURE_ACCEPTED ("loop_break_value", LOOP_BREAK_VALUE, "1.19.0", + ISSUE_SOME (37339)) +FEATURE_ACCEPTED ("relaxed_adts", RELAXED_ADTS, "1.19.0", ISSUE_SOME (35626)) +FEATURE_ACCEPTED ("closure_to_fn_coercion", CLOSURE_TO_FN_COERCION, "1.19.0", + ISSUE_SOME (39817)) +FEATURE_ACCEPTED ("struct_field_attributes", STRUCT_FIELD_ATTRIBUTES, "1.20.0", + ISSUE_SOME (38814)) +FEATURE_ACCEPTED ("associated_consts", ASSOCIATED_CONSTS, "1.20.0", + ISSUE_SOME (29646)) +FEATURE_ACCEPTED ("compile_error", COMPILE_ERROR, "1.20.0", ISSUE_SOME (40872)) +FEATURE_ACCEPTED ("rvalue_static_promotion", RVALUE_STATIC_PROMOTION, "1.21.0", + ISSUE_SOME (38865)) +FEATURE_ACCEPTED ("drop_types_in_const", DROP_TYPES_IN_CONST, "1.22.0", + ISSUE_SOME (33156)) +FEATURE_ACCEPTED ("abi_sysv64", ABI_SYSV64, "1.24.0", ISSUE_SOME (36167)) +FEATURE_ACCEPTED ("repr_align", REPR_ALIGN, "1.25.0", ISSUE_SOME (33626)) +FEATURE_ACCEPTED ("match_beginning_vert", MATCH_BEGINNING_VERT, "1.25.0", + ISSUE_SOME (44101)) +FEATURE_ACCEPTED ("use_nested_groups", USE_NESTED_GROUPS, "1.25.0", + ISSUE_SOME (44494)) +FEATURE_ACCEPTED ("const_indexing", CONST_INDEXING, "1.26.0", + ISSUE_SOME (29947)) +FEATURE_ACCEPTED ("inclusive_range_syntax", INCLUSIVE_RANGE_SYNTAX, "1.26.0", + ISSUE_SOME (28237)) +FEATURE_ACCEPTED ("dotdoteq_in_patterns", DOTDOTEQ_IN_PATTERNS, "1.26.0", + ISSUE_SOME (28237)) +FEATURE_ACCEPTED ("termination_trait", TERMINATION_TRAIT, "1.26.0", + ISSUE_SOME (43301)) +FEATURE_ACCEPTED ("clone_closures", CLONE_CLOSURES, "1.26.0", + ISSUE_SOME (44490)) +FEATURE_ACCEPTED ("copy_closures", COPY_CLOSURES, "1.26.0", ISSUE_SOME (44490)) +FEATURE_ACCEPTED ("universal_impl_trait", UNIVERSAL_IMPL_TRAIT, "1.26.0", + ISSUE_SOME (34511)) +FEATURE_ACCEPTED ("conservative_impl_trait", CONSERVATIVE_IMPL_TRAIT, "1.26.0", + ISSUE_SOME (34511)) +FEATURE_ACCEPTED ("i128_type", I128_TYPE, "1.26.0", ISSUE_SOME (35118)) +FEATURE_ACCEPTED ("match_default_bindings", MATCH_DEFAULT_BINDINGS, "1.26.0", + ISSUE_SOME (42640)) +FEATURE_ACCEPTED ("underscore_lifetimes", UNDERSCORE_LIFETIMES, "1.26.0", + ISSUE_SOME (44524)) +FEATURE_ACCEPTED ("generic_param_attrs", GENERIC_PARAM_ATTRS, "1.27.0", + ISSUE_SOME (48848)) +FEATURE_ACCEPTED ("cfg_target_feature", CFG_TARGET_FEATURE, "1.27.0", + ISSUE_SOME (29717)) +FEATURE_ACCEPTED ("target_feature", TARGET_FEATURE, "1.27.0", ISSUE_NONE) +FEATURE_ACCEPTED ("dyn_trait", DYN_TRAIT, "1.27.0", ISSUE_SOME (44662)) +FEATURE_ACCEPTED ("fn_must_use", FN_MUST_USE, "1.27.0", ISSUE_SOME (43302)) +FEATURE_ACCEPTED ("macro_lifetime_matcher", MACRO_LIFETIME_MATCHER, "1.27.0", + ISSUE_SOME (34303)) +FEATURE_ACCEPTED ("termination_trait_test", TERMINATION_TRAIT_TEST, "1.27.0", + ISSUE_SOME (48854)) +FEATURE_ACCEPTED ("global_allocator", GLOBAL_ALLOCATOR, "1.28.0", + ISSUE_SOME (27389)) +FEATURE_ACCEPTED ("repr_transparent", REPR_TRANSPARENT, "1.28.0", + ISSUE_SOME (43036)) +FEATURE_ACCEPTED ("proc_macro", PROC_MACRO, "1.29.0", ISSUE_SOME (38356)) +FEATURE_ACCEPTED ("non_modrs_mods", NON_MODRS_MODS, "1.30.0", + ISSUE_SOME (44660)) +FEATURE_ACCEPTED ("macro_vis_matcher", MACRO_VIS_MATCHER, "1.30.0", + ISSUE_SOME (41022)) +FEATURE_ACCEPTED ("use_extern_macros", USE_EXTERN_MACROS, "1.30.0", + ISSUE_SOME (35896)) +FEATURE_ACCEPTED ("raw_identifiers", RAW_IDENTIFIERS, "1.30.0", + ISSUE_SOME (48589)) +FEATURE_ACCEPTED ("tool_attributes", TOOL_ATTRIBUTES, "1.30.0", + ISSUE_SOME (44690)) +FEATURE_ACCEPTED ("proc_macro_path_invoc", PROC_MACRO_PATH_INVOC, "1.30.0", + ISSUE_SOME (38356)) +FEATURE_ACCEPTED ("attr_literals", ATTR_LITERALS, "1.30.0", ISSUE_SOME (34981)) +FEATURE_ACCEPTED ("infer_outlives_requirements", INFER_OUTLIVES_REQUIREMENTS, + "1.30.0", ISSUE_SOME (44493)) +FEATURE_ACCEPTED ("panic_handler", PANIC_HANDLER, "1.30.0", ISSUE_SOME (44489)) +FEATURE_ACCEPTED ("used", USED, "1.30.0", ISSUE_SOME (40289)) +FEATURE_ACCEPTED ("crate_in_paths", CRATE_IN_PATHS, "1.30.0", + ISSUE_SOME (45477)) +FEATURE_ACCEPTED ("extern_absolute_paths", EXTERN_ABSOLUTE_PATHS, "1.30.0", + ISSUE_SOME (44660)) +FEATURE_ACCEPTED ("extern_prelude", EXTERN_PRELUDE, "1.30.0", + ISSUE_SOME (44660)) +FEATURE_ACCEPTED ("pattern_parentheses", PATTERN_PARENTHESES, "1.31.0", + ISSUE_SOME (51087)) +FEATURE_ACCEPTED ("min_const_fn", MIN_CONST_FN, "1.31.0", ISSUE_SOME (53555)) +FEATURE_ACCEPTED ("tool_lints", TOOL_LINTS, "1.31.0", ISSUE_SOME (44690)) +FEATURE_ACCEPTED ("impl_header_lifetime_elision", IMPL_HEADER_LIFETIME_ELISION, + "1.31.0", ISSUE_SOME (15872)) +FEATURE_ACCEPTED ("extern_crate_item_prelude", EXTERN_CRATE_ITEM_PRELUDE, + "1.31.0", ISSUE_SOME (55599)) +FEATURE_ACCEPTED ("macro_literal_matcher", MACRO_LITERAL_MATCHER, "1.32.0", + ISSUE_SOME (35625)) +FEATURE_ACCEPTED ("macro_at_most_once_rep", MACRO_AT_MOST_ONCE_REP, "1.32.0", + ISSUE_SOME (48075)) +FEATURE_ACCEPTED ("self_struct_ctor", SELF_STRUCT_CTOR, "1.32.0", + ISSUE_SOME (51994)) +FEATURE_ACCEPTED ("self_in_typedefs", SELF_IN_TYPEDEFS, "1.32.0", + ISSUE_SOME (49303)) +FEATURE_ACCEPTED ("uniform_paths", UNIFORM_PATHS, "1.32.0", ISSUE_SOME (53130)) +FEATURE_ACCEPTED ("exhaustive_integer_patterns", EXHAUSTIVE_INTEGER_PATTERNS, + "1.33.0", ISSUE_SOME (50907)) +FEATURE_ACCEPTED ("underscore_imports", UNDERSCORE_IMPORTS, "1.33.0", + ISSUE_SOME (48216)) +FEATURE_ACCEPTED ("repr_packed", REPR_PACKED, "1.33.0", ISSUE_SOME (33158)) +FEATURE_ACCEPTED ("irrefutable_let_patterns", IRREFUTABLE_LET_PATTERNS, + "1.33.0", ISSUE_SOME (44495)) +FEATURE_ACCEPTED ("min_const_unsafe_fn", MIN_CONST_UNSAFE_FN, "1.33.0", + ISSUE_SOME (55607)) +FEATURE_ACCEPTED ("const_let", CONST_LET, "1.33.0", ISSUE_SOME (48821)) +FEATURE_ACCEPTED ("cfg_attr_multi", CFG_ATTR_MULTI, "1.33.0", + ISSUE_SOME (54881)) +FEATURE_ACCEPTED ("if_while_or_patterns", IF_WHILE_OR_PATTERNS, "1.33.0", + ISSUE_SOME (48215)) +FEATURE_ACCEPTED ("cfg_target_vendor", CFG_TARGET_VENDOR, "1.33.0", + ISSUE_SOME (29718)) +FEATURE_ACCEPTED ("extern_crate_self", EXTERN_CRATE_SELF, "1.34.0", + ISSUE_SOME (56409)) +FEATURE_ACCEPTED ("unrestricted_attribute_tokens", + UNRESTRICTED_ATTRIBUTE_TOKENS, "1.34.0", ISSUE_SOME (55208)) +FEATURE_ACCEPTED ("type_alias_enum_variants", TYPE_ALIAS_ENUM_VARIANTS, + "1.37.0", ISSUE_SOME (49683)) +FEATURE_ACCEPTED ("repr_align_enum", REPR_ALIGN_ENUM, "1.37.0", + ISSUE_SOME (57996)) +FEATURE_ACCEPTED ("underscore_const_names", UNDERSCORE_CONST_NAMES, "1.37.0", + ISSUE_SOME (54912)) +FEATURE_ACCEPTED ("async_await", ASYNC_AWAIT, "1.39.0", ISSUE_SOME (50547)) +FEATURE_ACCEPTED ("bind_by_move_pattern_guards", BIND_BY_MOVE_PATTERN_GUARDS, + "1.39.0", ISSUE_SOME (15287)) +FEATURE_ACCEPTED ("param_attrs", PARAM_ATTRS, "1.39.0", ISSUE_SOME (60406)) +FEATURE_ACCEPTED ("macros_in_extern", MACROS_IN_EXTERN, "1.40.0", + ISSUE_SOME (49476)) +FEATURE_ACCEPTED ("non_exhaustive", NON_EXHAUSTIVE, "1.40.0", + ISSUE_SOME (44109)) +FEATURE_ACCEPTED ("const_constructor", CONST_CONSTRUCTOR, "1.40.0", + ISSUE_SOME (61456)) +FEATURE_ACCEPTED ("cfg_doctest", CFG_DOCTEST, "1.40.0", ISSUE_SOME (62210)) +FEATURE_ACCEPTED ("re_rebalance_coherence", RE_REBALANCE_COHERENCE, "1.41.0", + ISSUE_SOME (55437)) +FEATURE_ACCEPTED ("transparent_enums", TRANSPARENT_ENUMS, "1.42.0", + ISSUE_SOME (60405)) +FEATURE_ACCEPTED ("slice_patterns", SLICE_PATTERNS, "1.42.0", + ISSUE_SOME (62254)) +FEATURE_ACCEPTED ("const_if_match", CONST_IF_MATCH, "1.46.0", + ISSUE_SOME (49146)) +FEATURE_ACCEPTED ("const_loop", CONST_LOOP, "1.46.0", ISSUE_SOME (52000)) +FEATURE_ACCEPTED ("track_caller", TRACK_CALLER, "1.46.0", ISSUE_SOME (47809)) +FEATURE_ACCEPTED ("doc_alias", DOC_ALIAS, "1.48.0", ISSUE_SOME (50146)) +FEATURE_ACCEPTED ("move_ref_pattern", MOVE_REF_PATTERN, "1.48.0", + ISSUE_SOME (68354)) +FEATURE_ACTIVE ("rustc_attrs", RUSTC_ATTRS, "1.0.0", ISSUE_NONE, EDITION_NONE) +FEATURE_ACTIVE ("rustc_private", RUSTC_PRIVATE, "1.0.0", ISSUE_SOME (27812), + EDITION_NONE) +FEATURE_ACTIVE ("intrinsics", INTRINSICS, "1.0.0", ISSUE_NONE, EDITION_NONE) +FEATURE_ACTIVE ("lang_items", LANG_ITEMS, "1.0.0", ISSUE_NONE, EDITION_NONE) +FEATURE_ACTIVE ("staged_api", STAGED_API, "1.0.0", ISSUE_NONE, EDITION_NONE) +FEATURE_ACTIVE ("allow_internal_unstable", ALLOW_INTERNAL_UNSTABLE, "1.0.0", + ISSUE_NONE, EDITION_NONE) +FEATURE_ACTIVE ("allow_internal_unsafe", ALLOW_INTERNAL_UNSAFE, "1.0.0", + ISSUE_NONE, EDITION_NONE) +FEATURE_ACTIVE ("link_llvm_intrinsics", LINK_LLVM_INTRINSICS, "1.0.0", + ISSUE_SOME (29602), EDITION_NONE) +FEATURE_ACTIVE ("box_syntax", BOX_SYNTAX, "1.0.0", ISSUE_SOME (49733), + EDITION_NONE) +FEATURE_ACTIVE ("main", MAIN, "1.0.0", ISSUE_SOME (29634), EDITION_NONE) +FEATURE_ACTIVE ("start", START, "1.0.0", ISSUE_SOME (29633), EDITION_NONE) +FEATURE_ACTIVE ("fundamental", FUNDAMENTAL, "1.0.0", ISSUE_SOME (29635), + EDITION_NONE) +FEATURE_ACTIVE ("unboxed_closures", UNBOXED_CLOSURES, "1.0.0", + ISSUE_SOME (29625), EDITION_NONE) +FEATURE_ACTIVE ("linkage", LINKAGE, "1.0.0", ISSUE_SOME (29603), EDITION_NONE) +FEATURE_ACTIVE ("optin_builtin_traits", OPTIN_BUILTIN_TRAITS, "1.0.0", + ISSUE_SOME (13231), EDITION_NONE) +FEATURE_ACTIVE ("box_patterns", BOX_PATTERNS, "1.0.0", ISSUE_SOME (29641), + EDITION_NONE) +FEATURE_ACTIVE ("prelude_import", PRELUDE_IMPORT, "1.2.0", ISSUE_NONE, + EDITION_NONE) +FEATURE_ACTIVE ("omit_gdb_pretty_printer_section", + OMIT_GDB_PRETTY_PRINTER_SECTION, "1.5.0", ISSUE_NONE, + EDITION_NONE) +FEATURE_ACTIVE ("abi_vectorcall", ABI_VECTORCALL, "1.7.0", ISSUE_NONE, + EDITION_NONE) +FEATURE_ACTIVE ("structural_match", STRUCTURAL_MATCH, "1.8.0", + ISSUE_SOME (31434), EDITION_NONE) +FEATURE_ACTIVE ("dropck_eyepatch", DROPCK_EYEPATCH, "1.10.0", + ISSUE_SOME (34761), EDITION_NONE) +FEATURE_ACTIVE ("panic_runtime", PANIC_RUNTIME, "1.10.0", ISSUE_SOME (32837), + EDITION_NONE) +FEATURE_ACTIVE ("needs_panic_runtime", NEEDS_PANIC_RUNTIME, "1.10.0", + ISSUE_SOME (32837), EDITION_NONE) +FEATURE_ACTIVE ("compiler_builtins", COMPILER_BUILTINS, "1.13.0", ISSUE_NONE, + EDITION_NONE) +FEATURE_ACTIVE ("abi_unadjusted", ABI_UNADJUSTED, "1.16.0", ISSUE_NONE, + EDITION_NONE) +FEATURE_ACTIVE ("profiler_runtime", PROFILER_RUNTIME, "1.18.0", ISSUE_NONE, + EDITION_NONE) +FEATURE_ACTIVE ("abi_thiscall", ABI_THISCALL, "1.19.0", ISSUE_NONE, + EDITION_NONE) +FEATURE_ACTIVE ("allocator_internals", ALLOCATOR_INTERNALS, "1.20.0", + ISSUE_NONE, EDITION_NONE) +FEATURE_ACTIVE ("test_2018_feature", TEST_2018_FEATURE, "1.31.0", ISSUE_NONE, + EDITION_2018) +FEATURE_ACTIVE ("no_niche", NO_NICHE, "1.42.0", ISSUE_NONE, EDITION_NONE) +FEATURE_ACTIVE ("rustc_allow_const_fn_unstable", RUSTC_ALLOW_CONST_FN_UNSTABLE, + "1.49.0", ISSUE_SOME (69399), EDITION_NONE) +FEATURE_ACTIVE ("arm_target_feature", ARM_TARGET_FEATURE, "1.27.0", + ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("aarch64_target_feature", AARCH64_TARGET_FEATURE, "1.27.0", + ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("hexagon_target_feature", HEXAGON_TARGET_FEATURE, "1.27.0", + ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("powerpc_target_feature", POWERPC_TARGET_FEATURE, "1.27.0", + ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("mips_target_feature", MIPS_TARGET_FEATURE, "1.27.0", + ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("avx512_target_feature", AVX512_TARGET_FEATURE, "1.27.0", + ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("sse4a_target_feature", SSE4A_TARGET_FEATURE, "1.27.0", + ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("tbm_target_feature", TBM_TARGET_FEATURE, "1.27.0", + ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("wasm_target_feature", WASM_TARGET_FEATURE, "1.30.0", + ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("adx_target_feature", ADX_TARGET_FEATURE, "1.32.0", + ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("cmpxchg16b_target_feature", CMPXCHG16B_TARGET_FEATURE, + "1.32.0", ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("movbe_target_feature", MOVBE_TARGET_FEATURE, "1.34.0", + ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("rtm_target_feature", RTM_TARGET_FEATURE, "1.35.0", + ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("f16c_target_feature", F16C_TARGET_FEATURE, "1.36.0", + ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("riscv_target_feature", RISCV_TARGET_FEATURE, "1.45.0", + ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("ermsb_target_feature", ERMSB_TARGET_FEATURE, "1.49.0", + ISSUE_SOME (44839), EDITION_NONE) +FEATURE_ACTIVE ("link_args", LINK_ARGS, "1.0.0", ISSUE_SOME (29596), + EDITION_NONE) +FEATURE_ACTIVE ("non_ascii_idents", NON_ASCII_IDENTS, "1.0.0", + ISSUE_SOME (55467), EDITION_NONE) +FEATURE_ACTIVE ("plugin_registrar", PLUGIN_REGISTRAR, "1.0.0", + ISSUE_SOME (29597), EDITION_NONE) +FEATURE_ACTIVE ("plugin", PLUGIN, "1.0.0", ISSUE_SOME (29597), EDITION_NONE) +FEATURE_ACTIVE ("thread_local", THREAD_LOCAL, "1.0.0", ISSUE_SOME (29594), + EDITION_NONE) +FEATURE_ACTIVE ("simd_ffi", SIMD_FFI, "1.0.0", ISSUE_SOME (27731), EDITION_NONE) +FEATURE_ACTIVE ("nll", NLL, "1.0.0", ISSUE_SOME (43234), EDITION_NONE) +FEATURE_ACTIVE ("const_fn", CONST_FN, "1.2.0", ISSUE_SOME (57563), EDITION_NONE) +FEATURE_ACTIVE ("associated_type_defaults", ASSOCIATED_TYPE_DEFAULTS, "1.2.0", + ISSUE_SOME (29661), EDITION_NONE) +FEATURE_ACTIVE ("no_core", NO_CORE, "1.3.0", ISSUE_SOME (29639), EDITION_NONE) +FEATURE_ACTIVE ("default_type_parameter_fallback", + DEFAULT_TYPE_PARAMETER_FALLBACK, "1.3.0", ISSUE_SOME (27336), + EDITION_NONE) +FEATURE_ACTIVE ("repr_simd", REPR_SIMD, "1.4.0", ISSUE_SOME (27731), + EDITION_NONE) +FEATURE_ACTIVE ("platform_intrinsics", PLATFORM_INTRINSICS, "1.4.0", + ISSUE_SOME (27731), EDITION_NONE) +FEATURE_ACTIVE ("unwind_attributes", UNWIND_ATTRIBUTES, "1.4.0", + ISSUE_SOME (58760), EDITION_NONE) +FEATURE_ACTIVE ("stmt_expr_attributes", STMT_EXPR_ATTRIBUTES, "1.6.0", + ISSUE_SOME (15701), EDITION_NONE) +FEATURE_ACTIVE ("type_ascription", TYPE_ASCRIPTION, "1.6.0", ISSUE_SOME (23416), + EDITION_NONE) +FEATURE_ACTIVE ("cfg_target_thread_local", CFG_TARGET_THREAD_LOCAL, "1.7.0", + ISSUE_SOME (29594), EDITION_NONE) +FEATURE_ACTIVE ("specialization", SPECIALIZATION, "1.7.0", ISSUE_SOME (31844), + EDITION_NONE) +FEATURE_ACTIVE ("min_specialization", MIN_SPECIALIZATION, "1.7.0", + ISSUE_SOME (31844), EDITION_NONE) +FEATURE_ACTIVE ("naked_functions", NAKED_FUNCTIONS, "1.9.0", ISSUE_SOME (32408), + EDITION_NONE) +FEATURE_ACTIVE ("cfg_target_has_atomic", CFG_TARGET_HAS_ATOMIC, "1.9.0", + ISSUE_SOME (32976), EDITION_NONE) +FEATURE_ACTIVE ("exclusive_range_pattern", EXCLUSIVE_RANGE_PATTERN, "1.11.0", + ISSUE_SOME (37854), EDITION_NONE) +FEATURE_ACTIVE ("never_type", NEVER_TYPE, "1.13.0", ISSUE_SOME (35121), + EDITION_NONE) +FEATURE_ACTIVE ("exhaustive_patterns", EXHAUSTIVE_PATTERNS, "1.13.0", + ISSUE_SOME (51085), EDITION_NONE) +FEATURE_ACTIVE ("untagged_unions", UNTAGGED_UNIONS, "1.13.0", + ISSUE_SOME (55149), EDITION_NONE) +FEATURE_ACTIVE ("link_cfg", LINK_CFG, "1.14.0", ISSUE_SOME (37406), + EDITION_NONE) +FEATURE_ACTIVE ("abi_ptx", ABI_PTX, "1.15.0", ISSUE_SOME (38788), EDITION_NONE) +FEATURE_ACTIVE ("repr128", REPR128, "1.16.0", ISSUE_SOME (56071), EDITION_NONE) +FEATURE_ACTIVE ("static_nobundle", STATIC_NOBUNDLE, "1.16.0", + ISSUE_SOME (37403), EDITION_NONE) +FEATURE_ACTIVE ("abi_msp430_interrupt", ABI_MSP430_INTERRUPT, "1.16.0", + ISSUE_SOME (38487), EDITION_NONE) +FEATURE_ACTIVE ("decl_macro", DECL_MACRO, "1.17.0", ISSUE_SOME (39412), + EDITION_NONE) +FEATURE_ACTIVE ("abi_x86_interrupt", ABI_X86_INTERRUPT, "1.17.0", + ISSUE_SOME (40180), EDITION_NONE) +FEATURE_ACTIVE ("allow_fail", ALLOW_FAIL, "1.19.0", ISSUE_SOME (46488), + EDITION_NONE) +FEATURE_ACTIVE ("unsized_tuple_coercion", UNSIZED_TUPLE_COERCION, "1.20.0", + ISSUE_SOME (42877), EDITION_NONE) +FEATURE_ACTIVE ("generators", GENERATORS, "1.21.0", ISSUE_SOME (43122), + EDITION_NONE) +FEATURE_ACTIVE ("doc_cfg", DOC_CFG, "1.21.0", ISSUE_SOME (43781), EDITION_NONE) +FEATURE_ACTIVE ("doc_masked", DOC_MASKED, "1.21.0", ISSUE_SOME (44027), + EDITION_NONE) +FEATURE_ACTIVE ("doc_spotlight", DOC_SPOTLIGHT, "1.22.0", ISSUE_SOME (45040), + EDITION_NONE) +FEATURE_ACTIVE ("external_doc", EXTERNAL_DOC, "1.22.0", ISSUE_SOME (44732), + EDITION_NONE) +FEATURE_ACTIVE ("crate_visibility_modifier", CRATE_VISIBILITY_MODIFIER, + "1.23.0", ISSUE_SOME (53120), EDITION_NONE) +FEATURE_ACTIVE ("extern_types", EXTERN_TYPES, "1.23.0", ISSUE_SOME (43467), + EDITION_NONE) +FEATURE_ACTIVE ("arbitrary_self_types", ARBITRARY_SELF_TYPES, "1.23.0", + ISSUE_SOME (44874), EDITION_NONE) +FEATURE_ACTIVE ("in_band_lifetimes", IN_BAND_LIFETIMES, "1.23.0", + ISSUE_SOME (44524), EDITION_NONE) +FEATURE_ACTIVE ("generic_associated_types", GENERIC_ASSOCIATED_TYPES, "1.23.0", + ISSUE_SOME (44265), EDITION_NONE) +FEATURE_ACTIVE ("trait_alias", TRAIT_ALIAS, "1.24.0", ISSUE_SOME (41517), + EDITION_NONE) +FEATURE_ACTIVE ("infer_static_outlives_requirements", + INFER_STATIC_OUTLIVES_REQUIREMENTS, "1.26.0", + ISSUE_SOME (54185), EDITION_NONE) +FEATURE_ACTIVE ("const_fn_union", CONST_FN_UNION, "1.27.0", ISSUE_SOME (51909), + EDITION_NONE) +FEATURE_ACTIVE ("const_raw_ptr_to_usize_cast", CONST_RAW_PTR_TO_USIZE_CAST, + "1.27.0", ISSUE_SOME (51910), EDITION_NONE) +FEATURE_ACTIVE ("const_raw_ptr_deref", CONST_RAW_PTR_DEREF, "1.27.0", + ISSUE_SOME (51911), EDITION_NONE) +FEATURE_ACTIVE ("trivial_bounds", TRIVIAL_BOUNDS, "1.28.0", ISSUE_SOME (48214), + EDITION_NONE) +FEATURE_ACTIVE ("label_break_value", LABEL_BREAK_VALUE, "1.28.0", + ISSUE_SOME (48594), EDITION_NONE) +FEATURE_ACTIVE ("doc_keyword", DOC_KEYWORD, "1.28.0", ISSUE_SOME (51315), + EDITION_NONE) +FEATURE_ACTIVE ("try_blocks", TRY_BLOCKS, "1.29.0", ISSUE_SOME (31436), + EDITION_NONE) +FEATURE_ACTIVE ("alloc_error_handler", ALLOC_ERROR_HANDLER, "1.29.0", + ISSUE_SOME (51540), EDITION_NONE) +FEATURE_ACTIVE ("abi_amdgpu_kernel", ABI_AMDGPU_KERNEL, "1.29.0", + ISSUE_SOME (51575), EDITION_NONE) +FEATURE_ACTIVE ("const_panic", CONST_PANIC, "1.30.0", ISSUE_SOME (51999), + EDITION_NONE) +FEATURE_ACTIVE ("marker_trait_attr", MARKER_TRAIT_ATTR, "1.30.0", + ISSUE_SOME (29864), EDITION_NONE) +FEATURE_ACTIVE ("proc_macro_hygiene", PROC_MACRO_HYGIENE, "1.30.0", + ISSUE_SOME (54727), EDITION_NONE) +FEATURE_ACTIVE ("unsized_locals", UNSIZED_LOCALS, "1.30.0", ISSUE_SOME (48055), + EDITION_NONE) +FEATURE_ACTIVE ("custom_test_frameworks", CUSTOM_TEST_FRAMEWORKS, "1.30.0", + ISSUE_SOME (50297), EDITION_NONE) +FEATURE_ACTIVE ("custom_inner_attributes", CUSTOM_INNER_ATTRIBUTES, "1.30.0", + ISSUE_SOME (54726), EDITION_NONE) +FEATURE_ACTIVE ("impl_trait_in_bindings", IMPL_TRAIT_IN_BINDINGS, "1.30.0", + ISSUE_SOME (63065), EDITION_NONE) +FEATURE_ACTIVE ("lint_reasons", LINT_REASONS, "1.31.0", ISSUE_SOME (54503), + EDITION_NONE) +FEATURE_ACTIVE ("precise_pointer_size_matching", PRECISE_POINTER_SIZE_MATCHING, + "1.32.0", ISSUE_SOME (56354), EDITION_NONE) +FEATURE_ACTIVE ("ffi_returns_twice", FFI_RETURNS_TWICE, "1.34.0", + ISSUE_SOME (58314), EDITION_NONE) +FEATURE_ACTIVE ("const_generics", CONST_GENERICS, "1.34.0", ISSUE_SOME (44580), + EDITION_NONE) +FEATURE_ACTIVE ("optimize_attribute", OPTIMIZE_ATTRIBUTE, "1.34.0", + ISSUE_SOME (54882), EDITION_NONE) +FEATURE_ACTIVE ("c_variadic", C_VARIADIC, "1.34.0", ISSUE_SOME (44930), + EDITION_NONE) +FEATURE_ACTIVE ("associated_type_bounds", ASSOCIATED_TYPE_BOUNDS, "1.34.0", + ISSUE_SOME (52662), EDITION_NONE) +FEATURE_ACTIVE ("let_chains", LET_CHAINS, "1.37.0", ISSUE_SOME (53667), + EDITION_NONE) +FEATURE_ACTIVE ("transparent_unions", TRANSPARENT_UNIONS, "1.37.0", + ISSUE_SOME (60405), EDITION_NONE) +FEATURE_ACTIVE ("arbitrary_enum_discriminant", ARBITRARY_ENUM_DISCRIMINANT, + "1.37.0", ISSUE_SOME (60553), EDITION_NONE) +FEATURE_ACTIVE ("member_constraints", MEMBER_CONSTRAINTS, "1.37.0", + ISSUE_SOME (61997), EDITION_NONE) +FEATURE_ACTIVE ("async_closure", ASYNC_CLOSURE, "1.37.0", ISSUE_SOME (62290), + EDITION_NONE) +FEATURE_ACTIVE ("const_in_array_repeat_expressions", + CONST_IN_ARRAY_REPEAT_EXPRESSIONS, "1.37.0", ISSUE_SOME (49147), + EDITION_NONE) +FEATURE_ACTIVE ("type_alias_impl_trait", TYPE_ALIAS_IMPL_TRAIT, "1.38.0", + ISSUE_SOME (63063), EDITION_NONE) +FEATURE_ACTIVE ("or_patterns", OR_PATTERNS, "1.38.0", ISSUE_SOME (54883), + EDITION_NONE) +FEATURE_ACTIVE ("const_extern_fn", CONST_EXTERN_FN, "1.40.0", + ISSUE_SOME (64926), EDITION_NONE) +FEATURE_ACTIVE ("raw_dylib", RAW_DYLIB, "1.40.0", ISSUE_SOME (58713), + EDITION_NONE) +FEATURE_ACTIVE ("object_safe_for_dispatch", OBJECT_SAFE_FOR_DISPATCH, "1.40.0", + ISSUE_SOME (43561), EDITION_NONE) +FEATURE_ACTIVE ("abi_efiapi", ABI_EFIAPI, "1.40.0", ISSUE_SOME (65815), + EDITION_NONE) +FEATURE_ACTIVE ("raw_ref_op", RAW_REF_OP, "1.41.0", ISSUE_SOME (64490), + EDITION_NONE) +FEATURE_ACTIVE ("never_type_fallback", NEVER_TYPE_FALLBACK, "1.41.0", + ISSUE_SOME (65992), EDITION_NONE) +FEATURE_ACTIVE ("register_attr", REGISTER_ATTR, "1.41.0", ISSUE_SOME (66080), + EDITION_NONE) +FEATURE_ACTIVE ("register_tool", REGISTER_TOOL, "1.41.0", ISSUE_SOME (66079), + EDITION_NONE) +FEATURE_ACTIVE ("cfg_sanitize", CFG_SANITIZE, "1.41.0", ISSUE_SOME (39699), + EDITION_NONE) +FEATURE_ACTIVE ("half_open_range_patterns", HALF_OPEN_RANGE_PATTERNS, "1.41.0", + ISSUE_SOME (67264), EDITION_NONE) +FEATURE_ACTIVE ("const_mut_refs", CONST_MUT_REFS, "1.41.0", ISSUE_SOME (57349), + EDITION_NONE) +FEATURE_ACTIVE ("bindings_after_at", BINDINGS_AFTER_AT, "1.41.0", + ISSUE_SOME (65490), EDITION_NONE) +FEATURE_ACTIVE ("const_trait_impl", CONST_TRAIT_IMPL, "1.42.0", + ISSUE_SOME (67792), EDITION_NONE) +FEATURE_ACTIVE ("const_trait_bound_opt_out", CONST_TRAIT_BOUND_OPT_OUT, + "1.42.0", ISSUE_SOME (67794), EDITION_NONE) +FEATURE_ACTIVE ("no_sanitize", NO_SANITIZE, "1.42.0", ISSUE_SOME (39699), + EDITION_NONE) +FEATURE_ACTIVE ("const_eval_limit", CONST_EVAL_LIMIT, "1.43.0", + ISSUE_SOME (67217), EDITION_NONE) +FEATURE_ACTIVE ("negative_impls", NEGATIVE_IMPLS, "1.44.0", ISSUE_SOME (68318), + EDITION_NONE) +FEATURE_ACTIVE ("target_feature_11", TARGET_FEATURE_11, "1.45.0", + ISSUE_SOME (69098), EDITION_NONE) +FEATURE_ACTIVE ("cfg_version", CFG_VERSION, "1.45.0", ISSUE_SOME (64796), + EDITION_NONE) +FEATURE_ACTIVE ("ffi_pure", FFI_PURE, "1.45.0", ISSUE_SOME (58329), + EDITION_NONE) +FEATURE_ACTIVE ("ffi_const", FFI_CONST, "1.45.0", ISSUE_SOME (58328), + EDITION_NONE) +FEATURE_ACTIVE ("unsafe_block_in_unsafe_fn", UNSAFE_BLOCK_IN_UNSAFE_FN, + "1.45.0", ISSUE_SOME (71668), EDITION_NONE) +FEATURE_ACTIVE ("abi_avr_interrupt", ABI_AVR_INTERRUPT, "1.45.0", + ISSUE_SOME (69664), EDITION_NONE) +FEATURE_ACTIVE ("const_precise_live_drops", CONST_PRECISE_LIVE_DROPS, "1.46.0", + ISSUE_SOME (73255), EDITION_NONE) +FEATURE_ACTIVE ("format_args_capture", FORMAT_ARGS_CAPTURE, "1.46.0", + ISSUE_SOME (67984), EDITION_NONE) +FEATURE_ACTIVE ("lazy_normalization_consts", LAZY_NORMALIZATION_CONSTS, + "1.46.0", ISSUE_SOME (72219), EDITION_NONE) +FEATURE_ACTIVE ("const_fn_transmute", CONST_FN_TRANSMUTE, "1.46.0", + ISSUE_SOME (53605), EDITION_NONE) +FEATURE_ACTIVE ("min_const_generics", MIN_CONST_GENERICS, "1.47.0", + ISSUE_SOME (74878), EDITION_NONE) +FEATURE_ACTIVE ("if_let_guard", IF_LET_GUARD, "1.47.0", ISSUE_SOME (51114), + EDITION_NONE) +FEATURE_ACTIVE ("const_evaluatable_checked", CONST_EVALUATABLE_CHECKED, + "1.48.0", ISSUE_SOME (76560), EDITION_NONE) +FEATURE_ACTIVE ("const_fn_floating_point_arithmetic", + CONST_FN_FLOATING_POINT_ARITHMETIC, "1.48.0", + ISSUE_SOME (57241), EDITION_NONE) +FEATURE_ACTIVE ("const_fn_fn_ptr_basics", CONST_FN_FN_PTR_BASICS, "1.48.0", + ISSUE_SOME (57563), EDITION_NONE) +FEATURE_ACTIVE ("cmse_nonsecure_entry", CMSE_NONSECURE_ENTRY, "1.48.0", + ISSUE_SOME (75835), EDITION_NONE) +FEATURE_ACTIVE ("default_alloc_error_handler", DEFAULT_ALLOC_ERROR_HANDLER, + "1.48.0", ISSUE_SOME (66741), EDITION_NONE) +FEATURE_ACTIVE ("const_impl_trait", CONST_IMPL_TRAIT, "1.48.0", + ISSUE_SOME (77463), EDITION_NONE) +FEATURE_ACTIVE ("isa_attribute", ISA_ATTRIBUTE, "1.48.0", ISSUE_SOME (74727), + EDITION_NONE) +FEATURE_ACTIVE ("inline_const", INLINE_CONST, "1.49.0", ISSUE_SOME (76001), + EDITION_NONE) +FEATURE_ACTIVE ("unsized_fn_params", UNSIZED_FN_PARAMS, "1.49.0", + ISSUE_SOME (48055), EDITION_NONE) +FEATURE_ACTIVE ("destructuring_assignment", DESTRUCTURING_ASSIGNMENT, "1.49.0", + ISSUE_SOME (71126), EDITION_NONE) +FEATURE_ACTIVE ("cfg_panic", CFG_PANIC, "1.49.0", ISSUE_SOME (77443), + EDITION_NONE) +FEATURE_REMOVED ("import_shadowing", IMPORT_SHADOWING, "1.0.0", ISSUE_NONE, + REASON_NONE) +FEATURE_REMOVED ("managed_boxes", MANAGED_BOXES, "1.0.0", ISSUE_NONE, + REASON_NONE) +FEATURE_REMOVED ("negate_unsigned", NEGATE_UNSIGNED, "1.0.0", + ISSUE_SOME (29645), REASON_NONE) +FEATURE_REMOVED ("reflect", REFLECT, "1.0.0", ISSUE_SOME (27749), REASON_NONE) +FEATURE_REMOVED ("opt_out_copy", OPT_OUT_COPY, "1.0.0", ISSUE_NONE, REASON_NONE) +FEATURE_REMOVED ("quad_precision_float", QUAD_PRECISION_FLOAT, "1.0.0", + ISSUE_NONE, REASON_NONE) +FEATURE_REMOVED ("struct_inherit", STRUCT_INHERIT, "1.0.0", ISSUE_NONE, + REASON_NONE) +FEATURE_REMOVED ("test_removed_feature", TEST_REMOVED_FEATURE, "1.0.0", + ISSUE_NONE, REASON_NONE) +FEATURE_REMOVED ("visible_private_types", VISIBLE_PRIVATE_TYPES, "1.0.0", + ISSUE_NONE, REASON_NONE) +FEATURE_REMOVED ("unsafe_no_drop_flag", UNSAFE_NO_DROP_FLAG, "1.0.0", + ISSUE_NONE, REASON_NONE) +FEATURE_REMOVED ("unmarked_api", UNMARKED_API, "1.0.0", ISSUE_NONE, REASON_NONE) +FEATURE_REMOVED ("allocator", ALLOCATOR, "1.0.0", ISSUE_NONE, REASON_NONE) +FEATURE_REMOVED ("simd", SIMD, "1.0.0", ISSUE_SOME (27731), + REASON_SOME ("removed in favor of `#[repr(simd)]`")) +FEATURE_REMOVED ("advanced_slice_patterns", ADVANCED_SLICE_PATTERNS, "1.0.0", + ISSUE_SOME (62254), + REASON_SOME ("merged into `#![feature(slice_patterns)]`")) +FEATURE_REMOVED ("macro_reexport", MACRO_REEXPORT, "1.0.0", ISSUE_SOME (29638), + REASON_SOME ("subsumed by `pub use`")) +FEATURE_REMOVED ( + "custom_attribute", CUSTOM_ATTRIBUTE, "1.0.0", ISSUE_SOME (29642), + REASON_SOME ( + "removed in favor of `#![register_tool]` and `#![register_attr]`")) +FEATURE_REMOVED ("pushpop_unsafe", PUSHPOP_UNSAFE, "1.2.0", ISSUE_NONE, + REASON_NONE) +FEATURE_REMOVED ("needs_allocator", NEEDS_ALLOCATOR, "1.4.0", + ISSUE_SOME (27389), + REASON_SOME ("subsumed by `#![feature(allocator_internals)]`")) +FEATURE_REMOVED ("sanitizer_runtime", SANITIZER_RUNTIME, "1.17.0", ISSUE_NONE, + REASON_NONE) +FEATURE_REMOVED ("proc_macro_mod", PROC_MACRO_MOD, "1.27.0", ISSUE_SOME (54727), + REASON_SOME ("subsumed by `#![feature(proc_macro_hygiene)]`")) +FEATURE_REMOVED ("proc_macro_expr", PROC_MACRO_EXPR, "1.27.0", + ISSUE_SOME (54727), + REASON_SOME ("subsumed by `#![feature(proc_macro_hygiene)]`")) +FEATURE_REMOVED ("proc_macro_non_items", PROC_MACRO_NON_ITEMS, "1.27.0", + ISSUE_SOME (54727), + REASON_SOME ("subsumed by `#![feature(proc_macro_hygiene)]`")) +FEATURE_REMOVED ("proc_macro_gen", PROC_MACRO_GEN, "1.27.0", ISSUE_SOME (54727), + REASON_SOME ("subsumed by `#![feature(proc_macro_hygiene)]`")) +FEATURE_REMOVED ("panic_implementation", PANIC_IMPLEMENTATION, "1.28.0", + ISSUE_SOME (44489), + REASON_SOME ("subsumed by `#[panic_handler]`")) +FEATURE_REMOVED ("custom_derive", CUSTOM_DERIVE, "1.32.0", ISSUE_SOME (29644), + REASON_SOME ("subsumed by `#[proc_macro_derive]`")) +FEATURE_REMOVED ("extern_in_paths", EXTERN_IN_PATHS, "1.33.0", + ISSUE_SOME (55600), + REASON_SOME ("subsumed by `::foo::bar` paths")) +FEATURE_REMOVED ("quote", QUOTE, "1.33.0", ISSUE_SOME (29601), REASON_NONE) +FEATURE_REMOVED ("dropck_parametricity", DROPCK_PARAMETRICITY, "1.38.0", + ISSUE_SOME (28498), REASON_NONE) +FEATURE_REMOVED ("await_macro", AWAIT_MACRO, "1.38.0", ISSUE_SOME (50547), + REASON_SOME ("subsumed by `.await` syntax")) +FEATURE_REMOVED ( + "existential_type", EXISTENTIAL_TYPE, "1.38.0", ISSUE_SOME (63063), + REASON_SOME ("removed in favor of `#![feature(type_alias_impl_trait)]`")) +FEATURE_REMOVED ("rustc_diagnostic_macros", RUSTC_DIAGNOSTIC_MACROS, "1.38.0", + ISSUE_NONE, REASON_NONE) +FEATURE_REMOVED ("on_unimplemented", ON_UNIMPLEMENTED, "1.40.0", ISSUE_NONE, + REASON_NONE) +FEATURE_REMOVED ( + "overlapping_marker_traits", OVERLAPPING_MARKER_TRAITS, "1.42.0", + ISSUE_SOME (29864), + REASON_SOME ("removed in favor of `#![feature(marker_trait_attr)]`")) +FEATURE_REMOVED ("no_debug", F_NO_DEBUG, "1.43.0", ISSUE_SOME (29721), + REASON_SOME ("removed due to lack of demand")) +FEATURE_REMOVED ( + "const_compare_raw_pointers", CONST_COMPARE_RAW_POINTERS, "1.46.0", + ISSUE_SOME (53020), + REASON_SOME ("cannot be allowed in const eval in any meaningful way")) +FEATURE_STABLE_REMOVED ("no_stack_check", NO_STACK_CHECK, "1.0.0", ISSUE_NONE) diff --git a/gcc/rust/checks/errors/feature/rust-feature-gate.cc b/gcc/rust/checks/errors/feature/rust-feature-gate.cc index 44007f99e5cf..b2a6b6c64812 100644 --- a/gcc/rust/checks/errors/feature/rust-feature-gate.cc +++ b/gcc/rust/checks/errors/feature/rust-feature-gate.cc @@ -82,7 +82,7 @@ FeatureGate::gate (Feature::Name name, location_t loc, { if (!valid_features.count (name)) { - auto feature = Feature::create (name); + auto &feature = Feature::lookup (name); if (auto issue = feature.issue ()) { auto issue_number = issue.value (); @@ -184,7 +184,7 @@ void FeatureGate::visit (AST::Trait &trait) { if (trait.is_auto ()) - gate (Feature::Name::AUTO_TRAITS, trait.get_locus (), + gate (Feature::Name::OPTIN_BUILTIN_TRAITS, trait.get_locus (), "auto traits are experimental and possibly buggy"); AST::DefaultASTVisitor::visit (trait); } diff --git a/gcc/rust/checks/errors/feature/rust-feature.cc b/gcc/rust/checks/errors/feature/rust-feature.cc index 071d3f8c0d97..7fc5cb047975 100644 --- a/gcc/rust/checks/errors/feature/rust-feature.cc +++ b/gcc/rust/checks/errors/feature/rust-feature.cc @@ -20,70 +20,58 @@ namespace Rust { -Feature -Feature::create (Feature::Name f) -{ - switch (f) - { - case Feature::Name::ASSOCIATED_TYPE_BOUNDS: - return Feature (Feature::Name::ASSOCIATED_TYPE_BOUNDS, - Feature::State::ACCEPTED, "associated_type_bounds", - "1.34.0", 52662); - case Feature::Name::INTRINSICS: - return Feature (f, Feature::State::ACCEPTED, "intrinsics", "1.0.0"); - case Feature::Name::RUSTC_ATTRS: - return Feature (f, Feature::State::ACCEPTED, "rustc_attrs", "1.0.0"); - case Feature::Name::DECL_MACRO: - return Feature (f, Feature::State::ACCEPTED, "decl_macro", "1.0.0", - 39412); - case Feature::Name::EXTERN_TYPES: - return Feature (f, Feature::State::ACTIVE, "extern_types", "1.23.0", - 43467); - case Feature::Name::NEGATIVE_IMPLS: - return Feature (f, Feature::State::ACTIVE, "negative_impls", "1.0.0", - 68318); - case Feature::Name::BOX_SYNTAX: - return Feature (f, Feature::State::ACTIVE, "box_syntax", "1.0.0", 49733); - case Feature::Name::DROPCK_EYEPATCH: - return Feature (f, Feature::State::ACTIVE, "dropck_eyepatch", "1.10.0", - 34761); - case Feature::Name::RAW_REF_OP: - return Feature (f, Feature::State::ACTIVE, "raw_ref_op", "1.41.0", 64490); - case Feature::Name::EXCLUSIVE_RANGE_PATTERN: - return Feature (Feature::Name::EXCLUSIVE_RANGE_PATTERN, - Feature::State::ACTIVE, "exclusive_range_pattern", - "1.11.0", 37854); - case Feature::Name::PRELUDE_IMPORT: - return Feature (f, Feature::State::ACTIVE, "prelude_import", "1.0.0"); - case Feature::Name::MIN_SPECIALIZATION: - return Feature (f, Feature::State::ACTIVE, "min_specialization", - "1.0.0" /* FIXME: What version here? */, 31844); - case Feature::Name::AUTO_TRAITS: - return Feature (f, Feature::State::ACTIVE, "optin_builtin_traits", - "1.0.0", 13231); - default: - rust_unreachable (); - } -} +Feature Feature::feature_list[] = { +#define ISSUE_SOME(n) n +#define ISSUE_NONE tl::nullopt +#define EDITION_2018 Edition::E2018 +#define EDITION_NONE tl::nullopt +#define REASON_SOME(r) r +#define REASON_NONE tl::nullopt + +#define FEATURE_BASE(state, name_str, name, rust_since, issue, ...) \ + Feature (Feature::Name::name, Feature::State::state, name_str, rust_since, \ + issue, __VA_ARGS__), + +#define FEATURE_ACTIVE(a, b, c, d, edition) \ + FEATURE_BASE (ACTIVE, a, b, c, d, edition, tl::nullopt) + +#define FEATURE_ACCEPTED(a, b, c, d) \ + FEATURE_BASE (ACCEPTED, a, b, c, d, tl::nullopt, tl::nullopt) + +#define FEATURE_REMOVED(a, b, c, d, reason) \ + FEATURE_BASE (REMOVED, a, b, c, d, tl::nullopt, reason) + +#define FEATURE_STABLE_REMOVED(a, b, c, d) \ + FEATURE_BASE (ACCEPTED, a, b, c, d, tl::nullopt, tl::nullopt) + +#include "rust-feature-defs.h" + +#undef ISSUE_SOME +#undef ISSUE_NONE +#undef EDITION_2018 +#undef EDITION_NONE +#undef REASON_SOME +#undef REASON_NONE + +#undef FEATURE_BASE +#undef FEATURE_ACTIVE +#undef FEATURE_ACCEPTED +#undef FEATURE_REMOVED +#undef FEATURE_STABLE_REMOVED +}; const std::map Feature::name_hash_map = { - {"associated_type_bounds", Feature::Name::ASSOCIATED_TYPE_BOUNDS}, - {"intrinsics", Feature::Name::INTRINSICS}, - {"rustc_attrs", Feature::Name::RUSTC_ATTRS}, - {"decl_macro", Feature::Name::DECL_MACRO}, - {"negative_impls", Feature::Name::NEGATIVE_IMPLS}, - // TODO: Rename to "auto_traits" when supporting - // later Rust versions - {"optin_builtin_traits", Feature::Name::AUTO_TRAITS}, - {"extern_types", Feature::Name::EXTERN_TYPES}, - {"lang_items", Feature::Name::LANG_ITEMS}, - {"no_core", Feature::Name::NO_CORE}, - {"box_syntax", Feature::Name::BOX_SYNTAX}, - {"dropck_eyepatch", Feature::Name::DROPCK_EYEPATCH}, - {"raw_ref_op", Feature::Name::RAW_REF_OP}, - {"exclusive_range_pattern", Feature::Name::EXCLUSIVE_RANGE_PATTERN}, - {"prelude_import", Feature::Name::PRELUDE_IMPORT}, - {"min_specialization", Feature::Name::MIN_SPECIALIZATION}, +#define FEATURE(s, name, ...) {s, Feature::Name::name}, +#define FEATURE_ACTIVE(...) FEATURE (__VA_ARGS__) +#define FEATURE_ACCEPTED(...) FEATURE (__VA_ARGS__) +#define FEATURE_REMOVED(...) FEATURE (__VA_ARGS__) +#define FEATURE_STABLE_REMOVED(...) FEATURE (__VA_ARGS__) +#include "rust-feature-defs.h" +#undef FEATURE +#undef FEATURE_ACTIVE +#undef FEATURE_ACCEPTED +#undef FEATURE_REMOVED +#undef FEATURE_STABLE_REMOVED }; tl::optional @@ -95,4 +83,17 @@ Feature::as_name (const std::string &name) return tl::nullopt; } +tl::optional> +Feature::lookup (const std::string &name) +{ + return as_name (name).map ( + [] (Name n) { return std::ref (Feature::lookup (n)); }); +} + +const Feature & +Feature::lookup (Feature::Name name) +{ + return feature_list[static_cast (name)]; +} + } // namespace Rust diff --git a/gcc/rust/checks/errors/feature/rust-feature.h b/gcc/rust/checks/errors/feature/rust-feature.h index e7cb0afc6895..8686cf4b3b76 100644 --- a/gcc/rust/checks/errors/feature/rust-feature.h +++ b/gcc/rust/checks/errors/feature/rust-feature.h @@ -29,59 +29,55 @@ class Feature public: enum class State { - ACCEPTED, - ACTIVE, - REMOVED, - STABILIZED, + ACCEPTED, // stabilized + ACTIVE, // unstable + REMOVED, // removed + STABILIZED, // removed after stabilization }; enum class Name { - ASSOCIATED_TYPE_BOUNDS, - INTRINSICS, - NEGATIVE_IMPLS, - RUSTC_ATTRS, - DECL_MACRO, - AUTO_TRAITS, - EXTERN_TYPES, - LANG_ITEMS, - NO_CORE, - BOX_SYNTAX, - DROPCK_EYEPATCH, - RAW_REF_OP, - EXCLUSIVE_RANGE_PATTERN, - PRELUDE_IMPORT, - MIN_SPECIALIZATION, +#define FEATURE_ACTIVE(x, name, ...) name, +#define FEATURE_ACCEPTED(x, name, ...) name, +#define FEATURE_REMOVED(x, name, ...) name, +#define FEATURE_STABLE_REMOVED(x, name, ...) name, +#include "rust-feature-defs.h" +#undef FEATURE_ACTIVE +#undef FEATURE_ACCEPTED +#undef FEATURE_REMOVED +#undef FEATURE_STABLE_REMOVED }; - const std::string &as_string () { return m_name_str; } - Name name () { return m_name; } - const std::string &description () { return m_description; } - State state () { return m_state; } - tl::optional issue () { return m_issue; } + const std::string &as_string () const { return m_name_str; } + + Name name () const { return m_name; } + State state () const { return m_state; } + tl::optional issue () const { return m_issue; } static tl::optional as_name (const std::string &name); - static Feature create (Name name); + + static tl::optional> + lookup (const std::string &name); + static const Feature &lookup (Name name); private: - Feature (Name name, State state, const char *name_str, - const char *rustc_since, - tl::optional issue_number = tl::nullopt, - const tl::optional &edition = tl::nullopt, - const char *description = "") - : m_state (state), m_name (name), m_name_str (name_str), - m_rustc_since (rustc_since), m_issue (issue_number), edition (edition), - m_description (description) + Feature (Name name, State state, const char *name_str, const char *rust_since, + tl::optional issue_number, tl::optional edition, + tl::optional reason) + : m_name (name), m_state (state), m_name_str (name_str), + m_rust_since (rust_since), m_issue (issue_number), edition (edition), + m_reason (reason) {} - State m_state; Name m_name; + State m_state; std::string m_name_str; - std::string m_rustc_since; + std::string m_rust_since; tl::optional m_issue; tl::optional edition; - std::string m_description; // TODO: Switch to optional? + tl::optional m_reason; + static Feature feature_list[]; static const std::map name_hash_map; }; From 86d1fc783097c820e78290c64a89985cac792549 Mon Sep 17 00:00:00 2001 From: Yap Zhi Heng Date: Sat, 15 Nov 2025 15:08:36 +0800 Subject: [PATCH 011/373] gccrs: Fix compile_float_literal not compiling negatives properly gcc/rust/ChangeLog: * backend/rust-compile-expr.cc (compile_float_literal): Add is_negative check to compile negative float literals properly. * backend/rust-compile-pattern.cc (CompilePatternCheckExpr::visit(RangePattern)): Minor optimization to E0579 checks to reduce memory copy. Signed-off-by: Yap Zhi Heng --- gcc/rust/backend/rust-compile-expr.cc | 2 ++ gcc/rust/backend/rust-compile-pattern.cc | 6 +++--- gcc/testsuite/rust/compile/e0579-neg-float-fail.rs | 9 +++++++++ gcc/testsuite/rust/compile/e0579-neg-float.rs | 9 +++++++++ 4 files changed, 23 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/rust/compile/e0579-neg-float-fail.rs create mode 100644 gcc/testsuite/rust/compile/e0579-neg-float.rs diff --git a/gcc/rust/backend/rust-compile-expr.cc b/gcc/rust/backend/rust-compile-expr.cc index 6404825b02f7..9a9c31590483 100644 --- a/gcc/rust/backend/rust-compile-expr.cc +++ b/gcc/rust/backend/rust-compile-expr.cc @@ -1712,6 +1712,8 @@ CompileExpr::compile_float_literal (const HIR::LiteralExpr &expr, rust_error_at (expr.get_locus (), "bad number in literal"); return error_mark_node; } + if (expr.is_negative ()) + mpfr_neg (fval, fval, MPFR_RNDN); // taken from: // see go/gofrontend/expressions.cc:check_float_type diff --git a/gcc/rust/backend/rust-compile-pattern.cc b/gcc/rust/backend/rust-compile-pattern.cc index 708a824ad4d5..af5f4538c4d0 100644 --- a/gcc/rust/backend/rust-compile-pattern.cc +++ b/gcc/rust/backend/rust-compile-pattern.cc @@ -170,9 +170,9 @@ CompilePatternCheckExpr::visit (HIR::RangePattern &pattern) bool error_E0579 = false; if (TREE_CODE (upper) == REAL_CST) { - REAL_VALUE_TYPE upper_r = TREE_REAL_CST (upper); - REAL_VALUE_TYPE lower_r = TREE_REAL_CST (lower); - if (real_compare (GE_EXPR, &lower_r, &upper_r)) + const REAL_VALUE_TYPE *upper_r = TREE_REAL_CST_PTR (upper); + const REAL_VALUE_TYPE *lower_r = TREE_REAL_CST_PTR (lower); + if (real_compare (GE_EXPR, lower_r, upper_r)) error_E0579 = true; } else if (TREE_CODE (upper) == INTEGER_CST) diff --git a/gcc/testsuite/rust/compile/e0579-neg-float-fail.rs b/gcc/testsuite/rust/compile/e0579-neg-float-fail.rs new file mode 100644 index 000000000000..fefe2213c57c --- /dev/null +++ b/gcc/testsuite/rust/compile/e0579-neg-float-fail.rs @@ -0,0 +1,9 @@ +#![feature(exclusive_range_pattern)] + +fn main() { + let x = 1.0; + + match x { // { dg-message "sorry, unimplemented: match on floating-point types is not yet supported" } + -1.0f32..-1.2f32 => 2, // { dg-error "lower range bound must be less than upper .E0579." } + }; +} \ No newline at end of file diff --git a/gcc/testsuite/rust/compile/e0579-neg-float.rs b/gcc/testsuite/rust/compile/e0579-neg-float.rs new file mode 100644 index 000000000000..cc60e80c3a58 --- /dev/null +++ b/gcc/testsuite/rust/compile/e0579-neg-float.rs @@ -0,0 +1,9 @@ +#![feature(exclusive_range_pattern)] + +fn main() { + let x = 1.0; + + match x { // { dg-message "sorry, unimplemented: match on floating-point types is not yet supported" } + -1.2f32..-1.0f32 => 2, + }; +} \ No newline at end of file From ad7717b994732d0de46c506d96f2f569f0b65866 Mon Sep 17 00:00:00 2001 From: Lucas Ly Ba Date: Fri, 7 Nov 2025 16:38:46 +0000 Subject: [PATCH 012/373] gccrs: fix segfault on empty doc attribute gcc/rust/ChangeLog: * hir/rust-ast-lower-base.cc (ASTLoweringBase::handle_doc_item_attribute): Make error. gcc/testsuite/ChangeLog: * rust/compile/issue-4226.rs: New test. Signed-off-by: Lucas Ly Ba --- gcc/rust/hir/rust-ast-lower-base.cc | 14 +++++++++++--- gcc/testsuite/rust/compile/issue-4226.rs | 3 +++ 2 files changed, 14 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/rust/compile/issue-4226.rs diff --git a/gcc/rust/hir/rust-ast-lower-base.cc b/gcc/rust/hir/rust-ast-lower-base.cc index 1c8e5b6d2c0e..8984c98daaac 100644 --- a/gcc/rust/hir/rust-ast-lower-base.cc +++ b/gcc/rust/hir/rust-ast-lower-base.cc @@ -820,9 +820,17 @@ void ASTLoweringBase::handle_doc_item_attribute (const ItemWrapper &, const AST::Attribute &attr) { - auto simple_doc_comment = attr.has_attr_input () - && attr.get_attr_input ().get_attr_input_type () - == AST::AttrInput::AttrInputType::LITERAL; + if (!attr.has_attr_input ()) + { + rust_error_at (attr.get_locus (), + "attribute must be of the form %qs or %qs", + "#[doc(hidden|inline|...)]", "#[doc = string]"); + return; + } + + auto simple_doc_comment = attr.get_attr_input ().get_attr_input_type () + == AST::AttrInput::AttrInputType::LITERAL; + if (simple_doc_comment) return; diff --git a/gcc/testsuite/rust/compile/issue-4226.rs b/gcc/testsuite/rust/compile/issue-4226.rs new file mode 100644 index 000000000000..553faf291f46 --- /dev/null +++ b/gcc/testsuite/rust/compile/issue-4226.rs @@ -0,0 +1,3 @@ +#[doc] +// { dg-error "attribute must be of the form ...doc.hidden.inline....... or ...doc = string.." "" { target *-*-* } .-1 } +pub fn a(){} From bfacb5f326751f980619834d09e6c87a480689f5 Mon Sep 17 00:00:00 2001 From: Lucas Ly Ba Date: Tue, 14 Oct 2025 13:40:04 +0000 Subject: [PATCH 013/373] gccrs: add error check if derive has wrong item Derive may only be applied to structs, enums and unions. gcc/rust/ChangeLog: * expand/rust-derive.cc (DeriveVisitor::derive): Add check and error. gcc/testsuite/ChangeLog: * rust/compile/issue-3971.rs: New test. Signed-off-by: Lucas Ly Ba --- gcc/rust/expand/rust-derive.cc | 11 +++++++++++ gcc/testsuite/rust/compile/issue-3971.rs | 11 +++++++++++ 2 files changed, 22 insertions(+) create mode 100644 gcc/testsuite/rust/compile/issue-3971.rs diff --git a/gcc/rust/expand/rust-derive.cc b/gcc/rust/expand/rust-derive.cc index 55147df26f24..2777f076f024 100644 --- a/gcc/rust/expand/rust-derive.cc +++ b/gcc/rust/expand/rust-derive.cc @@ -25,6 +25,7 @@ #include "rust-derive-ord.h" #include "rust-derive-partial-eq.h" #include "rust-derive-hash.h" +#include "rust-system.h" namespace Rust { namespace AST { @@ -39,6 +40,16 @@ DeriveVisitor::derive (Item &item, const Attribute &attr, { auto loc = attr.get_locus (); + using Kind = AST::Item::Kind; + auto item_kind = item.get_item_kind (); + if (item_kind != Kind::Enum && item_kind != Kind::Struct + && item_kind != Kind::Union) + { + rust_error_at (loc, + "derive may only be applied to structs, enums and unions"); + return {}; + } + switch (to_derive) { case BuiltinMacro::Clone: diff --git a/gcc/testsuite/rust/compile/issue-3971.rs b/gcc/testsuite/rust/compile/issue-3971.rs new file mode 100644 index 000000000000..5607d2d74a5c --- /dev/null +++ b/gcc/testsuite/rust/compile/issue-3971.rs @@ -0,0 +1,11 @@ +#[lang = "copy"] +trait Copy {} + +// since the macro expansion fails, the current nameres fixpoint error is emitted - just accept it for now +#[derive(Copy)] +// { dg-error "derive may only be applied to structs, enums and unions" "" { target *-*-* } .-1 } +// { dg-excess-errors "could not resolve trait" } + +pub fn check_ge(a: i32, b: i32) -> bool { + a >= b +} From af42d91c9571bf4b95b8939b971244e9eba0828f Mon Sep 17 00:00:00 2001 From: Philip Herron Date: Mon, 17 Nov 2025 21:14:44 +0000 Subject: [PATCH 014/373] gccrs: Add support for initial generic associated types This patch is the initial part in supporting generic associated types. In rust we have trait item types that get implemented for example: trait Foo { type Bar } impl Foo for T { type Bar = T } The trait position uses a Ty::Placeholder which is just a thing that gets set for lazy evaluation to the impl type alias which is actually a Ty::Projection see: 0798add3d3c1bf4b20ecc1b4fa1047ba4ba19759 For more info the projection type needs to hold onto generics in order to properly support generic types this GAT's support extends this all the way to the placeholder which still needs to be done. Fixes Rust-GCC#4276 gcc/rust/ChangeLog: * ast/rust-ast.cc (TraitItemType::as_string): add generic params * ast/rust-ast.h: remove old comment * ast/rust-item.h: add generic params to associated type * ast/rust-type.h: remove old comment * hir/rust-ast-lower-implitem.cc (ASTLowerTraitItem::visit): hir lowering for gat's * hir/tree/rust-hir-item.cc (TraitItemType::TraitItemType): gat's on TraitItemType (TraitItemType::operator=): preserve generic params * hir/tree/rust-hir-item.h: likewise * hir/tree/rust-hir.cc (TraitItemType::as_string): likewise * parse/rust-parse-impl.h (Parser::parse_trait_type): hit the < and parse params * typecheck/rust-hir-type-check-implitem.cc (TypeCheckImplItemWithTrait::visit): typecheck * typecheck/rust-tyty.cc (BaseType::has_substitutions_defined): dont destructure gcc/testsuite/ChangeLog: * rust/compile/gat1.rs: New test. * rust/execute/torture/gat1.rs: New test. Signed-off-by: Philip Herron --- gcc/rust/ast/rust-ast.cc | 12 +++++++ gcc/rust/ast/rust-ast.h | 1 - gcc/rust/ast/rust-item.h | 25 +++++++++++++-- gcc/rust/ast/rust-type.h | 3 -- gcc/rust/hir/rust-ast-lower-implitem.cc | 32 +++++++++++++++---- gcc/rust/hir/tree/rust-hir-item.cc | 11 +++++-- gcc/rust/hir/tree/rust-hir-item.h | 14 ++++++++ gcc/rust/hir/tree/rust-hir.cc | 12 +++++++ gcc/rust/parse/rust-parse-impl.h | 12 +++++-- .../typecheck/rust-hir-type-check-implitem.cc | 6 ++++ gcc/rust/typecheck/rust-tyty.cc | 2 +- gcc/testsuite/rust/compile/gat1.rs | 4 +++ gcc/testsuite/rust/execute/torture/gat1.rs | 18 +++++++++++ 13 files changed, 134 insertions(+), 18 deletions(-) create mode 100644 gcc/testsuite/rust/compile/gat1.rs create mode 100644 gcc/testsuite/rust/execute/torture/gat1.rs diff --git a/gcc/rust/ast/rust-ast.cc b/gcc/rust/ast/rust-ast.cc index d8713071c4c3..851f7ea4b6f6 100644 --- a/gcc/rust/ast/rust-ast.cc +++ b/gcc/rust/ast/rust-ast.cc @@ -3050,6 +3050,18 @@ TraitItemType::as_string () const str += "\ntype " + name.as_string (); + if (has_generics ()) + { + str += "<"; + for (size_t i = 0; i < generic_params.size (); i++) + { + if (i > 0) + str += ", "; + str += generic_params[i]->as_string (); + } + str += ">"; + } + str += "\n Type param bounds: "; if (!has_type_param_bounds ()) { diff --git a/gcc/rust/ast/rust-ast.h b/gcc/rust/ast/rust-ast.h index 8a7e618b05ce..8610ade830c1 100644 --- a/gcc/rust/ast/rust-ast.h +++ b/gcc/rust/ast/rust-ast.h @@ -1891,7 +1891,6 @@ struct MacroInvocData { parsed_items = std::move (new_items); } - // TODO: mutable getter seems kinda dodgy std::vector> &get_meta_items () { return parsed_items; diff --git a/gcc/rust/ast/rust-item.h b/gcc/rust/ast/rust-item.h index 7aea763bd12e..3e3735c3ece6 100644 --- a/gcc/rust/ast/rust-item.h +++ b/gcc/rust/ast/rust-item.h @@ -2726,21 +2726,28 @@ class TraitItemType : public TraitItem Identifier name; + // Generic parameters for GATs (Generic Associated Types) + std::vector> generic_params; + // bool has_type_param_bounds; // TypeParamBounds type_param_bounds; std::vector> type_param_bounds; // inlined form public: + bool has_generics () const { return !generic_params.empty (); } + // Returns whether trait item type has type param bounds. bool has_type_param_bounds () const { return !type_param_bounds.empty (); } TraitItemType (Identifier name, + std::vector> generic_params, std::vector> type_param_bounds, std::vector outer_attrs, Visibility vis, location_t locus) : TraitItem (vis, locus), outer_attrs (std::move (outer_attrs)), - name (std::move (name)), type_param_bounds (std::move (type_param_bounds)) + name (std::move (name)), generic_params (std::move (generic_params)), + type_param_bounds (std::move (type_param_bounds)) {} // Copy constructor with vector clone @@ -2749,6 +2756,9 @@ class TraitItemType : public TraitItem name (other.name) { node_id = other.node_id; + generic_params.reserve (other.generic_params.size ()); + for (const auto &e : other.generic_params) + generic_params.push_back (e->clone_generic_param ()); type_param_bounds.reserve (other.type_param_bounds.size ()); for (const auto &e : other.type_param_bounds) type_param_bounds.push_back (e->clone_type_param_bound ()); @@ -2763,6 +2773,9 @@ class TraitItemType : public TraitItem locus = other.locus; node_id = other.node_id; + generic_params.reserve (other.generic_params.size ()); + for (const auto &e : other.generic_params) + generic_params.push_back (e->clone_generic_param ()); type_param_bounds.reserve (other.type_param_bounds.size ()); for (const auto &e : other.type_param_bounds) type_param_bounds.push_back (e->clone_type_param_bound ()); @@ -2786,7 +2799,15 @@ class TraitItemType : public TraitItem std::vector &get_outer_attrs () { return outer_attrs; } const std::vector &get_outer_attrs () const { return outer_attrs; } - // TODO: mutable getter seems kinda dodgy + std::vector> &get_generic_params () + { + return generic_params; + } + const std::vector> &get_generic_params () const + { + return generic_params; + } + std::vector> &get_type_param_bounds () { return type_param_bounds; diff --git a/gcc/rust/ast/rust-type.h b/gcc/rust/ast/rust-type.h index 014963fb520b..38a34748130e 100644 --- a/gcc/rust/ast/rust-type.h +++ b/gcc/rust/ast/rust-type.h @@ -177,7 +177,6 @@ class ImplTraitType : public Type void accept_vis (ASTVisitor &vis) override; - // TODO: mutable getter seems kinda dodgy std::vector > &get_type_param_bounds () { return type_param_bounds; @@ -250,7 +249,6 @@ class TraitObjectType : public Type bool is_dyn () const { return has_dyn; } - // TODO: mutable getter seems kinda dodgy std::vector > &get_type_param_bounds () { return type_param_bounds; @@ -463,7 +461,6 @@ class TupleType : public TypeNoBounds void accept_vis (ASTVisitor &vis) override; - // TODO: mutable getter seems kinda dodgy std::vector > &get_elems () { return elems; } const std::vector > &get_elems () const { diff --git a/gcc/rust/hir/rust-ast-lower-implitem.cc b/gcc/rust/hir/rust-ast-lower-implitem.cc index 8fd9d167cea3..87f1e015321e 100644 --- a/gcc/rust/hir/rust-ast-lower-implitem.cc +++ b/gcc/rust/hir/rust-ast-lower-implitem.cc @@ -55,11 +55,11 @@ ASTLowerImplItem::translate (AST::AssociatedItem &item, HirId parent_impl_id) void ASTLowerImplItem::visit (AST::TypeAlias &alias) { - std::vector > where_clause_items; + std::vector> where_clause_items; HIR::WhereClause where_clause (std::move (where_clause_items)); HIR::Visibility vis = translate_visibility (alias.get_visibility ()); - std::vector > generic_params; + std::vector> generic_params; if (alias.has_generics ()) generic_params = lower_generic_params (alias.get_generic_params ()); @@ -110,7 +110,7 @@ void ASTLowerImplItem::visit (AST::Function &function) { // ignore for now and leave empty - std::vector > where_clause_items; + std::vector> where_clause_items; for (auto &item : function.get_where_clause ().get_items ()) { HIR::WhereClauseItem *i @@ -124,7 +124,7 @@ ASTLowerImplItem::visit (AST::Function &function) HIR::Visibility vis = translate_visibility (function.get_visibility ()); // need - std::vector > generic_params; + std::vector> generic_params; if (function.has_generics ()) { generic_params = lower_generic_params (function.get_generic_params ()); @@ -233,12 +233,12 @@ ASTLowerTraitItem::translate (AST::AssociatedItem &item) void ASTLowerTraitItem::visit (AST::Function &func) { - std::vector > where_clause_items; + std::vector> where_clause_items; HIR::WhereClause where_clause (std::move (where_clause_items)); HIR::FunctionQualifiers qualifiers = lower_qualifiers (func.get_qualifiers ()); - std::vector > generic_params; + std::vector> generic_params; if (func.has_generics ()) generic_params = lower_generic_params (func.get_generic_params ()); @@ -342,7 +342,24 @@ ASTLowerTraitItem::visit (AST::ConstantItem &constant) void ASTLowerTraitItem::visit (AST::TraitItemType &type) { - std::vector > type_param_bounds; + // Lower generic parameters (for GATs) + std::vector> generic_params; + for (auto ¶m : type.get_generic_params ()) + { + auto lowered_param = ASTLowerGenericParam::translate (*param.get ()); + generic_params.push_back ( + std::unique_ptr (lowered_param)); + } + + // Lower type parameter bounds + std::vector> type_param_bounds; + for (auto &bound : type.get_type_param_bounds ()) + { + auto lowered_bound = lower_bound (*bound.get ()); + type_param_bounds.push_back ( + std::unique_ptr (lowered_bound)); + } + auto crate_num = mappings.get_current_crate (); Analysis::NodeMapping mapping (crate_num, type.get_node_id (), mappings.get_next_hir_id (crate_num), @@ -350,6 +367,7 @@ ASTLowerTraitItem::visit (AST::TraitItemType &type) HIR::TraitItemType *trait_item = new HIR::TraitItemType (mapping, type.get_identifier (), + std::move (generic_params), std::move (type_param_bounds), type.get_outer_attrs (), type.get_locus ()); translated = trait_item; diff --git a/gcc/rust/hir/tree/rust-hir-item.cc b/gcc/rust/hir/tree/rust-hir-item.cc index 1406e7aeb515..268b09b1ecaf 100644 --- a/gcc/rust/hir/tree/rust-hir-item.cc +++ b/gcc/rust/hir/tree/rust-hir-item.cc @@ -716,17 +716,21 @@ TraitItemConst::operator= (TraitItemConst const &other) TraitItemType::TraitItemType ( Analysis::NodeMapping mappings, Identifier name, + std::vector> generic_params, std::vector> type_param_bounds, AST::AttrVec outer_attrs, location_t locus) : TraitItem (mappings), outer_attrs (std::move (outer_attrs)), - name (std::move (name)), type_param_bounds (std::move (type_param_bounds)), - locus (locus) + name (std::move (name)), generic_params (std::move (generic_params)), + type_param_bounds (std::move (type_param_bounds)), locus (locus) {} TraitItemType::TraitItemType (TraitItemType const &other) : TraitItem (other.mappings), outer_attrs (other.outer_attrs), name (other.name), locus (other.locus) { + generic_params.reserve (other.generic_params.size ()); + for (const auto &e : other.generic_params) + generic_params.push_back (e->clone_generic_param ()); type_param_bounds.reserve (other.type_param_bounds.size ()); for (const auto &e : other.type_param_bounds) type_param_bounds.push_back (e->clone_type_param_bound ()); @@ -741,6 +745,9 @@ TraitItemType::operator= (TraitItemType const &other) locus = other.locus; mappings = other.mappings; + generic_params.reserve (other.generic_params.size ()); + for (const auto &e : other.generic_params) + generic_params.push_back (e->clone_generic_param ()); type_param_bounds.reserve (other.type_param_bounds.size ()); for (const auto &e : other.type_param_bounds) type_param_bounds.push_back (e->clone_type_param_bound ()); diff --git a/gcc/rust/hir/tree/rust-hir-item.h b/gcc/rust/hir/tree/rust-hir-item.h index eb9cec741963..76294061d974 100644 --- a/gcc/rust/hir/tree/rust-hir-item.h +++ b/gcc/rust/hir/tree/rust-hir-item.h @@ -2121,15 +2121,20 @@ class TraitItemType : public TraitItem AST::AttrVec outer_attrs; Identifier name; + // Generic parameters for GATs (Generic Associated Types) + std::vector> generic_params; std::vector> type_param_bounds; // inlined form location_t locus; public: + bool has_generics () const { return !generic_params.empty (); } + // Returns whether trait item type has type param bounds. bool has_type_param_bounds () const { return !type_param_bounds.empty (); } TraitItemType (Analysis::NodeMapping mappings, Identifier name, + std::vector> generic_params, std::vector> type_param_bounds, AST::AttrVec outer_attrs, location_t locus); @@ -2152,6 +2157,15 @@ class TraitItemType : public TraitItem Identifier get_name () const { return name; } + std::vector> &get_generic_params () + { + return generic_params; + } + const std::vector> &get_generic_params () const + { + return generic_params; + } + std::vector> &get_type_param_bounds () { return type_param_bounds; diff --git a/gcc/rust/hir/tree/rust-hir.cc b/gcc/rust/hir/tree/rust-hir.cc index 57f560b06d3e..614fec7076e1 100644 --- a/gcc/rust/hir/tree/rust-hir.cc +++ b/gcc/rust/hir/tree/rust-hir.cc @@ -3582,6 +3582,18 @@ TraitItemType::as_string () const str += "\ntype " + name.as_string (); + if (has_generics ()) + { + str += "<"; + for (size_t i = 0; i < generic_params.size (); i++) + { + if (i > 0) + str += ", "; + str += generic_params[i]->as_string (); + } + str += ">"; + } + str += "\n Type param bounds: "; if (!has_type_param_bounds ()) { diff --git a/gcc/rust/parse/rust-parse-impl.h b/gcc/rust/parse/rust-parse-impl.h index 64554f5e9e49..0421d6cb80e5 100644 --- a/gcc/rust/parse/rust-parse-impl.h +++ b/gcc/rust/parse/rust-parse-impl.h @@ -5221,6 +5221,13 @@ Parser::parse_trait_type (AST::AttrVec outer_attrs, Identifier ident{ident_tok}; + // Parse optional generic parameters for GATs (Generic Associated Types) + std::vector> generic_params; + if (lexer.peek_token ()->get_id () == LEFT_ANGLE) + { + generic_params = parse_generic_params_in_angles (); + } + std::vector> bounds; // parse optional colon @@ -5241,8 +5248,9 @@ Parser::parse_trait_type (AST::AttrVec outer_attrs, } return std::unique_ptr ( - new AST::TraitItemType (std::move (ident), std::move (bounds), - std::move (outer_attrs), vis, locus)); + new AST::TraitItemType (std::move (ident), std::move (generic_params), + std::move (bounds), std::move (outer_attrs), vis, + locus)); } // Parses a constant trait item. diff --git a/gcc/rust/typecheck/rust-hir-type-check-implitem.cc b/gcc/rust/typecheck/rust-hir-type-check-implitem.cc index 83adf2ea761b..8df8a18bddd0 100644 --- a/gcc/rust/typecheck/rust-hir-type-check-implitem.cc +++ b/gcc/rust/typecheck/rust-hir-type-check-implitem.cc @@ -519,6 +519,12 @@ TypeCheckImplItemWithTrait::visit (HIR::ConstantItem &constant) void TypeCheckImplItemWithTrait::visit (HIR::TypeAlias &type) { + auto binder_pin = context->push_lifetime_binder (); + + if (type.has_generics ()) + resolve_generic_params (HIR::Item::ItemKind::TypeAlias, type.get_locus (), + type.get_generic_params (), substitutions); + // normal resolution of the item TyTy::BaseType *lookup = TypeCheckImplItem::Resolve (parent, type, self, substitutions); diff --git a/gcc/rust/typecheck/rust-tyty.cc b/gcc/rust/typecheck/rust-tyty.cc index 480e244fd38e..5386b72f602f 100644 --- a/gcc/rust/typecheck/rust-tyty.cc +++ b/gcc/rust/typecheck/rust-tyty.cc @@ -890,7 +890,7 @@ BaseType::is_concrete () const bool BaseType::has_substitutions_defined () const { - const TyTy::BaseType *x = destructure (); + const auto x = this; switch (x->get_kind ()) { case INFER: diff --git a/gcc/testsuite/rust/compile/gat1.rs b/gcc/testsuite/rust/compile/gat1.rs new file mode 100644 index 000000000000..032f64e080ac --- /dev/null +++ b/gcc/testsuite/rust/compile/gat1.rs @@ -0,0 +1,4 @@ +trait Foo { + type Bar; + type Baz<'a>; +} diff --git a/gcc/testsuite/rust/execute/torture/gat1.rs b/gcc/testsuite/rust/execute/torture/gat1.rs new file mode 100644 index 000000000000..8310a5883809 --- /dev/null +++ b/gcc/testsuite/rust/execute/torture/gat1.rs @@ -0,0 +1,18 @@ +#[lang = "sized"] +trait Sized {} + +pub struct MyBuf; + +trait Foo { + type Bar: Sized; +} + +impl Foo for MyBuf { + type Bar = T; +} + +type A = ::Bar; +fn main() -> i32 { + let a: A = 1; + a as i32 - 1 +} From 910bae566ebff5142688971792d13dc5d7274b88 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=BAcio=20Boari=20Fleury?= Date: Fri, 21 Nov 2025 22:04:25 -0300 Subject: [PATCH 015/373] gccrs: stop an infinite loop at END_OF_FILE MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit gcc/rust/ChangeLog: * parse/rust-parse-impl.h: Add early exit condition to parsing loop. Signed-off-by: Lúcio Boari Fleury --- gcc/rust/parse/rust-parse-impl.h | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gcc/rust/parse/rust-parse-impl.h b/gcc/rust/parse/rust-parse-impl.h index 0421d6cb80e5..afc701230951 100644 --- a/gcc/rust/parse/rust-parse-impl.h +++ b/gcc/rust/parse/rust-parse-impl.h @@ -1861,7 +1861,8 @@ Parser::parse_macro_invocation_semi ( t = lexer.peek_token (); // parse token trees until the initial delimiter token is found again - while (!token_id_matches_delims (t->get_id (), delim_type)) + while (!token_id_matches_delims (t->get_id (), delim_type) + && t->get_id () != END_OF_FILE) { std::unique_ptr tree = parse_token_tree (); From ec720456deb39c15f4efdd8ae98e23f5fb885b22 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=BAcio=20Boari=20Fleury?= Date: Sat, 22 Nov 2025 11:55:39 -0300 Subject: [PATCH 016/373] gccrs: Add test for issue Rust-GCC#3608 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit gcc/testsuite/ChangeLog: * rust/compile/macros/mbe/macro-issue3608.rs: New Test. The test skips an issue at line 11 Signed-off-by: Lúcio Boari Fleury --- .../rust/compile/macros/mbe/macro-issue3608.rs | 12 ++++++++++++ 1 file changed, 12 insertions(+) create mode 100644 gcc/testsuite/rust/compile/macros/mbe/macro-issue3608.rs diff --git a/gcc/testsuite/rust/compile/macros/mbe/macro-issue3608.rs b/gcc/testsuite/rust/compile/macros/mbe/macro-issue3608.rs new file mode 100644 index 000000000000..15207992ad27 --- /dev/null +++ b/gcc/testsuite/rust/compile/macros/mbe/macro-issue3608.rs @@ -0,0 +1,12 @@ +include!(; + +struct Baz { + +impl Bar for + + +fn main() { )// { dg-error "unexpected closing delimiter .\\). - token tree requires either paired delimiters or non-delimiter tokens" } + // { dg-error "failed to parse token tree in delimited token tree - found .\\)." "" { target *-*-* } .-1 } + // { dg-error "unexpected token .end of file. - expecting closing delimiter .\}. .for a delimited token tree." "" { target *-*-* } .+3 } + // { dg-error "unexpected token .end of file. - expecting closing delimiter .\\). .for a macro invocation semi." "" { target *-*-* } .+2 } + // { dg-error "failed to parse item in crate" "" { target *-*-* } .+1 } From 9c9d3aef2f66625d9cb03ef4baee10ed6648e681 Mon Sep 17 00:00:00 2001 From: Frank Scheiner Date: Tue, 25 Nov 2025 16:58:23 -0700 Subject: [PATCH 017/373] [PATCH] libgomp: Fix GCC build after glibc@cd748a6 The toolchain autobuilds for ia64 failed ([1]) yesterday with: ``` libtool: compile: /usr/src/t2-src/src.gcc.ia64-toolchain.251121.040147.278918/gcc-16-20251116/objs/gcc/xgcc-wrapper /usr/src/t2-src/src.gcc.ia64-toolchain.251121.040147.278918/gcc-16-20251116/objs/./gcc/xgcc -B/usr/src/t2-src/src.gcc.ia64-toolchain.251121.040147.278918/gcc-16-20251116/objs/./gcc/ -B/usr/src/t2-src/build/ia64-toolchain-24-svn-generic-ia64-itanium2-cross-linux/TOOLCHAIN/cross/usr/ia64-t2-linux-gnu/bin/ -B/usr/src/t2-src/build/ia64-toolchain-24-svn-generic-ia64-itanium2-cross-linux/TOOLCHAIN/cross/usr/ia64-t2-linux-gnu/lib/ -isystem /usr/src/t2-src/build/ia64-toolchain-24-svn-generic-ia64-itanium2-cross-linux/TOOLCHAIN/cross/usr/ia64-t2-linux-gnu/include -isystem /usr/src/t2-src/build/ia64-toolchain-24-svn-generic-ia64-itanium2-cross-linux/TOOLCHAIN/cross/usr/ia64-t2-linux-gnu/sys-include --sysroot=/usr/src/t2-src/build/ia64-toolchain-24-svn-generic-ia64-itanium2-cross-linux -DHAVE_CONFIG_H -I. -I../../../libgomp -I../../../libgomp/config/linux/ia64 -I../../../libgomp/config/linux -I../../../libgomp/config/posix -I../../../libgomp -I../../../libgomp/../include -Wall -Werror -ftls-model=initial-exec -pthread -DUSING_INITIAL_EXEC_TLS -g -O2 -MT oacc-cuda.lo -MD -MP -MF .deps/oacc-cuda.Tpo -c ../../../libgomp/oacc-cuda.c -o oacc-cuda.o >/dev/null 2>&1 ../../../libgomp/affinity-fmt.c: In function 'gomp_display_affinity': ../../../libgomp/affinity-fmt.c:330:25: error: initialization discards 'const' qualifier from pointer target type [-Werror=discarded-qualifiers] 330 | char *q = strchr (p + 1, '}'); | ^~~~~~ ``` [1]: https://github.com/johnny-mnemonic/toolchain-autobuilds/actions/runs/19559235881 This is not ia64-specific but due to the changes in the recent glibc commit "Implement C23 const-preserving standard library macros" (i.e. [2]) now requiring "char *q" to be a pointer to a const char to compile w/o error because of the return value of strchr() . [2]: https://sourceware.org/git/?p=glibc.git;a=commit;h=cd748a63ab1a7ae846175c532a3daab341c62690 Also see the related discussion at [3] for details. [3]: https://sourceware.org/pipermail/libc-alpha/2025-November/172809.html The GCC build is fixed by the attached patch, see [4] for a successful build with the then latest snapshots of binutils, glibc and GCC. [4]: https://github.com/johnny-mnemonic/toolchain-autobuilds/actions/runs/19585045571 Idea from Tomas, attached patch from me. Cheers, Frank 0001-libgomp-Fix-GCC-build-after-glibc-cd748a6.patch From 80af9c233c694904174b54a59404d311378f41f8 Mon Sep 17 00:00:00 2001 From: Frank Scheiner Date: Sat, 22 Nov 2025 14:58:10 +0100 Subject: [PATCH] libgomp: Fix GCC build after glibc@cd748a6 char *q needs to be a pointer to a const char for the return value of strchr() with glibc after "Implement C23 const-preserving standard library macros". [glibc@cd748a6]: https://sourceware.org/git/?p=glibc.git;a=commit;h=cd748a63ab1a7ae846175c532a3daab341c62690 libgomp/ChangeLog: * affinity-fmt.c: Make char *q a pointer to a const char. --- libgomp/affinity-fmt.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libgomp/affinity-fmt.c b/libgomp/affinity-fmt.c index 1fae893cbaca..8d3df5f1cd55 100644 --- a/libgomp/affinity-fmt.c +++ b/libgomp/affinity-fmt.c @@ -327,7 +327,7 @@ gomp_display_affinity (char *buffer, size_t size, } if (c == '{') { - char *q = strchr (p + 1, '}'); + const char *q = strchr (p + 1, '}'); if (q) gomp_fatal ("unsupported long type name '%.*s' in affinity " "format", (int) (q - (p + 1)), p + 1); From 3c62023d05e9112ac51678fef42b2ba6e582f383 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Wed, 26 Nov 2025 00:20:39 +0000 Subject: [PATCH 018/373] Daily bump. --- gcc/ChangeLog | 82 ++++++++++++++ gcc/DATESTAMP | 2 +- gcc/analyzer/ChangeLog | 6 ++ gcc/c-family/ChangeLog | 27 +++++ gcc/cp/ChangeLog | 22 ++++ gcc/lto/ChangeLog | 5 + gcc/rust/ChangeLog | 99 +++++++++++++++++ gcc/testsuite/ChangeLog | 234 ++++++++++++++++++++++++++++++++++++++++ libgomp/ChangeLog | 9 ++ libstdc++-v3/ChangeLog | 5 + 10 files changed, 490 insertions(+), 1 deletion(-) diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 3aa2a2eeb612..2c098e384cf8 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,85 @@ +2025-11-25 Rainer Orth + + * configure.ac (gcc_cv_header_zstd_h): Save, restore CXXFLAGS, + LDFLAGS. + * configure: Regenerate. + +2025-11-25 Tamar Christina + + PR target/118974 + * config/aarch64/aarch64-simd.md (xor3): Rename ... + (@xor3): .. to this. + (cbranch4): Update comments. + (): New. + * config/aarch64/aarch64-sve.md (cbranch4): Update comment. + (): New. + (aarch64_ptest): Rename to ... + (@aarch64_ptest): .. this. + * config/aarch64/iterators.md (UNSPEC_CMP_ALL, UNSPEC_CMP_ANY, + UNSPEC_COND_CMP_ALL, UNSPEC_COND_CMP_ANY): New. + (optabs): Add them. + (CBRANCH_CMP, COND_CBRANCH_CMP, cbranch_op): New. + * config/aarch64/predicates.md (aarch64_cbranch_compare_operation): New. + +2025-11-25 Tamar Christina + + PR target/118974 + * tree-vect-stmts.cc (supports_vector_compare_and_branch): New. + (vectorizable_early_exit): Use it. + +2025-11-25 Tamar Christina + + PR target/118974 + * optabs.def (vec_cbranch_any_optab, vec_cbranch_all_optab, + cond_vec_cbranch_any_optab, cond_vec_cbranch_all_optab, + cond_len_vec_cbranch_any_optab, cond_len_vec_cbranch_all_optab): New. + * doc/md.texi: Document them. + * optabs.cc (prepare_cmp_insn): Refactor to take optab to check for + instead of hardcoded cbranch and support mask and len. + (emit_cmp_and_jump_insn_1, emit_cmp_and_jump_insns): Implement them. + (emit_conditional_move, emit_conditional_add, gen_cond_trap): Update + after changing function signatures to support new optabs. + +2025-11-25 Jason Merrill + + * doc/invoke.texi: Document --compile-std-module. + * gcc.cc (struct infile): Add artificial field. + (add_infile): Set it. + (driver::prepare_infiles): Check it. + +2025-11-25 Jason Merrill + + * doc/invoke.texi (C++ Modules): Remove TU-local caveat. + +2025-11-25 Jakub Jelinek + + PR middle-end/120052 + * gimplify.cc (gimplify_call_expr): For IFN_UBSAN_BOUNDS + call with integer_onep first argument, change that argument + to 0 and add TYPE_MAX_VALUE (TYPE_DOMAIN (arr_type)) to + 3rd argument before gimplification. + +2025-11-25 Jakub Jelinek + + PR middle-end/120564 + * omp-expand.cc (extract_omp_for_update_vars): Use build2 instead of + fold_build2 to build argument for gimple_build_cond_empty. + +2025-11-25 Jakub Jelinek + + * alias.cc (get_alias_set): Fix comment typo, TYPE_CANOINCAL + -> TYPE_CANONICAL. + +2025-11-25 Jakub Jelinek + + PR middle-end/122624 + * tree.cc (build_bitint_type): Use type_hash_canon_hash. + +2025-11-25 Rainer Orth + + * doc/sourcebuild.texi (Add Options): Document + check_function_bodies. + 2025-11-24 Alexandre Oliva PR rtl-optimization/122767 diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index e0428feb0905..913858765e79 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20251125 +20251126 diff --git a/gcc/analyzer/ChangeLog b/gcc/analyzer/ChangeLog index f96b31323565..70fe4dd2b826 100644 --- a/gcc/analyzer/ChangeLog +++ b/gcc/analyzer/ChangeLog @@ -1,3 +1,9 @@ +2025-11-25 David Malcolm + + * sm-malloc.cc (deref_before_check::emit): Add logging of the + various conditions for late-rejection of a + -Wanalyzer-deref-before-check warning. + 2025-11-12 David Malcolm * program-state.cc (log_set_of_svalues): Avoid -Wformat-security diff --git a/gcc/c-family/ChangeLog b/gcc/c-family/ChangeLog index 741c11e634c6..ba0e3c6af34b 100644 --- a/gcc/c-family/ChangeLog +++ b/gcc/c-family/ChangeLog @@ -1,3 +1,30 @@ +2025-11-25 Jason Merrill + + * c.opt: Add --compile-std-module. + +2025-11-25 Jakub Jelinek + + PR middle-end/120052 + * c-ubsan.cc (ubsan_instrument_bounds): For VLAs use + 1 instead of 0 as first IFN_UBSAN_BOUNDS argument and only + use the addend without TYPE_MAX_VALUE (TYPE_DOMAIN (type)) + in the 3rd argument. + +2025-11-25 Jakub Jelinek + + PR middle-end/122624 + * c-common.cc (c_common_get_alias_set): Fix up handling of BITINT_TYPE + and non-standard INTEGER_TYPEs. For unsigned _BitInt(1) always return + -1. For other unsigned types set TYPE_ALIAS_SET to get_alias_set of + corresponding signed type and return that. For signed types check if + corresponding unsigned type has TYPE_ALIAS_SET_KNOWN_P and if so copy + its TYPE_ALIAS_SET and return that. + +2025-11-25 Kito Cheng + + * c-opts.cc (c_common_post_options): Skip register_include_chains + when cpp_opts->preprocessed is set. + 2025-11-22 Sandra Loosemore Julian Brown waffl3x diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 04c9684aa6fe..7560da06fbeb 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,25 @@ +2025-11-25 Nathaniel Shead + + PR c++/122699 + * name-lookup.h (expose_existing_namespace): Declare. + * name-lookup.cc (expose_existing_namespace): New function. + (push_namespace): Call it. + * pt.cc (tsubst_friend_function): Likewise. + +2025-11-25 Nathaniel Shead + + PR c++/122789 + * module.cc (trees_out::core_vals): Treat REQUIRES_EXPR + specially and stream the chained decls of its first operand. + (trees_in::core_vals): Likewise. + (trees_out::tree_node): Check the PARM_DECLs we see are what we + expect. + +2025-11-25 Jason Merrill + + * lang-specs.h: Add @c++-system-module. + * g++spec.cc (lang_specific_driver): Handle --compile-std-module. + 2025-11-24 Marek Polacek PR c++/119964 diff --git a/gcc/lto/ChangeLog b/gcc/lto/ChangeLog index 4adfd9ebfa29..ff9e2e809724 100644 --- a/gcc/lto/ChangeLog +++ b/gcc/lto/ChangeLog @@ -1,3 +1,8 @@ +2025-11-25 Siddhesh Poyarekar + + PR lto/122515 + * lto-common.cc (lto_read_section_data): Avoid using SSIZE_MAX. + 2025-11-13 Michal Jires PR lto/122603 diff --git a/gcc/rust/ChangeLog b/gcc/rust/ChangeLog index e2d7fb86e3f0..c581e08ffbb6 100644 --- a/gcc/rust/ChangeLog +++ b/gcc/rust/ChangeLog @@ -1,3 +1,102 @@ +2025-11-25 Lúcio Boari Fleury + + * parse/rust-parse-impl.h: Add early exit condition to parsing loop. + +2025-11-25 Philip Herron + + * ast/rust-ast.cc (TraitItemType::as_string): add generic params + * ast/rust-ast.h: remove old comment + * ast/rust-item.h: add generic params to associated type + * ast/rust-type.h: remove old comment + * hir/rust-ast-lower-implitem.cc (ASTLowerTraitItem::visit): hir lowering for gat's + * hir/tree/rust-hir-item.cc (TraitItemType::TraitItemType): gat's on TraitItemType + (TraitItemType::operator=): preserve generic params + * hir/tree/rust-hir-item.h: likewise + * hir/tree/rust-hir.cc (TraitItemType::as_string): likewise + * parse/rust-parse-impl.h (Parser::parse_trait_type): hit the < and parse params + * typecheck/rust-hir-type-check-implitem.cc (TypeCheckImplItemWithTrait::visit): typecheck + * typecheck/rust-tyty.cc (BaseType::has_substitutions_defined): dont destructure + +2025-11-25 Lucas Ly Ba + + * expand/rust-derive.cc (DeriveVisitor::derive): + Add check and error. + +2025-11-25 Lucas Ly Ba + + * hir/rust-ast-lower-base.cc (ASTLoweringBase::handle_doc_item_attribute): Make error. + +2025-11-25 Yap Zhi Heng + + * backend/rust-compile-expr.cc (compile_float_literal): Add is_negative + check to compile negative float literals properly. + * backend/rust-compile-pattern.cc (CompilePatternCheckExpr::visit(RangePattern)): + Minor optimization to E0579 checks to reduce memory copy. + +2025-11-25 Owen Avery + + * checks/errors/feature/rust-feature-gate.cc + (FeatureGate::gate): Handle removal of Feature::create. + (FeatureGate::visit): Refer to AUTO_TRAITS as + OPTIN_BUILTIN_TRAITS. + * checks/errors/feature/rust-feature.cc (Feature::create): + Remove. + (Feature::feature_list): New static member variable. + (Feature::name_hash_map): Use "rust-feature-defs.h" to define. + (Feature::lookup): New member function definition. + * checks/errors/feature/rust-feature.h (Feature::State): Add + comments. + (Feature::Name): Use "rust-feature-defs.h" to define. + (Feature::as_string): Make const. + (Feature::name): Likewise. + (Feature::state): Likewise. + (Feature::issue): Likewise. + (Feature::description): Remove member function declaration. + (Feature::create): Remove static member function declaration. + (Feature::lookup): New member function declarations. + (Feature::Feature): Adjust arguments. + (Feature::m_rustc_since): Rename to... + (Feature::m_rust_since): ...here. + (Feature::m_description): Remove. + (Feature::m_reason): New member variable. + (Feature::feature_list): New static member variable. + * checks/errors/feature/rust-feature-defs.h: New file. + * checks/errors/feature/contrib/parse.y: New file. + * checks/errors/feature/contrib/scan.l: New file. + * checks/errors/feature/contrib/.gitignore: New file. + * checks/errors/feature/contrib/Makefile: New file. + * checks/errors/feature/contrib/fetch: New file. + * checks/errors/feature/contrib/regen: New file. + * checks/errors/feature/contrib/copyright-stub.h: New file. + * checks/errors/feature/contrib/README: New file. + +2025-11-25 Lucas Ly Ba + + * ast/rust-ast.cc (Attribute::check_cfg_predicate): Make error when attribute has no input. + +2025-11-25 Owen Avery + + * backend/rust-compile-expr.cc (CompileExpr::visit): Implicitly + convert LocalVariable to pointer to Bvariable. + * rust-backend.h (local_variable): Return LocalVariable. + (parameter_variable): Likewise. + (static_chain_variable): Likewise. + (temporary_variable): Likewise. + * rust-gcc.cc (local_variable): Likewise. + (parameter_variable): Likewise. + (static_chain_variable): Likewise. + (temporary_variable): Likewise. + (LocalVariable::get_tree): New function. + (LocalVariable::error_variable): Likewise. + * rust-gcc.h (class LocalVariable): New class. + +2025-11-25 lenny.chiadmi-delage + + * expand/rust-macro-expand.cc (transcribe_expression): Check if + parser didn't fail. + (transcribe_type): Likewise. + (transcribe_pattern): Likewise. + 2025-11-17 Philip Herron * typecheck/rust-hir-type-check-implitem.cc (TypeCheckImplItemWithTrait::visit): null guard diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7ec9f42ea3a9..32abfa1665fc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,237 @@ +2025-11-25 Lúcio Boari Fleury + + * rust/compile/macros/mbe/macro-issue3608.rs: New Test. The test skips an issue at line 11 + +2025-11-25 Philip Herron + + * rust/compile/gat1.rs: New test. + * rust/execute/torture/gat1.rs: New test. + +2025-11-25 Lucas Ly Ba + + * rust/compile/issue-3971.rs: New test. + +2025-11-25 Lucas Ly Ba + + * rust/compile/issue-4226.rs: New test. + +2025-11-25 Yap Zhi Heng + + * rust/compile/e0579-neg-float-fail.rs: New file. + * rust/compile/e0579-neg-float.rs: New file. + +2025-11-25 Lucas Ly Ba + + * rust/compile/issue-4262.rs: New test. + +2025-11-25 lenny.chiadmi-delage + + * rust/compile/issue-4140-1.rs: Fixes test. + * rust/compile/issue-4140-2.rs: Likewise. + +2025-11-25 lenny.chiadmi-delage + + * rust/compile/issue-4140-1.rs: New test. + * rust/compile/issue-4140-2.rs: Likewise. + +2025-11-25 David Malcolm + + * gcc.dg/analyzer/strchr-1.c: Drop include of , and use + __builtin_strchr throughout rather than strchr to avoid const + correctness issues when the header implements strchr with a C23 + const-preserving macro. Drop "const" from two vars. + +2025-11-25 Tamar Christina + + PR target/118974 + * gcc.target/aarch64/sve/pr119351.c: Update codegen. + * gcc.target/aarch64/sve/vect-early-break-cbranch.c: Likewise. + * gcc.target/aarch64/vect-early-break-cbranch.c: Likewise. + * gcc.target/aarch64/sve/vect-early-break-cbranch_2.c: New test. + * gcc.target/aarch64/sve/vect-early-break-cbranch_3.c: New test. + * gcc.target/aarch64/sve/vect-early-break-cbranch_4.c: New test. + * gcc.target/aarch64/sve/vect-early-break-cbranch_5.c: New test. + * gcc.target/aarch64/sve/vect-early-break-cbranch_7.c: New test. + * gcc.target/aarch64/sve/vect-early-break-cbranch_8.c: New test. + * gcc.target/aarch64/vect-early-break-cbranch_2.c: New test. + * gcc.target/aarch64/vect-early-break-cbranch_3.c: New test. + +2025-11-25 Nathaniel Shead + + PR c++/122699 + * g++.dg/modules/tpl-friend-21_a.C: New test. + * g++.dg/modules/tpl-friend-21_b.C: New test. + +2025-11-25 Andre Vieira + + * gcc.dg/Wstringop-overflow-47.c: Adjust warnings to allow for 32-bit + stores. + +2025-11-25 Nathaniel Shead + + PR c++/122789 + * g++.dg/modules/concept-12_a.C: New test. + * g++.dg/modules/concept-12_b.C: New test. + +2025-11-25 Jason Merrill + + * g++.dg/modules/compile-std1.C: New test. + * g++.dg/modules/modules.exp: Only run it once. + +2025-11-25 Jakub Jelinek + + PR middle-end/120052 + * c-c++-common/gomp/pr120052.c: New test. + +2025-11-25 Jakub Jelinek + + PR testsuite/119931 + * gcc.dg/vla-1.c (main): Hide x value from optimizers and use it after + the call as well. + +2025-11-25 Rainer Orth + + * g++.dg/DRs/dr2581-1.C (__STDC_ISO_10646__): xfail on non-Linux. + * g++.dg/DRs/dr2581-2.C: Likewise. + (__STDC_VERSION__): Expect error instead of warning on Solaris. + +2025-11-25 Jakub Jelinek + + PR middle-end/120564 + * c-c++-common/gomp/pr120564.c: New test. + +2025-11-25 Rainer Orth + + * gcc.target/i386/pr120936-1.c: Restrict to *-*-linux*. + * gcc.target/i386/pr120936-2.c: Likewise. + * gcc.target/i386/pr120936-4.c: Likewise. + * gcc.target/i386/pr120936-5.c: Likewise. + * gcc.target/i386/pr120936-9.c: Likewise. + * gcc.target/i386/pr120936-11.c: Likewise. + +2025-11-25 Rainer Orth + + * gcc.target/i386/pr120936-3.c: Restrict to *-*-linux*. + * gcc.target/i386/pr120936-6.c: Likewise. + * gcc.target/i386/pr120936-10.c: Likewise. + * gcc.target/i386/pr120936-12.c: Likewise. + +2025-11-25 Rainer Orth + + * lib/target-supports.exp (add_options_for_check_function_bodies): + New proc. + * g++.target/i386/cf_check-3.C: Add dg-add-options + check_function_bodies. + * g++.target/i386/cf_check-4.C: Likewise. + * gcc.target/i386/builtin-copysign-2.c: Likewise. + * gcc.target/i386/builtin-copysign-3.c: Likewise. + * gcc.target/i386/builtin-copysign-4.c: Likewise. + * gcc.target/i386/builtin-copysign-5.c: Likewise. + * gcc.target/i386/builtin-copysign-6.c: Likewise. + * gcc.target/i386/builtin-copysign-7.c: Likewise. + * gcc.target/i386/builtin-copysign-8a.c: Likewise. + * gcc.target/i386/builtin-copysign-8b.c: Likewise. + * gcc.target/i386/builtin-fabs-1.c: Likewise. + * gcc.target/i386/builtin-memmove-10.c: Likewise. + * gcc.target/i386/builtin-memmove-11a.c: Likewise. + * gcc.target/i386/builtin-memmove-11b.c: Likewise. + * gcc.target/i386/builtin-memmove-11c.c: Likewise. + * gcc.target/i386/builtin-memmove-12.c: Likewise. + * gcc.target/i386/builtin-memmove-13.c: Likewise. + * gcc.target/i386/builtin-memmove-14.c: Likewise. + * gcc.target/i386/builtin-memmove-15.c: Likewise. + * gcc.target/i386/builtin-memmove-1a.c: Likewise. + * gcc.target/i386/builtin-memmove-1b.c: Likewise. + * gcc.target/i386/builtin-memmove-1c.c: Likewise. + * gcc.target/i386/builtin-memmove-1d.c: Likewise. + * gcc.target/i386/builtin-memmove-2a.c: Likewise. + * gcc.target/i386/builtin-memmove-2b.c: Likewise. + * gcc.target/i386/builtin-memmove-2c.c: Likewise. + * gcc.target/i386/builtin-memmove-2d.c: Likewise. + * gcc.target/i386/builtin-memmove-3a.c: Likewise. + * gcc.target/i386/builtin-memmove-3b.c: Likewise. + * gcc.target/i386/builtin-memmove-3c.c: Likewise. + * gcc.target/i386/builtin-memmove-4a.c: Likewise. + * gcc.target/i386/builtin-memmove-4b.c: Likewise. + * gcc.target/i386/builtin-memmove-4c.c: Likewise. + * gcc.target/i386/builtin-memmove-5a.c: Likewise. + * gcc.target/i386/builtin-memmove-5b.c: Likewise. + * gcc.target/i386/builtin-memmove-5c.c: Likewise. + * gcc.target/i386/builtin-memmove-6.c: Likewise. + * gcc.target/i386/builtin-memmove-7.c: Likewise. + * gcc.target/i386/builtin-memmove-8.c: Likewise. + * gcc.target/i386/builtin-memmove-9.c: Likewise. + * gcc.target/i386/cf_check-11.c: Likewise. + * gcc.target/i386/cf_check-7.c: Likewise. + * gcc.target/i386/pr120936-1.c: Likewise. + * gcc.target/i386/pr120936-11.c: Likewise. + * gcc.target/i386/pr120936-2.c: Likewise. + * gcc.target/i386/pr120936-4.c: Likewise. + * gcc.target/i386/pr120936-5.c: Likewise. + * gcc.target/i386/pr120936-9.c: Likewise. + * g++.target/i386/memset-pr101366-1.C: Switch to dg-add-options + check_function_bodies. + * g++.target/i386/memset-pr101366-2.C: Likewise. + * g++.target/i386/memset-pr108585-1a.C: Likewise. + * g++.target/i386/memset-pr108585-1b.C: Likewise. + * g++.target/i386/memset-pr118276-1a.C: Likewise. + * g++.target/i386/memset-pr118276-1b.C: Likewise. + * g++.target/i386/memset-pr118276-1c.C: Likewise. + * gcc.target/i386/memcpy-pr120683-1.c: Likewise. + * gcc.target/i386/memcpy-pr120683-2.c: Likewise. + * gcc.target/i386/memcpy-pr120683-3.c: Likewise. + * gcc.target/i386/memcpy-pr120683-4.c: Likewise. + * gcc.target/i386/memcpy-pr120683-5.c: Likewise. + * gcc.target/i386/memcpy-pr120683-6.c: Likewise. + * gcc.target/i386/memcpy-pr120683-7.c: Likewise. + * gcc.target/i386/memcpy-strategy-12.c: Likewise. + * gcc.target/i386/memset-pr120683-1.c: Likewise. + * gcc.target/i386/memset-pr120683-10.c: Likewise. + * gcc.target/i386/memset-pr120683-11.c: Likewise. + * gcc.target/i386/memset-pr120683-12.c: Likewise. + * gcc.target/i386/memset-pr120683-13.c: Likewise. + * gcc.target/i386/memset-pr120683-14.c: Likewise. + * gcc.target/i386/memset-pr120683-15.c: Likewise. + * gcc.target/i386/memset-pr120683-16.c: Likewise. + * gcc.target/i386/memset-pr120683-17.c: Likewise. + * gcc.target/i386/memset-pr120683-18.c: Likewise. + * gcc.target/i386/memset-pr120683-19.c: Likewise. + * gcc.target/i386/memset-pr120683-2.c: Likewise. + * gcc.target/i386/memset-pr120683-20.c: Likewise. + * gcc.target/i386/memset-pr120683-21.c: Likewise. + * gcc.target/i386/memset-pr120683-22.c: Likewise. + * gcc.target/i386/memset-pr120683-23.c: Likewise. + * gcc.target/i386/memset-pr120683-3.c: Likewise. + * gcc.target/i386/memset-pr120683-4.c: Likewise. + * gcc.target/i386/memset-pr120683-5.c: Likewise. + * gcc.target/i386/memset-pr120683-6.c: Likewise. + * gcc.target/i386/memset-pr120683-7.c: Likewise. + * gcc.target/i386/memset-pr120683-8.c: Likewise. + * gcc.target/i386/memset-pr120683-9.c: Likewise. + * gcc.target/i386/memset-pr70308-1a.c: Likewise. + * gcc.target/i386/memset-pr70308-1b.c: Likewise. + * gcc.target/i386/memset-strategy-10.c: Likewise. + * gcc.target/i386/memset-strategy-13.c: Likewise. + * gcc.target/i386/memset-strategy-25.c: Likewise. + * gcc.target/i386/memset-strategy-28.c: Likewise. + * gcc.target/i386/memset-strategy-29.c: Likewise. + * gcc.target/i386/memset-strategy-30.c: Likewise. + * gcc.target/i386/pr111673.c: Likewise. + * gcc.target/i386/pr82142a.c: Likewise. + * gcc.target/i386/pr82142b.c: Likewise. + * gcc.target/i386/pr92080-17.c: Likewise. + +2025-11-25 Rainer Orth + + * gcc.dg/debug/dwarf2/dwarf-btf-decl-tag-1.c + (scan-assembler-times): Switch to brace quotes. + Allow for alternative assembler syntax. + * gcc.dg/debug/dwarf2/dwarf-btf-type-tag-1.c: Likewise. + * gcc.dg/debug/dwarf2/dwarf-btf-type-tag-10.c: Likewise. + * gcc.dg/debug/dwarf2/dwarf-btf-type-tag-2.c: Likewise. + * gcc.dg/debug/dwarf2/dwarf-btf-type-tag-4.c: Likewise. + * gcc.dg/debug/dwarf2/dwarf-btf-type-tag-5.c: Likewise. + 2025-11-24 Robin Dapp * gcc.target/riscv/rvv/autovec/pr121582.c: New test. diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index ae35cd2e35e2..f9b1a769b7c9 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,12 @@ +2025-11-25 Frank Scheiner + + * affinity-fmt.c: Make char *q a pointer to a const char. + +2025-11-25 Arsen Arsenović + + * testsuite/libgomp.oacc-c-c++-common/atomic_capture-3.c: Copy + changes in r11-3059-g8183ebcdc1c843 from atomic_capture-2.c. + 2025-11-22 Sandra Loosemore * libgomp.texi (OpenMP 5.1): Update "begin declare variant" status. diff --git a/libstdc++-v3/ChangeLog b/libstdc++-v3/ChangeLog index 2fe75939c788..99eadd725049 100644 --- a/libstdc++-v3/ChangeLog +++ b/libstdc++-v3/ChangeLog @@ -1,3 +1,8 @@ +2025-11-25 Jonathan Wakely + + * acinclude.m4 (libtool_VERSION): Bump version. + * configure: Regenerate. + 2025-11-24 Jonathan Wakely * include/std/optional (operator==, operator!=, operator>) From e75a9e33b97cfdcc76b6bfea3e7ca6184be5d5c0 Mon Sep 17 00:00:00 2001 From: Andrew Pinski Date: Tue, 25 Nov 2025 14:19:18 -0800 Subject: [PATCH 019/373] phiprop: Make sure types of the load match the inserted phi [PR122847] This was introduced with r16-5556-ge94e91d6f3775, but the type check for the delay was not happen because the type at the point of delaying was set to NULL. It is only until a non-delayed load when the phi is created, the type is set. This adds the type check to the replacement for the delayed statements. Pushed as obvious. PR tree-optimization/122847 gcc/ChangeLog: * tree-ssa-phiprop.cc (propagate_with_phi): Add type check for reuse of the phi for the delayed statements. gcc/testsuite/ChangeLog: * gcc.dg/torture/pr122847-1.c: New test. Signed-off-by: Andrew Pinski --- gcc/testsuite/gcc.dg/torture/pr122847-1.c | 17 +++++++++++++++++ gcc/tree-ssa-phiprop.cc | 3 +++ 2 files changed, 20 insertions(+) create mode 100644 gcc/testsuite/gcc.dg/torture/pr122847-1.c diff --git a/gcc/testsuite/gcc.dg/torture/pr122847-1.c b/gcc/testsuite/gcc.dg/torture/pr122847-1.c new file mode 100644 index 000000000000..9ec4360e329c --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr122847-1.c @@ -0,0 +1,17 @@ +/* { dg-do compile } */ +/* PR tree-optimization/122847 */ + +struct { + char x[6]; +} *a, b; + +int c; + +int d() { + /* `a->x` might trap. */ + char *p = a ? a->x : b.x; + char e = *p; + if (c) + return *(short *)p & e; + return 0; +} diff --git a/gcc/tree-ssa-phiprop.cc b/gcc/tree-ssa-phiprop.cc index d24613d58938..04aa138f521c 100644 --- a/gcc/tree-ssa-phiprop.cc +++ b/gcc/tree-ssa-phiprop.cc @@ -506,6 +506,9 @@ next:; if (phi_inserted) for (auto use_stmt : delayed_uses) { + /* The types must match of the inserted phi. */ + if (!types_compatible_p (type, TREE_TYPE (gimple_assign_lhs (use_stmt)))) + continue; gimple_assign_set_rhs1 (use_stmt, res); update_stmt (use_stmt); } From d4e439f395e807f0f7606f92288db8be9852b2f4 Mon Sep 17 00:00:00 2001 From: Andrew Pinski Date: Mon, 24 Nov 2025 23:34:45 -0800 Subject: [PATCH 020/373] phiprop: Small compile time improvement for phiprop Now that post dom information is only needed when the new store can trap (since r16-5555-g952e145796d), only calculate it when that is the case. It was calculated on demand by r14-2051-g3124bfb14c0bdc. This just changes when we need to calculate it. Pushed as obvious. gcc/ChangeLog: * tree-ssa-phiprop.cc (propagate_with_phi): Only calculate on demand post dom info when the new store might trap. Signed-off-by: Andrew Pinski --- gcc/tree-ssa-phiprop.cc | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gcc/tree-ssa-phiprop.cc b/gcc/tree-ssa-phiprop.cc index 04aa138f521c..0c840b182e02 100644 --- a/gcc/tree-ssa-phiprop.cc +++ b/gcc/tree-ssa-phiprop.cc @@ -339,7 +339,8 @@ propagate_with_phi (basic_block bb, gphi *vphi, gphi *phi, tree vuse; bool delay = false; - if (!dom_info_available_p (cfun, CDI_POST_DOMINATORS)) + if (canpossible_trap + && !dom_info_available_p (cfun, CDI_POST_DOMINATORS)) calculate_dominance_info (CDI_POST_DOMINATORS); /* Only replace loads in blocks that post-dominate the PHI node. That From 09ca98e854dca41ae0987b878a1eaab59b31383d Mon Sep 17 00:00:00 2001 From: Pan Li Date: Tue, 25 Nov 2025 15:18:38 +0800 Subject: [PATCH 021/373] Match: Add unsigned SAT_MUL for form 7 This patch would like to try to match the the unsigned SAT_MUL form 7, aka below: #define DEF_SAT_U_MUL_FMT_7(NT, WT) \ NT __attribute__((noinline)) \ sat_u_mul_##NT##_from_##WT##_fmt_7 (NT a, NT b) \ { \ WT x = (WT)a * (WT)b; \ NT max = -1; \ bool overflow_p = x > (WT)(max); \ return -(NT)(overflow_p) | (NT)x; \ } while WT is uint128_t, uint64_t, uint32_t and uint16_t, and NT is uint64_t, uint32_t, uint16_t or uint8_t. gcc/ChangeLog: * match.pd: Add pattern for SAT_MUL form 7 include mul and widen_mul. Signed-off-by: Pan Li --- gcc/match.pd | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/gcc/match.pd b/gcc/match.pd index 36d8f2f72750..2877f81e7a51 100644 --- a/gcc/match.pd +++ b/gcc/match.pd @@ -3793,6 +3793,25 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) bool c2_is_type_precision_p = tree_to_uhwi (@2) == prec; } (if (c2_is_type_precision_p))))) + (match (unsigned_integer_sat_mul @0 @1) + /* SAT_U_MUL (X, Y) = { + WT x = (WT)a * (WT)b; + NT max = -1; + bool overflow_p = x > (WT)max; + return -(NT)(overflow_p) | (NT)x; + } while WT is uint128_t, uint64_t, uint32_t, uint16_t, + and T is uint64_t, uint32_t, uint16_t, uint8_t. */ + (bit_ior:c (negate (convert (gt @3 INTEGER_CST@2))) + (convert (usmul_widen_mult@3 @0 @1))) + (if (types_match (type, @0, @1)) + (with + { + unsigned prec = TYPE_PRECISION (type); + unsigned widen_prec = TYPE_PRECISION (TREE_TYPE (@3)); + wide_int max = wi::mask (prec, false, widen_prec); + bool c2_is_max_p = wi::eq_p (wi::to_wide (@2), max); + } + (if (c2_is_max_p))))) ) /* The boundary condition for case 10: IMM = 1: From be848078841cbd937ff0ce7bb1564e09d5e2959e Mon Sep 17 00:00:00 2001 From: Pan Li Date: Mon, 20 Oct 2025 21:08:46 +0800 Subject: [PATCH 022/373] RISC-V: Add testcase for unsigned scalar SAT_MUL form 7 The form 7 of unsigned scalar SAT_MUL has supported from the previous change. Thus, add the test cases to make sure it works well. gcc/testsuite/ChangeLog: * gcc.target/riscv/sat/sat_arith.h: Add test helper macros. * gcc.target/riscv/sat/sat_u_mul-8-u16-from-u128.c: New test. * gcc.target/riscv/sat/sat_u_mul-8-u16-from-u32.c: New test. * gcc.target/riscv/sat/sat_u_mul-8-u16-from-u64.rv32.c: New test. * gcc.target/riscv/sat/sat_u_mul-8-u16-from-u64.rv64.c: New test. * gcc.target/riscv/sat/sat_u_mul-8-u32-from-u128.c: New test. * gcc.target/riscv/sat/sat_u_mul-8-u32-from-u64.rv32.c: New test. * gcc.target/riscv/sat/sat_u_mul-8-u32-from-u64.rv64.c: New test. * gcc.target/riscv/sat/sat_u_mul-8-u64-from-u128.c: New test. * gcc.target/riscv/sat/sat_u_mul-8-u8-from-u128.c: New test. * gcc.target/riscv/sat/sat_u_mul-8-u8-from-u16.c: New test. * gcc.target/riscv/sat/sat_u_mul-8-u8-from-u32.c: New test. * gcc.target/riscv/sat/sat_u_mul-8-u8-from-u64.rv32.c: New test. * gcc.target/riscv/sat/sat_u_mul-8-u8-from-u64.rv64.c: New test. * gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u128.c: New test. * gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u32.c: New test. * gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u64.c: New test. * gcc.target/riscv/sat/sat_u_mul-run-8-u32-from-u128.c: New test. * gcc.target/riscv/sat/sat_u_mul-run-8-u32-from-u64.c: New test. * gcc.target/riscv/sat/sat_u_mul-run-8-u64-from-u128.c: New test. * gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u128.c: New test. * gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u16.c: New test. * gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u32.c: New test. * gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u64.c: New test. Signed-off-by: Pan Li --- gcc/testsuite/gcc.target/riscv/sat/sat_arith.h | 15 +++++++++++++++ .../riscv/sat/sat_u_mul-8-u16-from-u128.c | 11 +++++++++++ .../riscv/sat/sat_u_mul-8-u16-from-u32.c | 11 +++++++++++ .../riscv/sat/sat_u_mul-8-u16-from-u64.rv32.c | 11 +++++++++++ .../riscv/sat/sat_u_mul-8-u16-from-u64.rv64.c | 11 +++++++++++ .../riscv/sat/sat_u_mul-8-u32-from-u128.c | 11 +++++++++++ .../riscv/sat/sat_u_mul-8-u32-from-u64.rv32.c | 11 +++++++++++ .../riscv/sat/sat_u_mul-8-u32-from-u64.rv64.c | 11 +++++++++++ .../riscv/sat/sat_u_mul-8-u64-from-u128.c | 11 +++++++++++ .../riscv/sat/sat_u_mul-8-u8-from-u128.c | 11 +++++++++++ .../riscv/sat/sat_u_mul-8-u8-from-u16.c | 11 +++++++++++ .../riscv/sat/sat_u_mul-8-u8-from-u32.c | 11 +++++++++++ .../riscv/sat/sat_u_mul-8-u8-from-u64.rv32.c | 11 +++++++++++ .../riscv/sat/sat_u_mul-8-u8-from-u64.rv64.c | 11 +++++++++++ .../riscv/sat/sat_u_mul-run-8-u16-from-u128.c | 16 ++++++++++++++++ .../riscv/sat/sat_u_mul-run-8-u16-from-u32.c | 16 ++++++++++++++++ .../riscv/sat/sat_u_mul-run-8-u16-from-u64.c | 16 ++++++++++++++++ .../riscv/sat/sat_u_mul-run-8-u32-from-u128.c | 16 ++++++++++++++++ .../riscv/sat/sat_u_mul-run-8-u32-from-u64.c | 16 ++++++++++++++++ .../riscv/sat/sat_u_mul-run-8-u64-from-u128.c | 16 ++++++++++++++++ .../riscv/sat/sat_u_mul-run-8-u8-from-u128.c | 16 ++++++++++++++++ .../riscv/sat/sat_u_mul-run-8-u8-from-u16.c | 16 ++++++++++++++++ .../riscv/sat/sat_u_mul-run-8-u8-from-u32.c | 16 ++++++++++++++++ .../riscv/sat/sat_u_mul-run-8-u8-from-u64.c | 16 ++++++++++++++++ 24 files changed, 318 insertions(+) create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u128.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u32.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u64.rv32.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u64.rv64.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u32-from-u128.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u32-from-u64.rv32.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u32-from-u64.rv64.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u64-from-u128.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u128.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u16.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u32.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u64.rv32.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u64.rv64.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u128.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u32.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u64.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u32-from-u128.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u32-from-u64.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u64-from-u128.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u128.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u16.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u32.c create mode 100644 gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u64.c diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_arith.h b/gcc/testsuite/gcc.target/riscv/sat/sat_arith.h index e1748a6d6acd..f094d4d3309c 100644 --- a/gcc/testsuite/gcc.target/riscv/sat/sat_arith.h +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_arith.h @@ -770,4 +770,19 @@ sat_u_mul_##NT##_from_##WT##_fmt_6 (NT a, NT b) \ sat_u_mul_##NT##_from_##WT##_fmt_6 (a, b) #define RUN_SAT_U_MUL_FMT_6_WRAP(NT, WT, a, b) RUN_SAT_U_MUL_FMT_6(NT, WT, a, b) +#define DEF_SAT_U_MUL_FMT_7(NT, WT) \ +NT __attribute__((noinline)) \ +sat_u_mul_##NT##_from_##WT##_fmt_7 (NT a, NT b) \ +{ \ + WT x = (WT)a * (WT)b; \ + NT max = -1; \ + bool overflow_p = x > (WT)(max); \ + return -(NT)(overflow_p) | (NT)x; \ +} + +#define DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) DEF_SAT_U_MUL_FMT_7(NT, WT) +#define RUN_SAT_U_MUL_FMT_7(NT, WT, a, b) \ + sat_u_mul_##NT##_from_##WT##_fmt_7 (a, b) +#define RUN_SAT_U_MUL_FMT_7_WRAP(NT, WT, a, b) RUN_SAT_U_MUL_FMT_7(NT, WT, a, b) + #endif diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u128.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u128.c new file mode 100644 index 000000000000..c392c777bf36 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u128.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-march=rv64gc -mabi=lp64d -fdump-tree-optimized" } */ + +#include "sat_arith.h" + +#define NT uint16_t +#define WT uint128_t + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +/* { dg-final { scan-tree-dump-times ".SAT_MUL" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u32.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u32.c new file mode 100644 index 000000000000..7fab31345e35 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u32.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-march=rv64gc -mabi=lp64d -fdump-tree-optimized" } */ + +#include "sat_arith.h" + +#define NT uint16_t +#define WT uint32_t + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +/* { dg-final { scan-tree-dump-times ".SAT_MUL" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u64.rv32.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u64.rv32.c new file mode 100644 index 000000000000..44939a54e253 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u64.rv32.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-march=rv32gc -mabi=ilp32 -fdump-tree-optimized" } */ + +#include "sat_arith.h" + +#define NT uint16_t +#define WT uint64_t + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +/* { dg-final { scan-tree-dump-times ".SAT_MUL" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u64.rv64.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u64.rv64.c new file mode 100644 index 000000000000..4607d459f7d3 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u16-from-u64.rv64.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-march=rv64gc -mabi=lp64d -fdump-tree-optimized" } */ + +#include "sat_arith.h" + +#define NT uint16_t +#define WT uint64_t + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +/* { dg-final { scan-tree-dump-times ".SAT_MUL" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u32-from-u128.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u32-from-u128.c new file mode 100644 index 000000000000..18e0ffb660fd --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u32-from-u128.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-march=rv64gc -mabi=lp64d -fdump-tree-optimized" } */ + +#include "sat_arith.h" + +#define NT uint32_t +#define WT uint128_t + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +/* { dg-final { scan-tree-dump-times ".SAT_MUL" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u32-from-u64.rv32.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u32-from-u64.rv32.c new file mode 100644 index 000000000000..5786ec40236f --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u32-from-u64.rv32.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-march=rv32gc -mabi=ilp32 -fdump-tree-optimized" } */ + +#include "sat_arith.h" + +#define NT uint32_t +#define WT uint64_t + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +/* { dg-final { scan-tree-dump-times ".SAT_MUL" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u32-from-u64.rv64.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u32-from-u64.rv64.c new file mode 100644 index 000000000000..9d24001296da --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u32-from-u64.rv64.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-march=rv64gc -mabi=lp64d -fdump-tree-optimized" } */ + +#include "sat_arith.h" + +#define NT uint32_t +#define WT uint64_t + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +/* { dg-final { scan-tree-dump-times ".SAT_MUL" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u64-from-u128.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u64-from-u128.c new file mode 100644 index 000000000000..93af21489f8d --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u64-from-u128.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-march=rv64gc -mabi=lp64d -fdump-tree-optimized" } */ + +#include "sat_arith.h" + +#define NT uint64_t +#define WT uint128_t + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +/* { dg-final { scan-tree-dump-times ".SAT_MUL" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u128.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u128.c new file mode 100644 index 000000000000..5d1866bc338b --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u128.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-march=rv64gc -mabi=lp64d -fdump-tree-optimized" } */ + +#include "sat_arith.h" + +#define NT uint8_t +#define WT uint128_t + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +/* { dg-final { scan-tree-dump-times ".SAT_MUL" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u16.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u16.c new file mode 100644 index 000000000000..b09706ccab45 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u16.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-march=rv64gc -mabi=lp64d -fdump-tree-optimized" } */ + +#include "sat_arith.h" + +#define NT uint8_t +#define WT uint16_t + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +/* { dg-final { scan-tree-dump-times ".SAT_MUL" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u32.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u32.c new file mode 100644 index 000000000000..99bad8701845 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u32.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-march=rv64gc -mabi=lp64d -fdump-tree-optimized" } */ + +#include "sat_arith.h" + +#define NT uint8_t +#define WT uint32_t + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +/* { dg-final { scan-tree-dump-times ".SAT_MUL" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u64.rv32.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u64.rv32.c new file mode 100644 index 000000000000..4ff227b12ed9 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u64.rv32.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-march=rv32gc -mabi=ilp32 -fdump-tree-optimized" } */ + +#include "sat_arith.h" + +#define NT uint8_t +#define WT uint64_t + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +/* { dg-final { scan-tree-dump-times ".SAT_MUL" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u64.rv64.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u64.rv64.c new file mode 100644 index 000000000000..33783f6c840a --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-8-u8-from-u64.rv64.c @@ -0,0 +1,11 @@ +/* { dg-do compile } */ +/* { dg-options "-march=rv64gc -mabi=lp64d -fdump-tree-optimized" } */ + +#include "sat_arith.h" + +#define NT uint8_t +#define WT uint64_t + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +/* { dg-final { scan-tree-dump-times ".SAT_MUL" 1 "optimized" } } */ diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u128.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u128.c new file mode 100644 index 000000000000..fb2a3f3e208e --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u128.c @@ -0,0 +1,16 @@ +/* { dg-do run { target { rv64 } } } */ +/* { dg-additional-options "-std=c99" } */ + +#include "sat_arith.h" +#include "sat_arith_data.h" + +#define NT uint8_t +#define WT uint128_t +#define NAME usmul +#define DATA TEST_BINARY_DATA_WRAP(NT, NAME) +#define T TEST_BINARY_STRUCT_DECL_WRAP(NT, NAME) +#define RUN_BINARY(x, y) RUN_SAT_U_MUL_FMT_7_WRAP(NT, WT, x, y) + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +#include "scalar_sat_binary_run_xxx.h" diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u32.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u32.c new file mode 100644 index 000000000000..3039893da20f --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u32.c @@ -0,0 +1,16 @@ +/* { dg-do run { target { rv32 || rv64 } } } */ +/* { dg-additional-options "-std=c99" } */ + +#include "sat_arith.h" +#include "sat_arith_data.h" + +#define NT uint16_t +#define WT uint32_t +#define NAME usmul +#define DATA TEST_BINARY_DATA_WRAP(NT, NAME) +#define T TEST_BINARY_STRUCT_DECL_WRAP(NT, NAME) +#define RUN_BINARY(x, y) RUN_SAT_U_MUL_FMT_7_WRAP(NT, WT, x, y) + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +#include "scalar_sat_binary_run_xxx.h" diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u64.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u64.c new file mode 100644 index 000000000000..4a26af227c9a --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u64.c @@ -0,0 +1,16 @@ +/* { dg-do run { target { rv32 || rv64 } } } */ +/* { dg-additional-options "-std=c99" } */ + +#include "sat_arith.h" +#include "sat_arith_data.h" + +#define NT uint16_t +#define WT uint64_t +#define NAME usmul +#define DATA TEST_BINARY_DATA_WRAP(NT, NAME) +#define T TEST_BINARY_STRUCT_DECL_WRAP(NT, NAME) +#define RUN_BINARY(x, y) RUN_SAT_U_MUL_FMT_7_WRAP(NT, WT, x, y) + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +#include "scalar_sat_binary_run_xxx.h" diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u32-from-u128.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u32-from-u128.c new file mode 100644 index 000000000000..f1fb94ab7fce --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u32-from-u128.c @@ -0,0 +1,16 @@ +/* { dg-do run { target { rv64 } } } */ +/* { dg-additional-options "-std=c99" } */ + +#include "sat_arith.h" +#include "sat_arith_data.h" + +#define NT uint32_t +#define WT uint128_t +#define NAME usmul +#define DATA TEST_BINARY_DATA_WRAP(NT, NAME) +#define T TEST_BINARY_STRUCT_DECL_WRAP(NT, NAME) +#define RUN_BINARY(x, y) RUN_SAT_U_MUL_FMT_7_WRAP(NT, WT, x, y) + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +#include "scalar_sat_binary_run_xxx.h" diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u32-from-u64.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u32-from-u64.c new file mode 100644 index 000000000000..7ef6f3c8fa45 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u32-from-u64.c @@ -0,0 +1,16 @@ +/* { dg-do run { target { rv32 || rv64 } } } */ +/* { dg-additional-options "-std=c99" } */ + +#include "sat_arith.h" +#include "sat_arith_data.h" + +#define NT uint32_t +#define WT uint64_t +#define NAME usmul +#define DATA TEST_BINARY_DATA_WRAP(NT, NAME) +#define T TEST_BINARY_STRUCT_DECL_WRAP(NT, NAME) +#define RUN_BINARY(x, y) RUN_SAT_U_MUL_FMT_7_WRAP(NT, WT, x, y) + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +#include "scalar_sat_binary_run_xxx.h" diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u64-from-u128.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u64-from-u128.c new file mode 100644 index 000000000000..badf22d46397 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u64-from-u128.c @@ -0,0 +1,16 @@ +/* { dg-do run { target { rv64 } } } */ +/* { dg-additional-options "-std=c99" } */ + +#include "sat_arith.h" +#include "sat_arith_data.h" + +#define NT uint64_t +#define WT uint128_t +#define NAME usmul +#define DATA TEST_BINARY_DATA_WRAP(NT, NAME) +#define T TEST_BINARY_STRUCT_DECL_WRAP(NT, NAME) +#define RUN_BINARY(x, y) RUN_SAT_U_MUL_FMT_7_WRAP(NT, WT, x, y) + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +#include "scalar_sat_binary_run_xxx.h" diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u128.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u128.c new file mode 100644 index 000000000000..fb2a3f3e208e --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u128.c @@ -0,0 +1,16 @@ +/* { dg-do run { target { rv64 } } } */ +/* { dg-additional-options "-std=c99" } */ + +#include "sat_arith.h" +#include "sat_arith_data.h" + +#define NT uint8_t +#define WT uint128_t +#define NAME usmul +#define DATA TEST_BINARY_DATA_WRAP(NT, NAME) +#define T TEST_BINARY_STRUCT_DECL_WRAP(NT, NAME) +#define RUN_BINARY(x, y) RUN_SAT_U_MUL_FMT_7_WRAP(NT, WT, x, y) + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +#include "scalar_sat_binary_run_xxx.h" diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u16.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u16.c new file mode 100644 index 000000000000..c36713019b60 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u16.c @@ -0,0 +1,16 @@ +/* { dg-do run { target { rv32 || rv64 } } } */ +/* { dg-additional-options "-std=c99" } */ + +#include "sat_arith.h" +#include "sat_arith_data.h" + +#define NT uint8_t +#define WT uint16_t +#define NAME usmul +#define DATA TEST_BINARY_DATA_WRAP(NT, NAME) +#define T TEST_BINARY_STRUCT_DECL_WRAP(NT, NAME) +#define RUN_BINARY(x, y) RUN_SAT_U_MUL_FMT_7_WRAP(NT, WT, x, y) + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +#include "scalar_sat_binary_run_xxx.h" diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u32.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u32.c new file mode 100644 index 000000000000..a62958cef470 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u32.c @@ -0,0 +1,16 @@ +/* { dg-do run { target { rv32 || rv64 } } } */ +/* { dg-additional-options "-std=c99" } */ + +#include "sat_arith.h" +#include "sat_arith_data.h" + +#define NT uint8_t +#define WT uint32_t +#define NAME usmul +#define DATA TEST_BINARY_DATA_WRAP(NT, NAME) +#define T TEST_BINARY_STRUCT_DECL_WRAP(NT, NAME) +#define RUN_BINARY(x, y) RUN_SAT_U_MUL_FMT_7_WRAP(NT, WT, x, y) + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +#include "scalar_sat_binary_run_xxx.h" diff --git a/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u64.c b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u64.c new file mode 100644 index 000000000000..b67b8c6223a2 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u64.c @@ -0,0 +1,16 @@ +/* { dg-do run { target { rv32 || rv64 } } } */ +/* { dg-additional-options "-std=c99" } */ + +#include "sat_arith.h" +#include "sat_arith_data.h" + +#define NT uint8_t +#define WT uint64_t +#define NAME usmul +#define DATA TEST_BINARY_DATA_WRAP(NT, NAME) +#define T TEST_BINARY_STRUCT_DECL_WRAP(NT, NAME) +#define RUN_BINARY(x, y) RUN_SAT_U_MUL_FMT_7_WRAP(NT, WT, x, y) + +DEF_SAT_U_MUL_FMT_7_WRAP(NT, WT) + +#include "scalar_sat_binary_run_xxx.h" From 3c378398111f7fc3c026b705e3ac088b27d4c307 Mon Sep 17 00:00:00 2001 From: Dhruv Chawla Date: Wed, 23 Jul 2025 01:41:51 -0700 Subject: [PATCH 023/373] Make better use of overflowing operations in max/min(a, add/sub(a, b)) [PR116815] This patch folds the following patterns: - For add: - umax (a, add (a, b)) -> [sum, ovf] = adds (a, b); !ovf ? sum : a - umin (a, add (a, b)) -> [sum, ovf] = adds (a, b); !ovf ? a : sum ... along with the commutated versions: - umax (a, add (b, a)) -> [sum, ovf] = adds (b, a); !ovf ? sum : a - umin (a, add (b, a)) -> [sum, ovf] = adds (b, a); !ovf ? a : sum - For sub: - umax (a, sub (a, b)) -> [diff, udf] = subs (a, b); udf ? diff : a - umin (a, sub (a, b)) -> [diff, udf] = subs (a, b); udf ? a : diff Where ovf is the overflow flag and udf is the underflow flag. adds and subs are generated by generating parallel compare+plus/minus which map to add3_compareC and sub3_compare1. This patch is a respin of the patch posted at https://gcc.gnu.org/pipermail/gcc-patches/2025-May/685021.html as per the suggestion to turn it into a target-specific transform by Richard Biener. FIXME: This pattern cannot currently factor multiple occurences of the add expression into a single adds, eg: max (a, a + b) + min (a + b, b) ends up generating two adds instructions. This is something that was lost when going from GIMPLE to target-specific transforms. Bootstrapped and regtested on aarch64-unknown-linux-gnu. Signed-off-by: Dhruv Chawla PR middle-end/116815 gcc/ChangeLog: * config/aarch64/aarch64.md (*aarch64_plus_within_3_): New pattern. (*aarch64_minus_within_3): Likewise. * config/aarch64/iterators.md (ovf_add_cmp): New code attribute. (udf_sub_cmp): Likewise. (UMAXMIN): New code iterator. (ovf_commutate): New iterator. (ovf_comm_opp): New int attribute. gcc/testsuite/ChangeLog: * gcc.target/aarch64/pr116815-1.c: New test. * gcc.target/aarch64/pr116815-2.c: Likewise. * gcc.target/aarch64/pr116815-3.c: Likewise. --- gcc/config/aarch64/aarch64.md | 60 +++++++++ gcc/config/aarch64/iterators.md | 9 ++ gcc/testsuite/gcc.target/aarch64/pr116815-1.c | 120 ++++++++++++++++++ gcc/testsuite/gcc.target/aarch64/pr116815-2.c | 44 +++++++ gcc/testsuite/gcc.target/aarch64/pr116815-3.c | 60 +++++++++ 5 files changed, 293 insertions(+) create mode 100644 gcc/testsuite/gcc.target/aarch64/pr116815-1.c create mode 100644 gcc/testsuite/gcc.target/aarch64/pr116815-2.c create mode 100644 gcc/testsuite/gcc.target/aarch64/pr116815-3.c diff --git a/gcc/config/aarch64/aarch64.md b/gcc/config/aarch64/aarch64.md index de6b1d0ed06b..8dcb5e3f0ecb 100644 --- a/gcc/config/aarch64/aarch64.md +++ b/gcc/config/aarch64/aarch64.md @@ -4482,6 +4482,66 @@ [(set_attr "type" "div")] ) +;; umax (a, add (a, b)) => [sum, ovf] = adds (a, b); !ovf ? sum : a +;; umin (a, add (a, b)) => [sum, ovf] = adds (a, b); !ovf ? a : sum +;; ... and the commutated versions: +;; umax (a, add (b, a)) => [sum, ovf] = adds (b, a); !ovf ? sum : a +;; umin (a, add (b, a)) => [sum, ovf] = adds (b, a); !ovf ? a : sum +(define_insn_and_split "*aarch64_plus_within_3_" + [(set (match_operand:GPI 0 "register_operand" "=r") + (UMAXMIN:GPI + (plus:GPI (match_operand:GPI 1 "register_operand" "r") + (match_operand:GPI 2 "register_operand" "r")) + (match_dup ovf_commutate))) + (clobber (match_scratch:GPI 3 "=r"))] + "!TARGET_CSSC" + "#" + "&& 1" + [(parallel + [(set (reg:CC_C CC_REGNUM) + (compare:CC_C (plus:GPI (match_dup ovf_commutate) + (match_dup )) + (match_dup ovf_commutate))) + (set (match_dup 3) (plus:GPI (match_dup ovf_commutate) + (match_dup )))]) + (set (match_dup 0) + (if_then_else:GPI ( (reg:CC_C CC_REGNUM) + (const_int 0)) + (match_dup 3) + (match_dup ovf_commutate)))] + { + if (GET_CODE (operands[3]) == SCRATCH) + operands[3] = gen_reg_rtx (mode); + } +) + +;; umax (a, sub (a, b)) => [diff, udf] = subs (a, b); udf ? diff : a +;; umin (a, sub (a, b)) => [diff, udf] = subs (a, b); udf ? a : diff +(define_insn_and_split "*aarch64_minus_within_3" + [(set (match_operand:GPI 0 "register_operand" "=r") + (UMAXMIN:GPI + (minus:GPI (match_operand:GPI 1 "register_operand" "r") + (match_operand:GPI 2 "register_operand" "r")) + (match_dup 1))) + (clobber (match_scratch:GPI 3 "=r"))] + "!TARGET_CSSC" + "#" + "&& 1" + [(parallel + [(set (reg:CC CC_REGNUM) + (compare:CC (match_dup 1) (match_dup 2))) + (set (match_dup 3) (minus:GPI (match_dup 1) (match_dup 2)))]) + (set (match_dup 0) + (if_then_else:GPI ( (reg:CC CC_REGNUM) + (const_int 0)) + (match_dup 3) + (match_dup 1)))] + { + if (GET_CODE (operands[3]) == SCRATCH) + operands[3] = gen_reg_rtx (mode); + } +) + ;; ------------------------------------------------------------------- ;; Comparison insns ;; ------------------------------------------------------------------- diff --git a/gcc/config/aarch64/iterators.md b/gcc/config/aarch64/iterators.md index 82579b05ff7a..ff5688529d38 100644 --- a/gcc/config/aarch64/iterators.md +++ b/gcc/config/aarch64/iterators.md @@ -2853,6 +2853,8 @@ (define_code_iterator FMAXMIN [smax smin]) +(define_code_iterator UMAXMIN [umax umin]) + ;; Signed and unsigned max operations. (define_code_iterator USMAX [smax umax]) @@ -3141,6 +3143,9 @@ (define_code_attr maxminand [(smax "bic") (smin "and")]) +(define_code_attr ovf_add_cmp [(umax "geu") (umin "ltu")]) +(define_code_attr udf_sub_cmp [(umax "ltu") (umin "geu")]) + ;; MLA/MLS attributes. (define_code_attr as [(ss_plus "a") (ss_minus "s")]) @@ -5164,3 +5169,7 @@ (UNSPEC_F2CVT "f2cvt") (UNSPEC_F1CVTLT "f1cvtlt") (UNSPEC_F2CVTLT "f2cvtlt")]) + +;; Operand numbers for commutative operations +(define_int_iterator ovf_commutate [1 2]) +(define_int_attr ovf_comm_opp [(1 "2") (2 "1")]) diff --git a/gcc/testsuite/gcc.target/aarch64/pr116815-1.c b/gcc/testsuite/gcc.target/aarch64/pr116815-1.c new file mode 100644 index 000000000000..f3bdb7943188 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/pr116815-1.c @@ -0,0 +1,120 @@ +/* { dg-do compile } */ +/* { dg-options "-O2" } */ +/* { dg-final { check-function-bodies "**" "" "" } } */ + +/* PR middle-end/116815 */ + +/* Single-use tests. */ + +static inline unsigned __attribute__ ((always_inline)) +max (unsigned a, unsigned b) +{ + return a > b ? a : b; +} + +static inline unsigned __attribute__ ((always_inline)) +min (unsigned a, unsigned b) +{ + return a < b ? a : b; +} + +#define OPERATION(op, type, N, exp1, exp2) \ + unsigned u##op##type##N (unsigned a, unsigned b) { return op (exp1, exp2); } + +/* +** umaxadd1: +** adds (w[0-9]+), w0, w1 +** csel w0, \1, w0, cc +** ret +*/ +OPERATION (max, add, 1, a, a + b) + +/* +** umaxadd2: +** adds (w[0-9]+), w0, w1 +** csel w0, \1, w0, cc +** ret +*/ +OPERATION (max, add, 2, a, b + a) + +/* +** umaxadd3: +** adds (w[0-9]+), w0, w1 +** csel w0, \1, w0, cc +** ret +*/ +OPERATION (max, add, 3, a + b, a) + +/* +** umaxadd4: +** adds (w[0-9]+), w0, w1 +** csel w0, \1, w0, cc +** ret +*/ +OPERATION (max, add, 4, b + a, a) + +/* +** uminadd1: +** adds (w[0-9]+), w0, w1 +** csel w0, \1, w0, cs +** ret +*/ +OPERATION (min, add, 1, a, a + b) + +/* +** uminadd2: +** adds (w[0-9]+), w0, w1 +** csel w0, \1, w0, cs +** ret +*/ +OPERATION (min, add, 2, a, b + a) + +/* +** uminadd3: +** adds (w[0-9]+), w0, w1 +** csel w0, \1, w0, cs +** ret +*/ +OPERATION (min, add, 3, a + b, a) + +/* +** uminadd4: +** adds (w[0-9]+), w0, w1 +** csel w0, \1, w0, cs +** ret +*/ +OPERATION (min, add, 4, b + a, a) + +/* sub requires the inverse of the comparison from add. */ + +/* +** umaxsub1: +** subs (w[0-9]+), w0, w1 +** csel w0, \1, w0, cc +** ret +*/ +OPERATION (max, sub, 1, a, a - b) + +/* +** umaxsub2: +** subs (w[0-9]+), w0, w1 +** csel w0, \1, w0, cc +** ret +*/ +OPERATION (max, sub, 2, a - b, a) + +/* +** uminsub1: +** subs (w[0-9]+), w0, w1 +** csel w0, \1, w0, cs +** ret +*/ +OPERATION (min, sub, 1, a, a - b) + +/* +** uminsub2: +** subs (w[0-9]+), w0, w1 +** csel w0, \1, w0, cs +** ret +*/ +OPERATION (min, sub, 2, a - b, a) diff --git a/gcc/testsuite/gcc.target/aarch64/pr116815-2.c b/gcc/testsuite/gcc.target/aarch64/pr116815-2.c new file mode 100644 index 000000000000..015c868aec28 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/pr116815-2.c @@ -0,0 +1,44 @@ +/* { dg-do compile } */ +/* { dg-options "-O2" } */ + +#pragma GCC target "+cssc" + +/* PR middle-end/116815 */ + +/* Make sure that umax/umin instructions are generated with CSSC. */ + +static inline unsigned __attribute__ ((always_inline)) +max (unsigned a, unsigned b) +{ + return a > b ? a : b; +} + +static inline unsigned __attribute__ ((always_inline)) +min (unsigned a, unsigned b) +{ + return a < b ? a : b; +} + +#define OPERATION(op, type, N, exp1, exp2) \ + unsigned u##op##type##N (unsigned a, unsigned b) { return op (exp1, exp2); } + +OPERATION (max, add, 1, a, a + b) +OPERATION (max, add, 2, a, b + a) +OPERATION (max, add, 3, a + b, a) +OPERATION (max, add, 4, b + a, a) + +OPERATION (min, add, 1, a, a + b) +OPERATION (min, add, 2, a, b + a) +OPERATION (min, add, 3, a + b, a) +OPERATION (min, add, 4, b + a, a) + +OPERATION (max, sub, 1, a, a - b) +OPERATION (max, sub, 2, a - b, a) + +OPERATION (min, sub, 1, a, a - b) +OPERATION (min, sub, 2, a - b, a) + +/* { dg-final { scan-assembler-times "umax\\t" 6 } } */ +/* { dg-final { scan-assembler-times "umin\\t" 6 } } */ +/* { dg-final { scan-assembler-not "adds\\t" } } */ +/* { dg-final { scan-assembler-not "subs\\t" } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/pr116815-3.c b/gcc/testsuite/gcc.target/aarch64/pr116815-3.c new file mode 100644 index 000000000000..d262d2170f39 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/pr116815-3.c @@ -0,0 +1,60 @@ +/* { dg-do run } */ +/* { dg-options "-O2" } */ + +/* PR middle-end/116815 */ + +/* Verify that the transformation gives correct results */ + +static inline unsigned __attribute__ ((always_inline)) +min (unsigned a, unsigned b) +{ + return (a < b) ? a : b; +} + +static inline unsigned __attribute__ ((always_inline)) +max (unsigned a, unsigned b) +{ + return (a > b) ? a : b; +} + +__attribute__ ((noipa)) unsigned +umaxadd (unsigned a, unsigned b) +{ + return max (a + b, a); +} + +__attribute__ ((noipa)) unsigned +umaxsub (unsigned a, unsigned b) +{ + return max (a - b, a); +} + +__attribute__ ((noipa)) unsigned +uminadd (unsigned a, unsigned b) +{ + return min (a + b, a); +} + +__attribute__ ((noipa)) unsigned +uminsub (unsigned a, unsigned b) +{ + return min (a - b, a); +} + +int +main () +{ + /* Overflows to 0x30000000. */ + if (umaxadd (0x90000000, 0xa0000000) != 0x90000000) + __builtin_abort (); + + if (uminadd (0x90000000, 0xa0000000) != 0x30000000) + __builtin_abort (); + + /* Underflows to 0x60000000. */ + if (umaxsub (0x00000000, 0xa0000000) != 0x60000000) + __builtin_abort (); + + if (uminsub (0x00000000, 0xa0000000) != 0x00000000) + __builtin_abort (); +} From 4cb1f7fe1480b535e946361ab7e7a9ef82f8872c Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Wed, 26 Nov 2025 06:59:20 +0000 Subject: [PATCH 024/373] Fortran: Implement finalization PDTs [PR104650] 2025-11-26 Paul Thomas gcc/fortran PR fortran/104650 * decl.cc (gfc_get_pdt_instance): If the PDT template has finalizers, make a new f2k_derived namespace for this intance and copy the template namespace into it. Set the instance template_sym field to point to the template. * expr.cc (gfc_check_pointer_assign): Allow array value pointer lvalues to point to scalar null expressions in initialization. * gfortran.h : Add the template_sym field to gfc_symbol. * resolve.cc (gfc_resolve_finalizers): For a pdt_type, copy the final subroutines with the same type argument into the pdt_type finalizer list. Prevent final subroutine type checking and creation of the vtab for pdt_templates. * symbol.cc (gfc_free_symbol): Do not call gfc_free_namespace for pdt_type with finalizers. Instead, free the finalizers and the namespace. gcc/testsuite PR fortran/104650 * gfortran.dg/pdt_70.f03: New test. --- gcc/fortran/decl.cc | 10 +++ gcc/fortran/expr.cc | 3 +- gcc/fortran/gfortran.h | 1 + gcc/fortran/resolve.cc | 52 +++++++++++-- gcc/fortran/symbol.cc | 16 +++- gcc/testsuite/gfortran.dg/pdt_70.f03 | 112 +++++++++++++++++++++++++++ 6 files changed, 186 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pdt_70.f03 diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 1346f329e612..2568f7378926 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -4200,6 +4200,16 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, instance->attr.pdt_type = 1; instance->declared_at = gfc_current_locus; + /* In resolution, the finalizers are copied, according to the type of the + argument, to the instance finalizers. However, they are retained by the + template and procedures are freed there. */ + if (pdt->f2k_derived && pdt->f2k_derived->finalizers) + { + instance->f2k_derived = gfc_get_namespace (NULL, 0); + instance->template_sym = pdt; + *instance->f2k_derived = *pdt->f2k_derived; + } + /* Add the components, replacing the parameters in all expressions with the expressions for their values in 'type_param_spec_list'. */ c1 = pdt->components; diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index a11ff79ab6be..00abd9e8734c 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -4577,7 +4577,8 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, return false; } - if (lvalue->rank != rvalue->rank && !rank_remap) + if (lvalue->rank != rvalue->rank && !rank_remap + && !(rvalue->expr_type == EXPR_NULL && is_init_expr)) { gfc_error ("Different ranks in pointer assignment at %L", &lvalue->where); return false; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 848ad9ca1fa2..2997c0326ca1 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1958,6 +1958,7 @@ typedef struct gfc_symbol /* List of PDT parameter expressions */ struct gfc_actual_arglist *param_list; + struct gfc_symbol *template_sym; struct gfc_expr *value; /* Parameter/Initializer value */ gfc_array_spec *as; diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 2390858424e2..e4e7751dbf04 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -15836,7 +15836,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) static bool gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable) { - gfc_finalizer* list; + gfc_finalizer *list, *pdt_finalizers = NULL; gfc_finalizer** prev_link; /* For removing wrong entries from the list. */ bool result = true; bool seen_scalar = false; @@ -15866,6 +15866,41 @@ gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable) return true; } + /* If a PDT has finalizers, the pdt_type's f2k_derived is a copy of that of + the template. If the finalizers field has the same value, it needs to be + supplied with finalizers of the same pdt_type. */ + if (derived->attr.pdt_type + && derived->template_sym + && derived->template_sym->f2k_derived + && (pdt_finalizers = derived->template_sym->f2k_derived->finalizers) + && derived->f2k_derived->finalizers == pdt_finalizers) + { + gfc_finalizer *tmp = NULL; + derived->f2k_derived->finalizers = NULL; + prev_link = &derived->f2k_derived->finalizers; + for (list = pdt_finalizers; list; list = list->next) + { + gfc_formal_arglist *args = gfc_sym_get_dummy_args (list->proc_sym); + if (args->sym + && args->sym->ts.type == BT_DERIVED + && args->sym->ts.u.derived + && !strcmp (args->sym->ts.u.derived->name, derived->name)) + { + tmp = gfc_get_finalizer (); + *tmp = *list; + tmp->next = NULL; + if (*prev_link) + { + (*prev_link)->next = tmp; + prev_link = &tmp; + } + else + *prev_link = tmp; + list->proc_tree = gfc_find_sym_in_symtree (list->proc_sym); + } + } + } + /* Walk over the list of finalizer-procedures, check them, and if any one does not fit in with the standard's definition, print an error and remove it from the list. */ @@ -15922,7 +15957,8 @@ gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable) } /* This argument must be of our type. */ - if (arg->ts.type != BT_DERIVED || arg->ts.u.derived != derived) + if (!derived->attr.pdt_template + && (arg->ts.type != BT_DERIVED || arg->ts.u.derived != derived)) { gfc_error ("Argument of FINAL procedure at %L must be of type %qs", &arg->declared_at, derived->name); @@ -15977,7 +16013,7 @@ gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable) /* Argument list might be empty; that is an error signalled earlier, but we nevertheless continued resolving. */ dummy_args = gfc_sym_get_dummy_args (i->proc_sym); - if (dummy_args) + if (dummy_args && !derived->attr.pdt_template) { gfc_symbol* i_arg = dummy_args->sym; const int i_rank = (i_arg->as ? i_arg->as->rank : 0); @@ -16025,9 +16061,13 @@ gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable) " rank finalizer has been declared", derived->name, &derived->declared_at); - vtab = gfc_find_derived_vtab (derived); - c = vtab->ts.u.derived->components->next->next->next->next->next; - gfc_set_sym_referenced (c->initializer->symtree->n.sym); + if (!derived->attr.pdt_template) + { + vtab = gfc_find_derived_vtab (derived); + c = vtab->ts.u.derived->components->next->next->next->next->next; + if (c && c->initializer && c->initializer->symtree && c->initializer->symtree->n.sym) + gfc_set_sym_referenced (c->initializer->symtree->n.sym); + } if (finalizable) *finalizable = true; diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc index b4d3ed6394db..becaaf394509 100644 --- a/gcc/fortran/symbol.cc +++ b/gcc/fortran/symbol.cc @@ -3225,7 +3225,21 @@ gfc_free_symbol (gfc_symbol *&sym) gfc_free_formal_arglist (sym->formal); - gfc_free_namespace (sym->f2k_derived); + /* The pdt_type f2k_derived namespaces are copies of that of the pdt_template + and are only made if there are finalizers. The complete list of finalizers + is kept by the pdt_template and are freed with its f2k_derived. */ + if (!sym->attr.pdt_type) + gfc_free_namespace (sym->f2k_derived); + else if (sym->f2k_derived && sym->f2k_derived->finalizers) + { + gfc_finalizer *p, *q = NULL; + for (p = sym->f2k_derived->finalizers; p; p = q) + { + q = p->next; + free (p); + } + free (sym->f2k_derived); + } set_symbol_common_block (sym, NULL); diff --git a/gcc/testsuite/gfortran.dg/pdt_70.f03 b/gcc/testsuite/gfortran.dg/pdt_70.f03 new file mode 100644 index 000000000000..25801ed95494 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_70.f03 @@ -0,0 +1,112 @@ +! { dg-do run } +! +! PR104650 +! Contributed by Gerhard Steinmetz +! +module m1 + type t1 + integer :: i + contains + final :: s + end type + type t2(n) + integer, len :: n = 1 + type(t1) :: a + end type + integer :: ctr = 0 + +contains + + impure elemental subroutine s(x) + type(t1), intent(in) :: x + ctr = ctr + x%i + end +end + +! From F2018: C.2.6 Final subroutines (7.5.6, 7.5.6.2, 7.5.6.3, 7.5.6.4) +module m2 + + type t(k) + integer, kind :: k + real(k), pointer :: vector(:) => NULL () + contains + final :: finalize_t1s, finalize_t1v, finalize_t2e + end type + + integer :: flag = 0 + +contains + + impure subroutine finalize_t1s(x) + type(t(kind(0.0))) x + if (associated(x%vector)) deallocate(x%vector) + flag = flag + 1 + END subroutine + + impure subroutine finalize_t1v(x) + type(t(kind(0.0))) x(:) + do i = lbound(x,1), ubound(x,1) + if (associated(x(i)%vector)) deallocate(x(i)%vector) + flag = flag + 1 + end do + end subroutine + + impure elemental subroutine finalize_t2e(x) + type(t(kind(0.0d0))), intent(inout) :: x + if (associated(x%vector)) deallocate(x%vector) + flag = flag + 1 + end subroutine + + elemental subroutine alloc_ts (x) + type(t(kind(0.0))), intent(inout) :: x + allocate (x%vector, source = [42.0,-42.0]) + end subroutine + + elemental subroutine alloc_td (x) + type(t(kind(0.0d0))), intent(inout) :: x + allocate (x%vector, source = [42.0d0,-42.0d0]) + end subroutine + +end module + + use m1 + use m2 + integer, parameter :: dims = 2 + integer :: p = 42 + +! Test pr104650 + call u (kind(0e0), p) + if (ctr /= p * (1 + kind(0e0))) stop 1 + +! Test the standard example + call example (dims) + if (flag /= 11 + dims**2) stop 2 + +contains + + subroutine u (k, p) + integer :: k, p + type (t2(k)) :: u_k, v_k(k) + u_k%a%i = p + v_k%a%i = p + end + +! Returning from 'example' will effectively do +! call finalize_t1s(a) +! call finalize_t1v(b) +! call finalize_t2e(d) +! No final subroutine will be called for variable C because the user +! omitted to define a suitable specific procedure for it. + subroutine example(n) + type(t(kind(0.0))) a, b(10), c(n,2) + type(t(kind(0.0d0))) d(n,n) + real(kind(0.0)),target :: tgt(1) + + ! Explicit allocation to provide a valid memory refence for deallocation. + call alloc_ts(a) + call alloc_ts(b) + call alloc_ts(c) + call alloc_td(d) + end subroutine + +end From 1c9d93bfcd172c156fd0e94ea9990569bf46aeda Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tomasz=20Kami=C5=84ski?= Date: Wed, 19 Nov 2025 10:29:18 +0100 Subject: [PATCH 025/373] libstdc++: Hashing support for chrono value classes [PR110357] MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This patch implements P2592R3 Hashing support for std::chrono value classes. To avoid the know issues with current hashing of integer types (see PR104945), we use chrono::__int_hash function that hash the bytes of representation, instead of hash, as the later simply cast to value. Currently _Hash_impl it used, but we should consider replacing it (see PR55815) before C++26 ABI is made stable. The function is declared inside header and chrono namespace, to make sure that only chrono components would be affected by such change. Finally, chrono::__int_hash is made variadic, to support combining hashes of multiple integers. To reduce the number of calls to hasher (defined out of line), the calendar types are packed into single unsigned integer value. This is done by chrono::__hash helper, that calls: * chrono::__as_int to cast the value of single component, to unsigned integer with size matching the one used by internal representation: unsigned short for year/weekday_indexed, and unsigned char in all other cases, * chrono::__pack_ints to pack integers (if more than one) into single integer by performing bit shift operations, * chrono::__int_hash to hash the value produced by above. Hashing of duration, time_point, and zoned_time only hashes the value and ignores any difference in the period, i.e. hashes of nanoseconds(2) and seconds(2) are the same. This does not affect the usages inside unordered containers, as the arguments are converted to key type first. To address that period::num and period::den could be included in the hash, however such approach will not make hashes of equal durations (2000ms, 2s) equal, so they would remain unusable for precomputed hashes. In consequence, including period in hash, would only increase runtime cost, withou any clear benefits. Futhermore, chrono::__int_hash is used when the duration representation is integral type, and for other types (floating point due special handling of +/-0.0 and user defined types) we delegate to hash specialization. This is automatically picked up by time_point, that delegates to hasher of duration. Similarly for leap_second that is specified to use integer durations, we simply hash representations of date() and value(). Finally zoned_time in addition to handling integer durations as described above, we also use __int_hash for const time_zone* (if used), as hash have similar problems as hash specialization for integers. This is limited only to _TimeZonePtr being const time_zone* (default), as user can define hash specializations for raw pointers to they zones. As accessing the representation for duration requires calling count() method that returns a copy of representation by value, the noexcept specification of the hasher needs to take into consideration copy constructor of duration. Similar reasoning applies for time_since_epoch for time_points, and get_sys_time, get_time_zone for zoned_time. For all this cases we use internal __is_nothrow_copy_hashable concept. Finally support for zoned_time is provided only for CXX11 string ABI, __cpp_lib_chrono feature test macro cannot be bumped if COW string are used. To indicate presence of hasher for remaining types this patch also bumps the internal __glibcxx_chrono_cxx20 macro, and uses it as guard to new features. PR libstdc++/110357 libstdc++-v3/ChangeLog: * include/bits/version.def (chrono, chrono_cxx20): Bump values. * include/bits/version.h: Regenerate. * include/std/chrono (__is_nothrow_copy_hashable) (chrono::__pack_ints, chrono::__as_int, chrono::__int_hash) (chrono::__hash): Define. (std::hash): Define partial specialization for duration, time_point, and zoned_time, and full specializations for calendar types and leap_second. (std::__is_fast_hash): Define partial specializations for duration, time_point, zoned_time. * testsuite/std/time/hash.cc: New test. Reviewed-by: Jonathan Wakely Co-authored-by: Giuseppe D'Angelo Signed-off-by: Tomasz Kamiński Signed-off-by: Giuseppe D'Angelo --- libstdc++-v3/include/bits/version.def | 13 +- libstdc++-v3/include/bits/version.h | 13 +- libstdc++-v3/include/std/chrono | 324 ++++++++++++++++++++++++ libstdc++-v3/testsuite/std/time/hash.cc | 280 ++++++++++++++++++++ 4 files changed, 627 insertions(+), 3 deletions(-) create mode 100644 libstdc++-v3/testsuite/std/time/hash.cc diff --git a/libstdc++-v3/include/bits/version.def b/libstdc++-v3/include/bits/version.def index 29ecf15c7e39..1fde9eef9d36 100644 --- a/libstdc++-v3/include/bits/version.def +++ b/libstdc++-v3/include/bits/version.def @@ -593,6 +593,12 @@ ftms = { ftms = { name = chrono; + values = { + v = 202306; + cxxmin = 26; + hosted = yes; + cxx11abi = yes; + }; values = { v = 201907; cxxmin = 20; @@ -607,8 +613,13 @@ ftms = { }; ftms = { - // Unofficial macro for C++20 chrono features supported for old string ABI. + // Unofficial macro for chrono features supported for old string ABI. name = chrono_cxx20; + values = { + v = 202306; + cxxmin = 26; + no_stdname = yes; + }; values = { v = 201800; cxxmin = 20; diff --git a/libstdc++-v3/include/bits/version.h b/libstdc++-v3/include/bits/version.h index 5901d27113d7..2ebc48b234b9 100644 --- a/libstdc++-v3/include/bits/version.h +++ b/libstdc++-v3/include/bits/version.h @@ -666,7 +666,12 @@ #undef __glibcxx_want_boyer_moore_searcher #if !defined(__cpp_lib_chrono) -# if (__cplusplus >= 202002L) && _GLIBCXX_USE_CXX11_ABI && _GLIBCXX_HOSTED +# if (__cplusplus > 202302L) && _GLIBCXX_USE_CXX11_ABI && _GLIBCXX_HOSTED +# define __glibcxx_chrono 202306L +# if defined(__glibcxx_want_all) || defined(__glibcxx_want_chrono) +# define __cpp_lib_chrono 202306L +# endif +# elif (__cplusplus >= 202002L) && _GLIBCXX_USE_CXX11_ABI && _GLIBCXX_HOSTED # define __glibcxx_chrono 201907L # if defined(__glibcxx_want_all) || defined(__glibcxx_want_chrono) # define __cpp_lib_chrono 201907L @@ -681,7 +686,11 @@ #undef __glibcxx_want_chrono #if !defined(__cpp_lib_chrono_cxx20) -# if (__cplusplus >= 202002L) +# if (__cplusplus > 202302L) +# define __glibcxx_chrono_cxx20 202306L +# if defined(__glibcxx_want_all) || defined(__glibcxx_want_chrono_cxx20) +# endif +# elif (__cplusplus >= 202002L) # define __glibcxx_chrono_cxx20 201800L # if defined(__glibcxx_want_all) || defined(__glibcxx_want_chrono_cxx20) # endif diff --git a/libstdc++-v3/include/std/chrono b/libstdc++-v3/include/std/chrono index f0207eaae8e0..0cfad2ce1d0c 100644 --- a/libstdc++-v3/include/std/chrono +++ b/libstdc++-v3/include/std/chrono @@ -64,6 +64,9 @@ # include # include #endif +#if __glibcxx_chrono_cxx20 >= 202306L // C++26 +# include +#endif namespace std _GLIBCXX_VISIBILITY(default) { @@ -3322,6 +3325,327 @@ namespace __detail #endif // C++20 } // namespace chrono +#if __glibcxx_chrono_cxx20 >= 202306 // C++26 + // Hash support [time.hash] + + template + concept __is_nothrow_copy_hashable = requires(const _Tp& __t) { + { hash<_Tp>{}(_Tp(__t)) } noexcept -> same_as; + }; + + namespace chrono { + + template + [[__gnu__::__always_inline__]] + constexpr auto + __pack_ints(_T1 __v1, _Ts... __vs) + { + using _ResT = decltype([] { + constexpr size_t __tsize = (sizeof(_T1) + ... + sizeof(_Ts)); + if constexpr (__tsize <= 1) + return static_cast(0); + else if constexpr (__tsize <= 2) + return static_cast<__UINT16_TYPE__>(0); + else if constexpr (__tsize <= 4) + return static_cast<__UINT32_TYPE__>(0); + else if constexpr (__tsize <= 8) + return static_cast<__UINT64_TYPE__>(0); + else + static_assert(__tsize <= 8); + }()); + + _ResT __res = __v1; + ((__res = (__res <= (sizeof(_Ts) * __CHAR_BIT__) | _ResT(__vs))), ...); + return __res; + } + + template + [[__gnu__::__always_inline__]] + constexpr auto + __as_int(_Tp __val) + { + if constexpr (is_same_v<_Tp, year>) + return static_cast(static_cast(__val)); + else if constexpr (is_same_v<_Tp, month> || is_same_v<_Tp, day>) + return static_cast(static_cast(__val)); + else if constexpr (is_same_v<_Tp, weekday>) + return static_cast(__val.c_encoding()); + else if constexpr (is_same_v<_Tp, weekday_indexed>) + return __pack_ints(chrono::__as_int(__val.weekday()), + static_cast(__val.index())); + else if constexpr (is_same_v<_Tp, weekday_last>) + return chrono::__as_int(__val.weekday()); + else + static_assert(false); + } + + template + size_t + __int_hash(_Arg __arg, _Args... __args) + { + static_assert((is_integral_v<_Arg> && ... && is_integral_v<_Args>)); + + // TODO consider using a better quality hasher + using _Hasher = _Hash_impl; + size_t __result = _Hasher::hash(__arg); + ((__result = _Hasher::__hash_combine(__args, __result)), ...); + return __result; + } + + template + [[__gnu__::__always_inline__]] + inline size_t + __hash(_Tps... __vals) + { + if constexpr (sizeof...(_Tps) == 1) + return chrono::__int_hash(chrono::__as_int(__vals)...); + else + { + auto __packed = chrono::__pack_ints(chrono::__as_int(__vals)...); + return chrono::__int_hash(__packed); + } + } + } // namespace chrono + + // duration + template + requires __is_hash_enabled_for<_Rep> + struct hash> + { + size_t + operator()(const chrono::duration<_Rep, _Period>& __val) const + noexcept(__is_nothrow_copy_hashable<_Rep>) + { + if constexpr (is_integral_v<_Rep>) + return chrono::__int_hash(__val.count()); + else + return hash<_Rep>{}(__val.count()); + } + }; + + template + struct __is_fast_hash>> + : __is_fast_hash> + {}; + + // time_point + template + requires __is_hash_enabled_for<_Dur> + struct hash> + { + size_t + operator()(const chrono::time_point<_Clock, _Dur>& __val) const + noexcept(__is_nothrow_copy_hashable<_Dur>) + { return hash<_Dur>{}(__val.time_since_epoch()); } + }; + + template + struct __is_fast_hash>> + : __is_fast_hash> + {}; + + // day + template<> + struct hash + { + size_t + operator()(chrono::day __val) const noexcept + { return chrono::__hash(__val); } + }; + + // month + template<> + struct hash + { + size_t + operator()(chrono::month __val) const noexcept + { return chrono::__hash(__val); } + }; + + // year + template<> + struct hash + { + size_t + operator()(chrono::year __val) const noexcept + { return chrono::__hash(__val); } + }; + + // weekday + template<> + struct hash + { + size_t + operator()(chrono::weekday __val) const noexcept + { return chrono::__hash(__val); } + }; + + // weekday_indexed + template<> + struct hash + { + size_t + operator()(chrono::weekday_indexed __val) const noexcept + { return chrono::__hash(__val); } + }; + + // weekday_last + template<> + struct hash + { + size_t + operator()(chrono::weekday_last __val) const noexcept + { return chrono::__hash(__val); } + }; + + // month_day + template<> + struct hash + { + size_t + operator()(chrono::month_day __val) const noexcept + { return chrono::__hash(__val.month(), __val.day()); } + }; + + // month_day_last + template<> + struct hash + { + size_t operator()(chrono::month_day_last __val) const noexcept + { return chrono::__hash(__val.month()); } + }; + + // month_weekday + template<> + struct hash + { + size_t + operator()(chrono::month_weekday __val) const noexcept + { return chrono::__hash(__val.month(), __val.weekday_indexed()); } + }; + + // month_weekday_last + template<> + struct hash + { + size_t + operator()(chrono::month_weekday_last __val) const noexcept + { return chrono::__hash(__val.month(), __val.weekday_last()); } + }; + + // year_month + template<> + struct hash + { + size_t + operator()(chrono::year_month __val) const noexcept + { return chrono::__hash(__val.year(), __val.month()); } + }; + + // year_month_day + template<> + struct hash + { + size_t + operator()(chrono::year_month_day __val) const noexcept + { return chrono::__hash(__val.year(), __val.month(), __val.day()); } + }; + + // year_month_day_last + template<> + struct hash + { + size_t + operator()(chrono::year_month_day_last __val) const noexcept + { return chrono::__hash(__val.year(), __val.month()); } + }; + + // year_month_weekday + template<> + struct hash + { + size_t + operator()(chrono::year_month_weekday __val) const noexcept + { + return chrono::__hash(__val.year(), __val.month(), + __val.weekday_indexed()); + } + }; + + // year_month_weekday_last + template<> + struct hash + { + size_t + operator()(chrono::year_month_weekday_last __val) const noexcept + { + return chrono::__hash(__val.year(), __val.month(), + __val.weekday_last()); + } + }; + +#if _GLIBCXX_HOSTED +#if _GLIBCXX_USE_CXX11_ABI || ! _GLIBCXX_USE_DUAL_ABI + // zoned_time + template + requires __is_hash_enabled_for< + typename chrono::zoned_time<_Duration, _TimeZonePtr>::duration> + && __is_hash_enabled_for<_TimeZonePtr> + struct hash> + { + private: + using _ActualDuration = + typename chrono::zoned_time<_Duration, _TimeZonePtr>::duration; + + public: + size_t + operator()(const chrono::zoned_time<_Duration, _TimeZonePtr>& __val) const + noexcept(__is_nothrow_copy_hashable<_ActualDuration> + && __is_nothrow_copy_hashable<_TimeZonePtr>) + { + const auto __iduration = [&] { + const _ActualDuration __sd = __val.get_sys_time().time_since_epoch(); + if constexpr (is_integral_v) + return __sd.count(); + else + return hash<_ActualDuration>{}(__sd); + }(); + + const auto __izone = [&] { + const _TimeZonePtr __tz = __val.get_time_zone(); + if constexpr (is_same_v<_TimeZonePtr, const chrono::time_zone*>) + return reinterpret_cast(__tz); + else + return hash<_TimeZonePtr>{}(__tz); + }(); + + return chrono::__int_hash(__iduration, __izone); + } + }; + + template + struct __is_fast_hash>> + : __and_<__is_fast_hash::duration>>, + __is_fast_hash>> + {}; + + // leap_second + template<> + struct hash + { + size_t + operator()(chrono::leap_second __val) const noexcept + { + return chrono::__int_hash( + __val.date().time_since_epoch().count(), + __val.value().count()); + } + }; +#endif // _GLIBCXX_USE_CXX11_ABI || ! _GLIBCXX_USE_DUAL_ABI +#endif // _GLIBCXX_HOSTED +#endif // __glibcxx_chrono_cxx20 >= 202306 + #ifdef __glibcxx_chrono_cxx20 inline namespace literals { diff --git a/libstdc++-v3/testsuite/std/time/hash.cc b/libstdc++-v3/testsuite/std/time/hash.cc new file mode 100644 index 000000000000..ed9139bb8108 --- /dev/null +++ b/libstdc++-v3/testsuite/std/time/hash.cc @@ -0,0 +1,280 @@ +// { dg-do run { target c++26 } } + +#include +#include +#include +#include + +#if _GLIBCXX_USE_CXX11_ABI +# if !defined(__cpp_lib_chrono) +# error "__cpp_lib_chrono not defined" +# elif __cpp_lib_chrono < 202306L +# error "Wrong value for __cpp_lib_chrono" +# endif +#endif + +template +struct arithmetic_wrapper +{ + arithmetic_wrapper() = default; + arithmetic_wrapper(T t) : t(t) {} + friend bool operator==(arithmetic_wrapper, arithmetic_wrapper) = default; + T t; +}; + +template +struct std::hash> +{ + size_t operator()(arithmetic_wrapper val) const noexcept + { return std::hash{}(val.t); } +}; + +template +struct non_hashable_arithmetic_wrapper +{ + non_hashable_arithmetic_wrapper() = default; + non_hashable_arithmetic_wrapper(T t) : t(t) {} + friend bool operator==(non_hashable_arithmetic_wrapper, non_hashable_arithmetic_wrapper) = default; + T t; +}; + +template +constexpr bool is_hash_poisoned = !std::is_default_constructible_v>; + +template +void test_unordered_set(const T& t) +{ + std::unordered_set set; + + set.insert(t); + VERIFY(set.size() == 1); + VERIFY(set.contains(t)); + + set.erase(t); + VERIFY(set.size() == 0); + VERIFY(!set.contains(t)); +} + +template +void test_hash(const T& t) +{ + static_assert(noexcept(std::hash{}(t))); + static_assert(std::__is_fast_hash::value); + test_unordered_set(t); +} + +void test01() +{ + using namespace std::chrono; + using namespace std::literals::chrono_literals; + + // duration + test_hash(-999s); + test_hash(1234ms); +#if defined __SIZEOF_INT128__ + test_hash(duration<__int128>(123456)); +#endif + test_hash(duration(123.45)); + using AWint = arithmetic_wrapper; + test_hash(duration(AWint(1234))); + using AWdouble = arithmetic_wrapper; + test_hash(duration(AWdouble(123.45))); + + // time_point + test_hash(sys_seconds(1234s)); +#if defined __SIZEOF_INT128__ + test_hash(sys_time>(duration<__int128>(123456))); +#endif + test_hash(sys_time>(duration(123.45))); + test_hash(utc_seconds(1234s)); + test_hash(local_days(days(1234))); + test_hash(system_clock::now()); + test_hash(steady_clock::now()); + test_hash(utc_clock::now()); + test_hash(gps_clock::now()); + + // day + test_hash(1d); + test_hash(0d); + test_hash(255d); + test_hash(1234d); + test_hash(day(UINT_MAX)); + + // month + test_hash(January); + test_hash(September); + test_hash(month(0u)); + test_hash(month(255u)); + test_hash(month(1234u)); + test_hash(month(UINT_MAX)); + + // year + test_hash(2024y); + test_hash(0y); + test_hash(year::min()); + test_hash(year::max()); + test_hash(year(INT_MAX)); + test_hash(year(INT_MIN)); + + // weekday + test_hash(Monday); + test_hash(Thursday); + test_hash(weekday(255u)); + test_hash(weekday(UINT_MAX)); + + // weekday_indexed + test_hash(Monday[0u]); + test_hash(Monday[7u]); + test_hash(Monday[1234u]); + test_hash(weekday(1234u)[0u]); + + // weekday_last + test_hash(Monday[last]); + test_hash(Friday[last]); + test_hash(weekday(1234u)[last]); + + // month_day + test_hash(March / 3); + test_hash(March / 31); + test_hash(February / 31); + test_hash(February / 1234); + test_hash(month(1234u) / 1); + + // month_day_last + test_hash(March / last); + test_hash(month(1234u) / last); + + // month_weekday + test_hash(March / Tuesday[2u]); + test_hash(month(1234u) / Tuesday[2u]); + test_hash(March / weekday(1234u)[2u]); + test_hash(March / Tuesday[1234u]); + + // month_weekday_last + test_hash(April / Sunday[last]); + test_hash(month(1234u) / Tuesday[last]); + test_hash(April / weekday(1234u)[last]); + + // year_month + test_hash(2024y / August); + test_hash(1'000'000y / August); + test_hash(2024y / month(1234u)); + + // year_month_day + test_hash(2024y / August / 31); + test_hash(-10y / March / 5); + test_hash(2024y / February / 31); + test_hash(1'000'000y / March / 5); + test_hash(2024y / month(1234u) / 5); + test_hash(2024y / March / 1234); + + // year_month_day_last + test_hash(2024y / August / last); + test_hash(1'000'000y / August / last); + test_hash(2024y / month(1234u) / last); + + // year_month_weekday + test_hash(2024y / August / Tuesday[2u]); + test_hash(-10y / August / Tuesday[2u]); + test_hash(1'000'000y / August / Tuesday[2u]); + test_hash(2024y / month(1234u) / Tuesday[2u]); + test_hash(2024y / August / weekday(1234u)[2u]); + test_hash(2024y / August / Tuesday[1234u]); + + // year_month_weekday_last + test_hash(2024y / August / Tuesday[last]); + test_hash(-10y / August / Tuesday[last]); + test_hash(1'000'000y / August / Tuesday[last]); + test_hash(2024y / month(1234u) / Tuesday[last]); + test_hash(2024y / August / weekday(1234u)[last]); + +#if _GLIBCXX_USE_CXX11_ABI + // zoned_time + test_hash(zoned_seconds("Europe/Rome", sys_seconds(1234s))); + test_hash(zoned_time("Europe/Rome", system_clock::now())); + + // leap_second + for (leap_second l : get_tzdb().leap_seconds) + test_hash(l); +#endif +} + +void test02() +{ + using namespace std::chrono; + using namespace std::literals::chrono_literals; + + { + std::unordered_set set; + set.insert(2000ms); + VERIFY(set.contains(2000ms)); + VERIFY(set.contains(2s)); + VERIFY(!set.contains(1234ms)); + VERIFY(!set.contains(1234s)); + } + { + using TP = sys_time; + std::unordered_set set; + set.insert(TP(2000ms)); + VERIFY(set.contains(TP(2000ms))); + VERIFY(set.contains(sys_seconds(2s))); + VERIFY(!set.contains(TP(1234ms))); + VERIFY(!set.contains(sys_seconds(1234s))); + } +} + +void test03() +{ + using namespace std::chrono; + + static constexpr + auto test_hash = [](const T& t) + { + static_assert(noexcept(std::hash{}(t))); + }; + + static constexpr + auto test = [](const D& d) + { + test_hash(d); + test_hash(sys_time(d)); +#if _GLIBCXX_USE_CXX11_ABI + test_hash(zoned_time(sys_time(d))); +#endif + }; + + test(duration(123)); + test(duration>(123)); + test(duration>(123)); + test(duration(123.456)); + test(duration>(arithmetic_wrapper(123))); +} + +void test04() +{ + using namespace std::chrono; + + static_assert(!is_hash_poisoned>); + static_assert(!is_hash_poisoned>); + static_assert(!is_hash_poisoned>>); + static_assert(!is_hash_poisoned>>); + static_assert(is_hash_poisoned>>); + static_assert(is_hash_poisoned>>); + +#if _GLIBCXX_USE_CXX11_ABI + static_assert(!is_hash_poisoned>>); + static_assert(!is_hash_poisoned>>); + static_assert(!is_hash_poisoned>>>); + static_assert(!is_hash_poisoned>>>); + static_assert(is_hash_poisoned>>>); + static_assert(is_hash_poisoned>>>); +#endif +} + +int main() +{ + test01(); + test02(); + test03(); + test04(); +} From 7485f4a7dc942b9c0d9986d1a4f7a5de6ce83a60 Mon Sep 17 00:00:00 2001 From: Soumya AR Date: Thu, 10 Jul 2025 03:52:00 -0700 Subject: [PATCH 026/373] aarch64 + arm: Remove const keyword from tune_params members and nested members To allow runtime updates to tuning parameters, the const keyword is removed from the members of the tune_params structure and the members of its nested structures. Since this patch also touches tuning structures in the arm backend, it was bootstrapped on aarch64-linux-gnu as well as arm-linux-gnueabihf. Signed-off-by: Soumya AR gcc/ChangeLog: * config/aarch64/aarch64-protos.h (struct scale_addr_mode_cost): Remove const from struct members. (struct cpu_addrcost_table): Likewise. (struct cpu_regmove_cost): Likewise. (struct simd_vec_cost): Likewise. (struct sve_vec_cost): Likewise. (struct aarch64_base_vec_issue_info): Likewise. (struct aarch64_simd_vec_issue_info): Likewise. (struct aarch64_sve_vec_issue_info): Likewise. (struct aarch64_vec_issue_info): Likewise. (struct cpu_vector_cost): Likewise. (struct cpu_branch_cost): Likewise. (struct cpu_approx_modes): Likewise. (struct cpu_prefetch_tune): Likewise. * config/arm/aarch-common-protos.h (struct alu_cost_table): Remove const from struct members. (struct mult_cost_table): Likewise. (struct mem_cost_table): Likewise. (struct fp_cost_table): Likewise. (struct vector_cost_table): Likewise. (struct cpu_cost_table): Likewise. --- gcc/config/aarch64/aarch64-protos.h | 164 +++++++++++++-------------- gcc/config/arm/aarch-common-protos.h | 128 ++++++++++----------- 2 files changed, 146 insertions(+), 146 deletions(-) diff --git a/gcc/config/aarch64/aarch64-protos.h b/gcc/config/aarch64/aarch64-protos.h index 68f28bdcae89..c83d1ed910fe 100644 --- a/gcc/config/aarch64/aarch64-protos.h +++ b/gcc/config/aarch64/aarch64-protos.h @@ -166,88 +166,88 @@ enum aarch64_salt_type { struct scale_addr_mode_cost { - const int hi; - const int si; - const int di; - const int ti; + int hi; + int si; + int di; + int ti; }; /* Additional cost for addresses. */ struct cpu_addrcost_table { - const struct scale_addr_mode_cost addr_scale_costs; - const int pre_modify; - const int post_modify; - const int post_modify_ld3_st3; - const int post_modify_ld4_st4; - const int register_offset; - const int register_sextend; - const int register_zextend; - const int imm_offset; + struct scale_addr_mode_cost addr_scale_costs; + int pre_modify; + int post_modify; + int post_modify_ld3_st3; + int post_modify_ld4_st4; + int register_offset; + int register_sextend; + int register_zextend; + int imm_offset; }; /* Additional costs for register copies. Cost is for one register. */ struct cpu_regmove_cost { - const int GP2GP; - const int GP2FP; - const int FP2GP; - const int FP2FP; + int GP2GP; + int GP2FP; + int FP2GP; + int FP2FP; }; struct simd_vec_cost { /* Cost of any integer vector operation, excluding the ones handled specially below. */ - const int int_stmt_cost; + int int_stmt_cost; /* Cost of any fp vector operation, excluding the ones handled specially below. */ - const int fp_stmt_cost; + int fp_stmt_cost; /* Per-vector cost of permuting vectors after an LD2, LD3 or LD4, as well as the per-vector cost of permuting vectors before an ST2, ST3 or ST4. */ - const int ld2_st2_permute_cost; - const int ld3_st3_permute_cost; - const int ld4_st4_permute_cost; + int ld2_st2_permute_cost; + int ld3_st3_permute_cost; + int ld4_st4_permute_cost; /* Cost of a permute operation. */ - const int permute_cost; + int permute_cost; /* Cost of reductions for various vector types: iN is for N-bit integer elements and fN is for N-bit floating-point elements. We need to single out the element type because it affects the depth of the reduction. */ - const int reduc_i8_cost; - const int reduc_i16_cost; - const int reduc_i32_cost; - const int reduc_i64_cost; - const int reduc_f16_cost; - const int reduc_f32_cost; - const int reduc_f64_cost; + int reduc_i8_cost; + int reduc_i16_cost; + int reduc_i32_cost; + int reduc_i64_cost; + int reduc_f16_cost; + int reduc_f32_cost; + int reduc_f64_cost; /* Additional cost of storing a single vector element, on top of the normal cost of a scalar store. */ - const int store_elt_extra_cost; + int store_elt_extra_cost; /* Cost of a vector-to-scalar operation. */ - const int vec_to_scalar_cost; + int vec_to_scalar_cost; /* Cost of a scalar-to-vector operation. */ - const int scalar_to_vec_cost; + int scalar_to_vec_cost; /* Cost of an aligned vector load. */ - const int align_load_cost; + int align_load_cost; /* Cost of an unaligned vector load. */ - const int unalign_load_cost; + int unalign_load_cost; /* Cost of an unaligned vector store. */ - const int unalign_store_cost; + int unalign_store_cost; /* Cost of a vector store. */ - const int store_cost; + int store_cost; }; typedef struct simd_vec_cost advsimd_vec_cost; @@ -280,27 +280,27 @@ struct sve_vec_cost : simd_vec_cost /* The cost of a vector-to-scalar CLASTA or CLASTB instruction, with the scalar being stored in FP registers. This cost is assumed to be a cycle latency. */ - const int clast_cost; + int clast_cost; /* The costs of FADDA for the three data types that it supports. These costs are assumed to be cycle latencies. */ - const int fadda_f16_cost; - const int fadda_f32_cost; - const int fadda_f64_cost; + int fadda_f16_cost; + int fadda_f32_cost; + int fadda_f64_cost; /* The cost of a gather load instruction. The x32 value is for loads of 32-bit elements and the x64 value is for loads of 64-bit elements. */ - const unsigned int gather_load_x32_cost; - const unsigned int gather_load_x64_cost; + unsigned int gather_load_x32_cost; + unsigned int gather_load_x64_cost; /* Additional loop initialization cost of using a gather load instruction. The x32 value is for loads of 32-bit elements and the x64 value is for loads of 64-bit elements. */ - const int gather_load_x32_init_cost; - const int gather_load_x64_init_cost; + int gather_load_x32_init_cost; + int gather_load_x64_init_cost; /* The per-element cost of a scatter store. */ - const int scatter_store_elt_cost; + int scatter_store_elt_cost; }; /* Base information about how the CPU issues code, containing @@ -319,10 +319,10 @@ struct sve_vec_cost : simd_vec_cost struct aarch64_base_vec_issue_info { /* How many loads and stores can be issued per cycle. */ - const unsigned int loads_stores_per_cycle; + unsigned int loads_stores_per_cycle; /* How many stores can be issued per cycle. */ - const unsigned int stores_per_cycle; + unsigned int stores_per_cycle; /* How many integer or FP/SIMD operations can be issued per cycle. @@ -338,7 +338,7 @@ struct aarch64_base_vec_issue_info This is not very precise, but it's only meant to be a heuristic. We could certainly try to do better in future if there's an example of something that would benefit. */ - const unsigned int general_ops_per_cycle; + unsigned int general_ops_per_cycle; /* How many FP/SIMD operations to count for a floating-point or vector load operation. @@ -347,7 +347,7 @@ struct aarch64_base_vec_issue_info been loaded from memory, these values apply to each individual load. When using an SVE gather load, the values apply to each element of the gather. */ - const unsigned int fp_simd_load_general_ops; + unsigned int fp_simd_load_general_ops; /* How many FP/SIMD operations to count for a floating-point or vector store operation. @@ -355,7 +355,7 @@ struct aarch64_base_vec_issue_info When storing individual elements of an Advanced SIMD vector out to memory, these values apply to each individual store. When using an SVE scatter store, these values apply to each element of the scatter. */ - const unsigned int fp_simd_store_general_ops; + unsigned int fp_simd_store_general_ops; }; using aarch64_scalar_vec_issue_info = aarch64_base_vec_issue_info; @@ -382,9 +382,9 @@ struct aarch64_simd_vec_issue_info : aarch64_base_vec_issue_info load ops: 3 general ops: 3 * (fp_simd_load_general_ops + ld3_st3_general_ops). */ - const unsigned int ld2_st2_general_ops; - const unsigned int ld3_st3_general_ops; - const unsigned int ld4_st4_general_ops; + unsigned int ld2_st2_general_ops; + unsigned int ld3_st3_general_ops; + unsigned int ld4_st4_general_ops; }; using aarch64_advsimd_vec_issue_info = aarch64_simd_vec_issue_info; @@ -411,19 +411,19 @@ struct aarch64_sve_vec_issue_info : aarch64_simd_vec_issue_info {} /* How many predicate operations can be issued per cycle. */ - const unsigned int pred_ops_per_cycle; + unsigned int pred_ops_per_cycle; /* How many predicate operations are generated by a WHILExx instruction. */ - const unsigned int while_pred_ops; + unsigned int while_pred_ops; /* How many predicate operations are generated by an integer comparison instruction. */ - const unsigned int int_cmp_pred_ops; + unsigned int int_cmp_pred_ops; /* How many predicate operations are generated by a floating-point comparison instruction. */ - const unsigned int fp_cmp_pred_ops; + unsigned int fp_cmp_pred_ops; /* How many general and predicate operations are generated by each pair of elements in a gather load or scatter store. These values apply @@ -433,38 +433,38 @@ struct aarch64_sve_vec_issue_info : aarch64_simd_vec_issue_info The reason for using pairs is that that is the largest possible granule size for 128-bit SVE, which can load and store 2 64-bit elements or 4 32-bit elements. */ - const unsigned int gather_scatter_pair_general_ops; - const unsigned int gather_scatter_pair_pred_ops; + unsigned int gather_scatter_pair_general_ops; + unsigned int gather_scatter_pair_pred_ops; }; /* Information related to instruction issue for a particular CPU. */ struct aarch64_vec_issue_info { - const aarch64_base_vec_issue_info *const scalar; - const aarch64_simd_vec_issue_info *const advsimd; - const aarch64_sve_vec_issue_info *const sve; + const aarch64_base_vec_issue_info *scalar; + const aarch64_simd_vec_issue_info *advsimd; + const aarch64_sve_vec_issue_info *sve; }; /* Cost for vector insn classes. */ struct cpu_vector_cost { /* Cost of any integer scalar operation, excluding load and store. */ - const int scalar_int_stmt_cost; + int scalar_int_stmt_cost; /* Cost of any fp scalar operation, excluding load and store. */ - const int scalar_fp_stmt_cost; + int scalar_fp_stmt_cost; /* Cost of a scalar load. */ - const int scalar_load_cost; + int scalar_load_cost; /* Cost of a scalar store. */ - const int scalar_store_cost; + int scalar_store_cost; /* Cost of a taken branch. */ - const int cond_taken_branch_cost; + int cond_taken_branch_cost; /* Cost of a not-taken branch. */ - const int cond_not_taken_branch_cost; + int cond_not_taken_branch_cost; /* Cost of an Advanced SIMD operations. */ const advsimd_vec_cost *advsimd; @@ -473,14 +473,14 @@ struct cpu_vector_cost const sve_vec_cost *sve; /* Issue information, or null if none is provided. */ - const aarch64_vec_issue_info *const issue_info; + const aarch64_vec_issue_info *issue_info; }; /* Branch costs. */ struct cpu_branch_cost { - const int predictable; /* Predictable branch or optimizing for size. */ - const int unpredictable; /* Unpredictable branch or optimizing for speed. */ + int predictable; /* Predictable branch or optimizing for size. */ + int unpredictable; /* Unpredictable branch or optimizing for speed. */ }; /* Control approximate alternatives to certain FP operators. */ @@ -497,25 +497,25 @@ struct cpu_branch_cost /* Allowed modes for approximations. */ struct cpu_approx_modes { - const uint64_t division; /* Division. */ - const uint64_t sqrt; /* Square root. */ - const uint64_t recip_sqrt; /* Reciprocal square root. */ + uint64_t division; /* Division. */ + uint64_t sqrt; /* Square root. */ + uint64_t recip_sqrt; /* Reciprocal square root. */ }; /* Cache prefetch settings for prefetch-loop-arrays. */ struct cpu_prefetch_tune { - const int num_slots; - const int l1_cache_size; - const int l1_cache_line_size; - const int l2_cache_size; + int num_slots; + int l1_cache_size; + int l1_cache_line_size; + int l2_cache_size; /* Whether software prefetch hints should be issued for non-constant strides. */ - const bool prefetch_dynamic_strides; + bool prefetch_dynamic_strides; /* The minimum constant stride beyond which we should use prefetch hints for. */ - const int minimum_stride; - const int default_opt_level; + int minimum_stride; + int default_opt_level; }; /* Model the costs for loads/stores for the register allocators so that it can diff --git a/gcc/config/arm/aarch-common-protos.h b/gcc/config/arm/aarch-common-protos.h index 077387b9f902..1bafdbaa72f7 100644 --- a/gcc/config/arm/aarch-common-protos.h +++ b/gcc/config/arm/aarch-common-protos.h @@ -57,33 +57,33 @@ extern bool aarch_fun_is_indirect_return (rtx_insn *); Costs may not have a negative value. */ struct alu_cost_table { - const int arith; /* ADD/SUB. */ - const int logical; /* AND/ORR/EOR/BIC, etc. */ - const int shift; /* Simple shift. */ - const int shift_reg; /* Simple shift by reg. */ - const int arith_shift; /* Additional when arith also shifts... */ - const int arith_shift_reg; /* ... and when the shift is by a reg. */ - const int log_shift; /* Additional when logic also shifts... */ - const int log_shift_reg; /* ... and when the shift is by a reg. */ - const int extend; /* Zero/sign extension. */ - const int extend_arith; /* Extend and arith. */ - const int bfi; /* Bit-field insert. */ - const int bfx; /* Bit-field extraction. */ - const int clz; /* Count Leading Zeros. */ - const int rev; /* Reverse bits/bytes. */ - const int non_exec; /* Extra cost when not executing insn. */ - const bool non_exec_costs_exec; /* True if non-execution must add the exec + int arith; /* ADD/SUB. */ + int logical; /* AND/ORR/EOR/BIC, etc. */ + int shift; /* Simple shift. */ + int shift_reg; /* Simple shift by reg. */ + int arith_shift; /* Additional when arith also shifts... */ + int arith_shift_reg; /* ... and when the shift is by a reg. */ + int log_shift; /* Additional when logic also shifts... */ + int log_shift_reg; /* ... and when the shift is by a reg. */ + int extend; /* Zero/sign extension. */ + int extend_arith; /* Extend and arith. */ + int bfi; /* Bit-field insert. */ + int bfx; /* Bit-field extraction. */ + int clz; /* Count Leading Zeros. */ + int rev; /* Reverse bits/bytes. */ + int non_exec; /* Extra cost when not executing insn. */ + bool non_exec_costs_exec; /* True if non-execution must add the exec cost. */ }; struct mult_cost_table { - const int simple; - const int flag_setting; /* Additional cost if multiply sets flags. */ - const int extend; - const int add; - const int extend_add; - const int idiv; + int simple; + int flag_setting; /* Additional cost if multiply sets flags. */ + int extend; + int add; + int extend_add; + int idiv; }; /* Calculations of LDM costs are complex. We assume an initial cost @@ -98,60 +98,60 @@ struct mult_cost_table */ struct mem_cost_table { - const int load; - const int load_sign_extend; /* Additional to load cost. */ - const int ldrd; /* Cost of LDRD. */ - const int ldm_1st; - const int ldm_regs_per_insn_1st; - const int ldm_regs_per_insn_subsequent; - const int loadf; /* SFmode. */ - const int loadd; /* DFmode. */ - const int load_unaligned; /* Extra for unaligned loads. */ - const int store; - const int strd; - const int stm_1st; - const int stm_regs_per_insn_1st; - const int stm_regs_per_insn_subsequent; - const int storef; /* SFmode. */ - const int stored; /* DFmode. */ - const int store_unaligned; /* Extra for unaligned stores. */ - const int loadv; /* Vector load. */ - const int storev; /* Vector store. */ + int load; + int load_sign_extend; /* Additional to load cost. */ + int ldrd; /* Cost of LDRD. */ + int ldm_1st; + int ldm_regs_per_insn_1st; + int ldm_regs_per_insn_subsequent; + int loadf; /* SFmode. */ + int loadd; /* DFmode. */ + int load_unaligned; /* Extra for unaligned loads. */ + int store; + int strd; + int stm_1st; + int stm_regs_per_insn_1st; + int stm_regs_per_insn_subsequent; + int storef; /* SFmode. */ + int stored; /* DFmode. */ + int store_unaligned; /* Extra for unaligned stores. */ + int loadv; /* Vector load. */ + int storev; /* Vector store. */ }; struct fp_cost_table { - const int div; - const int mult; - const int mult_addsub; /* Non-fused. */ - const int fma; /* Fused. */ - const int addsub; - const int fpconst; /* Immediate. */ - const int neg; /* NEG and ABS. */ - const int compare; - const int widen; /* Widen to this size. */ - const int narrow; /* Narrow from this size. */ - const int toint; - const int fromint; - const int roundint; /* V8 round to integral, remains FP format. */ + int div; + int mult; + int mult_addsub; /* Non-fused. */ + int fma; /* Fused. */ + int addsub; + int fpconst; /* Immediate. */ + int neg; /* NEG and ABS. */ + int compare; + int widen; /* Widen to this size. */ + int narrow; /* Narrow from this size. */ + int toint; + int fromint; + int roundint; /* V8 round to integral, remains FP format. */ }; struct vector_cost_table { - const int alu; - const int mult; - const int movi; - const int dup; - const int extract; + int alu; + int mult; + int movi; + int dup; + int extract; }; struct cpu_cost_table { - const struct alu_cost_table alu; - const struct mult_cost_table mult[2]; /* SImode and DImode. */ - const struct mem_cost_table ldst; - const struct fp_cost_table fp[2]; /* SFmode and DFmode. */ - const struct vector_cost_table vect; + struct alu_cost_table alu; + struct mult_cost_table mult[2]; /* SImode and DImode. */ + struct mem_cost_table ldst; + struct fp_cost_table fp[2]; /* SFmode and DFmode. */ + struct vector_cost_table vect; }; rtx_insn *arm_md_asm_adjust (vec &outputs, vec & /*inputs*/, From 59f37983222d869b6213e1d8690b4deb0b6dc874 Mon Sep 17 00:00:00 2001 From: Soumya AR Date: Fri, 11 Jul 2025 05:28:17 -0700 Subject: [PATCH 027/373] aarch64: Enable dumping of AArch64 CPU tuning parameters to JSON This patch adds functionality to dump AArch64 CPU tuning parameters to a JSON file. The new '-fdump-tuning-model=' flag allows users to export the current tuning model configuration to a JSON file. This patch was bootstrapped and regtested on aarch64-linux-gnu, no regression. Signed-off-by: Soumya AR gcc/ChangeLog: * config.gcc: Add aarch64-json-tunings-printer.o. * config/aarch64/aarch64.cc (aarch64_override_options_internal): Invoke aarch64_print_tune_params if -fdump-tuning-model= is specified. * config/aarch64/aarch64.opt: New option. * config/aarch64/t-aarch64 (aarch64-json-tunings-printer.o): New define. * config/aarch64/aarch64-json-tunings-printer.cc: New file. * config/aarch64/aarch64-json-tunings-printer.h: New file. --- gcc/config.gcc | 2 +- .../aarch64/aarch64-json-tunings-printer.cc | 669 ++++++++++++++++++ .../aarch64/aarch64-json-tunings-printer.h | 28 + gcc/config/aarch64/aarch64.cc | 4 + gcc/config/aarch64/aarch64.opt | 4 + gcc/config/aarch64/t-aarch64 | 9 + 6 files changed, 715 insertions(+), 1 deletion(-) create mode 100644 gcc/config/aarch64/aarch64-json-tunings-printer.cc create mode 100644 gcc/config/aarch64/aarch64-json-tunings-printer.h diff --git a/gcc/config.gcc b/gcc/config.gcc index b46cea869cbd..d41160d60573 100644 --- a/gcc/config.gcc +++ b/gcc/config.gcc @@ -359,7 +359,7 @@ aarch64*-*-*) c_target_objs="aarch64-c.o" cxx_target_objs="aarch64-c.o" d_target_objs="aarch64-d.o" - extra_objs="aarch64-builtins.o aarch-common.o aarch64-elf-metadata.o aarch64-sve-builtins.o aarch64-sve-builtins-shapes.o aarch64-sve-builtins-base.o aarch64-sve-builtins-sve2.o aarch64-sve-builtins-sme.o cortex-a57-fma-steering.o aarch64-speculation.o aarch-bti-insert.o aarch64-early-ra.o aarch64-ldp-fusion.o aarch64-sched-dispatch.o" + extra_objs="aarch64-builtins.o aarch-common.o aarch64-elf-metadata.o aarch64-sve-builtins.o aarch64-sve-builtins-shapes.o aarch64-sve-builtins-base.o aarch64-sve-builtins-sve2.o aarch64-sve-builtins-sme.o cortex-a57-fma-steering.o aarch64-speculation.o aarch-bti-insert.o aarch64-early-ra.o aarch64-ldp-fusion.o aarch64-sched-dispatch.o aarch64-json-tunings-printer.o" target_gtfiles="\$(srcdir)/config/aarch64/aarch64-protos.h \$(srcdir)/config/aarch64/aarch64-builtins.h \$(srcdir)/config/aarch64/aarch64-builtins.cc \$(srcdir)/config/aarch64/aarch64-sve-builtins.h \$(srcdir)/config/aarch64/aarch64-sve-builtins.cc" target_has_targetm_common=yes ;; diff --git a/gcc/config/aarch64/aarch64-json-tunings-printer.cc b/gcc/config/aarch64/aarch64-json-tunings-printer.cc new file mode 100644 index 000000000000..861290742fcd --- /dev/null +++ b/gcc/config/aarch64/aarch64-json-tunings-printer.cc @@ -0,0 +1,669 @@ +/* Routines to print the AArch64 tuning parameters to a JSON file. + Copyright The GNU Toolchain Authors. + + This file is part of GCC. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_TYPE_TRAITS +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "pretty-print.h" +#include "tm.h" +#include "diagnostic-core.h" +#include "aarch64-json-tunings-printer.h" +#include "aarch64-protos.h" +#include "config/arm/aarch-common-protos.h" +#include "json.h" +#include "version.h" + +#define SERIALIZE_INTEGER_FIELD(obj, key, member) \ + (obj)->set_integer ((key), (member)) + +#define SERIALIZE_UNSIGNED_INTEGER_FIELD(obj, key, member) \ + (obj)->set_integer ((key), (member)) + +#define SERIALIZE_BOOLEAN_FIELD(obj, key, member) \ + (obj)->set_bool ((key), (member)) + +#define SERIALIZE_STRING_FIELD(obj, key, member) \ + (obj)->set_string ((key), (member)) + +#define SERIALIZE_OBJECT(obj, key, member, serialize_func) \ + { \ + auto field_obj = serialize_object_helper ((member), (serialize_func)); \ + if (field_obj) \ + (obj)->set ((key), std::move (field_obj)); \ + } + +#define SERIALIZE_ARRAY_FIELD(obj, key, member, size, serialize_func) \ + { \ + auto field_array = std::make_unique (); \ + for (size_t i = 0; i < (size); ++i) \ + { \ + auto element_obj = serialize_func ((member)[i]); \ + if (element_obj) \ + field_array->append (std::move (element_obj)); \ + } \ + (obj)->set ((key), std::move (field_array)); \ + } + +#define SERIALIZE_ENUM_FIELD(obj, key, member, mappings) \ + (obj)->set_string ((key), serialize_enum ((member), (mappings), \ + sizeof (mappings) \ + / sizeof (mappings[0]))) + +/* Type alias for serialize function pointer. */ +template +using serialize_func_type = std::unique_ptr (*) ( + const typename std::remove_pointer::type &); + +/* Serialize JSON object from non-pointer members. */ +template +static typename std::enable_if::value, + std::unique_ptr>::type +serialize_object_helper (const T &member, serialize_func_type serialize_func) +{ + return serialize_func (member); +} + +/* Serialize JSON object from pointer members. */ +template +static typename std::enable_if::value, + std::unique_ptr>::type +serialize_object_helper (const T &member, serialize_func_type serialize_func) +{ + if (member) + return serialize_func (*member); + return std::make_unique (); +} + +/* Mapping structure for enum-to-string conversion. */ +template struct enum_mapping +{ + const char *name; + EnumType value; +}; + +static const enum_mapping + autoprefetcher_model_mappings[] + = {{"AUTOPREFETCHER_OFF", tune_params::AUTOPREFETCHER_OFF}, + {"AUTOPREFETCHER_WEAK", tune_params::AUTOPREFETCHER_WEAK}, + {"AUTOPREFETCHER_STRONG", tune_params::AUTOPREFETCHER_STRONG}}; + +static const enum_mapping ldp_policy_model_mappings[] + = {{"AARCH64_LDP_STP_POLICY_DEFAULT", AARCH64_LDP_STP_POLICY_DEFAULT}, + {"AARCH64_LDP_STP_POLICY_ALIGNED", AARCH64_LDP_STP_POLICY_ALIGNED}, + {"AARCH64_LDP_STP_POLICY_ALWAYS", AARCH64_LDP_STP_POLICY_ALWAYS}, + {"AARCH64_LDP_STP_POLICY_NEVER", AARCH64_LDP_STP_POLICY_NEVER}}; + +static const enum_mapping stp_policy_model_mappings[] + = {{"AARCH64_LDP_STP_POLICY_DEFAULT", AARCH64_LDP_STP_POLICY_DEFAULT}, + {"AARCH64_LDP_STP_POLICY_ALIGNED", AARCH64_LDP_STP_POLICY_ALIGNED}, + {"AARCH64_LDP_STP_POLICY_ALWAYS", AARCH64_LDP_STP_POLICY_ALWAYS}, + {"AARCH64_LDP_STP_POLICY_NEVER", AARCH64_LDP_STP_POLICY_NEVER}}; + +/* Convert enum value to string using enum-to-string mappings. */ +template +static const char * +serialize_enum (EnumType enum_value, const enum_mapping *mappings, + size_t num_mappings) +{ + for (size_t i = 0; i < num_mappings; ++i) + if (enum_value == mappings[i].value) + return mappings[i].name; + return mappings[0].name; +} + +template +static std::unique_ptr +serialize_insn_extra_cost_alu (const T &alu) +{ + auto alu_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (alu_obj, "arith", alu.arith); + SERIALIZE_INTEGER_FIELD (alu_obj, "logical", alu.logical); + SERIALIZE_INTEGER_FIELD (alu_obj, "shift", alu.shift); + SERIALIZE_INTEGER_FIELD (alu_obj, "shift_reg", alu.shift_reg); + SERIALIZE_INTEGER_FIELD (alu_obj, "arith_shift", alu.arith_shift); + SERIALIZE_INTEGER_FIELD (alu_obj, "arith_shift_reg", alu.arith_shift_reg); + SERIALIZE_INTEGER_FIELD (alu_obj, "log_shift", alu.log_shift); + SERIALIZE_INTEGER_FIELD (alu_obj, "log_shift_reg", alu.log_shift_reg); + SERIALIZE_INTEGER_FIELD (alu_obj, "extend", alu.extend); + SERIALIZE_INTEGER_FIELD (alu_obj, "extend_arith", alu.extend_arith); + SERIALIZE_INTEGER_FIELD (alu_obj, "bfi", alu.bfi); + SERIALIZE_INTEGER_FIELD (alu_obj, "bfx", alu.bfx); + SERIALIZE_INTEGER_FIELD (alu_obj, "clz", alu.clz); + SERIALIZE_INTEGER_FIELD (alu_obj, "rev", alu.rev); + SERIALIZE_INTEGER_FIELD (alu_obj, "non_exec", alu.non_exec); + SERIALIZE_BOOLEAN_FIELD (alu_obj, "non_exec_costs_exec", + alu.non_exec_costs_exec); + + return alu_obj; +} + +template +static std::unique_ptr +serialize_insn_extra_cost_mult_element (const T &mult_element) +{ + auto mult_element_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (mult_element_obj, "simple", mult_element.simple); + SERIALIZE_INTEGER_FIELD (mult_element_obj, "flag_setting", + mult_element.flag_setting); + SERIALIZE_INTEGER_FIELD (mult_element_obj, "extend", mult_element.extend); + SERIALIZE_INTEGER_FIELD (mult_element_obj, "add", mult_element.add); + SERIALIZE_INTEGER_FIELD (mult_element_obj, "extend_add", + mult_element.extend_add); + SERIALIZE_INTEGER_FIELD (mult_element_obj, "idiv", mult_element.idiv); + + return mult_element_obj; +} + +template +static std::unique_ptr +serialize_insn_extra_cost_ldst (const T &ldst) +{ + auto ldst_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (ldst_obj, "load", ldst.load); + SERIALIZE_INTEGER_FIELD (ldst_obj, "load_sign_extend", ldst.load_sign_extend); + SERIALIZE_INTEGER_FIELD (ldst_obj, "ldrd", ldst.ldrd); + SERIALIZE_INTEGER_FIELD (ldst_obj, "ldm_1st", ldst.ldm_1st); + SERIALIZE_INTEGER_FIELD (ldst_obj, "ldm_regs_per_insn_1st", + ldst.ldm_regs_per_insn_1st); + SERIALIZE_INTEGER_FIELD (ldst_obj, "ldm_regs_per_insn_subsequent", + ldst.ldm_regs_per_insn_subsequent); + SERIALIZE_INTEGER_FIELD (ldst_obj, "loadf", ldst.loadf); + SERIALIZE_INTEGER_FIELD (ldst_obj, "loadd", ldst.loadd); + SERIALIZE_INTEGER_FIELD (ldst_obj, "load_unaligned", ldst.load_unaligned); + SERIALIZE_INTEGER_FIELD (ldst_obj, "store", ldst.store); + SERIALIZE_INTEGER_FIELD (ldst_obj, "strd", ldst.strd); + SERIALIZE_INTEGER_FIELD (ldst_obj, "stm_1st", ldst.stm_1st); + SERIALIZE_INTEGER_FIELD (ldst_obj, "stm_regs_per_insn_1st", + ldst.stm_regs_per_insn_1st); + SERIALIZE_INTEGER_FIELD (ldst_obj, "stm_regs_per_insn_subsequent", + ldst.stm_regs_per_insn_subsequent); + SERIALIZE_INTEGER_FIELD (ldst_obj, "storef", ldst.storef); + SERIALIZE_INTEGER_FIELD (ldst_obj, "stored", ldst.stored); + SERIALIZE_INTEGER_FIELD (ldst_obj, "store_unaligned", ldst.store_unaligned); + SERIALIZE_INTEGER_FIELD (ldst_obj, "loadv", ldst.loadv); + SERIALIZE_INTEGER_FIELD (ldst_obj, "storev", ldst.storev); + + return ldst_obj; +} + +template +static std::unique_ptr +serialize_insn_extra_cost_fp_element (const T &fp_element) +{ + auto fp_element_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (fp_element_obj, "div", fp_element.div); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "mult", fp_element.mult); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "mult_addsub", + fp_element.mult_addsub); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "fma", fp_element.fma); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "addsub", fp_element.addsub); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "fpconst", fp_element.fpconst); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "neg", fp_element.neg); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "compare", fp_element.compare); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "widen", fp_element.widen); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "narrow", fp_element.narrow); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "toint", fp_element.toint); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "fromint", fp_element.fromint); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "roundint", fp_element.roundint); + + return fp_element_obj; +} + +template +static std::unique_ptr +serialize_insn_extra_cost_vect (const T &vect) +{ + auto vect_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (vect_obj, "alu", vect.alu); + SERIALIZE_INTEGER_FIELD (vect_obj, "mult", vect.mult); + SERIALIZE_INTEGER_FIELD (vect_obj, "movi", vect.movi); + SERIALIZE_INTEGER_FIELD (vect_obj, "dup", vect.dup); + SERIALIZE_INTEGER_FIELD (vect_obj, "extract", vect.extract); + + return vect_obj; +} + +template +static std::unique_ptr +serialize_addr_cost_addr_scale_costs (const T &addr_scale_costs) +{ + auto addr_scale_costs_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (addr_scale_costs_obj, "hi", addr_scale_costs.hi); + SERIALIZE_INTEGER_FIELD (addr_scale_costs_obj, "si", addr_scale_costs.si); + SERIALIZE_INTEGER_FIELD (addr_scale_costs_obj, "di", addr_scale_costs.di); + SERIALIZE_INTEGER_FIELD (addr_scale_costs_obj, "ti", addr_scale_costs.ti); + + return addr_scale_costs_obj; +} + +template +static std::unique_ptr +serialize_regmove_cost (const T ®move_cost) +{ + auto regmove_cost_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (regmove_cost_obj, "GP2GP", regmove_cost.GP2GP); + SERIALIZE_INTEGER_FIELD (regmove_cost_obj, "GP2FP", regmove_cost.GP2FP); + SERIALIZE_INTEGER_FIELD (regmove_cost_obj, "FP2GP", regmove_cost.FP2GP); + SERIALIZE_INTEGER_FIELD (regmove_cost_obj, "FP2FP", regmove_cost.FP2FP); + + return regmove_cost_obj; +} + +template +static std::unique_ptr +serialize_vec_costs_advsimd (const T &advsimd) +{ + auto advsimd_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (advsimd_obj, "int_stmt_cost", advsimd.int_stmt_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "fp_stmt_cost", advsimd.fp_stmt_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "ld2_st2_permute_cost", + advsimd.ld2_st2_permute_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "ld3_st3_permute_cost", + advsimd.ld3_st3_permute_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "ld4_st4_permute_cost", + advsimd.ld4_st4_permute_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "permute_cost", advsimd.permute_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_i8_cost", advsimd.reduc_i8_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_i16_cost", + advsimd.reduc_i16_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_i32_cost", + advsimd.reduc_i32_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_i64_cost", + advsimd.reduc_i64_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_f16_cost", + advsimd.reduc_f16_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_f32_cost", + advsimd.reduc_f32_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_f64_cost", + advsimd.reduc_f64_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "store_elt_extra_cost", + advsimd.store_elt_extra_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "vec_to_scalar_cost", + advsimd.vec_to_scalar_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "scalar_to_vec_cost", + advsimd.scalar_to_vec_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "align_load_cost", + advsimd.align_load_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "unalign_load_cost", + advsimd.unalign_load_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "unalign_store_cost", + advsimd.unalign_store_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "store_cost", advsimd.store_cost); + + return advsimd_obj; +} + +template +static std::unique_ptr +serialize_vec_costs_sve (const T &sve) +{ + auto sve_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (sve_obj, "clast_cost", sve.clast_cost); + SERIALIZE_INTEGER_FIELD (sve_obj, "fadda_f16_cost", sve.fadda_f16_cost); + SERIALIZE_INTEGER_FIELD (sve_obj, "fadda_f32_cost", sve.fadda_f32_cost); + SERIALIZE_INTEGER_FIELD (sve_obj, "fadda_f64_cost", sve.fadda_f64_cost); + SERIALIZE_INTEGER_FIELD (sve_obj, "gather_load_x32_cost", + sve.gather_load_x32_cost); + SERIALIZE_INTEGER_FIELD (sve_obj, "gather_load_x64_cost", + sve.gather_load_x64_cost); + SERIALIZE_INTEGER_FIELD (sve_obj, "gather_load_x32_init_cost", + sve.gather_load_x32_init_cost); + SERIALIZE_INTEGER_FIELD (sve_obj, "gather_load_x64_init_cost", + sve.gather_load_x64_init_cost); + SERIALIZE_INTEGER_FIELD (sve_obj, "scatter_store_elt_cost", + sve.scatter_store_elt_cost); + + return sve_obj; +} + +template +static std::unique_ptr +serialize_vec_costs_issue_info_scalar (const T &scalar) +{ + auto scalar_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (scalar_obj, "loads_stores_per_cycle", + scalar.loads_stores_per_cycle); + SERIALIZE_INTEGER_FIELD (scalar_obj, "stores_per_cycle", + scalar.stores_per_cycle); + SERIALIZE_INTEGER_FIELD (scalar_obj, "general_ops_per_cycle", + scalar.general_ops_per_cycle); + SERIALIZE_INTEGER_FIELD (scalar_obj, "fp_simd_load_general_ops", + scalar.fp_simd_load_general_ops); + SERIALIZE_INTEGER_FIELD (scalar_obj, "fp_simd_store_general_ops", + scalar.fp_simd_store_general_ops); + + return scalar_obj; +} + +template +static std::unique_ptr +serialize_vec_costs_issue_info_advsimd (const T &advsimd) +{ + auto advsimd_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (advsimd_obj, "loads_stores_per_cycle", + advsimd.loads_stores_per_cycle); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "stores_per_cycle", + advsimd.stores_per_cycle); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "general_ops_per_cycle", + advsimd.general_ops_per_cycle); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "fp_simd_load_general_ops", + advsimd.fp_simd_load_general_ops); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "fp_simd_store_general_ops", + advsimd.fp_simd_store_general_ops); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "ld2_st2_general_ops", + advsimd.ld2_st2_general_ops); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "ld3_st3_general_ops", + advsimd.ld3_st3_general_ops); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "ld4_st4_general_ops", + advsimd.ld4_st4_general_ops); + + return advsimd_obj; +} + +template +static std::unique_ptr +serialize_vec_costs_issue_info_sve (const T &sve) +{ + auto sve_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (sve_obj, "loads_stores_per_cycle", + sve.loads_stores_per_cycle); + SERIALIZE_INTEGER_FIELD (sve_obj, "stores_per_cycle", sve.stores_per_cycle); + SERIALIZE_INTEGER_FIELD (sve_obj, "general_ops_per_cycle", + sve.general_ops_per_cycle); + SERIALIZE_INTEGER_FIELD (sve_obj, "fp_simd_load_general_ops", + sve.fp_simd_load_general_ops); + SERIALIZE_INTEGER_FIELD (sve_obj, "fp_simd_store_general_ops", + sve.fp_simd_store_general_ops); + SERIALIZE_INTEGER_FIELD (sve_obj, "ld2_st2_general_ops", + sve.ld2_st2_general_ops); + SERIALIZE_INTEGER_FIELD (sve_obj, "ld3_st3_general_ops", + sve.ld3_st3_general_ops); + SERIALIZE_INTEGER_FIELD (sve_obj, "ld4_st4_general_ops", + sve.ld4_st4_general_ops); + SERIALIZE_INTEGER_FIELD (sve_obj, "pred_ops_per_cycle", + sve.pred_ops_per_cycle); + SERIALIZE_INTEGER_FIELD (sve_obj, "while_pred_ops", sve.while_pred_ops); + SERIALIZE_INTEGER_FIELD (sve_obj, "int_cmp_pred_ops", sve.int_cmp_pred_ops); + SERIALIZE_INTEGER_FIELD (sve_obj, "fp_cmp_pred_ops", sve.fp_cmp_pred_ops); + SERIALIZE_INTEGER_FIELD (sve_obj, "gather_scatter_pair_general_ops", + sve.gather_scatter_pair_general_ops); + SERIALIZE_INTEGER_FIELD (sve_obj, "gather_scatter_pair_pred_ops", + sve.gather_scatter_pair_pred_ops); + + return sve_obj; +} + +template +static std::unique_ptr +serialize_branch_costs (const T &branch_costs) +{ + auto branch_costs_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (branch_costs_obj, "predictable", + branch_costs.predictable); + SERIALIZE_INTEGER_FIELD (branch_costs_obj, "unpredictable", + branch_costs.unpredictable); + + return branch_costs_obj; +} + +template +static std::unique_ptr +serialize_approx_modes (const T &approx_modes) +{ + auto approx_modes_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (approx_modes_obj, "division", approx_modes.division); + SERIALIZE_INTEGER_FIELD (approx_modes_obj, "sqrt", approx_modes.sqrt); + SERIALIZE_INTEGER_FIELD (approx_modes_obj, "recip_sqrt", + approx_modes.recip_sqrt); + + return approx_modes_obj; +} + +template +static std::unique_ptr +serialize_memmov_cost (const T &memmov_cost) +{ + auto memmov_cost_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "load_int", memmov_cost.load_int); + SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "store_int", memmov_cost.store_int); + SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "load_fp", memmov_cost.load_fp); + SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "store_fp", memmov_cost.store_fp); + SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "load_pred", memmov_cost.load_pred); + SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "store_pred", + memmov_cost.store_pred); + + return memmov_cost_obj; +} + +template +static std::unique_ptr +serialize_prefetch (const T &prefetch) +{ + auto prefetch_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (prefetch_obj, "num_slots", prefetch.num_slots); + SERIALIZE_INTEGER_FIELD (prefetch_obj, "l1_cache_size", + prefetch.l1_cache_size); + SERIALIZE_INTEGER_FIELD (prefetch_obj, "l1_cache_line_size", + prefetch.l1_cache_line_size); + SERIALIZE_INTEGER_FIELD (prefetch_obj, "l2_cache_size", + prefetch.l2_cache_size); + SERIALIZE_BOOLEAN_FIELD (prefetch_obj, "prefetch_dynamic_strides", + prefetch.prefetch_dynamic_strides); + SERIALIZE_INTEGER_FIELD (prefetch_obj, "minimum_stride", + prefetch.minimum_stride); + SERIALIZE_INTEGER_FIELD (prefetch_obj, "default_opt_level", + prefetch.default_opt_level); + + return prefetch_obj; +} + +template +static std::unique_ptr +serialize_insn_extra_cost (const T &insn_extra_cost) +{ + auto insn_extra_cost_obj = std::make_unique (); + + SERIALIZE_OBJECT (insn_extra_cost_obj, "alu", insn_extra_cost.alu, + serialize_insn_extra_cost_alu); + SERIALIZE_ARRAY_FIELD (insn_extra_cost_obj, "mult", insn_extra_cost.mult, 2, + serialize_insn_extra_cost_mult_element); + SERIALIZE_OBJECT (insn_extra_cost_obj, "ldst", insn_extra_cost.ldst, + serialize_insn_extra_cost_ldst); + SERIALIZE_ARRAY_FIELD (insn_extra_cost_obj, "fp", insn_extra_cost.fp, 2, + serialize_insn_extra_cost_fp_element); + SERIALIZE_OBJECT (insn_extra_cost_obj, "vect", insn_extra_cost.vect, + serialize_insn_extra_cost_vect); + + return insn_extra_cost_obj; +} + +template +static std::unique_ptr +serialize_addr_cost (const T &addr_cost) +{ + auto addr_cost_obj = std::make_unique (); + + SERIALIZE_OBJECT (addr_cost_obj, "addr_scale_costs", + addr_cost.addr_scale_costs, + serialize_addr_cost_addr_scale_costs); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "pre_modify", addr_cost.pre_modify); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "post_modify", addr_cost.post_modify); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "post_modify_ld3_st3", + addr_cost.post_modify_ld3_st3); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "post_modify_ld4_st4", + addr_cost.post_modify_ld4_st4); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "register_offset", + addr_cost.register_offset); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "register_sextend", + addr_cost.register_sextend); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "register_zextend", + addr_cost.register_zextend); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "imm_offset", addr_cost.imm_offset); + + return addr_cost_obj; +} + +template +static std::unique_ptr +serialize_vec_costs_issue_info (const T &issue_info) +{ + auto issue_info_obj = std::make_unique (); + + SERIALIZE_OBJECT (issue_info_obj, "scalar", issue_info.scalar, + serialize_vec_costs_issue_info_scalar); + SERIALIZE_OBJECT (issue_info_obj, "advsimd", issue_info.advsimd, + serialize_vec_costs_issue_info_advsimd); + SERIALIZE_OBJECT (issue_info_obj, "sve", issue_info.sve, + serialize_vec_costs_issue_info_sve); + + return issue_info_obj; +} + +template +static std::unique_ptr +serialize_vec_costs (const T &vec_costs) +{ + auto vec_costs_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (vec_costs_obj, "scalar_int_stmt_cost", + vec_costs.scalar_int_stmt_cost); + SERIALIZE_INTEGER_FIELD (vec_costs_obj, "scalar_fp_stmt_cost", + vec_costs.scalar_fp_stmt_cost); + SERIALIZE_INTEGER_FIELD (vec_costs_obj, "scalar_load_cost", + vec_costs.scalar_load_cost); + SERIALIZE_INTEGER_FIELD (vec_costs_obj, "scalar_store_cost", + vec_costs.scalar_store_cost); + SERIALIZE_INTEGER_FIELD (vec_costs_obj, "cond_taken_branch_cost", + vec_costs.cond_taken_branch_cost); + SERIALIZE_INTEGER_FIELD (vec_costs_obj, "cond_not_taken_branch_cost", + vec_costs.cond_not_taken_branch_cost); + SERIALIZE_OBJECT (vec_costs_obj, "advsimd", vec_costs.advsimd, + serialize_vec_costs_advsimd); + SERIALIZE_OBJECT (vec_costs_obj, "sve", vec_costs.sve, + serialize_vec_costs_sve); + SERIALIZE_OBJECT (vec_costs_obj, "issue_info", vec_costs.issue_info, + serialize_vec_costs_issue_info); + + return vec_costs_obj; +} + +template +static std::unique_ptr +serialize_tunings (const T &tunings) +{ + auto tunings_obj = std::make_unique (); + + SERIALIZE_OBJECT (tunings_obj, "insn_extra_cost", tunings.insn_extra_cost, + serialize_insn_extra_cost); + SERIALIZE_OBJECT (tunings_obj, "addr_cost", tunings.addr_cost, + serialize_addr_cost); + SERIALIZE_OBJECT (tunings_obj, "regmove_cost", tunings.regmove_cost, + serialize_regmove_cost); + SERIALIZE_OBJECT (tunings_obj, "vec_costs", tunings.vec_costs, + serialize_vec_costs); + SERIALIZE_OBJECT (tunings_obj, "branch_costs", tunings.branch_costs, + serialize_branch_costs); + SERIALIZE_OBJECT (tunings_obj, "approx_modes", tunings.approx_modes, + serialize_approx_modes); + SERIALIZE_INTEGER_FIELD (tunings_obj, "sve_width", tunings.sve_width); + SERIALIZE_OBJECT (tunings_obj, "memmov_cost", tunings.memmov_cost, + serialize_memmov_cost); + SERIALIZE_INTEGER_FIELD (tunings_obj, "issue_rate", tunings.issue_rate); + SERIALIZE_INTEGER_FIELD (tunings_obj, "fusible_ops", tunings.fusible_ops); + SERIALIZE_STRING_FIELD (tunings_obj, "function_align", + tunings.function_align); + SERIALIZE_STRING_FIELD (tunings_obj, "jump_align", tunings.jump_align); + SERIALIZE_STRING_FIELD (tunings_obj, "loop_align", tunings.loop_align); + SERIALIZE_INTEGER_FIELD (tunings_obj, "int_reassoc_width", + tunings.int_reassoc_width); + SERIALIZE_INTEGER_FIELD (tunings_obj, "fp_reassoc_width", + tunings.fp_reassoc_width); + SERIALIZE_INTEGER_FIELD (tunings_obj, "fma_reassoc_width", + tunings.fma_reassoc_width); + SERIALIZE_INTEGER_FIELD (tunings_obj, "vec_reassoc_width", + tunings.vec_reassoc_width); + SERIALIZE_INTEGER_FIELD (tunings_obj, "min_div_recip_mul_sf", + tunings.min_div_recip_mul_sf); + SERIALIZE_INTEGER_FIELD (tunings_obj, "min_div_recip_mul_df", + tunings.min_div_recip_mul_df); + SERIALIZE_INTEGER_FIELD (tunings_obj, "max_case_values", + tunings.max_case_values); + SERIALIZE_ENUM_FIELD (tunings_obj, "autoprefetcher_model", + tunings.autoprefetcher_model, + autoprefetcher_model_mappings); + SERIALIZE_INTEGER_FIELD (tunings_obj, "extra_tuning_flags", + tunings.extra_tuning_flags); + SERIALIZE_OBJECT (tunings_obj, "prefetch", tunings.prefetch, + serialize_prefetch); + SERIALIZE_ENUM_FIELD (tunings_obj, "ldp_policy_model", + tunings.ldp_policy_model, ldp_policy_model_mappings); + SERIALIZE_ENUM_FIELD (tunings_obj, "stp_policy_model", + tunings.stp_policy_model, stp_policy_model_mappings); + + return tunings_obj; +} + +/* Print tune_params structure to JSON file. */ +void +aarch64_print_tune_params (const tune_params ¶ms, const char *filename) +{ + /* Use default filename if none provided or empty string given. */ + const char *output_filename = filename; + if (!output_filename || *output_filename == '\0') + output_filename = "aarch64-tuning.json"; + + auto aarch64_tune_params_json = std::make_unique (); + + auto metadata = std::make_unique (); + metadata->set_integer ("gcc_version", GCC_major_version); + aarch64_tune_params_json->set ("metadata", std::move (metadata)); + + aarch64_tune_params_json->set ("tune_params", serialize_tunings (params)); + + pretty_printer pp; + aarch64_tune_params_json->print (&pp, true); + + FILE *outputFile = fopen (output_filename, "w"); + if (!outputFile) + { + error ("Error opening file %s", output_filename); + return; + } + + fprintf (outputFile, "%s", pp_formatted_text (&pp)); + fclose (outputFile); + return; +} \ No newline at end of file diff --git a/gcc/config/aarch64/aarch64-json-tunings-printer.h b/gcc/config/aarch64/aarch64-json-tunings-printer.h new file mode 100644 index 000000000000..a65c005d9fe0 --- /dev/null +++ b/gcc/config/aarch64/aarch64-json-tunings-printer.h @@ -0,0 +1,28 @@ +/* Routine to print the AArch64 tuning parameters to a JSON file. + Copyright The GNU Toolchain Authors. + + This file is part of GCC. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#ifndef AARCH64_JSON_TUNINGS_PRINTER_H +#define AARCH64_JSON_TUNINGS_PRINTER_H + +#include "aarch64-protos.h" + +void +aarch64_print_tune_params (const tune_params ¶ms, const char *filename); + +#endif \ No newline at end of file diff --git a/gcc/config/aarch64/aarch64.cc b/gcc/config/aarch64/aarch64.cc index 89097e237728..5586012f15cb 100644 --- a/gcc/config/aarch64/aarch64.cc +++ b/gcc/config/aarch64/aarch64.cc @@ -99,6 +99,7 @@ #include "ipa-fnsummary.h" #include "hash-map.h" #include "aarch64-sched-dispatch.h" +#include "aarch64-json-tunings-printer.h" /* This file should be included last. */ #include "target-def.h" @@ -19175,6 +19176,9 @@ aarch64_override_options_internal (struct gcc_options *opts) if (opts->x_aarch64_stp_policy_param) aarch64_tune_params.stp_policy_model = opts->x_aarch64_stp_policy_param; + if (opts->x_fdump_tuning_model) + aarch64_print_tune_params (aarch64_tune_params, opts->x_fdump_tuning_model); + /* This target defaults to strict volatile bitfields. */ if (opts->x_flag_strict_volatile_bitfields < 0 && abi_version_at_least (2)) opts->x_flag_strict_volatile_bitfields = 1; diff --git a/gcc/config/aarch64/aarch64.opt b/gcc/config/aarch64/aarch64.opt index fc3f632d93b1..adc65afc808a 100644 --- a/gcc/config/aarch64/aarch64.opt +++ b/gcc/config/aarch64/aarch64.opt @@ -193,6 +193,10 @@ mabi= Target RejectNegative Joined Enum(aarch64_abi) Var(aarch64_abi) Init(AARCH64_ABI_DEFAULT) Generate code that conforms to the specified ABI. +fdump-tuning-model= +Target Undocumented RejectNegative Negative(fdump-tuning-model=) Joined Var(fdump_tuning_model) +-fdump-tuning-model= Dump current tuning model to a JSON file. + moverride= Target RejectNegative ToLower Joined Var(aarch64_override_tune_string) Save -moverride= Power users only! Override CPU optimization parameters. diff --git a/gcc/config/aarch64/t-aarch64 b/gcc/config/aarch64/t-aarch64 index 71242f05b091..e1a1c9b963f8 100644 --- a/gcc/config/aarch64/t-aarch64 +++ b/gcc/config/aarch64/t-aarch64 @@ -210,6 +210,15 @@ aarch64-sched-dispatch.o: $(srcdir)/config/aarch64/aarch64-sched-dispatch.cc \ $(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ $(srcdir)/config/aarch64/aarch64-sched-dispatch.cc +aarch64-json-tunings-printer.o: $(srcdir)/config/aarch64/aarch64-json-tunings-printer.cc \ + $(CONFIG_H) $(SYSTEM_H) $(CORETYPES_H) $(TM_H) $(DIAGNOSTIC_CORE_H) \ + $(PRETTY_PRINT_H) json.h \ + $(srcdir)/config/aarch64/aarch64-json-tunings-printer.h \ + $(srcdir)/config/aarch64/aarch64-protos.h \ + $(srcdir)/config/arm/aarch-common-protos.h + $(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ + $(srcdir)/config/aarch64/aarch64-json-tunings-printer.cc + comma=, MULTILIB_OPTIONS = $(subst $(comma),/, $(patsubst %, mabi=%, $(subst $(comma),$(comma)mabi=,$(TM_MULTILIB_CONFIG)))) MULTILIB_DIRNAMES = $(subst $(comma), ,$(TM_MULTILIB_CONFIG)) From 0cf34825923d9fc82e3d015e9bc7d0b253bd9348 Mon Sep 17 00:00:00 2001 From: Soumya AR Date: Fri, 11 Jul 2025 05:54:33 -0700 Subject: [PATCH 028/373] json: Add get_map() method to JSON object class This patch adds a get_map () method to the JSON object class to provide access to the underlying hash map that stores the JSON key-value pairs. To do this, we expose the map_t typedef, the return type of get_map(). This change is needed to allow traversal of key-value pairs when parsing user-provided JSON tuning data. Additionally, is_a_helper template specializations for json::literal * and const json::literal * were added to make dynamic casting in the next patch easier. This patch was bootstrapped and regtested on aarch64-linux-gnu, no regression. Signed-off-by: Soumya AR gcc/ChangeLog: * json.h (class object): Add get_map () method. (is_a_helper, is_a_helper): New template specializations. --- gcc/json.h | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/gcc/json.h b/gcc/json.h index c53715ecb2ca..90b6c601f809 100644 --- a/gcc/json.h +++ b/gcc/json.h @@ -189,6 +189,9 @@ class object : public value public: ~object (); + typedef hash_map > map_t; + enum kind get_kind () const final override { return JSON_OBJECT; } void print (pretty_printer *pp, bool formatted) const final override; std::unique_ptr clone () const final override; @@ -214,6 +217,7 @@ class object : public value } value *get (const char *key) const; + const map_t &get_map () const { return m_map; } void set_string (const char *key, const char *utf8_value); void set_integer (const char *key, long v); @@ -243,8 +247,6 @@ class object : public value std::unique_ptr clone_as_object () const; private: - typedef hash_map > map_t; map_t m_map; /* Keep track of order in which keys were inserted. */ @@ -497,6 +499,26 @@ is_a_helper ::test (const json::value *jv) return jv->get_kind () == json::JSON_STRING; } +template <> +template <> +inline bool +is_a_helper::test (json::value *jv) +{ + return (jv->get_kind () == json::JSON_TRUE + || jv->get_kind () == json::JSON_FALSE + || jv->get_kind () == json::JSON_NULL); +} + +template <> +template <> +inline bool +is_a_helper::test (const json::value *jv) +{ + return (jv->get_kind () == json::JSON_TRUE + || jv->get_kind () == json::JSON_FALSE + || jv->get_kind () == json::JSON_NULL); +} + #if CHECKING_P namespace selftest { From efbaf167598be4eee4a8373f9546df441cc8a53f Mon Sep 17 00:00:00 2001 From: Soumya AR Date: Wed, 16 Jul 2025 06:29:57 -0700 Subject: [PATCH 029/373] aarch64: Enable parsing of user-provided AArch64 CPU tuning parameters This patch adds support for loading custom CPU tuning parameters from a JSON file for AArch64 targets. The '-muser-provided-CPU=' flag accepts a user provided JSON file and overrides the internal tuning parameters at GCC runtime. This patch was bootstrapped and regtested on aarch64-linux-gnu, no regression. Signed-off-by: Soumya AR gcc/ChangeLog: * config.gcc: Add aarch64-json-tunings-parser.o. * config/aarch64/aarch64.cc (aarch64_override_options_internal): Invoke aarch64_load_tuning_params_from_json if -muser-provided-CPU= is (aarch64_json_tunings_tests): Extern aarch64_json_tunings_tests(). (aarch64_run_selftests): Add aarch64_json_tunings_tests(). * config/aarch64/aarch64.opt: New option. * config/aarch64/t-aarch64 (aarch64-json-tunings-parser.o): New define. * config/aarch64/aarch64-json-schema.h: New file. * config/aarch64/aarch64-json-tunings-parser.cc: New file. * config/aarch64/aarch64-json-tunings-parser.h: New file. --- gcc/config.gcc | 2 +- gcc/config/aarch64/aarch64-json-schema.h | 264 +++++ .../aarch64/aarch64-json-tunings-parser.cc | 1005 +++++++++++++++++ .../aarch64/aarch64-json-tunings-parser.h | 29 + gcc/config/aarch64/aarch64.cc | 19 + gcc/config/aarch64/aarch64.opt | 4 + gcc/config/aarch64/t-aarch64 | 10 + 7 files changed, 1332 insertions(+), 1 deletion(-) create mode 100644 gcc/config/aarch64/aarch64-json-schema.h create mode 100644 gcc/config/aarch64/aarch64-json-tunings-parser.cc create mode 100644 gcc/config/aarch64/aarch64-json-tunings-parser.h diff --git a/gcc/config.gcc b/gcc/config.gcc index d41160d60573..6ac00ebdcb30 100644 --- a/gcc/config.gcc +++ b/gcc/config.gcc @@ -359,7 +359,7 @@ aarch64*-*-*) c_target_objs="aarch64-c.o" cxx_target_objs="aarch64-c.o" d_target_objs="aarch64-d.o" - extra_objs="aarch64-builtins.o aarch-common.o aarch64-elf-metadata.o aarch64-sve-builtins.o aarch64-sve-builtins-shapes.o aarch64-sve-builtins-base.o aarch64-sve-builtins-sve2.o aarch64-sve-builtins-sme.o cortex-a57-fma-steering.o aarch64-speculation.o aarch-bti-insert.o aarch64-early-ra.o aarch64-ldp-fusion.o aarch64-sched-dispatch.o aarch64-json-tunings-printer.o" + extra_objs="aarch64-builtins.o aarch-common.o aarch64-elf-metadata.o aarch64-sve-builtins.o aarch64-sve-builtins-shapes.o aarch64-sve-builtins-base.o aarch64-sve-builtins-sve2.o aarch64-sve-builtins-sme.o cortex-a57-fma-steering.o aarch64-speculation.o aarch-bti-insert.o aarch64-early-ra.o aarch64-ldp-fusion.o aarch64-sched-dispatch.o aarch64-json-tunings-printer.o aarch64-json-tunings-parser.o" target_gtfiles="\$(srcdir)/config/aarch64/aarch64-protos.h \$(srcdir)/config/aarch64/aarch64-builtins.h \$(srcdir)/config/aarch64/aarch64-builtins.cc \$(srcdir)/config/aarch64/aarch64-sve-builtins.h \$(srcdir)/config/aarch64/aarch64-sve-builtins.cc" target_has_targetm_common=yes ;; diff --git a/gcc/config/aarch64/aarch64-json-schema.h b/gcc/config/aarch64/aarch64-json-schema.h new file mode 100644 index 000000000000..0c1863fad18a --- /dev/null +++ b/gcc/config/aarch64/aarch64-json-schema.h @@ -0,0 +1,264 @@ +/* Raw JSON schema for the AArch64 tuning parameters. + Copyright The GNU Toolchain Authors. + + This file is part of GCC. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#ifndef AARCH64_JSON_SCHEMA_H +#define AARCH64_JSON_SCHEMA_H + +static const char *schema_json = R"json( +{ + "metadata": { + "gcc_version": "int" + }, + "tune_params": { + "insn_extra_cost": { + "alu": { + "arith": "int", + "logical": "int", + "shift": "int", + "shift_reg": "int", + "arith_shift": "int", + "arith_shift_reg": "int", + "log_shift": "int", + "log_shift_reg": "int", + "extend": "int", + "extend_arith": "int", + "bfi": "int", + "bfx": "int", + "clz": "int", + "rev": "int", + "non_exec": "int", + "non_exec_costs_exec": "boolean" + }, + "mult": [ + { + "simple": "int", + "flag_setting": "int", + "extend": "int", + "add": "int", + "extend_add": "int", + "idiv": "int" + }, + { + "simple": "int", + "flag_setting": "int", + "extend": "int", + "add": "int", + "extend_add": "int", + "idiv": "int" + } + ], + "ldst": { + "load": "int", + "load_sign_extend": "int", + "ldrd": "int", + "ldm_1st": "int", + "ldm_regs_per_insn_1st": "int", + "ldm_regs_per_insn_subsequent": "int", + "loadf": "int", + "loadd": "int", + "load_unaligned": "int", + "store": "int", + "strd": "int", + "stm_1st": "int", + "stm_regs_per_insn_1st": "int", + "stm_regs_per_insn_subsequent": "int", + "storef": "int", + "stored": "int", + "store_unaligned": "int", + "loadv": "int", + "storev": "int" + }, + "fp": [ + { + "div": "int", + "mult": "int", + "mult_addsub": "int", + "fma": "int", + "addsub": "int", + "fpconst": "int", + "neg": "int", + "compare": "int", + "widen": "int", + "narrow": "int", + "toint": "int", + "fromint": "int", + "roundint": "int" + }, + { + "div": "int", + "mult": "int", + "mult_addsub": "int", + "fma": "int", + "addsub": "int", + "fpconst": "int", + "neg": "int", + "compare": "int", + "widen": "int", + "narrow": "int", + "toint": "int", + "fromint": "int", + "roundint": "int" + } + ], + "vect": { + "alu": "int", + "mult": "int", + "movi": "int", + "dup": "int", + "extract": "int" + } + }, + "addr_cost": { + "addr_scale_costs": { + "hi": "int", + "si": "int", + "di": "int", + "ti": "int" + }, + "pre_modify": "int", + "post_modify": "int", + "post_modify_ld3_st3": "int", + "post_modify_ld4_st4": "int", + "register_offset": "int", + "register_sextend": "int", + "register_zextend": "int", + "imm_offset": "int" + }, + "regmove_cost": { + "GP2GP": "int", + "GP2FP": "int", + "FP2GP": "int", + "FP2FP": "int" + }, + "vec_costs": { + "scalar_int_stmt_cost": "int", + "scalar_fp_stmt_cost": "int", + "scalar_load_cost": "int", + "scalar_store_cost": "int", + "cond_taken_branch_cost": "int", + "cond_not_taken_branch_cost": "int", + "advsimd": { + "int_stmt_cost": "int", + "fp_stmt_cost": "int", + "ld2_st2_permute_cost": "int", + "ld3_st3_permute_cost": "int", + "ld4_st4_permute_cost": "int", + "permute_cost": "int", + "reduc_i8_cost": "int", + "reduc_i16_cost": "int", + "reduc_i32_cost": "int", + "reduc_i64_cost": "int", + "reduc_f16_cost": "int", + "reduc_f32_cost": "int", + "reduc_f64_cost": "int", + "store_elt_extra_cost": "int", + "vec_to_scalar_cost": "int", + "scalar_to_vec_cost": "int", + "align_load_cost": "int", + "unalign_load_cost": "int", + "unalign_store_cost": "int", + "store_cost": "int" + }, + "sve": { + "clast_cost": "int", + "fadda_f16_cost": "int", + "fadda_f32_cost": "int", + "fadda_f64_cost": "int", + "gather_load_x32_cost": "uint", + "gather_load_x64_cost": "uint", + "gather_load_x32_init_cost": "int", + "gather_load_x64_init_cost": "int", + "scatter_store_elt_cost": "int" + }, + "issue_info": { + "scalar": { + "loads_stores_per_cycle": "uint", + "stores_per_cycle": "uint", + "general_ops_per_cycle": "uint", + "fp_simd_load_general_ops": "uint", + "fp_simd_store_general_ops": "uint" + }, + "advsimd": { + "loads_stores_per_cycle": "uint", + "stores_per_cycle": "uint", + "general_ops_per_cycle": "uint", + "fp_simd_load_general_ops": "uint", + "fp_simd_store_general_ops": "uint", + "ld2_st2_general_ops": "uint", + "ld3_st3_general_ops": "uint", + "ld4_st4_general_ops": "uint" + }, + "sve": { + "loads_stores_per_cycle": "uint", + "stores_per_cycle": "uint", + "general_ops_per_cycle": "uint", + "fp_simd_load_general_ops": "uint", + "fp_simd_store_general_ops": "uint", + "ld2_st2_general_ops": "uint", + "ld3_st3_general_ops": "uint", + "ld4_st4_general_ops": "uint", + "pred_ops_per_cycle": "uint", + "while_pred_ops": "uint", + "int_cmp_pred_ops": "uint", + "fp_cmp_pred_ops": "uint", + "gather_scatter_pair_general_ops": "uint", + "gather_scatter_pair_pred_ops": "uint" + } + } + }, + "branch_costs": { "predictable": "int", "unpredictable": "int" }, + "approx_modes": { "division": "int", "sqrt": "int", "recip_sqrt": "int" }, + "sve_width": "uint", + "memmov_cost": { + "load_int": "int", + "store_int": "int", + "load_fp": "int", + "store_fp": "int", + "load_pred": "int", + "store_pred": "int" + }, + "issue_rate": "int", + "fusible_ops": "uint", + "function_align": "string", + "jump_align": "string", + "loop_align": "string", + "int_reassoc_width": "int", + "fp_reassoc_width": "int", + "fma_reassoc_width": "int", + "vec_reassoc_width": "int", + "min_div_recip_mul_sf": "int", + "min_div_recip_mul_df": "int", + "max_case_values": "uint", + "autoprefetcher_model": "enum", + "extra_tuning_flags": "uint", + "prefetch": { + "num_slots": "int", + "l1_cache_size": "int", + "l1_cache_line_size": "int", + "l2_cache_size": "int", + "prefetch_dynamic_strides": "boolean", + "minimum_stride": "int", + "default_opt_level": "int" + }, + "ldp_policy_model": "enum", + "stp_policy_model": "enum" + } +})json"; + +#endif \ No newline at end of file diff --git a/gcc/config/aarch64/aarch64-json-tunings-parser.cc b/gcc/config/aarch64/aarch64-json-tunings-parser.cc new file mode 100644 index 000000000000..f5959bf55e1d --- /dev/null +++ b/gcc/config/aarch64/aarch64-json-tunings-parser.cc @@ -0,0 +1,1005 @@ +/* Routines to parse the AArch64 tuning parameters from a JSON file. + Copyright The GNU Toolchain Authors. + + This file is part of GCC. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_STRING +#define INCLUDE_VECTOR +#define INCLUDE_TYPE_TRAITS +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "tm.h" +#include "diagnostic-core.h" +#include "json-parsing.h" +#include "aarch64-json-schema.h" +#include "aarch64-json-tunings-parser.h" +#include "aarch64-protos.h" +#include "config/arm/aarch-common-protos.h" +#include "selftest.h" +#include "version.h" + +#define PARSE_INTEGER_FIELD(obj, key, member) \ + { \ + const json::value *val = obj->get (key); \ + if (val) \ + member = extract_integer (val); \ + } + +#define PARSE_UNSIGNED_INTEGER_FIELD(obj, key, member) \ + { \ + const json::value *val = obj->get (key); \ + if (val) \ + member = extract_unsigned_integer (val); \ + } + +#define PARSE_BOOLEAN_FIELD(obj, key, member) \ + { \ + const json::value *val = obj->get (key); \ + if (val) \ + member = extract_boolean (val); \ + } + +#define PARSE_STRING_FIELD(obj, key, member) \ + { \ + const json::value *val = obj->get (key); \ + if (val) \ + member = extract_string (val); \ + } + +#define PARSE_OBJECT(obj, key, member, parse_func) \ + { \ + const json::value *field_value = obj->get (key); \ + if (field_value) \ + if (auto *field_obj = dyn_cast (field_value)) \ + parse_object_helper (field_obj, (member), (parse_func)); \ + } + +#define PARSE_ARRAY_FIELD(obj, key, member, parse_func) \ + { \ + const json::value *field_value = obj->get (key); \ + if (field_value) \ + if (auto *field_array = dyn_cast (field_value)) \ + for (size_t i = 0; i < field_array->size (); ++i) \ + { \ + const json::value *elem = field_array->get (i); \ + if (elem) \ + if (auto *array_obj = dyn_cast (elem)) \ + parse_func (array_obj, member[i]); \ + } \ + } + +#define PARSE_ENUM_FIELD(obj, key, member, mappings) \ + parse_enum_field (obj, key, member, mappings, \ + sizeof (mappings) / sizeof (mappings[0])) + +/* Type alias for parse function pointer. */ +template +using parse_func_type + = void (*) (const json::object *, + std::remove_const_t> &); + +/* Parse JSON object into non-pointer member type. */ +template +static std::enable_if_t::value> +parse_object_helper (const json::object *field_obj, T &member, + parse_func_type parse_func) +{ + parse_func (field_obj, member); +} + +/* Parse JSON object into a const pointer member by creating a temp copy. */ +template +static std::enable_if_t::value + && std::is_const>::value> +parse_object_helper (const json::object *field_obj, T &member, + parse_func_type parse_func) +{ + if (!member) + return; + + /* Use static storage for the non-const copy. + This works because tune_params does not have nested structures of the + same type, but has room for errors if we end up having pointers to the + same structure at some point. */ + static bool already_initialized = false; + if (already_initialized) + { + error ("static storage conflict - multiple pointer members of the " + "same type cannot be parsed"); + return; + } + already_initialized = true; + using NonConstType = std::remove_const_t>; + static NonConstType new_obj = *member; + parse_func (field_obj, new_obj); + member = &new_obj; +} + +/* Extract string value from JSON, returning allocated C string. */ +char * +extract_string (const json::value *val) +{ + if (auto *string_val = dyn_cast (val)) + return xstrdup (string_val->get_string ()); + warning (0, "expected a string but got something else or NULL"); + return nullptr; +} + +/* Extract signed integer value from JSON. */ +int +extract_integer (const json::value *val) +{ + if (auto *int_val = dyn_cast (val)) + { + long value = int_val->get (); + gcc_assert (value >= INT_MIN && value <= INT_MAX); + return static_cast (value); + } + warning (0, "expected an integer value but got something else or NULL"); + return 0; +} + +/* Extract unsigned integer value from JSON. */ +unsigned int +extract_unsigned_integer (const json::value *val) +{ + if (auto *int_val = dyn_cast (val)) + { + long value = int_val->get (); + gcc_assert (value >= 0 && value <= UINT_MAX); + return static_cast (value); + } + warning (0, + "expected an unsigned integer value but got something else or NULL"); + return 0; +} + +/* Extract boolean value from JSON literal. */ +bool +extract_boolean (const json::value *val) +{ + if (auto *literal_val = dyn_cast (val)) + { + json::kind kind = literal_val->get_kind (); + if (kind == json::JSON_TRUE || kind == json::JSON_FALSE) + return (kind == json::JSON_TRUE); + } + warning (0, "expected a boolean value but got something else or NULL"); + return false; +} + +template struct enum_mapping +{ + const char *name; + EnumType value; +}; + +/* Parse JSON string field into enum value using string-to-enum mappings. */ +template +static void +parse_enum_field (const json::object *jo, const std::string &key, + EnumType &enum_var, const enum_mapping *mappings, + size_t num_mappings) +{ + const json::value *field_value = jo->get (key.c_str ()); + if (!field_value) + return; + + auto *string_val = dyn_cast (field_value); + if (!string_val) + { + warning (0, "expected string for enum field %s", key.c_str ()); + enum_var = mappings[0].value; + return; + } + + const char *field_string = string_val->get_string (); + for (size_t i = 0; i < num_mappings; ++i) + { + if (strcmp (field_string, mappings[i].name) == 0) + { + enum_var = mappings[i].value; + return; + } + } + + warning (0, "%s not recognized, defaulting to %qs", key.c_str (), + mappings[0].name); + enum_var = mappings[0].value; +} + +/* Enum mappings for known tuning parameter enums. */ +static const enum_mapping + autoprefetcher_model_mappings[] + = {{"AUTOPREFETCHER_OFF", tune_params::AUTOPREFETCHER_OFF}, + {"AUTOPREFETCHER_WEAK", tune_params::AUTOPREFETCHER_WEAK}, + {"AUTOPREFETCHER_STRONG", tune_params::AUTOPREFETCHER_STRONG}}; + +static const enum_mapping ldp_policy_model_mappings[] + = {{"AARCH64_LDP_STP_POLICY_DEFAULT", AARCH64_LDP_STP_POLICY_DEFAULT}, + {"AARCH64_LDP_STP_POLICY_ALIGNED", AARCH64_LDP_STP_POLICY_ALIGNED}, + {"AARCH64_LDP_STP_POLICY_ALWAYS", AARCH64_LDP_STP_POLICY_ALWAYS}, + {"AARCH64_LDP_STP_POLICY_NEVER", AARCH64_LDP_STP_POLICY_NEVER}}; + +static const enum_mapping stp_policy_model_mappings[] + = {{"AARCH64_LDP_STP_POLICY_DEFAULT", AARCH64_LDP_STP_POLICY_DEFAULT}, + {"AARCH64_LDP_STP_POLICY_ALIGNED", AARCH64_LDP_STP_POLICY_ALIGNED}, + {"AARCH64_LDP_STP_POLICY_ALWAYS", AARCH64_LDP_STP_POLICY_ALWAYS}, + {"AARCH64_LDP_STP_POLICY_NEVER", AARCH64_LDP_STP_POLICY_NEVER}}; + +template +static void +parse_insn_extra_cost_alu (const json::object *jo, T &alu) +{ + PARSE_INTEGER_FIELD (jo, "arith", alu.arith); + PARSE_INTEGER_FIELD (jo, "logical", alu.logical); + PARSE_INTEGER_FIELD (jo, "shift", alu.shift); + PARSE_INTEGER_FIELD (jo, "shift_reg", alu.shift_reg); + PARSE_INTEGER_FIELD (jo, "arith_shift", alu.arith_shift); + PARSE_INTEGER_FIELD (jo, "arith_shift_reg", alu.arith_shift_reg); + PARSE_INTEGER_FIELD (jo, "log_shift", alu.log_shift); + PARSE_INTEGER_FIELD (jo, "log_shift_reg", alu.log_shift_reg); + PARSE_INTEGER_FIELD (jo, "extend", alu.extend); + PARSE_INTEGER_FIELD (jo, "extend_arith", alu.extend_arith); + PARSE_INTEGER_FIELD (jo, "bfi", alu.bfi); + PARSE_INTEGER_FIELD (jo, "bfx", alu.bfx); + PARSE_INTEGER_FIELD (jo, "clz", alu.clz); + PARSE_INTEGER_FIELD (jo, "rev", alu.rev); + PARSE_INTEGER_FIELD (jo, "non_exec", alu.non_exec); + PARSE_BOOLEAN_FIELD (jo, "non_exec_costs_exec", alu.non_exec_costs_exec); +} + +template +static void +parse_insn_extra_cost_mult_element (const json::object *jo, T &mult_element) +{ + PARSE_INTEGER_FIELD (jo, "simple", mult_element.simple); + PARSE_INTEGER_FIELD (jo, "flag_setting", mult_element.flag_setting); + PARSE_INTEGER_FIELD (jo, "extend", mult_element.extend); + PARSE_INTEGER_FIELD (jo, "add", mult_element.add); + PARSE_INTEGER_FIELD (jo, "extend_add", mult_element.extend_add); + PARSE_INTEGER_FIELD (jo, "idiv", mult_element.idiv); +} + +template +static void +parse_insn_extra_cost_ldst (const json::object *jo, T &ldst) +{ + PARSE_INTEGER_FIELD (jo, "load", ldst.load); + PARSE_INTEGER_FIELD (jo, "load_sign_extend", ldst.load_sign_extend); + PARSE_INTEGER_FIELD (jo, "ldrd", ldst.ldrd); + PARSE_INTEGER_FIELD (jo, "ldm_1st", ldst.ldm_1st); + PARSE_INTEGER_FIELD (jo, "ldm_regs_per_insn_1st", ldst.ldm_regs_per_insn_1st); + PARSE_INTEGER_FIELD (jo, "ldm_regs_per_insn_subsequent", + ldst.ldm_regs_per_insn_subsequent); + PARSE_INTEGER_FIELD (jo, "loadf", ldst.loadf); + PARSE_INTEGER_FIELD (jo, "loadd", ldst.loadd); + PARSE_INTEGER_FIELD (jo, "load_unaligned", ldst.load_unaligned); + PARSE_INTEGER_FIELD (jo, "store", ldst.store); + PARSE_INTEGER_FIELD (jo, "strd", ldst.strd); + PARSE_INTEGER_FIELD (jo, "stm_1st", ldst.stm_1st); + PARSE_INTEGER_FIELD (jo, "stm_regs_per_insn_1st", ldst.stm_regs_per_insn_1st); + PARSE_INTEGER_FIELD (jo, "stm_regs_per_insn_subsequent", + ldst.stm_regs_per_insn_subsequent); + PARSE_INTEGER_FIELD (jo, "storef", ldst.storef); + PARSE_INTEGER_FIELD (jo, "stored", ldst.stored); + PARSE_INTEGER_FIELD (jo, "store_unaligned", ldst.store_unaligned); + PARSE_INTEGER_FIELD (jo, "loadv", ldst.loadv); + PARSE_INTEGER_FIELD (jo, "storev", ldst.storev); +} + +template +static void +parse_insn_extra_cost_fp_element (const json::object *jo, T &fp_element) +{ + PARSE_INTEGER_FIELD (jo, "div", fp_element.div); + PARSE_INTEGER_FIELD (jo, "mult", fp_element.mult); + PARSE_INTEGER_FIELD (jo, "mult_addsub", fp_element.mult_addsub); + PARSE_INTEGER_FIELD (jo, "fma", fp_element.fma); + PARSE_INTEGER_FIELD (jo, "addsub", fp_element.addsub); + PARSE_INTEGER_FIELD (jo, "fpconst", fp_element.fpconst); + PARSE_INTEGER_FIELD (jo, "neg", fp_element.neg); + PARSE_INTEGER_FIELD (jo, "compare", fp_element.compare); + PARSE_INTEGER_FIELD (jo, "widen", fp_element.widen); + PARSE_INTEGER_FIELD (jo, "narrow", fp_element.narrow); + PARSE_INTEGER_FIELD (jo, "toint", fp_element.toint); + PARSE_INTEGER_FIELD (jo, "fromint", fp_element.fromint); + PARSE_INTEGER_FIELD (jo, "roundint", fp_element.roundint); +} + +template +static void +parse_insn_extra_cost_vect (const json::object *jo, T &vect) +{ + PARSE_INTEGER_FIELD (jo, "alu", vect.alu); + PARSE_INTEGER_FIELD (jo, "mult", vect.mult); + PARSE_INTEGER_FIELD (jo, "movi", vect.movi); + PARSE_INTEGER_FIELD (jo, "dup", vect.dup); + PARSE_INTEGER_FIELD (jo, "extract", vect.extract); +} + +template +static void +parse_addr_cost_addr_scale_costs (const json::object *jo, T &addr_scale_costs) +{ + PARSE_INTEGER_FIELD (jo, "hi", addr_scale_costs.hi); + PARSE_INTEGER_FIELD (jo, "si", addr_scale_costs.si); + PARSE_INTEGER_FIELD (jo, "di", addr_scale_costs.di); + PARSE_INTEGER_FIELD (jo, "ti", addr_scale_costs.ti); +} + +template +static void +parse_regmove_cost (const json::object *jo, T ®move_cost) +{ + PARSE_INTEGER_FIELD (jo, "GP2GP", regmove_cost.GP2GP); + PARSE_INTEGER_FIELD (jo, "GP2FP", regmove_cost.GP2FP); + PARSE_INTEGER_FIELD (jo, "FP2GP", regmove_cost.FP2GP); + PARSE_INTEGER_FIELD (jo, "FP2FP", regmove_cost.FP2FP); +} + +template +static void +parse_vec_costs_advsimd (const json::object *jo, T &advsimd) +{ + PARSE_INTEGER_FIELD (jo, "int_stmt_cost", advsimd.int_stmt_cost); + PARSE_INTEGER_FIELD (jo, "fp_stmt_cost", advsimd.fp_stmt_cost); + PARSE_INTEGER_FIELD (jo, "ld2_st2_permute_cost", + advsimd.ld2_st2_permute_cost); + PARSE_INTEGER_FIELD (jo, "ld3_st3_permute_cost", + advsimd.ld3_st3_permute_cost); + PARSE_INTEGER_FIELD (jo, "ld4_st4_permute_cost", + advsimd.ld4_st4_permute_cost); + PARSE_INTEGER_FIELD (jo, "permute_cost", advsimd.permute_cost); + PARSE_INTEGER_FIELD (jo, "reduc_i8_cost", advsimd.reduc_i8_cost); + PARSE_INTEGER_FIELD (jo, "reduc_i16_cost", advsimd.reduc_i16_cost); + PARSE_INTEGER_FIELD (jo, "reduc_i32_cost", advsimd.reduc_i32_cost); + PARSE_INTEGER_FIELD (jo, "reduc_i64_cost", advsimd.reduc_i64_cost); + PARSE_INTEGER_FIELD (jo, "reduc_f16_cost", advsimd.reduc_f16_cost); + PARSE_INTEGER_FIELD (jo, "reduc_f32_cost", advsimd.reduc_f32_cost); + PARSE_INTEGER_FIELD (jo, "reduc_f64_cost", advsimd.reduc_f64_cost); + PARSE_INTEGER_FIELD (jo, "store_elt_extra_cost", + advsimd.store_elt_extra_cost); + PARSE_INTEGER_FIELD (jo, "vec_to_scalar_cost", advsimd.vec_to_scalar_cost); + PARSE_INTEGER_FIELD (jo, "scalar_to_vec_cost", advsimd.scalar_to_vec_cost); + PARSE_INTEGER_FIELD (jo, "align_load_cost", advsimd.align_load_cost); + PARSE_INTEGER_FIELD (jo, "unalign_load_cost", advsimd.unalign_load_cost); + PARSE_INTEGER_FIELD (jo, "unalign_store_cost", advsimd.unalign_store_cost); + PARSE_INTEGER_FIELD (jo, "store_cost", advsimd.store_cost); +} + +template +static void +parse_vec_costs_sve (const json::object *jo, T &sve) +{ + PARSE_INTEGER_FIELD (jo, "clast_cost", sve.clast_cost); + PARSE_INTEGER_FIELD (jo, "fadda_f16_cost", sve.fadda_f16_cost); + PARSE_INTEGER_FIELD (jo, "fadda_f32_cost", sve.fadda_f32_cost); + PARSE_INTEGER_FIELD (jo, "fadda_f64_cost", sve.fadda_f64_cost); + PARSE_INTEGER_FIELD (jo, "gather_load_x32_cost", sve.gather_load_x32_cost); + PARSE_INTEGER_FIELD (jo, "gather_load_x64_cost", sve.gather_load_x64_cost); + PARSE_INTEGER_FIELD (jo, "gather_load_x32_init_cost", + sve.gather_load_x32_init_cost); + PARSE_INTEGER_FIELD (jo, "gather_load_x64_init_cost", + sve.gather_load_x64_init_cost); + PARSE_INTEGER_FIELD (jo, "scatter_store_elt_cost", + sve.scatter_store_elt_cost); +} + +template +static void +parse_vec_costs_issue_info_scalar (const json::object *jo, T &scalar) +{ + PARSE_INTEGER_FIELD (jo, "loads_stores_per_cycle", + scalar.loads_stores_per_cycle); + PARSE_INTEGER_FIELD (jo, "stores_per_cycle", scalar.stores_per_cycle); + PARSE_INTEGER_FIELD (jo, "general_ops_per_cycle", + scalar.general_ops_per_cycle); + PARSE_INTEGER_FIELD (jo, "fp_simd_load_general_ops", + scalar.fp_simd_load_general_ops); + PARSE_INTEGER_FIELD (jo, "fp_simd_store_general_ops", + scalar.fp_simd_store_general_ops); +} + +template +static void +parse_vec_costs_issue_info_advsimd (const json::object *jo, T &advsimd) +{ + PARSE_INTEGER_FIELD (jo, "loads_stores_per_cycle", + advsimd.loads_stores_per_cycle); + PARSE_INTEGER_FIELD (jo, "stores_per_cycle", advsimd.stores_per_cycle); + PARSE_INTEGER_FIELD (jo, "general_ops_per_cycle", + advsimd.general_ops_per_cycle); + PARSE_INTEGER_FIELD (jo, "fp_simd_load_general_ops", + advsimd.fp_simd_load_general_ops); + PARSE_INTEGER_FIELD (jo, "fp_simd_store_general_ops", + advsimd.fp_simd_store_general_ops); + PARSE_INTEGER_FIELD (jo, "ld2_st2_general_ops", advsimd.ld2_st2_general_ops); + PARSE_INTEGER_FIELD (jo, "ld3_st3_general_ops", advsimd.ld3_st3_general_ops); + PARSE_INTEGER_FIELD (jo, "ld4_st4_general_ops", advsimd.ld4_st4_general_ops); +} + +template +static void +parse_vec_costs_issue_info_sve (const json::object *jo, T &sve) +{ + PARSE_INTEGER_FIELD (jo, "loads_stores_per_cycle", + sve.loads_stores_per_cycle); + PARSE_INTEGER_FIELD (jo, "stores_per_cycle", sve.stores_per_cycle); + PARSE_INTEGER_FIELD (jo, "general_ops_per_cycle", sve.general_ops_per_cycle); + PARSE_INTEGER_FIELD (jo, "fp_simd_load_general_ops", + sve.fp_simd_load_general_ops); + PARSE_INTEGER_FIELD (jo, "fp_simd_store_general_ops", + sve.fp_simd_store_general_ops); + PARSE_INTEGER_FIELD (jo, "ld2_st2_general_ops", sve.ld2_st2_general_ops); + PARSE_INTEGER_FIELD (jo, "ld3_st3_general_ops", sve.ld3_st3_general_ops); + PARSE_INTEGER_FIELD (jo, "ld4_st4_general_ops", sve.ld4_st4_general_ops); + PARSE_INTEGER_FIELD (jo, "pred_ops_per_cycle", sve.pred_ops_per_cycle); + PARSE_INTEGER_FIELD (jo, "while_pred_ops", sve.while_pred_ops); + PARSE_INTEGER_FIELD (jo, "int_cmp_pred_ops", sve.int_cmp_pred_ops); + PARSE_INTEGER_FIELD (jo, "fp_cmp_pred_ops", sve.fp_cmp_pred_ops); + PARSE_INTEGER_FIELD (jo, "gather_scatter_pair_general_ops", + sve.gather_scatter_pair_general_ops); + PARSE_INTEGER_FIELD (jo, "gather_scatter_pair_pred_ops", + sve.gather_scatter_pair_pred_ops); +} + +template +static void +parse_branch_costs (const json::object *jo, T &branch_costs) +{ + PARSE_INTEGER_FIELD (jo, "predictable", branch_costs.predictable); + PARSE_INTEGER_FIELD (jo, "unpredictable", branch_costs.unpredictable); +} + +template +static void +parse_approx_modes (const json::object *jo, T &approx_modes) +{ + PARSE_INTEGER_FIELD (jo, "division", approx_modes.division); + PARSE_INTEGER_FIELD (jo, "sqrt", approx_modes.sqrt); + PARSE_INTEGER_FIELD (jo, "recip_sqrt", approx_modes.recip_sqrt); +} + +template +static void +parse_memmov_cost (const json::object *jo, T &memmov_cost) +{ + PARSE_INTEGER_FIELD (jo, "load_int", memmov_cost.load_int); + PARSE_INTEGER_FIELD (jo, "store_int", memmov_cost.store_int); + PARSE_INTEGER_FIELD (jo, "load_fp", memmov_cost.load_fp); + PARSE_INTEGER_FIELD (jo, "store_fp", memmov_cost.store_fp); + PARSE_INTEGER_FIELD (jo, "load_pred", memmov_cost.load_pred); + PARSE_INTEGER_FIELD (jo, "store_pred", memmov_cost.store_pred); +} + +template +static void +parse_prefetch (const json::object *jo, T &prefetch) +{ + PARSE_INTEGER_FIELD (jo, "num_slots", prefetch.num_slots); + PARSE_INTEGER_FIELD (jo, "l1_cache_size", prefetch.l1_cache_size); + PARSE_INTEGER_FIELD (jo, "l1_cache_line_size", prefetch.l1_cache_line_size); + PARSE_INTEGER_FIELD (jo, "l2_cache_size", prefetch.l2_cache_size); + PARSE_BOOLEAN_FIELD (jo, "prefetch_dynamic_strides", + prefetch.prefetch_dynamic_strides); + PARSE_INTEGER_FIELD (jo, "minimum_stride", prefetch.minimum_stride); + PARSE_INTEGER_FIELD (jo, "default_opt_level", prefetch.default_opt_level); +} + +template +static void +parse_insn_extra_cost (const json::object *jo, T &insn_extra_cost) +{ + PARSE_OBJECT (jo, "alu", insn_extra_cost.alu, parse_insn_extra_cost_alu); + PARSE_ARRAY_FIELD (jo, "mult", insn_extra_cost.mult, + parse_insn_extra_cost_mult_element); + PARSE_OBJECT (jo, "ldst", insn_extra_cost.ldst, parse_insn_extra_cost_ldst); + PARSE_ARRAY_FIELD (jo, "fp", insn_extra_cost.fp, + parse_insn_extra_cost_fp_element); + PARSE_OBJECT (jo, "vect", insn_extra_cost.vect, parse_insn_extra_cost_vect); +} + +template +static void +parse_addr_cost (const json::object *jo, T &addr_cost) +{ + PARSE_OBJECT (jo, "addr_scale_costs", addr_cost.addr_scale_costs, + parse_addr_cost_addr_scale_costs); + PARSE_INTEGER_FIELD (jo, "pre_modify", addr_cost.pre_modify); + PARSE_INTEGER_FIELD (jo, "post_modify", addr_cost.post_modify); + PARSE_INTEGER_FIELD (jo, "post_modify_ld3_st3", + addr_cost.post_modify_ld3_st3); + PARSE_INTEGER_FIELD (jo, "post_modify_ld4_st4", + addr_cost.post_modify_ld4_st4); + PARSE_INTEGER_FIELD (jo, "register_offset", addr_cost.register_offset); + PARSE_INTEGER_FIELD (jo, "register_sextend", addr_cost.register_sextend); + PARSE_INTEGER_FIELD (jo, "register_zextend", addr_cost.register_zextend); + PARSE_INTEGER_FIELD (jo, "imm_offset", addr_cost.imm_offset); +} + +template +static void +parse_vec_costs_issue_info (const json::object *jo, T &issue_info) +{ + PARSE_OBJECT (jo, "scalar", issue_info.scalar, + parse_vec_costs_issue_info_scalar); + PARSE_OBJECT (jo, "advsimd", issue_info.advsimd, + parse_vec_costs_issue_info_advsimd); + PARSE_OBJECT (jo, "sve", issue_info.sve, parse_vec_costs_issue_info_sve); +} + +template +static void +parse_vec_costs (const json::object *jo, T &vec_costs) +{ + PARSE_INTEGER_FIELD (jo, "scalar_int_stmt_cost", + vec_costs.scalar_int_stmt_cost); + PARSE_INTEGER_FIELD (jo, "scalar_fp_stmt_cost", + vec_costs.scalar_fp_stmt_cost); + PARSE_INTEGER_FIELD (jo, "scalar_load_cost", vec_costs.scalar_load_cost); + PARSE_INTEGER_FIELD (jo, "scalar_store_cost", vec_costs.scalar_store_cost); + PARSE_INTEGER_FIELD (jo, "cond_taken_branch_cost", + vec_costs.cond_taken_branch_cost); + PARSE_INTEGER_FIELD (jo, "cond_not_taken_branch_cost", + vec_costs.cond_not_taken_branch_cost); + PARSE_OBJECT (jo, "advsimd", vec_costs.advsimd, parse_vec_costs_advsimd); + PARSE_OBJECT (jo, "sve", vec_costs.sve, parse_vec_costs_sve); + PARSE_OBJECT (jo, "issue_info", vec_costs.issue_info, + parse_vec_costs_issue_info); +} + +template +static void +parse_tunings (const json::object *jo, T &tunings) +{ + PARSE_OBJECT (jo, "insn_extra_cost", tunings.insn_extra_cost, + parse_insn_extra_cost); + PARSE_OBJECT (jo, "addr_cost", tunings.addr_cost, parse_addr_cost); + PARSE_OBJECT (jo, "regmove_cost", tunings.regmove_cost, parse_regmove_cost); + PARSE_OBJECT (jo, "vec_costs", tunings.vec_costs, parse_vec_costs); + PARSE_OBJECT (jo, "branch_costs", tunings.branch_costs, parse_branch_costs); + PARSE_OBJECT (jo, "approx_modes", tunings.approx_modes, parse_approx_modes); + PARSE_INTEGER_FIELD (jo, "sve_width", tunings.sve_width); + PARSE_OBJECT (jo, "memmov_cost", tunings.memmov_cost, parse_memmov_cost); + PARSE_INTEGER_FIELD (jo, "issue_rate", tunings.issue_rate); + PARSE_INTEGER_FIELD (jo, "fusible_ops", tunings.fusible_ops); + PARSE_STRING_FIELD (jo, "function_align", tunings.function_align); + PARSE_STRING_FIELD (jo, "jump_align", tunings.jump_align); + PARSE_STRING_FIELD (jo, "loop_align", tunings.loop_align); + PARSE_INTEGER_FIELD (jo, "int_reassoc_width", tunings.int_reassoc_width); + PARSE_INTEGER_FIELD (jo, "fp_reassoc_width", tunings.fp_reassoc_width); + PARSE_INTEGER_FIELD (jo, "fma_reassoc_width", tunings.fma_reassoc_width); + PARSE_INTEGER_FIELD (jo, "vec_reassoc_width", tunings.vec_reassoc_width); + PARSE_INTEGER_FIELD (jo, "min_div_recip_mul_sf", + tunings.min_div_recip_mul_sf); + PARSE_INTEGER_FIELD (jo, "min_div_recip_mul_df", + tunings.min_div_recip_mul_df); + PARSE_INTEGER_FIELD (jo, "max_case_values", tunings.max_case_values); + PARSE_ENUM_FIELD (jo, "autoprefetcher_model", tunings.autoprefetcher_model, + autoprefetcher_model_mappings); + PARSE_INTEGER_FIELD (jo, "extra_tuning_flags", tunings.extra_tuning_flags); + PARSE_OBJECT (jo, "prefetch", tunings.prefetch, parse_prefetch); + PARSE_ENUM_FIELD (jo, "ldp_policy_model", tunings.ldp_policy_model, + ldp_policy_model_mappings); + PARSE_ENUM_FIELD (jo, "stp_policy_model", tunings.stp_policy_model, + stp_policy_model_mappings); +} + +/* Validate the user provided JSON data against the present schema. + Checks for correct types, fields, and expected format. */ +static bool +validate_and_traverse (const json::object *json_obj, + const json::object *schema_obj, + const std::string &parent_key = "") +{ + for (const auto &json_entry : json_obj->get_map ()) + { + const std::string &key = json_entry.first; + const json::value *json_value = json_entry.second; + + std::string full_key = parent_key.empty () ? key : parent_key + "." + key; + + const json::value *schema_value = schema_obj->get (key.c_str ()); + if (!schema_value) + { + warning (0, "key %qs is not a tuning parameter, skipping", + full_key.c_str ()); + continue; + } + + if (auto *sub_schema_obj = dyn_cast (schema_value)) + { + if (auto *sub_json_obj = dyn_cast (json_value)) + { + if (!validate_and_traverse (sub_json_obj, sub_schema_obj, + full_key)) + return false; + } + else + { + error ("key %qs expected to be an object", full_key.c_str ()); + return false; + } + } + else if (schema_value->get_kind () == json::JSON_ARRAY) + { + if (json_value->get_kind () != json::JSON_ARRAY) + { + error ("key %qs expected to be an array", full_key.c_str ()); + return false; + } + } + else if (auto *schema_string + = dyn_cast (schema_value)) + { + const char *schema_type_str = schema_string->get_string (); + + if (strcmp (schema_type_str, "int") == 0) + { + if (json_value->get_kind () != json::JSON_INTEGER) + { + error ("key %qs expected to be an integer", + full_key.c_str ()); + return false; + } + // Check if the value is valid for signed integer + if (auto *int_val + = dyn_cast (json_value)) + { + long value = int_val->get (); + if (value > INT_MAX || value < INT_MIN) + { + error ("key %qs value %ld is out of range for % " + "type [%d, %d]", + full_key.c_str (), value, INT_MIN, INT_MAX); + return false; + } + } + } + else if (strcmp (schema_type_str, "uint") == 0) + { + if (json_value->get_kind () != json::JSON_INTEGER) + { + error ("key %qs expected to be an unsigned integer", + full_key.c_str ()); + return false; + } + // Check if the value is valid for unsigned integer + if (auto *int_val + = dyn_cast (json_value)) + { + long value = int_val->get (); + if (value < 0 || value > UINT_MAX) + { + error ("key %qs value %ld is out of range for % " + "type [0, %u]", + full_key.c_str (), value, UINT_MAX); + return false; + } + } + } + else if (strcmp (schema_type_str, "string") == 0) + { + if (json_value->get_kind () != json::JSON_STRING) + { + error ("key %qs expected to be a string", full_key.c_str ()); + return false; + } + } + else if (strcmp (schema_type_str, "boolean") == 0) + { + if (json_value->get_kind () != json::JSON_TRUE + && json_value->get_kind () != json::JSON_FALSE) + { + error ("key %qs expected to be a boolean (true/false)", + full_key.c_str ()); + return false; + } + } + else if (strcmp (schema_type_str, "enum") == 0) + { + if (json_value->get_kind () != json::JSON_STRING) + { + error ("key %qs expected to be an enum (string)", + full_key.c_str ()); + return false; + } + } + else + { + error ("key %qs has unsupported type", full_key.c_str ()); + return false; + } + } + else + { + error ("key %qs has unexpected format in schema", full_key.c_str ()); + return false; + } + } + return true; +} + +/* Helper routine for reading the provided JSON file. */ +static std::unique_ptr> +read_file (const char *path) +{ + FILE *f_in = fopen (path, "r"); + if (!f_in) + { + error ("could not open file %s", path); + return nullptr; + } + + auto result = std::make_unique> (); + char buf[4096]; + + while (size_t iter_sz_in = fread (buf, 1, sizeof (buf), f_in)) + result->insert (result->end (), buf, buf + iter_sz_in); + + if (!feof (f_in)) + { + error ("error reading file %s", path); + fclose (f_in); + return nullptr; + } + + fclose (f_in); + result->push_back ('\0'); + return result; +} + +static bool +check_version_compatibility (const json::object *root_obj) +{ + const json::value *metadata_value = root_obj->get ("metadata"); + int json_gcc_major_version = -1; + + if (metadata_value) + { + if (auto *metadata_obj = dyn_cast (metadata_value)) + { + const json::value *version_value = metadata_obj->get ("gcc_version"); + if (version_value) + { + if (auto *version_int_val + = dyn_cast (version_value)) + json_gcc_major_version = version_int_val->get (); + } + } + } + + if (json_gcc_major_version == -1) + { + warning (0, "JSON tuning file does not contain version information; " + "compatibility cannot be verified"); + return true; + } + + if (json_gcc_major_version != GCC_major_version) + { + error ("JSON tuning file was created with GCC version %d " + "but current GCC version is %d", + json_gcc_major_version, GCC_major_version); + inform (UNKNOWN_LOCATION, "JSON tuning files must be regenerated " + "when switching between major GCC versions"); + return false; + } + + return true; +} + +/* Main routine for setting up the parsing of JSON data. */ +static void +aarch64_load_tuning_params_from_json_string (const char *json_string, + const char *schema_string, + struct tune_params *tune) +{ + /* Try parsing the JSON string. */ + json::parser_result_t data_result + = json::parse_utf8_string (strlen (json_string), json_string, true, + nullptr); + + if (auto json_err = data_result.m_err.get ()) + { + error ("error parsing JSON data: %s", json_err->get_msg ()); + return; + } + + const std::unique_ptr &root = data_result.m_val; + if (!root) + { + error ("JSON parsing returned null data"); + return; + } + auto *root_obj = dyn_cast (root.get ()); + if (!root_obj) + { + warning (0, "no JSON object found in the provided data"); + return; + } + + /* Check version compatibility before proceeding. */ + if (!check_version_compatibility (root_obj)) + return; + + json::parser_result_t schema_result + = json::parse_utf8_string (strlen (schema_string), schema_string, true, + nullptr); + + gcc_assert (!schema_result.m_err.get ()); + gcc_assert (schema_result.m_val); + + auto *schema_obj + = dyn_cast (schema_result.m_val.get ()); + gcc_assert (schema_obj); + + const json::value *tune_params_value = root_obj->get ("tune_params"); + if (!tune_params_value) + { + warning (0, "key % not found in JSON data"); + return; + } + + auto *jo = dyn_cast (tune_params_value); + if (!jo) + { + error ("key % is not a JSON object"); + return; + } + + if (!validate_and_traverse (root_obj, schema_obj)) + { + error ("validation failed for the provided JSON data"); + return; + } + + parse_tunings (jo, *tune); + return; +} + +/* Wrapper for calling aarch64_load_tuning_params_from_json_string. */ +void +aarch64_load_tuning_params_from_json (const char *data_filename, + struct tune_params *tune) +{ + std::unique_ptr> json_data = read_file (data_filename); + if (!json_data || !json_data->data ()) + { + error ("cannot read JSON data in %s", data_filename); + return; + } + aarch64_load_tuning_params_from_json_string ( + (const char *) json_data->data (), schema_json, tune); +} + +#if CHECKING_P +namespace selftest { + +#define STR_(X) #X +#define STR(X) STR_(X) + +void +test_json_integers () +{ + const char *test_json = R"json({ + "metadata": { + "gcc_version": )json" STR (GCC_major_version) R"json( + }, + "tune_params": { + "sve_width": 256, + "issue_rate": 4 + } + })json"; + + tune_params params; + + aarch64_load_tuning_params_from_json_string (test_json, schema_json, ¶ms); + + ASSERT_EQ (params.sve_width, 256); + ASSERT_EQ (params.issue_rate, 4); +} + +void +test_json_boolean () +{ + const char *test_json = R"json({ + "metadata": { + "gcc_version": )json" STR (GCC_major_version) R"json( + }, + "tune_params": { + "insn_extra_cost": { + "alu": { + "non_exec_costs_exec": false + } + } + } + })json"; + + static const cpu_cost_table default_cost_table = {}; + + tune_params params; + params.insn_extra_cost = &default_cost_table; + + aarch64_load_tuning_params_from_json_string (test_json, schema_json, ¶ms); + + ASSERT_EQ (params.insn_extra_cost->alu.non_exec_costs_exec, false); +} + +void +test_json_strings () +{ + const char *test_json = R"json({ + "metadata": { + "gcc_version": )json" STR (GCC_major_version) R"json( + }, + "tune_params": { + "function_align": "16", + "jump_align": "2", + "loop_align": "8" + } + })json"; + + tune_params params; + + aarch64_load_tuning_params_from_json_string (test_json, schema_json, ¶ms); + + ASSERT_STREQ (params.function_align, "16"); + ASSERT_STREQ (params.jump_align, "2"); + ASSERT_STREQ (params.loop_align, "8"); +} + +void +test_json_enums () +{ + const char *test_json = R"json({ + "metadata": { + "gcc_version": )json" STR (GCC_major_version) R"json( + }, + "tune_params": { + "autoprefetcher_model": "AUTOPREFETCHER_OFF", + "ldp_policy_model": "AARCH64_LDP_STP_POLICY_NEVER", + "stp_policy_model": "AARCH64_LDP_STP_POLICY_DEFAULT" + } + })json"; + + tune_params params; + + aarch64_load_tuning_params_from_json_string (test_json, schema_json, ¶ms); + + ASSERT_EQ (params.autoprefetcher_model, tune_params::AUTOPREFETCHER_OFF); + ASSERT_EQ (params.ldp_policy_model, AARCH64_LDP_STP_POLICY_NEVER); + ASSERT_EQ (params.stp_policy_model, AARCH64_LDP_STP_POLICY_DEFAULT); +} + +void +aarch64_json_tunings_tests () +{ + test_json_integers (); + test_json_boolean (); + test_json_strings (); + test_json_enums (); +} + +} // namespace selftest + +#undef STR +#undef STR_ + +#endif /* CHECKING_P */ \ No newline at end of file diff --git a/gcc/config/aarch64/aarch64-json-tunings-parser.h b/gcc/config/aarch64/aarch64-json-tunings-parser.h new file mode 100644 index 000000000000..3c5cd4c3c20b --- /dev/null +++ b/gcc/config/aarch64/aarch64-json-tunings-parser.h @@ -0,0 +1,29 @@ +/* Routines to parse the AArch64 tuning parameters from a JSON file. + Copyright The GNU Toolchain Authors. + + This file is part of GCC. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#ifndef AARCH64_JSON_TUNINGS_PARSER_H +#define AARCH64_JSON_TUNINGS_PARSER_H + +#include "aarch64-protos.h" + +void +aarch64_load_tuning_params_from_json (const char *data_filename, + struct tune_params *tune); + +#endif \ No newline at end of file diff --git a/gcc/config/aarch64/aarch64.cc b/gcc/config/aarch64/aarch64.cc index 5586012f15cb..d8c99d8e3c27 100644 --- a/gcc/config/aarch64/aarch64.cc +++ b/gcc/config/aarch64/aarch64.cc @@ -100,6 +100,7 @@ #include "hash-map.h" #include "aarch64-sched-dispatch.h" #include "aarch64-json-tunings-printer.h" +#include "aarch64-json-tunings-parser.h" /* This file should be included last. */ #include "target-def.h" @@ -19170,6 +19171,21 @@ aarch64_override_options_internal (struct gcc_options *opts) aarch64_parse_override_string (opts->x_aarch64_override_tune_string, &aarch64_tune_params); + /* We need to parse the JSON file only once per program execution. */ + if (opts->x_muser_provided_CPU) + { + static bool json_parsed = false; + static struct tune_params aarch64_json_params; + if (!json_parsed) + { + aarch64_json_params = *(tune->tune); + aarch64_load_tuning_params_from_json (opts->x_muser_provided_CPU, + &aarch64_json_params); + json_parsed = true; + } + aarch64_tune_params = aarch64_json_params; + } + if (opts->x_aarch64_ldp_policy_param) aarch64_tune_params.ldp_policy_model = opts->x_aarch64_ldp_policy_param; @@ -32425,6 +32441,8 @@ aarch64_test_sve_folding () } } +extern void aarch64_json_tunings_tests (); + /* Run all target-specific selftests. */ static void @@ -32434,6 +32452,7 @@ aarch64_run_selftests (void) aarch64_test_fractional_cost (); aarch64_test_sysreg_encoding_clashes (); aarch64_test_sve_folding (); + aarch64_json_tunings_tests (); } } // namespace selftest diff --git a/gcc/config/aarch64/aarch64.opt b/gcc/config/aarch64/aarch64.opt index adc65afc808a..df93b59fe3f3 100644 --- a/gcc/config/aarch64/aarch64.opt +++ b/gcc/config/aarch64/aarch64.opt @@ -197,6 +197,10 @@ fdump-tuning-model= Target Undocumented RejectNegative Negative(fdump-tuning-model=) Joined Var(fdump_tuning_model) -fdump-tuning-model= Dump current tuning model to a JSON file. +muser-provided-CPU= +Target Undocumented RejectNegative Negative(muser-provided-CPU=) Joined Var(muser_provided_CPU) +-muser-provided-CPU= User specific CPU tunings. + moverride= Target RejectNegative ToLower Joined Var(aarch64_override_tune_string) Save -moverride= Power users only! Override CPU optimization parameters. diff --git a/gcc/config/aarch64/t-aarch64 b/gcc/config/aarch64/t-aarch64 index e1a1c9b963f8..34eb287adc57 100644 --- a/gcc/config/aarch64/t-aarch64 +++ b/gcc/config/aarch64/t-aarch64 @@ -219,6 +219,16 @@ aarch64-json-tunings-printer.o: $(srcdir)/config/aarch64/aarch64-json-tunings-pr $(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ $(srcdir)/config/aarch64/aarch64-json-tunings-printer.cc +aarch64-json-tunings-parser.o: $(srcdir)/config/aarch64/aarch64-json-tunings-parser.cc \ + $(CONFIG_H) $(SYSTEM_H) $(CORETYPES_H) $(TM_H) $(DIAGNOSTIC_CORE_H) \ + json-parsing.h \ + $(srcdir)/config/aarch64/aarch64-json-schema.h \ + $(srcdir)/config/aarch64/aarch64-json-tunings-parser.h \ + $(srcdir)/config/aarch64/aarch64-protos.h \ + $(srcdir)/config/arm/aarch-common-protos.h + $(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ + $(srcdir)/config/aarch64/aarch64-json-tunings-parser.cc + comma=, MULTILIB_OPTIONS = $(subst $(comma),/, $(patsubst %, mabi=%, $(subst $(comma),$(comma)mabi=,$(TM_MULTILIB_CONFIG)))) MULTILIB_DIRNAMES = $(subst $(comma), ,$(TM_MULTILIB_CONFIG)) From 6b454e69b7ba2c0a17c67f666bff7e203723ab69 Mon Sep 17 00:00:00 2001 From: Soumya AR Date: Wed, 16 Jul 2025 06:31:33 -0700 Subject: [PATCH 030/373] aarch64: Regression tests for parsing of user-provided AArch64 CPU tuning parameters Signed-off-by: Soumya AR gcc/testsuite/ChangeLog: * gcc.target/aarch64/aarch64-json-tunings/aarch64-json-tunings.exp: New test. * gcc.target/aarch64/aarch64-json-tunings/boolean-1.c: New test. * gcc.target/aarch64/aarch64-json-tunings/boolean-1.json: New test. * gcc.target/aarch64/aarch64-json-tunings/boolean-2.c: New test. * gcc.target/aarch64/aarch64-json-tunings/boolean-2.json: New test. * gcc.target/aarch64/aarch64-json-tunings/empty-brackets.c: New test. * gcc.target/aarch64/aarch64-json-tunings/empty-brackets.json: New test. * gcc.target/aarch64/aarch64-json-tunings/empty.c: New test. * gcc.target/aarch64/aarch64-json-tunings/empty.json: New test. * gcc.target/aarch64/aarch64-json-tunings/enum-1.c: New test. * gcc.target/aarch64/aarch64-json-tunings/enum-1.json: New test. * gcc.target/aarch64/aarch64-json-tunings/enum-2.c: New test. * gcc.target/aarch64/aarch64-json-tunings/enum-2.json: New test. * gcc.target/aarch64/aarch64-json-tunings/integer-1.c: New test. * gcc.target/aarch64/aarch64-json-tunings/integer-1.json: New test. * gcc.target/aarch64/aarch64-json-tunings/integer-2.c: New test. * gcc.target/aarch64/aarch64-json-tunings/integer-2.json: New test. * gcc.target/aarch64/aarch64-json-tunings/integer-3.c: New test. * gcc.target/aarch64/aarch64-json-tunings/integer-3.json: New test. * gcc.target/aarch64/aarch64-json-tunings/string-1.c: New test. * gcc.target/aarch64/aarch64-json-tunings/string-1.json: New test. * gcc.target/aarch64/aarch64-json-tunings/string-2.c: New test. * gcc.target/aarch64/aarch64-json-tunings/string-2.json: New test. * gcc.target/aarch64/aarch64-json-tunings/test-all.c: New test. * gcc.target/aarch64/aarch64-json-tunings/test-all.json: New test. * gcc.target/aarch64/aarch64-json-tunings/unidentified-key.c: New test. * gcc.target/aarch64/aarch64-json-tunings/unidentified-key.json: New test. * gcc.target/aarch64/aarch64-json-tunings/unsigned-1.c: New test. * gcc.target/aarch64/aarch64-json-tunings/unsigned-1.json: New test. * gcc.target/aarch64/aarch64-json-tunings/unsigned-2.c: New test. * gcc.target/aarch64/aarch64-json-tunings/unsigned-2.json: New test. * gcc.target/aarch64/aarch64-json-tunings/unsigned-3.c: New test. * gcc.target/aarch64/aarch64-json-tunings/unsigned-3.json: New test. --- .../aarch64-json-tunings.exp | 35 +++++++++++ .../aarch64/aarch64-json-tunings/boolean-1.c | 7 +++ .../aarch64-json-tunings/boolean-1.json | 9 +++ .../aarch64/aarch64-json-tunings/boolean-2.c | 8 +++ .../aarch64-json-tunings/boolean-2.json | 9 +++ .../aarch64-json-tunings/empty-brackets.c | 7 +++ .../aarch64-json-tunings/empty-brackets.json | 1 + .../aarch64/aarch64-json-tunings/empty.c | 6 ++ .../aarch64/aarch64-json-tunings/empty.json | 0 .../aarch64/aarch64-json-tunings/enum-1.c | 9 +++ .../aarch64/aarch64-json-tunings/enum-1.json | 7 +++ .../aarch64/aarch64-json-tunings/enum-2.c | 8 +++ .../aarch64/aarch64-json-tunings/enum-2.json | 7 +++ .../aarch64/aarch64-json-tunings/integer-1.c | 8 +++ .../aarch64-json-tunings/integer-1.json | 6 ++ .../aarch64/aarch64-json-tunings/integer-2.c | 8 +++ .../aarch64-json-tunings/integer-2.json | 5 ++ .../aarch64/aarch64-json-tunings/integer-3.c | 8 +++ .../aarch64-json-tunings/integer-3.json | 5 ++ .../aarch64/aarch64-json-tunings/string-1.c | 9 +++ .../aarch64-json-tunings/string-1.json | 7 +++ .../aarch64/aarch64-json-tunings/string-2.c | 8 +++ .../aarch64-json-tunings/string-2.json | 5 ++ .../aarch64/aarch64-json-tunings/test-all.c | 59 +++++++++++++++++++ .../aarch64-json-tunings/test-all.json | 39 ++++++++++++ .../aarch64-json-tunings/unidentified-key.c | 7 +++ .../unidentified-key.json | 5 ++ .../aarch64/aarch64-json-tunings/unsigned-1.c | 8 +++ .../aarch64-json-tunings/unsigned-1.json | 6 ++ .../aarch64/aarch64-json-tunings/unsigned-2.c | 8 +++ .../aarch64-json-tunings/unsigned-2.json | 6 ++ .../aarch64/aarch64-json-tunings/unsigned-3.c | 8 +++ .../aarch64-json-tunings/unsigned-3.json | 5 ++ 33 files changed, 333 insertions(+) create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/aarch64-json-tunings.exp create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-1.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-1.json create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-2.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-2.json create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/empty-brackets.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/empty-brackets.json create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/empty.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/empty.json create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-1.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-1.json create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-2.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-2.json create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-1.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-1.json create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-2.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-2.json create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-3.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-3.json create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-1.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-1.json create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-2.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-2.json create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/test-all.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/test-all.json create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unidentified-key.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unidentified-key.json create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-1.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-1.json create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-2.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-2.json create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-3.c create mode 100644 gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-3.json diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/aarch64-json-tunings.exp b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/aarch64-json-tunings.exp new file mode 100644 index 000000000000..974af6d78a2a --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/aarch64-json-tunings.exp @@ -0,0 +1,35 @@ +# Copyright (C) 2025 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +# GCC testsuite that uses the `dg.exp' driver. + +# Exit immediately if this isn't an AArch64 target. +if ![istarget aarch64*-*-*] then { + return +} + +# Load support procs. +load_lib gcc-dg.exp + +# Initialize `dg'. +dg-init + +# Main loop. +dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.\[cCS\]]] \ + "" "" + +# All done. +dg-finish diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-1.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-1.c new file mode 100644 index 000000000000..d0a6c35fae0f --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-1.c @@ -0,0 +1,7 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/boolean-1.json -fdump-tuning-model=temp.json" } */ + +/* { dg-warning "JSON tuning file does not contain version information" "" { target *-*-* } 0 } */ +/* { dg-final { scan-file "temp.json" "\"non_exec_costs_exec\": false" } } */ + +int main () {} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-1.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-1.json new file mode 100644 index 000000000000..b7bd3dd4f9ac --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-1.json @@ -0,0 +1,9 @@ +{ + "tune_params": { + "insn_extra_cost": { + "alu": { + "non_exec_costs_exec": false + } + } + } +} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-2.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-2.c new file mode 100644 index 000000000000..aef632f1d042 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-2.c @@ -0,0 +1,8 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/boolean-2.json -fdump-tuning-model=temp.json" } */ + +/* { dg-warning "JSON tuning file does not contain version information" "" { target *-*-* } 0 } */ +/* { dg-error "key .* expected to be a boolean" "" { target *-*-* } 0 } */ +/* { dg-error "validation failed for the provided JSON data" "" { target *-*-* } 0 } */ + +int main () {} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-2.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-2.json new file mode 100644 index 000000000000..d43e5b1a2918 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/boolean-2.json @@ -0,0 +1,9 @@ +{ + "tune_params": { + "insn_extra_cost": { + "alu": { + "non_exec_costs_exec": 0 + } + } + } +} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/empty-brackets.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/empty-brackets.c new file mode 100644 index 000000000000..4df72dbaf7ab --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/empty-brackets.c @@ -0,0 +1,7 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/empty-brackets.json -fdump-tuning-model=temp.json" } */ + +/* { dg-warning "JSON tuning file does not contain version information" "" { target *-*-* } 0 } */ +/* { dg-warning "key 'tune_params' not found in JSON data" "" { target *-*-* } 0 } */ + +int main () {} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/empty-brackets.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/empty-brackets.json new file mode 100644 index 000000000000..0967ef424bce --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/empty-brackets.json @@ -0,0 +1 @@ +{} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/empty.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/empty.c new file mode 100644 index 000000000000..0e722994fffb --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/empty.c @@ -0,0 +1,6 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/empty.json -fdump-tuning-model=temp.json" } */ + +/* { dg-error "expected a JSON value but got EOF" "" { target *-*-* } 0 } */ + +int main () {} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/empty.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/empty.json new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-1.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-1.c new file mode 100644 index 000000000000..48daf324d33b --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-1.c @@ -0,0 +1,9 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/enum-1.json -fdump-tuning-model=temp.json" } */ + +/* { dg-warning "JSON tuning file does not contain version information" "" { target *-*-* } 0 } */ +/* { dg-final { scan-file "temp.json" "\"autoprefetcher_model\": \"AUTOPREFETCHER_OFF\"" } } */ +/* { dg-final { scan-file "temp.json" "\"ldp_policy_model\": \"AARCH64_LDP_STP_POLICY_NEVER\"" } } */ +/* { dg-final { scan-file "temp.json" "\"stp_policy_model\": \"AARCH64_LDP_STP_POLICY_DEFAULT\"" } } */ + +int main () {} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-1.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-1.json new file mode 100644 index 000000000000..492af1c14e0b --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-1.json @@ -0,0 +1,7 @@ +{ + "tune_params": { + "autoprefetcher_model": "AUTOPREFETCHER_OFF", + "ldp_policy_model": "AARCH64_LDP_STP_POLICY_NEVER", + "stp_policy_model": "AARCH64_LDP_STP_POLICY_DEFAULT" + } +} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-2.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-2.c new file mode 100644 index 000000000000..c53bc5292d52 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-2.c @@ -0,0 +1,8 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/enum-2.json -fdump-tuning-model=temp.json" } */ + +/* { dg-warning "JSON tuning file does not contain version information" "" { target *-*-* } 0 } */ +/* { dg-warning "autoprefetcher_model not recognized, defaulting to 'AUTOPREFETCHER_OFF'" "" { target *-*-* } 0 } */ +/* { dg-warning "ldp_policy_model not recognized, defaulting to 'AARCH64_LDP_STP_POLICY_DEFAULT'" "" { target *-*-* } 0 } */ + +int main () {} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-2.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-2.json new file mode 100644 index 000000000000..61204071fd31 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/enum-2.json @@ -0,0 +1,7 @@ +{ + "tune_params": { + "autoprefetcher_model": "null", + "ldp_policy_model": "null", + "stp_policy_model": "AARCH64_LDP_STP_POLICY_DEFAULT" + } +} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-1.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-1.c new file mode 100644 index 000000000000..5d80560038c8 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-1.c @@ -0,0 +1,8 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/integer-1.json -fdump-tuning-model=temp.json" } */ + +/* { dg-warning "JSON tuning file does not contain version information" "" { target *-*-* } 0 } */ +/* { dg-final { scan-file "temp.json" "\"sve_width\": 256" } } */ +/* { dg-final { scan-file "temp.json" "\"issue_rate\": 4" } } */ + +int main () {} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-1.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-1.json new file mode 100644 index 000000000000..8db0efad28e6 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-1.json @@ -0,0 +1,6 @@ +{ + "tune_params": { + "sve_width": 256, + "issue_rate": 4 + } +} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-2.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-2.c new file mode 100644 index 000000000000..093c86048ce9 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-2.c @@ -0,0 +1,8 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/integer-2.json -fdump-tuning-model=temp.json" } */ + +/* { dg-warning "JSON tuning file does not contain version information" "" { target *-*-* } 0 } */ +/* { dg-error "key .* value .* is out of range for 'int' type" "" { target *-*-* } 0 } */ +/* { dg-error "validation failed for the provided JSON data" "" { target *-*-* } 0 } */ + +int main () {} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-2.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-2.json new file mode 100644 index 000000000000..5a897f164898 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-2.json @@ -0,0 +1,5 @@ +{ + "tune_params": { + "int_reassoc_width": 12097307449014 + } +} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-3.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-3.c new file mode 100644 index 000000000000..438685c6002c --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-3.c @@ -0,0 +1,8 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/integer-3.json -fdump-tuning-model=temp.json" } */ + +/* { dg-warning "JSON tuning file does not contain version information" "" { target *-*-* } 0 } */ +/* { dg-error "key .* expected to be an integer" "" { target *-*-* } 0 } */ +/* { dg-error "validation failed for the provided JSON data" "" { target *-*-* } 0 } */ + +int main () {} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-3.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-3.json new file mode 100644 index 000000000000..94fd12328406 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/integer-3.json @@ -0,0 +1,5 @@ +{ + "tune_params": { + "issue_rate": "10" + } +} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-1.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-1.c new file mode 100644 index 000000000000..419ab8691567 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-1.c @@ -0,0 +1,9 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/string-1.json -fdump-tuning-model=temp.json" } */ + +/* { dg-warning "JSON tuning file does not contain version information" "" { target *-*-* } 0 } */ +/* { dg-final { scan-file "temp.json" "\"function_align\": \"16\"" } } */ +/* { dg-final { scan-file "temp.json" "\"jump_align\": \"2\"" } } */ +/* { dg-final { scan-file "temp.json" "\"loop_align\": \"8\"" } } */ + +int main () {} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-1.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-1.json new file mode 100644 index 000000000000..fe78f324a5c0 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-1.json @@ -0,0 +1,7 @@ +{ + "tune_params": { + "function_align": "16", + "jump_align": "2", + "loop_align": "8" + } +} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-2.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-2.c new file mode 100644 index 000000000000..ad3ea1422bad --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-2.c @@ -0,0 +1,8 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/string-2.json -fdump-tuning-model=temp.json" } */ + +/* { dg-warning "JSON tuning file does not contain version information" "" { target *-*-* } 0 } */ +/* { dg-error "key .* expected to be a string" "" { target *-*-* } 0 } */ +/* { dg-error "validation failed for the provided JSON data" "" { target *-*-* } 0 } */ + +int main () {} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-2.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-2.json new file mode 100644 index 000000000000..5b1df22784b6 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/string-2.json @@ -0,0 +1,5 @@ +{ + "tune_params": { + "function_align": 16 + } +} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/test-all.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/test-all.c new file mode 100644 index 000000000000..3d6d5c14034a --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/test-all.c @@ -0,0 +1,59 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/test-all.json -fdump-tuning-model=temp.json" } */ +/* { dg-warning "JSON tuning file does not contain version information" "" { target *-*-* } 0 } */ + +/* Test round-trip parsing: load JSON, dump it, verify key values are preserved */ + +/* Check basic structure values */ +/* { dg-final { scan-file "temp.json" "\"issue_rate\": 3" } } */ +/* { dg-final { scan-file "temp.json" "\"fusible_ops\": 48" } } */ +/* { dg-final { scan-file "temp.json" "\"function_align\": \"32:16\"" } } */ + +/* Check alu costs */ +/* { dg-final { scan-file "temp.json" "\"arith\": 0" } } */ +/* { dg-final { scan-file "temp.json" "\"logical\": 0" } } */ +/* { dg-final { scan-file "temp.json" "\"shift\": 0" } } */ +/* { dg-final { scan-file "temp.json" "\"arith_shift\": 4" } } */ + +/* Check load/store costs */ +/* { dg-final { scan-file "temp.json" "\"load\": 12" } } */ +/* { dg-final { scan-file "temp.json" "\"store\": 0" } } */ +/* { dg-final { scan-file "temp.json" "\"loadf\": 16" } } */ +/* { dg-final { scan-file "temp.json" "\"storef\": 0" } } */ + +/* Check regmove costs */ +/* { dg-final { scan-file "temp.json" "\"GP2GP\": 1" } } */ +/* { dg-final { scan-file "temp.json" "\"GP2FP\": 5" } } */ +/* { dg-final { scan-file "temp.json" "\"FP2GP\": 5" } } */ +/* { dg-final { scan-file "temp.json" "\"FP2FP\": 2" } } */ + +/* Check vec_costs scalar fields */ +/* { dg-final { scan-file "temp.json" "\"scalar_int_stmt_cost\": 1" } } */ +/* { dg-final { scan-file "temp.json" "\"scalar_fp_stmt_cost\": 1" } } */ +/* { dg-final { scan-file "temp.json" "\"cond_taken_branch_cost\": 3" } } */ + +/* Check vec_costs advsimd nested fields */ +/* { dg-final { scan-file "temp.json" "\"int_stmt_cost\": 1" } } */ +/* { dg-final { scan-file "temp.json" "\"fp_stmt_cost\": 1" } } */ +/* { dg-final { scan-file "temp.json" "\"permute_cost\": 2" } } */ +/* { dg-final { scan-file "temp.json" "\"vec_to_scalar_cost\": 2" } } */ + +/* Check vec_costs sve nested fields */ +/* { dg-final { scan-file "temp.json" "\"clast_cost\": 2" } } */ +/* { dg-final { scan-file "temp.json" "\"fadda_f32_cost\": 2" } } */ +/* { dg-final { scan-file "temp.json" "\"gather_load_x32_cost\": 4" } } */ + +/* Check enum values */ +/* { dg-final { scan-file "temp.json" "\"autoprefetcher_model\": \"AUTOPREFETCHER_WEAK\"" } } */ +/* { dg-final { scan-file "temp.json" "\"ldp_policy_model\": \"AARCH64_LDP_STP_POLICY_ALWAYS\"" } } */ +/* { dg-final { scan-file "temp.json" "\"stp_policy_model\": \"AARCH64_LDP_STP_POLICY_ALWAYS\"" } } */ + +/* Check boolean values */ +/* { dg-final { scan-file "temp.json" "\"non_exec_costs_exec\": true" } } */ +/* { dg-final { scan-file "temp.json" "\"prefetch_dynamic_strides\": true" } } */ + +/* Check nested array values (mult costs) */ +/* { dg-final { scan-file "temp.json" "\"simple\": 4" } } */ +/* { dg-final { scan-file "temp.json" "\"idiv\": 24" } } */ + +int main () {} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/test-all.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/test-all.json new file mode 100644 index 000000000000..8851000c05c9 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/test-all.json @@ -0,0 +1,39 @@ +{ + "tune_params": { + "insn_extra_cost": { + "alu": { + "arith": 0, + "logical": 0, + "shift": 0, + "arith_shift": 4 + }, + "mult": [ + { + "simple": 4, + "idiv": 24 + } + ], + "ldst": { + "load": 12, + "store": 0, + "loadf": 16, + "storef": 0 + } + }, + "regmove_cost": { + "GP2GP": 1, + "GP2FP": 5, + "FP2GP": 5, + "FP2FP": 2 + }, + "issue_rate": 3, + "fusible_ops": 48, + "function_align": "32:16", + "autoprefetcher_model": "AUTOPREFETCHER_WEAK", + "ldp_policy_model": "AARCH64_LDP_STP_POLICY_ALWAYS", + "stp_policy_model": "AARCH64_LDP_STP_POLICY_ALWAYS", + "prefetch": { + "prefetch_dynamic_strides": true + } + } +} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unidentified-key.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unidentified-key.c new file mode 100644 index 000000000000..bafbda8a1ef5 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unidentified-key.c @@ -0,0 +1,7 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/unidentified-key.json -fdump-tuning-model=temp.json" } */ + +/* { dg-warning "JSON tuning file does not contain version information" "" { target *-*-* } 0 } */ +/* { dg-warning "key .* is not a tuning parameter, skipping" "" { target *-*-* } 0 } */ + +int main () {} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unidentified-key.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unidentified-key.json new file mode 100644 index 000000000000..89e69b2c690e --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unidentified-key.json @@ -0,0 +1,5 @@ +{ + "tune_params": { + "unidentified_key": "10" + } +} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-1.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-1.c new file mode 100644 index 000000000000..b176ae302366 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-1.c @@ -0,0 +1,8 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/unsigned-1.json -fdump-tuning-model=temp.json" } */ + +/* { dg-warning "JSON tuning file does not contain version information" "" { target *-*-* } 0 } */ +/* { dg-final { scan-file "temp.json" "\"sve_width\": 512" } } */ +/* { dg-final { scan-file "temp.json" "\"extra_tuning_flags\": 16" } } */ + +int main () {} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-1.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-1.json new file mode 100644 index 000000000000..0de87e152600 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-1.json @@ -0,0 +1,6 @@ +{ + "tune_params": { + "sve_width": 512, + "extra_tuning_flags": 16 + } +} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-2.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-2.c new file mode 100644 index 000000000000..ce1989d8e31d --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-2.c @@ -0,0 +1,8 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/unsigned-2.json -fdump-tuning-model=temp.json" } */ + +/* { dg-warning "JSON tuning file does not contain version information" "" { target *-*-* } 0 } */ +/* { dg-error "key .* value .* is out of range for 'uint' type" "" { target *-*-* } 0 } */ +/* { dg-error "validation failed for the provided JSON data" "" { target *-*-* } 0 } */ + +int main () {} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-2.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-2.json new file mode 100644 index 000000000000..15da31999395 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-2.json @@ -0,0 +1,6 @@ +{ + "tune_params": { + "sve_width": -128, + "extra_tuning_flags": 0 + } +} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-3.c b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-3.c new file mode 100644 index 000000000000..20a661f55702 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-3.c @@ -0,0 +1,8 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-muser-provided-CPU=${srcdir}/gcc.target/aarch64/aarch64-json-tunings/unsigned-3.json -fdump-tuning-model=temp.json" } */ + +/* { dg-warning "JSON tuning file does not contain version information" "" { target *-*-* } 0 } */ +/* { dg-error "key .* value .* is out of range for 'uint' type" "" { target *-*-* } 0 } */ +/* { dg-error "validation failed for the provided JSON data" "" { target *-*-* } 0 } */ + +int main () {} diff --git a/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-3.json b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-3.json new file mode 100644 index 000000000000..27411595f4b2 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/aarch64-json-tunings/unsigned-3.json @@ -0,0 +1,5 @@ +{ + "tune_params": { + "sve_width": 5000000000 + } +} From a0b8cc4a473e1e8798e1ca83842712a50281c885 Mon Sep 17 00:00:00 2001 From: Soumya AR Date: Wed, 16 Jul 2025 06:32:08 -0700 Subject: [PATCH 031/373] aarch64: Script to auto generate JSON tuning routines This commit introduces a Python maintenance script that generates C++ code for parsing and serializing AArch64 JSON tuning parameters based on the schema defined in aarch64-json-schema.h. The script generates two include files: - aarch64-json-tunings-parser-generated.inc - aarch64-json-tunings-printer-generated.inc These generated files are committed as regular source files and included by aarch64-json-tunings-parser.cc and aarch64-json-tunings-printer.cc respectively. ---- Additionally, this commit centralizes tuning enum definitions into a new aarch64-tuning-enums.def file. The enums (autoprefetch_model and ldp_stp_policy) are now defined once using macros and consumed by both the core definitions (aarch64-opts.h, aarch64-protos.h) and the generated parser/printer code. Doing this ensures that if someone wants to add a new enum value, they only need to make modifications in the .def file, and the codegen from the script will automatically refer to the same enums. ---- The script is run automatically whenever the JSON schema is modified. ---- Signed-off-by: Soumya AR gcc/ChangeLog: * config/aarch64/aarch64-json-tunings-parser.cc: Include aarch64-json-tunings-parser-generated.inc. * config/aarch64/aarch64-json-tunings-printer.cc: Include aarch64-json-tunings-printer-generated.inc. * config/aarch64/aarch64-opts.h (AARCH64_LDP_STP_POLICY): Use aarch64-tuning-enums.def. * config/aarch64/aarch64-protos.h (AARCH64_AUTOPREFETCH_MODE): Use aarch64-tuning-enums.def. * config/aarch64/t-aarch64: Invoke aarch64-generate-json-tuning-routines.py if the schema is modified. * config/aarch64/aarch64-generate-json-tuning-routines.py: New maintenance script to generate JSON parser/printer routines. * config/aarch64/aarch64-json-tunings-parser-generated.inc: New file. * config/aarch64/aarch64-json-tunings-printer-generated.inc: New file. * config/aarch64/aarch64-tuning-enums.def: New file. --- .../aarch64-generate-json-tuning-routines.py | 383 +++++++++++++ .../aarch64-json-tunings-parser-generated.inc | 355 ++++++++++++ .../aarch64/aarch64-json-tunings-parser.cc | 379 +------------ ...aarch64-json-tunings-printer-generated.inc | 439 +++++++++++++++ .../aarch64/aarch64-json-tunings-printer.cc | 527 +----------------- gcc/config/aarch64/aarch64-opts.h | 6 +- gcc/config/aarch64/aarch64-protos.h | 5 +- gcc/config/aarch64/aarch64-tuning-enums.def | 37 ++ gcc/config/aarch64/t-aarch64 | 8 + 9 files changed, 1230 insertions(+), 909 deletions(-) create mode 100755 gcc/config/aarch64/aarch64-generate-json-tuning-routines.py create mode 100644 gcc/config/aarch64/aarch64-json-tunings-parser-generated.inc create mode 100644 gcc/config/aarch64/aarch64-json-tunings-printer-generated.inc create mode 100644 gcc/config/aarch64/aarch64-tuning-enums.def diff --git a/gcc/config/aarch64/aarch64-generate-json-tuning-routines.py b/gcc/config/aarch64/aarch64-generate-json-tuning-routines.py new file mode 100755 index 000000000000..a4f9e4ece71a --- /dev/null +++ b/gcc/config/aarch64/aarch64-generate-json-tuning-routines.py @@ -0,0 +1,383 @@ +#!/usr/bin/env python3 + +# Script to autogenerate the parsing and serialization routines for the +# aarch64 JSON tuning parameters. +# +# Copyright The GNU Toolchain Authors. +# +# This file is part of GCC. +# +# GCC is free software; you can redistribute it and/or modify it under +# the terms of the GNU General Public License as published by the Free +# Software Foundation; either version 3, or (at your option) any later +# version. +# +# GCC is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or +# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +# for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +DESCRIPTION = """ +Maintenance script to regenerate aarch64-json-tunings-*-generated.inc files +from the JSON schema in aarch64-json-schema.h. + +This script is run automatically whenever aarch64-json-schema.h is modified. + +Usage: + + python3 /aarch64-generate-json-tuning-routines.py [options] + +Options: + --generate-only Generate only parser or printer file. + If not specified, generates both. + +Note that the script can be called from any directory. + +Generates (in gcc/config/aarch64/): + aarch64-json-tunings-parser-generated.inc + aarch64-json-tunings-printer-generated.inc +""" + +import json +import re +import os +import argparse +from typing import Dict, Any, List, Tuple + +def extract_schema_from_header(file_path: str) -> str: + with open(file_path, "r") as f: + content = f.read() + + # Find the schema_json variable content between R"json( and )json" + pattern = r'static const char \*schema_json = R"json\((.*?)\)json";' + match = re.search(pattern, content, re.DOTALL) + + if not match: + raise ValueError("Could not find schema_json in header file") + + return match.group(1).strip() + +def get_macro(operation: str, field_type: str) -> str: + type_map = { + "int": "INTEGER", + "uint": "UNSIGNED_INTEGER", + "boolean": "BOOLEAN", + "string": "STRING", + "enum": "ENUM", + } + if field_type not in type_map: + raise ValueError(f"Unknown field type: {field_type}") + return f"{operation}_{type_map[field_type]}_FIELD" + +def generate_field_code( + operation: str, + key: str, + value: Any, + struct_name: str, + current_path: List[str], + function_map: Dict[str, str], + obj_name: str = "jo", + indent: str = " ", +) -> List[str]: + lines = [] + + if isinstance(value, str): + macro = get_macro(operation.upper(), value) + if value == "enum": + enum_mapping = f"{key}_mappings" + lines.append( + f'{indent}{macro} ({obj_name}, "{key}", {struct_name}.{key}, {enum_mapping});' + ) + else: + lines.append(f'{indent}{macro} ({obj_name}, "{key}", {struct_name}.{key});') + + elif isinstance(value, dict): + # Nested object - find function name based on current context + key + child_path = current_path + [key] + child_path_key = "_".join(child_path) + func_name = function_map.get(child_path_key, f"{operation.lower()}_{key}") + macro_name = f"{operation.upper()}_OBJECT" + lines.append( + f'{indent}{macro_name} ({obj_name}, "{key}", {struct_name}.{key}, {func_name});' + ) + + elif isinstance(value, list) and len(value) > 0: + if isinstance(value[0], dict): + element_key = f"{key}_element" + element_path = current_path + [element_key] + element_path_key = "_".join(element_path) + func_name = function_map.get( + element_path_key, f"{operation.lower()}_{element_key}" + ) + macro_name = f"{operation.upper()}_ARRAY_FIELD" + + if operation.lower() == "serialize": + lines.append( + f'{indent}{macro_name} ({obj_name}, "{key}", {struct_name}.{key}, ARRAY_SIZE ({struct_name}.{key}), {func_name});' + ) + else: + lines.append( + f'{indent}{macro_name} ({obj_name}, "{key}", {struct_name}.{key}, {func_name});' + ) + else: + raise ValueError(f"Arrays of non-object types are not yet supported: {key}") + else: + raise ValueError(f"Unhandled field type for key '{key}': {type(value)}") + + return lines + +def generate_field_parsing( + key: str, + value: Any, + struct_name: str, + current_path: List[str], + function_map: Dict[str, str], + indent: str = " ", +) -> List[str]: + return generate_field_code( + "parse", key, value, struct_name, current_path, function_map, "jo", indent + ) + +def generate_field_serialization( + key: str, + value: Any, + struct_name: str, + obj_name: str, + current_path: List[str], + function_map: Dict[str, str], + indent: str = " ", +) -> List[str]: + return generate_field_code( + "serialize", + key, + value, + struct_name, + current_path, + function_map, + obj_name, + indent, + ) + +def generate_function( + operation: str, + full_name: str, + local_name: str, + schema: Dict[str, Any], + current_path: List[str], + function_map: Dict[str, str], +) -> List[str]: + lines = [] + lines.append("template ") + + if operation.lower() == "parse": + lines.append("static void") + lines.append(f"parse_{full_name} (const json::object *jo, T &{local_name})") + lines.append("{") + + for key, value in schema.items(): + field_lines = generate_field_parsing( + key, value, local_name, current_path, function_map + ) + lines.extend(field_lines) + + elif operation.lower() == "serialize": + lines.append("static std::unique_ptr") + lines.append(f"serialize_{full_name} (const T &{local_name})") + lines.append("{") + lines.append(f" auto {local_name}_obj = std::make_unique ();") + lines.append("") + + for key, value in schema.items(): + field_lines = generate_field_serialization( + key, value, local_name, f"{local_name}_obj", current_path, function_map + ) + lines.extend(field_lines) + + lines.append("") + lines.append(f" return {local_name}_obj;") + + lines.append("}") + + return lines + +"""Collect all object schemas with their full paths. This is necessary for +generating names for the routines with the correct hierarchal path to ensure +that identical keys in different structures are not given the same name. +For example: +vec_costs.issue_info.sve maps to _vec_costs_issue_info_sve +vec_costs.sve maps to _vec_costs_sve. +""" +def collect_all_objects_with_paths( + schema: Dict[str, Any], path: List[str] = [] +) -> Dict[str, Tuple[List[str], Dict[str, Any]]]: + objects = {} + + for key, value in schema.items(): + current_path = path + [key] + + if isinstance(value, dict): + path_key = "_".join(current_path) + objects[path_key] = (current_path, value) + nested = collect_all_objects_with_paths(value, current_path) + objects.update(nested) + + elif isinstance(value, list) and len(value) > 0 and isinstance(value[0], dict): + element_key = key.rstrip("s") if key.endswith("s") else f"{key}_element" + element_path = current_path[:-1] + [element_key] + element_path_key = "_".join(element_path) + objects[element_path_key] = (element_path, value[0]) + nested = collect_all_objects_with_paths(value[0], element_path) + objects.update(nested) + + return objects + +"""Calculate dependency depth of an object schema. 0 indicates no +dependencies, ie. the object has only primitive types.""" +def get_dependency_depth(obj_schema: Dict[str, Any]) -> int: + max_depth = 0 + for value in obj_schema.values(): + if isinstance(value, dict): + max_depth = max(max_depth, 1 + get_dependency_depth(value)) + elif isinstance(value, list) and len(value) > 0 and isinstance(value[0], dict): + max_depth = max(max_depth, 1 + get_dependency_depth(value[0])) + return max_depth + +def generate_enum_mappings(operation: str) -> str: + mappings = f""" +static const enum_mapping + autoprefetcher_model_mappings[] = {{ +#define AARCH64_AUTOPREFETCH_MODE(NAME, ENUM_VALUE) {{NAME, tune_params::ENUM_VALUE}}, +#include "aarch64-tuning-enums.def" +}}; + +static const enum_mapping ldp_policy_model_mappings[] = {{ +#define AARCH64_LDP_STP_POLICY(NAME, ENUM_VALUE) {{NAME, ENUM_VALUE}}, +#include "aarch64-tuning-enums.def" +}}; + +static const enum_mapping stp_policy_model_mappings[] = {{ +#define AARCH64_LDP_STP_POLICY(NAME, ENUM_VALUE) {{NAME, ENUM_VALUE}}, +#include "aarch64-tuning-enums.def" +}}; +""" + return mappings + +def generate_all_functions(schema_file: str, operation: str) -> str: + schema_str = extract_schema_from_header(schema_file) + schema = json.loads(schema_str) + tune_params_schema = schema.get("tune_params", {}) + + all_objects_with_paths = collect_all_objects_with_paths(tune_params_schema) + + function_map = {} + for path_key, (path, obj_schema) in all_objects_with_paths.items(): + if path: + full_name = "_".join(path) + function_map[path_key] = f"{operation}_{full_name}" + else: + function_map[path_key] = f"{operation}_{path_key}" + + """ Structures can have nested structures that may not have been defined yet. + Therefore, we need to sort the objects by dependency depth and define + functions for the inner structures first.""" + sorted_objects = sorted( + all_objects_with_paths.items(), key=lambda x: get_dependency_depth(x[1][1]) + ) + + generated_functions = [] + generated_functions.append(generate_enum_mappings(operation)) + + for path_key, (path, obj_schema) in sorted_objects: + # Use the full path for function generation + if path: + full_name = "_".join(path) + local_name = path[-1] + else: + full_name = path_key + local_name = path_key + + function_str = generate_function( + operation, full_name, local_name, obj_schema, path, function_map + ) + generated_functions.append("\n".join(function_str)) + + main_function = generate_function( + operation, "tunings", "tunings", tune_params_schema, [], function_map + ) + generated_functions.append("\n".join(main_function)) + return "\n\n".join(generated_functions) + +def write_generated_include_file( + output_file_path: str, generated_code: str, operation: str +) -> None: + header_comment = f"""/* This file is auto-generated by aarch64-generate-json-tuning-routines.py. */ +/* Copyright The GNU Toolchain Authors. + This file is part of GCC. + + GCC is free software; you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free + Software Foundation; either version 3, or (at your option) any later + version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +/* This file contains the auto-generated {operation} functions for JSON tuning parameters. */ + +""" + + try: + with open(output_file_path, "w") as f: + f.write(header_comment) + f.write(generated_code) + print(f"Successfully generated {output_file_path}") + except Exception as e: + print(f"Error writing to {output_file_path}: {e}") + +def main(): + parser = argparse.ArgumentParser() + parser.add_argument('--generate-only', + choices=['parser', 'printer'], + help='Generate only parser or printer file. If not specified, generates both.') + args = parser.parse_args() + + try: + script_dir = os.path.dirname(os.path.abspath(__file__)) + + schema_file = os.path.join(script_dir, "aarch64-json-schema.h") + parser_inc_file = os.path.join( + script_dir, "aarch64-json-tunings-parser-generated.inc" + ) + printer_inc_file = os.path.join( + script_dir, "aarch64-json-tunings-printer-generated.inc" + ) + if args.generate_only is None or args.generate_only == 'parser': + parser_generated_code = generate_all_functions(schema_file, "parse") + write_generated_include_file(parser_inc_file, parser_generated_code, "parser") + + if args.generate_only is None or args.generate_only == 'printer': + serializer_generated_code = generate_all_functions(schema_file, "serialize") + write_generated_include_file( + printer_inc_file, serializer_generated_code, "serializer" + ) + + print(f"Generated files in: {script_dir}") + + except Exception as e: + print(f"Error: {e}") + return 1 + + return 0 + +if __name__ == "__main__": + exit(main()) diff --git a/gcc/config/aarch64/aarch64-json-tunings-parser-generated.inc b/gcc/config/aarch64/aarch64-json-tunings-parser-generated.inc new file mode 100644 index 000000000000..cf31e539d3ba --- /dev/null +++ b/gcc/config/aarch64/aarch64-json-tunings-parser-generated.inc @@ -0,0 +1,355 @@ +/* This file is auto-generated by aarch64-generate-json-tuning-routines.py. */ +/* Copyright The GNU Toolchain Authors. + This file is part of GCC. + + GCC is free software; you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free + Software Foundation; either version 3, or (at your option) any later + version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +/* This file contains the auto-generated parser functions for JSON tuning parameters. */ + + +static const enum_mapping + autoprefetcher_model_mappings[] = { +#define AARCH64_AUTOPREFETCH_MODE(NAME, ENUM_VALUE) {NAME, tune_params::ENUM_VALUE}, +#include "aarch64-tuning-enums.def" +}; + +static const enum_mapping ldp_policy_model_mappings[] = { +#define AARCH64_LDP_STP_POLICY(NAME, ENUM_VALUE) {NAME, ENUM_VALUE}, +#include "aarch64-tuning-enums.def" +}; + +static const enum_mapping stp_policy_model_mappings[] = { +#define AARCH64_LDP_STP_POLICY(NAME, ENUM_VALUE) {NAME, ENUM_VALUE}, +#include "aarch64-tuning-enums.def" +}; + + +template +static void +parse_insn_extra_cost_alu (const json::object *jo, T &alu) +{ + PARSE_INTEGER_FIELD (jo, "arith", alu.arith); + PARSE_INTEGER_FIELD (jo, "logical", alu.logical); + PARSE_INTEGER_FIELD (jo, "shift", alu.shift); + PARSE_INTEGER_FIELD (jo, "shift_reg", alu.shift_reg); + PARSE_INTEGER_FIELD (jo, "arith_shift", alu.arith_shift); + PARSE_INTEGER_FIELD (jo, "arith_shift_reg", alu.arith_shift_reg); + PARSE_INTEGER_FIELD (jo, "log_shift", alu.log_shift); + PARSE_INTEGER_FIELD (jo, "log_shift_reg", alu.log_shift_reg); + PARSE_INTEGER_FIELD (jo, "extend", alu.extend); + PARSE_INTEGER_FIELD (jo, "extend_arith", alu.extend_arith); + PARSE_INTEGER_FIELD (jo, "bfi", alu.bfi); + PARSE_INTEGER_FIELD (jo, "bfx", alu.bfx); + PARSE_INTEGER_FIELD (jo, "clz", alu.clz); + PARSE_INTEGER_FIELD (jo, "rev", alu.rev); + PARSE_INTEGER_FIELD (jo, "non_exec", alu.non_exec); + PARSE_BOOLEAN_FIELD (jo, "non_exec_costs_exec", alu.non_exec_costs_exec); +} + +template +static void +parse_insn_extra_cost_mult_element (const json::object *jo, T &mult_element) +{ + PARSE_INTEGER_FIELD (jo, "simple", mult_element.simple); + PARSE_INTEGER_FIELD (jo, "flag_setting", mult_element.flag_setting); + PARSE_INTEGER_FIELD (jo, "extend", mult_element.extend); + PARSE_INTEGER_FIELD (jo, "add", mult_element.add); + PARSE_INTEGER_FIELD (jo, "extend_add", mult_element.extend_add); + PARSE_INTEGER_FIELD (jo, "idiv", mult_element.idiv); +} + +template +static void +parse_insn_extra_cost_ldst (const json::object *jo, T &ldst) +{ + PARSE_INTEGER_FIELD (jo, "load", ldst.load); + PARSE_INTEGER_FIELD (jo, "load_sign_extend", ldst.load_sign_extend); + PARSE_INTEGER_FIELD (jo, "ldrd", ldst.ldrd); + PARSE_INTEGER_FIELD (jo, "ldm_1st", ldst.ldm_1st); + PARSE_INTEGER_FIELD (jo, "ldm_regs_per_insn_1st", ldst.ldm_regs_per_insn_1st); + PARSE_INTEGER_FIELD (jo, "ldm_regs_per_insn_subsequent", ldst.ldm_regs_per_insn_subsequent); + PARSE_INTEGER_FIELD (jo, "loadf", ldst.loadf); + PARSE_INTEGER_FIELD (jo, "loadd", ldst.loadd); + PARSE_INTEGER_FIELD (jo, "load_unaligned", ldst.load_unaligned); + PARSE_INTEGER_FIELD (jo, "store", ldst.store); + PARSE_INTEGER_FIELD (jo, "strd", ldst.strd); + PARSE_INTEGER_FIELD (jo, "stm_1st", ldst.stm_1st); + PARSE_INTEGER_FIELD (jo, "stm_regs_per_insn_1st", ldst.stm_regs_per_insn_1st); + PARSE_INTEGER_FIELD (jo, "stm_regs_per_insn_subsequent", ldst.stm_regs_per_insn_subsequent); + PARSE_INTEGER_FIELD (jo, "storef", ldst.storef); + PARSE_INTEGER_FIELD (jo, "stored", ldst.stored); + PARSE_INTEGER_FIELD (jo, "store_unaligned", ldst.store_unaligned); + PARSE_INTEGER_FIELD (jo, "loadv", ldst.loadv); + PARSE_INTEGER_FIELD (jo, "storev", ldst.storev); +} + +template +static void +parse_insn_extra_cost_fp_element (const json::object *jo, T &fp_element) +{ + PARSE_INTEGER_FIELD (jo, "div", fp_element.div); + PARSE_INTEGER_FIELD (jo, "mult", fp_element.mult); + PARSE_INTEGER_FIELD (jo, "mult_addsub", fp_element.mult_addsub); + PARSE_INTEGER_FIELD (jo, "fma", fp_element.fma); + PARSE_INTEGER_FIELD (jo, "addsub", fp_element.addsub); + PARSE_INTEGER_FIELD (jo, "fpconst", fp_element.fpconst); + PARSE_INTEGER_FIELD (jo, "neg", fp_element.neg); + PARSE_INTEGER_FIELD (jo, "compare", fp_element.compare); + PARSE_INTEGER_FIELD (jo, "widen", fp_element.widen); + PARSE_INTEGER_FIELD (jo, "narrow", fp_element.narrow); + PARSE_INTEGER_FIELD (jo, "toint", fp_element.toint); + PARSE_INTEGER_FIELD (jo, "fromint", fp_element.fromint); + PARSE_INTEGER_FIELD (jo, "roundint", fp_element.roundint); +} + +template +static void +parse_insn_extra_cost_vect (const json::object *jo, T &vect) +{ + PARSE_INTEGER_FIELD (jo, "alu", vect.alu); + PARSE_INTEGER_FIELD (jo, "mult", vect.mult); + PARSE_INTEGER_FIELD (jo, "movi", vect.movi); + PARSE_INTEGER_FIELD (jo, "dup", vect.dup); + PARSE_INTEGER_FIELD (jo, "extract", vect.extract); +} + +template +static void +parse_addr_cost_addr_scale_costs (const json::object *jo, T &addr_scale_costs) +{ + PARSE_INTEGER_FIELD (jo, "hi", addr_scale_costs.hi); + PARSE_INTEGER_FIELD (jo, "si", addr_scale_costs.si); + PARSE_INTEGER_FIELD (jo, "di", addr_scale_costs.di); + PARSE_INTEGER_FIELD (jo, "ti", addr_scale_costs.ti); +} + +template +static void +parse_regmove_cost (const json::object *jo, T ®move_cost) +{ + PARSE_INTEGER_FIELD (jo, "GP2GP", regmove_cost.GP2GP); + PARSE_INTEGER_FIELD (jo, "GP2FP", regmove_cost.GP2FP); + PARSE_INTEGER_FIELD (jo, "FP2GP", regmove_cost.FP2GP); + PARSE_INTEGER_FIELD (jo, "FP2FP", regmove_cost.FP2FP); +} + +template +static void +parse_vec_costs_advsimd (const json::object *jo, T &advsimd) +{ + PARSE_INTEGER_FIELD (jo, "int_stmt_cost", advsimd.int_stmt_cost); + PARSE_INTEGER_FIELD (jo, "fp_stmt_cost", advsimd.fp_stmt_cost); + PARSE_INTEGER_FIELD (jo, "ld2_st2_permute_cost", advsimd.ld2_st2_permute_cost); + PARSE_INTEGER_FIELD (jo, "ld3_st3_permute_cost", advsimd.ld3_st3_permute_cost); + PARSE_INTEGER_FIELD (jo, "ld4_st4_permute_cost", advsimd.ld4_st4_permute_cost); + PARSE_INTEGER_FIELD (jo, "permute_cost", advsimd.permute_cost); + PARSE_INTEGER_FIELD (jo, "reduc_i8_cost", advsimd.reduc_i8_cost); + PARSE_INTEGER_FIELD (jo, "reduc_i16_cost", advsimd.reduc_i16_cost); + PARSE_INTEGER_FIELD (jo, "reduc_i32_cost", advsimd.reduc_i32_cost); + PARSE_INTEGER_FIELD (jo, "reduc_i64_cost", advsimd.reduc_i64_cost); + PARSE_INTEGER_FIELD (jo, "reduc_f16_cost", advsimd.reduc_f16_cost); + PARSE_INTEGER_FIELD (jo, "reduc_f32_cost", advsimd.reduc_f32_cost); + PARSE_INTEGER_FIELD (jo, "reduc_f64_cost", advsimd.reduc_f64_cost); + PARSE_INTEGER_FIELD (jo, "store_elt_extra_cost", advsimd.store_elt_extra_cost); + PARSE_INTEGER_FIELD (jo, "vec_to_scalar_cost", advsimd.vec_to_scalar_cost); + PARSE_INTEGER_FIELD (jo, "scalar_to_vec_cost", advsimd.scalar_to_vec_cost); + PARSE_INTEGER_FIELD (jo, "align_load_cost", advsimd.align_load_cost); + PARSE_INTEGER_FIELD (jo, "unalign_load_cost", advsimd.unalign_load_cost); + PARSE_INTEGER_FIELD (jo, "unalign_store_cost", advsimd.unalign_store_cost); + PARSE_INTEGER_FIELD (jo, "store_cost", advsimd.store_cost); +} + +template +static void +parse_vec_costs_sve (const json::object *jo, T &sve) +{ + PARSE_INTEGER_FIELD (jo, "clast_cost", sve.clast_cost); + PARSE_INTEGER_FIELD (jo, "fadda_f16_cost", sve.fadda_f16_cost); + PARSE_INTEGER_FIELD (jo, "fadda_f32_cost", sve.fadda_f32_cost); + PARSE_INTEGER_FIELD (jo, "fadda_f64_cost", sve.fadda_f64_cost); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "gather_load_x32_cost", sve.gather_load_x32_cost); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "gather_load_x64_cost", sve.gather_load_x64_cost); + PARSE_INTEGER_FIELD (jo, "gather_load_x32_init_cost", sve.gather_load_x32_init_cost); + PARSE_INTEGER_FIELD (jo, "gather_load_x64_init_cost", sve.gather_load_x64_init_cost); + PARSE_INTEGER_FIELD (jo, "scatter_store_elt_cost", sve.scatter_store_elt_cost); +} + +template +static void +parse_vec_costs_issue_info_scalar (const json::object *jo, T &scalar) +{ + PARSE_UNSIGNED_INTEGER_FIELD (jo, "loads_stores_per_cycle", scalar.loads_stores_per_cycle); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "stores_per_cycle", scalar.stores_per_cycle); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "general_ops_per_cycle", scalar.general_ops_per_cycle); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "fp_simd_load_general_ops", scalar.fp_simd_load_general_ops); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "fp_simd_store_general_ops", scalar.fp_simd_store_general_ops); +} + +template +static void +parse_vec_costs_issue_info_advsimd (const json::object *jo, T &advsimd) +{ + PARSE_UNSIGNED_INTEGER_FIELD (jo, "loads_stores_per_cycle", advsimd.loads_stores_per_cycle); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "stores_per_cycle", advsimd.stores_per_cycle); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "general_ops_per_cycle", advsimd.general_ops_per_cycle); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "fp_simd_load_general_ops", advsimd.fp_simd_load_general_ops); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "fp_simd_store_general_ops", advsimd.fp_simd_store_general_ops); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "ld2_st2_general_ops", advsimd.ld2_st2_general_ops); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "ld3_st3_general_ops", advsimd.ld3_st3_general_ops); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "ld4_st4_general_ops", advsimd.ld4_st4_general_ops); +} + +template +static void +parse_vec_costs_issue_info_sve (const json::object *jo, T &sve) +{ + PARSE_UNSIGNED_INTEGER_FIELD (jo, "loads_stores_per_cycle", sve.loads_stores_per_cycle); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "stores_per_cycle", sve.stores_per_cycle); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "general_ops_per_cycle", sve.general_ops_per_cycle); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "fp_simd_load_general_ops", sve.fp_simd_load_general_ops); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "fp_simd_store_general_ops", sve.fp_simd_store_general_ops); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "ld2_st2_general_ops", sve.ld2_st2_general_ops); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "ld3_st3_general_ops", sve.ld3_st3_general_ops); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "ld4_st4_general_ops", sve.ld4_st4_general_ops); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "pred_ops_per_cycle", sve.pred_ops_per_cycle); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "while_pred_ops", sve.while_pred_ops); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "int_cmp_pred_ops", sve.int_cmp_pred_ops); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "fp_cmp_pred_ops", sve.fp_cmp_pred_ops); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "gather_scatter_pair_general_ops", sve.gather_scatter_pair_general_ops); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "gather_scatter_pair_pred_ops", sve.gather_scatter_pair_pred_ops); +} + +template +static void +parse_branch_costs (const json::object *jo, T &branch_costs) +{ + PARSE_INTEGER_FIELD (jo, "predictable", branch_costs.predictable); + PARSE_INTEGER_FIELD (jo, "unpredictable", branch_costs.unpredictable); +} + +template +static void +parse_approx_modes (const json::object *jo, T &approx_modes) +{ + PARSE_INTEGER_FIELD (jo, "division", approx_modes.division); + PARSE_INTEGER_FIELD (jo, "sqrt", approx_modes.sqrt); + PARSE_INTEGER_FIELD (jo, "recip_sqrt", approx_modes.recip_sqrt); +} + +template +static void +parse_memmov_cost (const json::object *jo, T &memmov_cost) +{ + PARSE_INTEGER_FIELD (jo, "load_int", memmov_cost.load_int); + PARSE_INTEGER_FIELD (jo, "store_int", memmov_cost.store_int); + PARSE_INTEGER_FIELD (jo, "load_fp", memmov_cost.load_fp); + PARSE_INTEGER_FIELD (jo, "store_fp", memmov_cost.store_fp); + PARSE_INTEGER_FIELD (jo, "load_pred", memmov_cost.load_pred); + PARSE_INTEGER_FIELD (jo, "store_pred", memmov_cost.store_pred); +} + +template +static void +parse_prefetch (const json::object *jo, T &prefetch) +{ + PARSE_INTEGER_FIELD (jo, "num_slots", prefetch.num_slots); + PARSE_INTEGER_FIELD (jo, "l1_cache_size", prefetch.l1_cache_size); + PARSE_INTEGER_FIELD (jo, "l1_cache_line_size", prefetch.l1_cache_line_size); + PARSE_INTEGER_FIELD (jo, "l2_cache_size", prefetch.l2_cache_size); + PARSE_BOOLEAN_FIELD (jo, "prefetch_dynamic_strides", prefetch.prefetch_dynamic_strides); + PARSE_INTEGER_FIELD (jo, "minimum_stride", prefetch.minimum_stride); + PARSE_INTEGER_FIELD (jo, "default_opt_level", prefetch.default_opt_level); +} + +template +static void +parse_insn_extra_cost (const json::object *jo, T &insn_extra_cost) +{ + PARSE_OBJECT (jo, "alu", insn_extra_cost.alu, parse_insn_extra_cost_alu); + PARSE_ARRAY_FIELD (jo, "mult", insn_extra_cost.mult, parse_insn_extra_cost_mult_element); + PARSE_OBJECT (jo, "ldst", insn_extra_cost.ldst, parse_insn_extra_cost_ldst); + PARSE_ARRAY_FIELD (jo, "fp", insn_extra_cost.fp, parse_insn_extra_cost_fp_element); + PARSE_OBJECT (jo, "vect", insn_extra_cost.vect, parse_insn_extra_cost_vect); +} + +template +static void +parse_addr_cost (const json::object *jo, T &addr_cost) +{ + PARSE_OBJECT (jo, "addr_scale_costs", addr_cost.addr_scale_costs, parse_addr_cost_addr_scale_costs); + PARSE_INTEGER_FIELD (jo, "pre_modify", addr_cost.pre_modify); + PARSE_INTEGER_FIELD (jo, "post_modify", addr_cost.post_modify); + PARSE_INTEGER_FIELD (jo, "post_modify_ld3_st3", addr_cost.post_modify_ld3_st3); + PARSE_INTEGER_FIELD (jo, "post_modify_ld4_st4", addr_cost.post_modify_ld4_st4); + PARSE_INTEGER_FIELD (jo, "register_offset", addr_cost.register_offset); + PARSE_INTEGER_FIELD (jo, "register_sextend", addr_cost.register_sextend); + PARSE_INTEGER_FIELD (jo, "register_zextend", addr_cost.register_zextend); + PARSE_INTEGER_FIELD (jo, "imm_offset", addr_cost.imm_offset); +} + +template +static void +parse_vec_costs_issue_info (const json::object *jo, T &issue_info) +{ + PARSE_OBJECT (jo, "scalar", issue_info.scalar, parse_vec_costs_issue_info_scalar); + PARSE_OBJECT (jo, "advsimd", issue_info.advsimd, parse_vec_costs_issue_info_advsimd); + PARSE_OBJECT (jo, "sve", issue_info.sve, parse_vec_costs_issue_info_sve); +} + +template +static void +parse_vec_costs (const json::object *jo, T &vec_costs) +{ + PARSE_INTEGER_FIELD (jo, "scalar_int_stmt_cost", vec_costs.scalar_int_stmt_cost); + PARSE_INTEGER_FIELD (jo, "scalar_fp_stmt_cost", vec_costs.scalar_fp_stmt_cost); + PARSE_INTEGER_FIELD (jo, "scalar_load_cost", vec_costs.scalar_load_cost); + PARSE_INTEGER_FIELD (jo, "scalar_store_cost", vec_costs.scalar_store_cost); + PARSE_INTEGER_FIELD (jo, "cond_taken_branch_cost", vec_costs.cond_taken_branch_cost); + PARSE_INTEGER_FIELD (jo, "cond_not_taken_branch_cost", vec_costs.cond_not_taken_branch_cost); + PARSE_OBJECT (jo, "advsimd", vec_costs.advsimd, parse_vec_costs_advsimd); + PARSE_OBJECT (jo, "sve", vec_costs.sve, parse_vec_costs_sve); + PARSE_OBJECT (jo, "issue_info", vec_costs.issue_info, parse_vec_costs_issue_info); +} + +template +static void +parse_tunings (const json::object *jo, T &tunings) +{ + PARSE_OBJECT (jo, "insn_extra_cost", tunings.insn_extra_cost, parse_insn_extra_cost); + PARSE_OBJECT (jo, "addr_cost", tunings.addr_cost, parse_addr_cost); + PARSE_OBJECT (jo, "regmove_cost", tunings.regmove_cost, parse_regmove_cost); + PARSE_OBJECT (jo, "vec_costs", tunings.vec_costs, parse_vec_costs); + PARSE_OBJECT (jo, "branch_costs", tunings.branch_costs, parse_branch_costs); + PARSE_OBJECT (jo, "approx_modes", tunings.approx_modes, parse_approx_modes); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "sve_width", tunings.sve_width); + PARSE_OBJECT (jo, "memmov_cost", tunings.memmov_cost, parse_memmov_cost); + PARSE_INTEGER_FIELD (jo, "issue_rate", tunings.issue_rate); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "fusible_ops", tunings.fusible_ops); + PARSE_STRING_FIELD (jo, "function_align", tunings.function_align); + PARSE_STRING_FIELD (jo, "jump_align", tunings.jump_align); + PARSE_STRING_FIELD (jo, "loop_align", tunings.loop_align); + PARSE_INTEGER_FIELD (jo, "int_reassoc_width", tunings.int_reassoc_width); + PARSE_INTEGER_FIELD (jo, "fp_reassoc_width", tunings.fp_reassoc_width); + PARSE_INTEGER_FIELD (jo, "fma_reassoc_width", tunings.fma_reassoc_width); + PARSE_INTEGER_FIELD (jo, "vec_reassoc_width", tunings.vec_reassoc_width); + PARSE_INTEGER_FIELD (jo, "min_div_recip_mul_sf", tunings.min_div_recip_mul_sf); + PARSE_INTEGER_FIELD (jo, "min_div_recip_mul_df", tunings.min_div_recip_mul_df); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "max_case_values", tunings.max_case_values); + PARSE_ENUM_FIELD (jo, "autoprefetcher_model", tunings.autoprefetcher_model, autoprefetcher_model_mappings); + PARSE_UNSIGNED_INTEGER_FIELD (jo, "extra_tuning_flags", tunings.extra_tuning_flags); + PARSE_OBJECT (jo, "prefetch", tunings.prefetch, parse_prefetch); + PARSE_ENUM_FIELD (jo, "ldp_policy_model", tunings.ldp_policy_model, ldp_policy_model_mappings); + PARSE_ENUM_FIELD (jo, "stp_policy_model", tunings.stp_policy_model, stp_policy_model_mappings); +} \ No newline at end of file diff --git a/gcc/config/aarch64/aarch64-json-tunings-parser.cc b/gcc/config/aarch64/aarch64-json-tunings-parser.cc index f5959bf55e1d..59c745e347ef 100644 --- a/gcc/config/aarch64/aarch64-json-tunings-parser.cc +++ b/gcc/config/aarch64/aarch64-json-tunings-parser.cc @@ -223,383 +223,8 @@ parse_enum_field (const json::object *jo, const std::string &key, enum_var = mappings[0].value; } -/* Enum mappings for known tuning parameter enums. */ -static const enum_mapping - autoprefetcher_model_mappings[] - = {{"AUTOPREFETCHER_OFF", tune_params::AUTOPREFETCHER_OFF}, - {"AUTOPREFETCHER_WEAK", tune_params::AUTOPREFETCHER_WEAK}, - {"AUTOPREFETCHER_STRONG", tune_params::AUTOPREFETCHER_STRONG}}; - -static const enum_mapping ldp_policy_model_mappings[] - = {{"AARCH64_LDP_STP_POLICY_DEFAULT", AARCH64_LDP_STP_POLICY_DEFAULT}, - {"AARCH64_LDP_STP_POLICY_ALIGNED", AARCH64_LDP_STP_POLICY_ALIGNED}, - {"AARCH64_LDP_STP_POLICY_ALWAYS", AARCH64_LDP_STP_POLICY_ALWAYS}, - {"AARCH64_LDP_STP_POLICY_NEVER", AARCH64_LDP_STP_POLICY_NEVER}}; - -static const enum_mapping stp_policy_model_mappings[] - = {{"AARCH64_LDP_STP_POLICY_DEFAULT", AARCH64_LDP_STP_POLICY_DEFAULT}, - {"AARCH64_LDP_STP_POLICY_ALIGNED", AARCH64_LDP_STP_POLICY_ALIGNED}, - {"AARCH64_LDP_STP_POLICY_ALWAYS", AARCH64_LDP_STP_POLICY_ALWAYS}, - {"AARCH64_LDP_STP_POLICY_NEVER", AARCH64_LDP_STP_POLICY_NEVER}}; - -template -static void -parse_insn_extra_cost_alu (const json::object *jo, T &alu) -{ - PARSE_INTEGER_FIELD (jo, "arith", alu.arith); - PARSE_INTEGER_FIELD (jo, "logical", alu.logical); - PARSE_INTEGER_FIELD (jo, "shift", alu.shift); - PARSE_INTEGER_FIELD (jo, "shift_reg", alu.shift_reg); - PARSE_INTEGER_FIELD (jo, "arith_shift", alu.arith_shift); - PARSE_INTEGER_FIELD (jo, "arith_shift_reg", alu.arith_shift_reg); - PARSE_INTEGER_FIELD (jo, "log_shift", alu.log_shift); - PARSE_INTEGER_FIELD (jo, "log_shift_reg", alu.log_shift_reg); - PARSE_INTEGER_FIELD (jo, "extend", alu.extend); - PARSE_INTEGER_FIELD (jo, "extend_arith", alu.extend_arith); - PARSE_INTEGER_FIELD (jo, "bfi", alu.bfi); - PARSE_INTEGER_FIELD (jo, "bfx", alu.bfx); - PARSE_INTEGER_FIELD (jo, "clz", alu.clz); - PARSE_INTEGER_FIELD (jo, "rev", alu.rev); - PARSE_INTEGER_FIELD (jo, "non_exec", alu.non_exec); - PARSE_BOOLEAN_FIELD (jo, "non_exec_costs_exec", alu.non_exec_costs_exec); -} - -template -static void -parse_insn_extra_cost_mult_element (const json::object *jo, T &mult_element) -{ - PARSE_INTEGER_FIELD (jo, "simple", mult_element.simple); - PARSE_INTEGER_FIELD (jo, "flag_setting", mult_element.flag_setting); - PARSE_INTEGER_FIELD (jo, "extend", mult_element.extend); - PARSE_INTEGER_FIELD (jo, "add", mult_element.add); - PARSE_INTEGER_FIELD (jo, "extend_add", mult_element.extend_add); - PARSE_INTEGER_FIELD (jo, "idiv", mult_element.idiv); -} - -template -static void -parse_insn_extra_cost_ldst (const json::object *jo, T &ldst) -{ - PARSE_INTEGER_FIELD (jo, "load", ldst.load); - PARSE_INTEGER_FIELD (jo, "load_sign_extend", ldst.load_sign_extend); - PARSE_INTEGER_FIELD (jo, "ldrd", ldst.ldrd); - PARSE_INTEGER_FIELD (jo, "ldm_1st", ldst.ldm_1st); - PARSE_INTEGER_FIELD (jo, "ldm_regs_per_insn_1st", ldst.ldm_regs_per_insn_1st); - PARSE_INTEGER_FIELD (jo, "ldm_regs_per_insn_subsequent", - ldst.ldm_regs_per_insn_subsequent); - PARSE_INTEGER_FIELD (jo, "loadf", ldst.loadf); - PARSE_INTEGER_FIELD (jo, "loadd", ldst.loadd); - PARSE_INTEGER_FIELD (jo, "load_unaligned", ldst.load_unaligned); - PARSE_INTEGER_FIELD (jo, "store", ldst.store); - PARSE_INTEGER_FIELD (jo, "strd", ldst.strd); - PARSE_INTEGER_FIELD (jo, "stm_1st", ldst.stm_1st); - PARSE_INTEGER_FIELD (jo, "stm_regs_per_insn_1st", ldst.stm_regs_per_insn_1st); - PARSE_INTEGER_FIELD (jo, "stm_regs_per_insn_subsequent", - ldst.stm_regs_per_insn_subsequent); - PARSE_INTEGER_FIELD (jo, "storef", ldst.storef); - PARSE_INTEGER_FIELD (jo, "stored", ldst.stored); - PARSE_INTEGER_FIELD (jo, "store_unaligned", ldst.store_unaligned); - PARSE_INTEGER_FIELD (jo, "loadv", ldst.loadv); - PARSE_INTEGER_FIELD (jo, "storev", ldst.storev); -} - -template -static void -parse_insn_extra_cost_fp_element (const json::object *jo, T &fp_element) -{ - PARSE_INTEGER_FIELD (jo, "div", fp_element.div); - PARSE_INTEGER_FIELD (jo, "mult", fp_element.mult); - PARSE_INTEGER_FIELD (jo, "mult_addsub", fp_element.mult_addsub); - PARSE_INTEGER_FIELD (jo, "fma", fp_element.fma); - PARSE_INTEGER_FIELD (jo, "addsub", fp_element.addsub); - PARSE_INTEGER_FIELD (jo, "fpconst", fp_element.fpconst); - PARSE_INTEGER_FIELD (jo, "neg", fp_element.neg); - PARSE_INTEGER_FIELD (jo, "compare", fp_element.compare); - PARSE_INTEGER_FIELD (jo, "widen", fp_element.widen); - PARSE_INTEGER_FIELD (jo, "narrow", fp_element.narrow); - PARSE_INTEGER_FIELD (jo, "toint", fp_element.toint); - PARSE_INTEGER_FIELD (jo, "fromint", fp_element.fromint); - PARSE_INTEGER_FIELD (jo, "roundint", fp_element.roundint); -} - -template -static void -parse_insn_extra_cost_vect (const json::object *jo, T &vect) -{ - PARSE_INTEGER_FIELD (jo, "alu", vect.alu); - PARSE_INTEGER_FIELD (jo, "mult", vect.mult); - PARSE_INTEGER_FIELD (jo, "movi", vect.movi); - PARSE_INTEGER_FIELD (jo, "dup", vect.dup); - PARSE_INTEGER_FIELD (jo, "extract", vect.extract); -} - -template -static void -parse_addr_cost_addr_scale_costs (const json::object *jo, T &addr_scale_costs) -{ - PARSE_INTEGER_FIELD (jo, "hi", addr_scale_costs.hi); - PARSE_INTEGER_FIELD (jo, "si", addr_scale_costs.si); - PARSE_INTEGER_FIELD (jo, "di", addr_scale_costs.di); - PARSE_INTEGER_FIELD (jo, "ti", addr_scale_costs.ti); -} - -template -static void -parse_regmove_cost (const json::object *jo, T ®move_cost) -{ - PARSE_INTEGER_FIELD (jo, "GP2GP", regmove_cost.GP2GP); - PARSE_INTEGER_FIELD (jo, "GP2FP", regmove_cost.GP2FP); - PARSE_INTEGER_FIELD (jo, "FP2GP", regmove_cost.FP2GP); - PARSE_INTEGER_FIELD (jo, "FP2FP", regmove_cost.FP2FP); -} - -template -static void -parse_vec_costs_advsimd (const json::object *jo, T &advsimd) -{ - PARSE_INTEGER_FIELD (jo, "int_stmt_cost", advsimd.int_stmt_cost); - PARSE_INTEGER_FIELD (jo, "fp_stmt_cost", advsimd.fp_stmt_cost); - PARSE_INTEGER_FIELD (jo, "ld2_st2_permute_cost", - advsimd.ld2_st2_permute_cost); - PARSE_INTEGER_FIELD (jo, "ld3_st3_permute_cost", - advsimd.ld3_st3_permute_cost); - PARSE_INTEGER_FIELD (jo, "ld4_st4_permute_cost", - advsimd.ld4_st4_permute_cost); - PARSE_INTEGER_FIELD (jo, "permute_cost", advsimd.permute_cost); - PARSE_INTEGER_FIELD (jo, "reduc_i8_cost", advsimd.reduc_i8_cost); - PARSE_INTEGER_FIELD (jo, "reduc_i16_cost", advsimd.reduc_i16_cost); - PARSE_INTEGER_FIELD (jo, "reduc_i32_cost", advsimd.reduc_i32_cost); - PARSE_INTEGER_FIELD (jo, "reduc_i64_cost", advsimd.reduc_i64_cost); - PARSE_INTEGER_FIELD (jo, "reduc_f16_cost", advsimd.reduc_f16_cost); - PARSE_INTEGER_FIELD (jo, "reduc_f32_cost", advsimd.reduc_f32_cost); - PARSE_INTEGER_FIELD (jo, "reduc_f64_cost", advsimd.reduc_f64_cost); - PARSE_INTEGER_FIELD (jo, "store_elt_extra_cost", - advsimd.store_elt_extra_cost); - PARSE_INTEGER_FIELD (jo, "vec_to_scalar_cost", advsimd.vec_to_scalar_cost); - PARSE_INTEGER_FIELD (jo, "scalar_to_vec_cost", advsimd.scalar_to_vec_cost); - PARSE_INTEGER_FIELD (jo, "align_load_cost", advsimd.align_load_cost); - PARSE_INTEGER_FIELD (jo, "unalign_load_cost", advsimd.unalign_load_cost); - PARSE_INTEGER_FIELD (jo, "unalign_store_cost", advsimd.unalign_store_cost); - PARSE_INTEGER_FIELD (jo, "store_cost", advsimd.store_cost); -} - -template -static void -parse_vec_costs_sve (const json::object *jo, T &sve) -{ - PARSE_INTEGER_FIELD (jo, "clast_cost", sve.clast_cost); - PARSE_INTEGER_FIELD (jo, "fadda_f16_cost", sve.fadda_f16_cost); - PARSE_INTEGER_FIELD (jo, "fadda_f32_cost", sve.fadda_f32_cost); - PARSE_INTEGER_FIELD (jo, "fadda_f64_cost", sve.fadda_f64_cost); - PARSE_INTEGER_FIELD (jo, "gather_load_x32_cost", sve.gather_load_x32_cost); - PARSE_INTEGER_FIELD (jo, "gather_load_x64_cost", sve.gather_load_x64_cost); - PARSE_INTEGER_FIELD (jo, "gather_load_x32_init_cost", - sve.gather_load_x32_init_cost); - PARSE_INTEGER_FIELD (jo, "gather_load_x64_init_cost", - sve.gather_load_x64_init_cost); - PARSE_INTEGER_FIELD (jo, "scatter_store_elt_cost", - sve.scatter_store_elt_cost); -} - -template -static void -parse_vec_costs_issue_info_scalar (const json::object *jo, T &scalar) -{ - PARSE_INTEGER_FIELD (jo, "loads_stores_per_cycle", - scalar.loads_stores_per_cycle); - PARSE_INTEGER_FIELD (jo, "stores_per_cycle", scalar.stores_per_cycle); - PARSE_INTEGER_FIELD (jo, "general_ops_per_cycle", - scalar.general_ops_per_cycle); - PARSE_INTEGER_FIELD (jo, "fp_simd_load_general_ops", - scalar.fp_simd_load_general_ops); - PARSE_INTEGER_FIELD (jo, "fp_simd_store_general_ops", - scalar.fp_simd_store_general_ops); -} - -template -static void -parse_vec_costs_issue_info_advsimd (const json::object *jo, T &advsimd) -{ - PARSE_INTEGER_FIELD (jo, "loads_stores_per_cycle", - advsimd.loads_stores_per_cycle); - PARSE_INTEGER_FIELD (jo, "stores_per_cycle", advsimd.stores_per_cycle); - PARSE_INTEGER_FIELD (jo, "general_ops_per_cycle", - advsimd.general_ops_per_cycle); - PARSE_INTEGER_FIELD (jo, "fp_simd_load_general_ops", - advsimd.fp_simd_load_general_ops); - PARSE_INTEGER_FIELD (jo, "fp_simd_store_general_ops", - advsimd.fp_simd_store_general_ops); - PARSE_INTEGER_FIELD (jo, "ld2_st2_general_ops", advsimd.ld2_st2_general_ops); - PARSE_INTEGER_FIELD (jo, "ld3_st3_general_ops", advsimd.ld3_st3_general_ops); - PARSE_INTEGER_FIELD (jo, "ld4_st4_general_ops", advsimd.ld4_st4_general_ops); -} - -template -static void -parse_vec_costs_issue_info_sve (const json::object *jo, T &sve) -{ - PARSE_INTEGER_FIELD (jo, "loads_stores_per_cycle", - sve.loads_stores_per_cycle); - PARSE_INTEGER_FIELD (jo, "stores_per_cycle", sve.stores_per_cycle); - PARSE_INTEGER_FIELD (jo, "general_ops_per_cycle", sve.general_ops_per_cycle); - PARSE_INTEGER_FIELD (jo, "fp_simd_load_general_ops", - sve.fp_simd_load_general_ops); - PARSE_INTEGER_FIELD (jo, "fp_simd_store_general_ops", - sve.fp_simd_store_general_ops); - PARSE_INTEGER_FIELD (jo, "ld2_st2_general_ops", sve.ld2_st2_general_ops); - PARSE_INTEGER_FIELD (jo, "ld3_st3_general_ops", sve.ld3_st3_general_ops); - PARSE_INTEGER_FIELD (jo, "ld4_st4_general_ops", sve.ld4_st4_general_ops); - PARSE_INTEGER_FIELD (jo, "pred_ops_per_cycle", sve.pred_ops_per_cycle); - PARSE_INTEGER_FIELD (jo, "while_pred_ops", sve.while_pred_ops); - PARSE_INTEGER_FIELD (jo, "int_cmp_pred_ops", sve.int_cmp_pred_ops); - PARSE_INTEGER_FIELD (jo, "fp_cmp_pred_ops", sve.fp_cmp_pred_ops); - PARSE_INTEGER_FIELD (jo, "gather_scatter_pair_general_ops", - sve.gather_scatter_pair_general_ops); - PARSE_INTEGER_FIELD (jo, "gather_scatter_pair_pred_ops", - sve.gather_scatter_pair_pred_ops); -} - -template -static void -parse_branch_costs (const json::object *jo, T &branch_costs) -{ - PARSE_INTEGER_FIELD (jo, "predictable", branch_costs.predictable); - PARSE_INTEGER_FIELD (jo, "unpredictable", branch_costs.unpredictable); -} - -template -static void -parse_approx_modes (const json::object *jo, T &approx_modes) -{ - PARSE_INTEGER_FIELD (jo, "division", approx_modes.division); - PARSE_INTEGER_FIELD (jo, "sqrt", approx_modes.sqrt); - PARSE_INTEGER_FIELD (jo, "recip_sqrt", approx_modes.recip_sqrt); -} - -template -static void -parse_memmov_cost (const json::object *jo, T &memmov_cost) -{ - PARSE_INTEGER_FIELD (jo, "load_int", memmov_cost.load_int); - PARSE_INTEGER_FIELD (jo, "store_int", memmov_cost.store_int); - PARSE_INTEGER_FIELD (jo, "load_fp", memmov_cost.load_fp); - PARSE_INTEGER_FIELD (jo, "store_fp", memmov_cost.store_fp); - PARSE_INTEGER_FIELD (jo, "load_pred", memmov_cost.load_pred); - PARSE_INTEGER_FIELD (jo, "store_pred", memmov_cost.store_pred); -} - -template -static void -parse_prefetch (const json::object *jo, T &prefetch) -{ - PARSE_INTEGER_FIELD (jo, "num_slots", prefetch.num_slots); - PARSE_INTEGER_FIELD (jo, "l1_cache_size", prefetch.l1_cache_size); - PARSE_INTEGER_FIELD (jo, "l1_cache_line_size", prefetch.l1_cache_line_size); - PARSE_INTEGER_FIELD (jo, "l2_cache_size", prefetch.l2_cache_size); - PARSE_BOOLEAN_FIELD (jo, "prefetch_dynamic_strides", - prefetch.prefetch_dynamic_strides); - PARSE_INTEGER_FIELD (jo, "minimum_stride", prefetch.minimum_stride); - PARSE_INTEGER_FIELD (jo, "default_opt_level", prefetch.default_opt_level); -} - -template -static void -parse_insn_extra_cost (const json::object *jo, T &insn_extra_cost) -{ - PARSE_OBJECT (jo, "alu", insn_extra_cost.alu, parse_insn_extra_cost_alu); - PARSE_ARRAY_FIELD (jo, "mult", insn_extra_cost.mult, - parse_insn_extra_cost_mult_element); - PARSE_OBJECT (jo, "ldst", insn_extra_cost.ldst, parse_insn_extra_cost_ldst); - PARSE_ARRAY_FIELD (jo, "fp", insn_extra_cost.fp, - parse_insn_extra_cost_fp_element); - PARSE_OBJECT (jo, "vect", insn_extra_cost.vect, parse_insn_extra_cost_vect); -} - -template -static void -parse_addr_cost (const json::object *jo, T &addr_cost) -{ - PARSE_OBJECT (jo, "addr_scale_costs", addr_cost.addr_scale_costs, - parse_addr_cost_addr_scale_costs); - PARSE_INTEGER_FIELD (jo, "pre_modify", addr_cost.pre_modify); - PARSE_INTEGER_FIELD (jo, "post_modify", addr_cost.post_modify); - PARSE_INTEGER_FIELD (jo, "post_modify_ld3_st3", - addr_cost.post_modify_ld3_st3); - PARSE_INTEGER_FIELD (jo, "post_modify_ld4_st4", - addr_cost.post_modify_ld4_st4); - PARSE_INTEGER_FIELD (jo, "register_offset", addr_cost.register_offset); - PARSE_INTEGER_FIELD (jo, "register_sextend", addr_cost.register_sextend); - PARSE_INTEGER_FIELD (jo, "register_zextend", addr_cost.register_zextend); - PARSE_INTEGER_FIELD (jo, "imm_offset", addr_cost.imm_offset); -} - -template -static void -parse_vec_costs_issue_info (const json::object *jo, T &issue_info) -{ - PARSE_OBJECT (jo, "scalar", issue_info.scalar, - parse_vec_costs_issue_info_scalar); - PARSE_OBJECT (jo, "advsimd", issue_info.advsimd, - parse_vec_costs_issue_info_advsimd); - PARSE_OBJECT (jo, "sve", issue_info.sve, parse_vec_costs_issue_info_sve); -} - -template -static void -parse_vec_costs (const json::object *jo, T &vec_costs) -{ - PARSE_INTEGER_FIELD (jo, "scalar_int_stmt_cost", - vec_costs.scalar_int_stmt_cost); - PARSE_INTEGER_FIELD (jo, "scalar_fp_stmt_cost", - vec_costs.scalar_fp_stmt_cost); - PARSE_INTEGER_FIELD (jo, "scalar_load_cost", vec_costs.scalar_load_cost); - PARSE_INTEGER_FIELD (jo, "scalar_store_cost", vec_costs.scalar_store_cost); - PARSE_INTEGER_FIELD (jo, "cond_taken_branch_cost", - vec_costs.cond_taken_branch_cost); - PARSE_INTEGER_FIELD (jo, "cond_not_taken_branch_cost", - vec_costs.cond_not_taken_branch_cost); - PARSE_OBJECT (jo, "advsimd", vec_costs.advsimd, parse_vec_costs_advsimd); - PARSE_OBJECT (jo, "sve", vec_costs.sve, parse_vec_costs_sve); - PARSE_OBJECT (jo, "issue_info", vec_costs.issue_info, - parse_vec_costs_issue_info); -} - -template -static void -parse_tunings (const json::object *jo, T &tunings) -{ - PARSE_OBJECT (jo, "insn_extra_cost", tunings.insn_extra_cost, - parse_insn_extra_cost); - PARSE_OBJECT (jo, "addr_cost", tunings.addr_cost, parse_addr_cost); - PARSE_OBJECT (jo, "regmove_cost", tunings.regmove_cost, parse_regmove_cost); - PARSE_OBJECT (jo, "vec_costs", tunings.vec_costs, parse_vec_costs); - PARSE_OBJECT (jo, "branch_costs", tunings.branch_costs, parse_branch_costs); - PARSE_OBJECT (jo, "approx_modes", tunings.approx_modes, parse_approx_modes); - PARSE_INTEGER_FIELD (jo, "sve_width", tunings.sve_width); - PARSE_OBJECT (jo, "memmov_cost", tunings.memmov_cost, parse_memmov_cost); - PARSE_INTEGER_FIELD (jo, "issue_rate", tunings.issue_rate); - PARSE_INTEGER_FIELD (jo, "fusible_ops", tunings.fusible_ops); - PARSE_STRING_FIELD (jo, "function_align", tunings.function_align); - PARSE_STRING_FIELD (jo, "jump_align", tunings.jump_align); - PARSE_STRING_FIELD (jo, "loop_align", tunings.loop_align); - PARSE_INTEGER_FIELD (jo, "int_reassoc_width", tunings.int_reassoc_width); - PARSE_INTEGER_FIELD (jo, "fp_reassoc_width", tunings.fp_reassoc_width); - PARSE_INTEGER_FIELD (jo, "fma_reassoc_width", tunings.fma_reassoc_width); - PARSE_INTEGER_FIELD (jo, "vec_reassoc_width", tunings.vec_reassoc_width); - PARSE_INTEGER_FIELD (jo, "min_div_recip_mul_sf", - tunings.min_div_recip_mul_sf); - PARSE_INTEGER_FIELD (jo, "min_div_recip_mul_df", - tunings.min_div_recip_mul_df); - PARSE_INTEGER_FIELD (jo, "max_case_values", tunings.max_case_values); - PARSE_ENUM_FIELD (jo, "autoprefetcher_model", tunings.autoprefetcher_model, - autoprefetcher_model_mappings); - PARSE_INTEGER_FIELD (jo, "extra_tuning_flags", tunings.extra_tuning_flags); - PARSE_OBJECT (jo, "prefetch", tunings.prefetch, parse_prefetch); - PARSE_ENUM_FIELD (jo, "ldp_policy_model", tunings.ldp_policy_model, - ldp_policy_model_mappings); - PARSE_ENUM_FIELD (jo, "stp_policy_model", tunings.stp_policy_model, - stp_policy_model_mappings); -} +/* Include auto-generated parsing routines. */ +#include "aarch64-json-tunings-parser-generated.inc" /* Validate the user provided JSON data against the present schema. Checks for correct types, fields, and expected format. */ diff --git a/gcc/config/aarch64/aarch64-json-tunings-printer-generated.inc b/gcc/config/aarch64/aarch64-json-tunings-printer-generated.inc new file mode 100644 index 000000000000..6ffc4427a8bd --- /dev/null +++ b/gcc/config/aarch64/aarch64-json-tunings-printer-generated.inc @@ -0,0 +1,439 @@ +/* This file is auto-generated by aarch64-generate-json-tuning-routines.py. */ +/* Copyright The GNU Toolchain Authors. + This file is part of GCC. + + GCC is free software; you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free + Software Foundation; either version 3, or (at your option) any later + version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +/* This file contains the auto-generated serializer functions for JSON tuning parameters. */ + + +static const enum_mapping + autoprefetcher_model_mappings[] = { +#define AARCH64_AUTOPREFETCH_MODE(NAME, ENUM_VALUE) {NAME, tune_params::ENUM_VALUE}, +#include "aarch64-tuning-enums.def" +}; + +static const enum_mapping ldp_policy_model_mappings[] = { +#define AARCH64_LDP_STP_POLICY(NAME, ENUM_VALUE) {NAME, ENUM_VALUE}, +#include "aarch64-tuning-enums.def" +}; + +static const enum_mapping stp_policy_model_mappings[] = { +#define AARCH64_LDP_STP_POLICY(NAME, ENUM_VALUE) {NAME, ENUM_VALUE}, +#include "aarch64-tuning-enums.def" +}; + + +template +static std::unique_ptr +serialize_insn_extra_cost_alu (const T &alu) +{ + auto alu_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (alu_obj, "arith", alu.arith); + SERIALIZE_INTEGER_FIELD (alu_obj, "logical", alu.logical); + SERIALIZE_INTEGER_FIELD (alu_obj, "shift", alu.shift); + SERIALIZE_INTEGER_FIELD (alu_obj, "shift_reg", alu.shift_reg); + SERIALIZE_INTEGER_FIELD (alu_obj, "arith_shift", alu.arith_shift); + SERIALIZE_INTEGER_FIELD (alu_obj, "arith_shift_reg", alu.arith_shift_reg); + SERIALIZE_INTEGER_FIELD (alu_obj, "log_shift", alu.log_shift); + SERIALIZE_INTEGER_FIELD (alu_obj, "log_shift_reg", alu.log_shift_reg); + SERIALIZE_INTEGER_FIELD (alu_obj, "extend", alu.extend); + SERIALIZE_INTEGER_FIELD (alu_obj, "extend_arith", alu.extend_arith); + SERIALIZE_INTEGER_FIELD (alu_obj, "bfi", alu.bfi); + SERIALIZE_INTEGER_FIELD (alu_obj, "bfx", alu.bfx); + SERIALIZE_INTEGER_FIELD (alu_obj, "clz", alu.clz); + SERIALIZE_INTEGER_FIELD (alu_obj, "rev", alu.rev); + SERIALIZE_INTEGER_FIELD (alu_obj, "non_exec", alu.non_exec); + SERIALIZE_BOOLEAN_FIELD (alu_obj, "non_exec_costs_exec", alu.non_exec_costs_exec); + + return alu_obj; +} + +template +static std::unique_ptr +serialize_insn_extra_cost_mult_element (const T &mult_element) +{ + auto mult_element_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (mult_element_obj, "simple", mult_element.simple); + SERIALIZE_INTEGER_FIELD (mult_element_obj, "flag_setting", mult_element.flag_setting); + SERIALIZE_INTEGER_FIELD (mult_element_obj, "extend", mult_element.extend); + SERIALIZE_INTEGER_FIELD (mult_element_obj, "add", mult_element.add); + SERIALIZE_INTEGER_FIELD (mult_element_obj, "extend_add", mult_element.extend_add); + SERIALIZE_INTEGER_FIELD (mult_element_obj, "idiv", mult_element.idiv); + + return mult_element_obj; +} + +template +static std::unique_ptr +serialize_insn_extra_cost_ldst (const T &ldst) +{ + auto ldst_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (ldst_obj, "load", ldst.load); + SERIALIZE_INTEGER_FIELD (ldst_obj, "load_sign_extend", ldst.load_sign_extend); + SERIALIZE_INTEGER_FIELD (ldst_obj, "ldrd", ldst.ldrd); + SERIALIZE_INTEGER_FIELD (ldst_obj, "ldm_1st", ldst.ldm_1st); + SERIALIZE_INTEGER_FIELD (ldst_obj, "ldm_regs_per_insn_1st", ldst.ldm_regs_per_insn_1st); + SERIALIZE_INTEGER_FIELD (ldst_obj, "ldm_regs_per_insn_subsequent", ldst.ldm_regs_per_insn_subsequent); + SERIALIZE_INTEGER_FIELD (ldst_obj, "loadf", ldst.loadf); + SERIALIZE_INTEGER_FIELD (ldst_obj, "loadd", ldst.loadd); + SERIALIZE_INTEGER_FIELD (ldst_obj, "load_unaligned", ldst.load_unaligned); + SERIALIZE_INTEGER_FIELD (ldst_obj, "store", ldst.store); + SERIALIZE_INTEGER_FIELD (ldst_obj, "strd", ldst.strd); + SERIALIZE_INTEGER_FIELD (ldst_obj, "stm_1st", ldst.stm_1st); + SERIALIZE_INTEGER_FIELD (ldst_obj, "stm_regs_per_insn_1st", ldst.stm_regs_per_insn_1st); + SERIALIZE_INTEGER_FIELD (ldst_obj, "stm_regs_per_insn_subsequent", ldst.stm_regs_per_insn_subsequent); + SERIALIZE_INTEGER_FIELD (ldst_obj, "storef", ldst.storef); + SERIALIZE_INTEGER_FIELD (ldst_obj, "stored", ldst.stored); + SERIALIZE_INTEGER_FIELD (ldst_obj, "store_unaligned", ldst.store_unaligned); + SERIALIZE_INTEGER_FIELD (ldst_obj, "loadv", ldst.loadv); + SERIALIZE_INTEGER_FIELD (ldst_obj, "storev", ldst.storev); + + return ldst_obj; +} + +template +static std::unique_ptr +serialize_insn_extra_cost_fp_element (const T &fp_element) +{ + auto fp_element_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (fp_element_obj, "div", fp_element.div); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "mult", fp_element.mult); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "mult_addsub", fp_element.mult_addsub); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "fma", fp_element.fma); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "addsub", fp_element.addsub); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "fpconst", fp_element.fpconst); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "neg", fp_element.neg); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "compare", fp_element.compare); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "widen", fp_element.widen); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "narrow", fp_element.narrow); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "toint", fp_element.toint); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "fromint", fp_element.fromint); + SERIALIZE_INTEGER_FIELD (fp_element_obj, "roundint", fp_element.roundint); + + return fp_element_obj; +} + +template +static std::unique_ptr +serialize_insn_extra_cost_vect (const T &vect) +{ + auto vect_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (vect_obj, "alu", vect.alu); + SERIALIZE_INTEGER_FIELD (vect_obj, "mult", vect.mult); + SERIALIZE_INTEGER_FIELD (vect_obj, "movi", vect.movi); + SERIALIZE_INTEGER_FIELD (vect_obj, "dup", vect.dup); + SERIALIZE_INTEGER_FIELD (vect_obj, "extract", vect.extract); + + return vect_obj; +} + +template +static std::unique_ptr +serialize_addr_cost_addr_scale_costs (const T &addr_scale_costs) +{ + auto addr_scale_costs_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (addr_scale_costs_obj, "hi", addr_scale_costs.hi); + SERIALIZE_INTEGER_FIELD (addr_scale_costs_obj, "si", addr_scale_costs.si); + SERIALIZE_INTEGER_FIELD (addr_scale_costs_obj, "di", addr_scale_costs.di); + SERIALIZE_INTEGER_FIELD (addr_scale_costs_obj, "ti", addr_scale_costs.ti); + + return addr_scale_costs_obj; +} + +template +static std::unique_ptr +serialize_regmove_cost (const T ®move_cost) +{ + auto regmove_cost_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (regmove_cost_obj, "GP2GP", regmove_cost.GP2GP); + SERIALIZE_INTEGER_FIELD (regmove_cost_obj, "GP2FP", regmove_cost.GP2FP); + SERIALIZE_INTEGER_FIELD (regmove_cost_obj, "FP2GP", regmove_cost.FP2GP); + SERIALIZE_INTEGER_FIELD (regmove_cost_obj, "FP2FP", regmove_cost.FP2FP); + + return regmove_cost_obj; +} + +template +static std::unique_ptr +serialize_vec_costs_advsimd (const T &advsimd) +{ + auto advsimd_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (advsimd_obj, "int_stmt_cost", advsimd.int_stmt_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "fp_stmt_cost", advsimd.fp_stmt_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "ld2_st2_permute_cost", advsimd.ld2_st2_permute_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "ld3_st3_permute_cost", advsimd.ld3_st3_permute_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "ld4_st4_permute_cost", advsimd.ld4_st4_permute_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "permute_cost", advsimd.permute_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_i8_cost", advsimd.reduc_i8_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_i16_cost", advsimd.reduc_i16_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_i32_cost", advsimd.reduc_i32_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_i64_cost", advsimd.reduc_i64_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_f16_cost", advsimd.reduc_f16_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_f32_cost", advsimd.reduc_f32_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_f64_cost", advsimd.reduc_f64_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "store_elt_extra_cost", advsimd.store_elt_extra_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "vec_to_scalar_cost", advsimd.vec_to_scalar_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "scalar_to_vec_cost", advsimd.scalar_to_vec_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "align_load_cost", advsimd.align_load_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "unalign_load_cost", advsimd.unalign_load_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "unalign_store_cost", advsimd.unalign_store_cost); + SERIALIZE_INTEGER_FIELD (advsimd_obj, "store_cost", advsimd.store_cost); + + return advsimd_obj; +} + +template +static std::unique_ptr +serialize_vec_costs_sve (const T &sve) +{ + auto sve_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (sve_obj, "clast_cost", sve.clast_cost); + SERIALIZE_INTEGER_FIELD (sve_obj, "fadda_f16_cost", sve.fadda_f16_cost); + SERIALIZE_INTEGER_FIELD (sve_obj, "fadda_f32_cost", sve.fadda_f32_cost); + SERIALIZE_INTEGER_FIELD (sve_obj, "fadda_f64_cost", sve.fadda_f64_cost); + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "gather_load_x32_cost", sve.gather_load_x32_cost); + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "gather_load_x64_cost", sve.gather_load_x64_cost); + SERIALIZE_INTEGER_FIELD (sve_obj, "gather_load_x32_init_cost", sve.gather_load_x32_init_cost); + SERIALIZE_INTEGER_FIELD (sve_obj, "gather_load_x64_init_cost", sve.gather_load_x64_init_cost); + SERIALIZE_INTEGER_FIELD (sve_obj, "scatter_store_elt_cost", sve.scatter_store_elt_cost); + + return sve_obj; +} + +template +static std::unique_ptr +serialize_vec_costs_issue_info_scalar (const T &scalar) +{ + auto scalar_obj = std::make_unique (); + + SERIALIZE_UNSIGNED_INTEGER_FIELD (scalar_obj, "loads_stores_per_cycle", scalar.loads_stores_per_cycle); + SERIALIZE_UNSIGNED_INTEGER_FIELD (scalar_obj, "stores_per_cycle", scalar.stores_per_cycle); + SERIALIZE_UNSIGNED_INTEGER_FIELD (scalar_obj, "general_ops_per_cycle", scalar.general_ops_per_cycle); + SERIALIZE_UNSIGNED_INTEGER_FIELD (scalar_obj, "fp_simd_load_general_ops", scalar.fp_simd_load_general_ops); + SERIALIZE_UNSIGNED_INTEGER_FIELD (scalar_obj, "fp_simd_store_general_ops", scalar.fp_simd_store_general_ops); + + return scalar_obj; +} + +template +static std::unique_ptr +serialize_vec_costs_issue_info_advsimd (const T &advsimd) +{ + auto advsimd_obj = std::make_unique (); + + SERIALIZE_UNSIGNED_INTEGER_FIELD (advsimd_obj, "loads_stores_per_cycle", advsimd.loads_stores_per_cycle); + SERIALIZE_UNSIGNED_INTEGER_FIELD (advsimd_obj, "stores_per_cycle", advsimd.stores_per_cycle); + SERIALIZE_UNSIGNED_INTEGER_FIELD (advsimd_obj, "general_ops_per_cycle", advsimd.general_ops_per_cycle); + SERIALIZE_UNSIGNED_INTEGER_FIELD (advsimd_obj, "fp_simd_load_general_ops", advsimd.fp_simd_load_general_ops); + SERIALIZE_UNSIGNED_INTEGER_FIELD (advsimd_obj, "fp_simd_store_general_ops", advsimd.fp_simd_store_general_ops); + SERIALIZE_UNSIGNED_INTEGER_FIELD (advsimd_obj, "ld2_st2_general_ops", advsimd.ld2_st2_general_ops); + SERIALIZE_UNSIGNED_INTEGER_FIELD (advsimd_obj, "ld3_st3_general_ops", advsimd.ld3_st3_general_ops); + SERIALIZE_UNSIGNED_INTEGER_FIELD (advsimd_obj, "ld4_st4_general_ops", advsimd.ld4_st4_general_ops); + + return advsimd_obj; +} + +template +static std::unique_ptr +serialize_vec_costs_issue_info_sve (const T &sve) +{ + auto sve_obj = std::make_unique (); + + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "loads_stores_per_cycle", sve.loads_stores_per_cycle); + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "stores_per_cycle", sve.stores_per_cycle); + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "general_ops_per_cycle", sve.general_ops_per_cycle); + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "fp_simd_load_general_ops", sve.fp_simd_load_general_ops); + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "fp_simd_store_general_ops", sve.fp_simd_store_general_ops); + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "ld2_st2_general_ops", sve.ld2_st2_general_ops); + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "ld3_st3_general_ops", sve.ld3_st3_general_ops); + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "ld4_st4_general_ops", sve.ld4_st4_general_ops); + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "pred_ops_per_cycle", sve.pred_ops_per_cycle); + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "while_pred_ops", sve.while_pred_ops); + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "int_cmp_pred_ops", sve.int_cmp_pred_ops); + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "fp_cmp_pred_ops", sve.fp_cmp_pred_ops); + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "gather_scatter_pair_general_ops", sve.gather_scatter_pair_general_ops); + SERIALIZE_UNSIGNED_INTEGER_FIELD (sve_obj, "gather_scatter_pair_pred_ops", sve.gather_scatter_pair_pred_ops); + + return sve_obj; +} + +template +static std::unique_ptr +serialize_branch_costs (const T &branch_costs) +{ + auto branch_costs_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (branch_costs_obj, "predictable", branch_costs.predictable); + SERIALIZE_INTEGER_FIELD (branch_costs_obj, "unpredictable", branch_costs.unpredictable); + + return branch_costs_obj; +} + +template +static std::unique_ptr +serialize_approx_modes (const T &approx_modes) +{ + auto approx_modes_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (approx_modes_obj, "division", approx_modes.division); + SERIALIZE_INTEGER_FIELD (approx_modes_obj, "sqrt", approx_modes.sqrt); + SERIALIZE_INTEGER_FIELD (approx_modes_obj, "recip_sqrt", approx_modes.recip_sqrt); + + return approx_modes_obj; +} + +template +static std::unique_ptr +serialize_memmov_cost (const T &memmov_cost) +{ + auto memmov_cost_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "load_int", memmov_cost.load_int); + SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "store_int", memmov_cost.store_int); + SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "load_fp", memmov_cost.load_fp); + SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "store_fp", memmov_cost.store_fp); + SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "load_pred", memmov_cost.load_pred); + SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "store_pred", memmov_cost.store_pred); + + return memmov_cost_obj; +} + +template +static std::unique_ptr +serialize_prefetch (const T &prefetch) +{ + auto prefetch_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (prefetch_obj, "num_slots", prefetch.num_slots); + SERIALIZE_INTEGER_FIELD (prefetch_obj, "l1_cache_size", prefetch.l1_cache_size); + SERIALIZE_INTEGER_FIELD (prefetch_obj, "l1_cache_line_size", prefetch.l1_cache_line_size); + SERIALIZE_INTEGER_FIELD (prefetch_obj, "l2_cache_size", prefetch.l2_cache_size); + SERIALIZE_BOOLEAN_FIELD (prefetch_obj, "prefetch_dynamic_strides", prefetch.prefetch_dynamic_strides); + SERIALIZE_INTEGER_FIELD (prefetch_obj, "minimum_stride", prefetch.minimum_stride); + SERIALIZE_INTEGER_FIELD (prefetch_obj, "default_opt_level", prefetch.default_opt_level); + + return prefetch_obj; +} + +template +static std::unique_ptr +serialize_insn_extra_cost (const T &insn_extra_cost) +{ + auto insn_extra_cost_obj = std::make_unique (); + + SERIALIZE_OBJECT (insn_extra_cost_obj, "alu", insn_extra_cost.alu, serialize_insn_extra_cost_alu); + SERIALIZE_ARRAY_FIELD (insn_extra_cost_obj, "mult", insn_extra_cost.mult, ARRAY_SIZE (insn_extra_cost.mult), serialize_insn_extra_cost_mult_element); + SERIALIZE_OBJECT (insn_extra_cost_obj, "ldst", insn_extra_cost.ldst, serialize_insn_extra_cost_ldst); + SERIALIZE_ARRAY_FIELD (insn_extra_cost_obj, "fp", insn_extra_cost.fp, ARRAY_SIZE (insn_extra_cost.fp), serialize_insn_extra_cost_fp_element); + SERIALIZE_OBJECT (insn_extra_cost_obj, "vect", insn_extra_cost.vect, serialize_insn_extra_cost_vect); + + return insn_extra_cost_obj; +} + +template +static std::unique_ptr +serialize_addr_cost (const T &addr_cost) +{ + auto addr_cost_obj = std::make_unique (); + + SERIALIZE_OBJECT (addr_cost_obj, "addr_scale_costs", addr_cost.addr_scale_costs, serialize_addr_cost_addr_scale_costs); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "pre_modify", addr_cost.pre_modify); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "post_modify", addr_cost.post_modify); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "post_modify_ld3_st3", addr_cost.post_modify_ld3_st3); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "post_modify_ld4_st4", addr_cost.post_modify_ld4_st4); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "register_offset", addr_cost.register_offset); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "register_sextend", addr_cost.register_sextend); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "register_zextend", addr_cost.register_zextend); + SERIALIZE_INTEGER_FIELD (addr_cost_obj, "imm_offset", addr_cost.imm_offset); + + return addr_cost_obj; +} + +template +static std::unique_ptr +serialize_vec_costs_issue_info (const T &issue_info) +{ + auto issue_info_obj = std::make_unique (); + + SERIALIZE_OBJECT (issue_info_obj, "scalar", issue_info.scalar, serialize_vec_costs_issue_info_scalar); + SERIALIZE_OBJECT (issue_info_obj, "advsimd", issue_info.advsimd, serialize_vec_costs_issue_info_advsimd); + SERIALIZE_OBJECT (issue_info_obj, "sve", issue_info.sve, serialize_vec_costs_issue_info_sve); + + return issue_info_obj; +} + +template +static std::unique_ptr +serialize_vec_costs (const T &vec_costs) +{ + auto vec_costs_obj = std::make_unique (); + + SERIALIZE_INTEGER_FIELD (vec_costs_obj, "scalar_int_stmt_cost", vec_costs.scalar_int_stmt_cost); + SERIALIZE_INTEGER_FIELD (vec_costs_obj, "scalar_fp_stmt_cost", vec_costs.scalar_fp_stmt_cost); + SERIALIZE_INTEGER_FIELD (vec_costs_obj, "scalar_load_cost", vec_costs.scalar_load_cost); + SERIALIZE_INTEGER_FIELD (vec_costs_obj, "scalar_store_cost", vec_costs.scalar_store_cost); + SERIALIZE_INTEGER_FIELD (vec_costs_obj, "cond_taken_branch_cost", vec_costs.cond_taken_branch_cost); + SERIALIZE_INTEGER_FIELD (vec_costs_obj, "cond_not_taken_branch_cost", vec_costs.cond_not_taken_branch_cost); + SERIALIZE_OBJECT (vec_costs_obj, "advsimd", vec_costs.advsimd, serialize_vec_costs_advsimd); + SERIALIZE_OBJECT (vec_costs_obj, "sve", vec_costs.sve, serialize_vec_costs_sve); + SERIALIZE_OBJECT (vec_costs_obj, "issue_info", vec_costs.issue_info, serialize_vec_costs_issue_info); + + return vec_costs_obj; +} + +template +static std::unique_ptr +serialize_tunings (const T &tunings) +{ + auto tunings_obj = std::make_unique (); + + SERIALIZE_OBJECT (tunings_obj, "insn_extra_cost", tunings.insn_extra_cost, serialize_insn_extra_cost); + SERIALIZE_OBJECT (tunings_obj, "addr_cost", tunings.addr_cost, serialize_addr_cost); + SERIALIZE_OBJECT (tunings_obj, "regmove_cost", tunings.regmove_cost, serialize_regmove_cost); + SERIALIZE_OBJECT (tunings_obj, "vec_costs", tunings.vec_costs, serialize_vec_costs); + SERIALIZE_OBJECT (tunings_obj, "branch_costs", tunings.branch_costs, serialize_branch_costs); + SERIALIZE_OBJECT (tunings_obj, "approx_modes", tunings.approx_modes, serialize_approx_modes); + SERIALIZE_UNSIGNED_INTEGER_FIELD (tunings_obj, "sve_width", tunings.sve_width); + SERIALIZE_OBJECT (tunings_obj, "memmov_cost", tunings.memmov_cost, serialize_memmov_cost); + SERIALIZE_INTEGER_FIELD (tunings_obj, "issue_rate", tunings.issue_rate); + SERIALIZE_UNSIGNED_INTEGER_FIELD (tunings_obj, "fusible_ops", tunings.fusible_ops); + SERIALIZE_STRING_FIELD (tunings_obj, "function_align", tunings.function_align); + SERIALIZE_STRING_FIELD (tunings_obj, "jump_align", tunings.jump_align); + SERIALIZE_STRING_FIELD (tunings_obj, "loop_align", tunings.loop_align); + SERIALIZE_INTEGER_FIELD (tunings_obj, "int_reassoc_width", tunings.int_reassoc_width); + SERIALIZE_INTEGER_FIELD (tunings_obj, "fp_reassoc_width", tunings.fp_reassoc_width); + SERIALIZE_INTEGER_FIELD (tunings_obj, "fma_reassoc_width", tunings.fma_reassoc_width); + SERIALIZE_INTEGER_FIELD (tunings_obj, "vec_reassoc_width", tunings.vec_reassoc_width); + SERIALIZE_INTEGER_FIELD (tunings_obj, "min_div_recip_mul_sf", tunings.min_div_recip_mul_sf); + SERIALIZE_INTEGER_FIELD (tunings_obj, "min_div_recip_mul_df", tunings.min_div_recip_mul_df); + SERIALIZE_UNSIGNED_INTEGER_FIELD (tunings_obj, "max_case_values", tunings.max_case_values); + SERIALIZE_ENUM_FIELD (tunings_obj, "autoprefetcher_model", tunings.autoprefetcher_model, autoprefetcher_model_mappings); + SERIALIZE_UNSIGNED_INTEGER_FIELD (tunings_obj, "extra_tuning_flags", tunings.extra_tuning_flags); + SERIALIZE_OBJECT (tunings_obj, "prefetch", tunings.prefetch, serialize_prefetch); + SERIALIZE_ENUM_FIELD (tunings_obj, "ldp_policy_model", tunings.ldp_policy_model, ldp_policy_model_mappings); + SERIALIZE_ENUM_FIELD (tunings_obj, "stp_policy_model", tunings.stp_policy_model, stp_policy_model_mappings); + + return tunings_obj; +} \ No newline at end of file diff --git a/gcc/config/aarch64/aarch64-json-tunings-printer.cc b/gcc/config/aarch64/aarch64-json-tunings-printer.cc index 861290742fcd..7f28dde9bbed 100644 --- a/gcc/config/aarch64/aarch64-json-tunings-printer.cc +++ b/gcc/config/aarch64/aarch64-json-tunings-printer.cc @@ -98,24 +98,6 @@ template struct enum_mapping EnumType value; }; -static const enum_mapping - autoprefetcher_model_mappings[] - = {{"AUTOPREFETCHER_OFF", tune_params::AUTOPREFETCHER_OFF}, - {"AUTOPREFETCHER_WEAK", tune_params::AUTOPREFETCHER_WEAK}, - {"AUTOPREFETCHER_STRONG", tune_params::AUTOPREFETCHER_STRONG}}; - -static const enum_mapping ldp_policy_model_mappings[] - = {{"AARCH64_LDP_STP_POLICY_DEFAULT", AARCH64_LDP_STP_POLICY_DEFAULT}, - {"AARCH64_LDP_STP_POLICY_ALIGNED", AARCH64_LDP_STP_POLICY_ALIGNED}, - {"AARCH64_LDP_STP_POLICY_ALWAYS", AARCH64_LDP_STP_POLICY_ALWAYS}, - {"AARCH64_LDP_STP_POLICY_NEVER", AARCH64_LDP_STP_POLICY_NEVER}}; - -static const enum_mapping stp_policy_model_mappings[] - = {{"AARCH64_LDP_STP_POLICY_DEFAULT", AARCH64_LDP_STP_POLICY_DEFAULT}, - {"AARCH64_LDP_STP_POLICY_ALIGNED", AARCH64_LDP_STP_POLICY_ALIGNED}, - {"AARCH64_LDP_STP_POLICY_ALWAYS", AARCH64_LDP_STP_POLICY_ALWAYS}, - {"AARCH64_LDP_STP_POLICY_NEVER", AARCH64_LDP_STP_POLICY_NEVER}}; - /* Convert enum value to string using enum-to-string mappings. */ template static const char * @@ -128,513 +110,8 @@ serialize_enum (EnumType enum_value, const enum_mapping *mappings, return mappings[0].name; } -template -static std::unique_ptr -serialize_insn_extra_cost_alu (const T &alu) -{ - auto alu_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (alu_obj, "arith", alu.arith); - SERIALIZE_INTEGER_FIELD (alu_obj, "logical", alu.logical); - SERIALIZE_INTEGER_FIELD (alu_obj, "shift", alu.shift); - SERIALIZE_INTEGER_FIELD (alu_obj, "shift_reg", alu.shift_reg); - SERIALIZE_INTEGER_FIELD (alu_obj, "arith_shift", alu.arith_shift); - SERIALIZE_INTEGER_FIELD (alu_obj, "arith_shift_reg", alu.arith_shift_reg); - SERIALIZE_INTEGER_FIELD (alu_obj, "log_shift", alu.log_shift); - SERIALIZE_INTEGER_FIELD (alu_obj, "log_shift_reg", alu.log_shift_reg); - SERIALIZE_INTEGER_FIELD (alu_obj, "extend", alu.extend); - SERIALIZE_INTEGER_FIELD (alu_obj, "extend_arith", alu.extend_arith); - SERIALIZE_INTEGER_FIELD (alu_obj, "bfi", alu.bfi); - SERIALIZE_INTEGER_FIELD (alu_obj, "bfx", alu.bfx); - SERIALIZE_INTEGER_FIELD (alu_obj, "clz", alu.clz); - SERIALIZE_INTEGER_FIELD (alu_obj, "rev", alu.rev); - SERIALIZE_INTEGER_FIELD (alu_obj, "non_exec", alu.non_exec); - SERIALIZE_BOOLEAN_FIELD (alu_obj, "non_exec_costs_exec", - alu.non_exec_costs_exec); - - return alu_obj; -} - -template -static std::unique_ptr -serialize_insn_extra_cost_mult_element (const T &mult_element) -{ - auto mult_element_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (mult_element_obj, "simple", mult_element.simple); - SERIALIZE_INTEGER_FIELD (mult_element_obj, "flag_setting", - mult_element.flag_setting); - SERIALIZE_INTEGER_FIELD (mult_element_obj, "extend", mult_element.extend); - SERIALIZE_INTEGER_FIELD (mult_element_obj, "add", mult_element.add); - SERIALIZE_INTEGER_FIELD (mult_element_obj, "extend_add", - mult_element.extend_add); - SERIALIZE_INTEGER_FIELD (mult_element_obj, "idiv", mult_element.idiv); - - return mult_element_obj; -} - -template -static std::unique_ptr -serialize_insn_extra_cost_ldst (const T &ldst) -{ - auto ldst_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (ldst_obj, "load", ldst.load); - SERIALIZE_INTEGER_FIELD (ldst_obj, "load_sign_extend", ldst.load_sign_extend); - SERIALIZE_INTEGER_FIELD (ldst_obj, "ldrd", ldst.ldrd); - SERIALIZE_INTEGER_FIELD (ldst_obj, "ldm_1st", ldst.ldm_1st); - SERIALIZE_INTEGER_FIELD (ldst_obj, "ldm_regs_per_insn_1st", - ldst.ldm_regs_per_insn_1st); - SERIALIZE_INTEGER_FIELD (ldst_obj, "ldm_regs_per_insn_subsequent", - ldst.ldm_regs_per_insn_subsequent); - SERIALIZE_INTEGER_FIELD (ldst_obj, "loadf", ldst.loadf); - SERIALIZE_INTEGER_FIELD (ldst_obj, "loadd", ldst.loadd); - SERIALIZE_INTEGER_FIELD (ldst_obj, "load_unaligned", ldst.load_unaligned); - SERIALIZE_INTEGER_FIELD (ldst_obj, "store", ldst.store); - SERIALIZE_INTEGER_FIELD (ldst_obj, "strd", ldst.strd); - SERIALIZE_INTEGER_FIELD (ldst_obj, "stm_1st", ldst.stm_1st); - SERIALIZE_INTEGER_FIELD (ldst_obj, "stm_regs_per_insn_1st", - ldst.stm_regs_per_insn_1st); - SERIALIZE_INTEGER_FIELD (ldst_obj, "stm_regs_per_insn_subsequent", - ldst.stm_regs_per_insn_subsequent); - SERIALIZE_INTEGER_FIELD (ldst_obj, "storef", ldst.storef); - SERIALIZE_INTEGER_FIELD (ldst_obj, "stored", ldst.stored); - SERIALIZE_INTEGER_FIELD (ldst_obj, "store_unaligned", ldst.store_unaligned); - SERIALIZE_INTEGER_FIELD (ldst_obj, "loadv", ldst.loadv); - SERIALIZE_INTEGER_FIELD (ldst_obj, "storev", ldst.storev); - - return ldst_obj; -} - -template -static std::unique_ptr -serialize_insn_extra_cost_fp_element (const T &fp_element) -{ - auto fp_element_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (fp_element_obj, "div", fp_element.div); - SERIALIZE_INTEGER_FIELD (fp_element_obj, "mult", fp_element.mult); - SERIALIZE_INTEGER_FIELD (fp_element_obj, "mult_addsub", - fp_element.mult_addsub); - SERIALIZE_INTEGER_FIELD (fp_element_obj, "fma", fp_element.fma); - SERIALIZE_INTEGER_FIELD (fp_element_obj, "addsub", fp_element.addsub); - SERIALIZE_INTEGER_FIELD (fp_element_obj, "fpconst", fp_element.fpconst); - SERIALIZE_INTEGER_FIELD (fp_element_obj, "neg", fp_element.neg); - SERIALIZE_INTEGER_FIELD (fp_element_obj, "compare", fp_element.compare); - SERIALIZE_INTEGER_FIELD (fp_element_obj, "widen", fp_element.widen); - SERIALIZE_INTEGER_FIELD (fp_element_obj, "narrow", fp_element.narrow); - SERIALIZE_INTEGER_FIELD (fp_element_obj, "toint", fp_element.toint); - SERIALIZE_INTEGER_FIELD (fp_element_obj, "fromint", fp_element.fromint); - SERIALIZE_INTEGER_FIELD (fp_element_obj, "roundint", fp_element.roundint); - - return fp_element_obj; -} - -template -static std::unique_ptr -serialize_insn_extra_cost_vect (const T &vect) -{ - auto vect_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (vect_obj, "alu", vect.alu); - SERIALIZE_INTEGER_FIELD (vect_obj, "mult", vect.mult); - SERIALIZE_INTEGER_FIELD (vect_obj, "movi", vect.movi); - SERIALIZE_INTEGER_FIELD (vect_obj, "dup", vect.dup); - SERIALIZE_INTEGER_FIELD (vect_obj, "extract", vect.extract); - - return vect_obj; -} - -template -static std::unique_ptr -serialize_addr_cost_addr_scale_costs (const T &addr_scale_costs) -{ - auto addr_scale_costs_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (addr_scale_costs_obj, "hi", addr_scale_costs.hi); - SERIALIZE_INTEGER_FIELD (addr_scale_costs_obj, "si", addr_scale_costs.si); - SERIALIZE_INTEGER_FIELD (addr_scale_costs_obj, "di", addr_scale_costs.di); - SERIALIZE_INTEGER_FIELD (addr_scale_costs_obj, "ti", addr_scale_costs.ti); - - return addr_scale_costs_obj; -} - -template -static std::unique_ptr -serialize_regmove_cost (const T ®move_cost) -{ - auto regmove_cost_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (regmove_cost_obj, "GP2GP", regmove_cost.GP2GP); - SERIALIZE_INTEGER_FIELD (regmove_cost_obj, "GP2FP", regmove_cost.GP2FP); - SERIALIZE_INTEGER_FIELD (regmove_cost_obj, "FP2GP", regmove_cost.FP2GP); - SERIALIZE_INTEGER_FIELD (regmove_cost_obj, "FP2FP", regmove_cost.FP2FP); - - return regmove_cost_obj; -} - -template -static std::unique_ptr -serialize_vec_costs_advsimd (const T &advsimd) -{ - auto advsimd_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (advsimd_obj, "int_stmt_cost", advsimd.int_stmt_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "fp_stmt_cost", advsimd.fp_stmt_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "ld2_st2_permute_cost", - advsimd.ld2_st2_permute_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "ld3_st3_permute_cost", - advsimd.ld3_st3_permute_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "ld4_st4_permute_cost", - advsimd.ld4_st4_permute_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "permute_cost", advsimd.permute_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_i8_cost", advsimd.reduc_i8_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_i16_cost", - advsimd.reduc_i16_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_i32_cost", - advsimd.reduc_i32_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_i64_cost", - advsimd.reduc_i64_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_f16_cost", - advsimd.reduc_f16_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_f32_cost", - advsimd.reduc_f32_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "reduc_f64_cost", - advsimd.reduc_f64_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "store_elt_extra_cost", - advsimd.store_elt_extra_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "vec_to_scalar_cost", - advsimd.vec_to_scalar_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "scalar_to_vec_cost", - advsimd.scalar_to_vec_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "align_load_cost", - advsimd.align_load_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "unalign_load_cost", - advsimd.unalign_load_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "unalign_store_cost", - advsimd.unalign_store_cost); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "store_cost", advsimd.store_cost); - - return advsimd_obj; -} - -template -static std::unique_ptr -serialize_vec_costs_sve (const T &sve) -{ - auto sve_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (sve_obj, "clast_cost", sve.clast_cost); - SERIALIZE_INTEGER_FIELD (sve_obj, "fadda_f16_cost", sve.fadda_f16_cost); - SERIALIZE_INTEGER_FIELD (sve_obj, "fadda_f32_cost", sve.fadda_f32_cost); - SERIALIZE_INTEGER_FIELD (sve_obj, "fadda_f64_cost", sve.fadda_f64_cost); - SERIALIZE_INTEGER_FIELD (sve_obj, "gather_load_x32_cost", - sve.gather_load_x32_cost); - SERIALIZE_INTEGER_FIELD (sve_obj, "gather_load_x64_cost", - sve.gather_load_x64_cost); - SERIALIZE_INTEGER_FIELD (sve_obj, "gather_load_x32_init_cost", - sve.gather_load_x32_init_cost); - SERIALIZE_INTEGER_FIELD (sve_obj, "gather_load_x64_init_cost", - sve.gather_load_x64_init_cost); - SERIALIZE_INTEGER_FIELD (sve_obj, "scatter_store_elt_cost", - sve.scatter_store_elt_cost); - - return sve_obj; -} - -template -static std::unique_ptr -serialize_vec_costs_issue_info_scalar (const T &scalar) -{ - auto scalar_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (scalar_obj, "loads_stores_per_cycle", - scalar.loads_stores_per_cycle); - SERIALIZE_INTEGER_FIELD (scalar_obj, "stores_per_cycle", - scalar.stores_per_cycle); - SERIALIZE_INTEGER_FIELD (scalar_obj, "general_ops_per_cycle", - scalar.general_ops_per_cycle); - SERIALIZE_INTEGER_FIELD (scalar_obj, "fp_simd_load_general_ops", - scalar.fp_simd_load_general_ops); - SERIALIZE_INTEGER_FIELD (scalar_obj, "fp_simd_store_general_ops", - scalar.fp_simd_store_general_ops); - - return scalar_obj; -} - -template -static std::unique_ptr -serialize_vec_costs_issue_info_advsimd (const T &advsimd) -{ - auto advsimd_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (advsimd_obj, "loads_stores_per_cycle", - advsimd.loads_stores_per_cycle); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "stores_per_cycle", - advsimd.stores_per_cycle); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "general_ops_per_cycle", - advsimd.general_ops_per_cycle); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "fp_simd_load_general_ops", - advsimd.fp_simd_load_general_ops); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "fp_simd_store_general_ops", - advsimd.fp_simd_store_general_ops); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "ld2_st2_general_ops", - advsimd.ld2_st2_general_ops); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "ld3_st3_general_ops", - advsimd.ld3_st3_general_ops); - SERIALIZE_INTEGER_FIELD (advsimd_obj, "ld4_st4_general_ops", - advsimd.ld4_st4_general_ops); - - return advsimd_obj; -} - -template -static std::unique_ptr -serialize_vec_costs_issue_info_sve (const T &sve) -{ - auto sve_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (sve_obj, "loads_stores_per_cycle", - sve.loads_stores_per_cycle); - SERIALIZE_INTEGER_FIELD (sve_obj, "stores_per_cycle", sve.stores_per_cycle); - SERIALIZE_INTEGER_FIELD (sve_obj, "general_ops_per_cycle", - sve.general_ops_per_cycle); - SERIALIZE_INTEGER_FIELD (sve_obj, "fp_simd_load_general_ops", - sve.fp_simd_load_general_ops); - SERIALIZE_INTEGER_FIELD (sve_obj, "fp_simd_store_general_ops", - sve.fp_simd_store_general_ops); - SERIALIZE_INTEGER_FIELD (sve_obj, "ld2_st2_general_ops", - sve.ld2_st2_general_ops); - SERIALIZE_INTEGER_FIELD (sve_obj, "ld3_st3_general_ops", - sve.ld3_st3_general_ops); - SERIALIZE_INTEGER_FIELD (sve_obj, "ld4_st4_general_ops", - sve.ld4_st4_general_ops); - SERIALIZE_INTEGER_FIELD (sve_obj, "pred_ops_per_cycle", - sve.pred_ops_per_cycle); - SERIALIZE_INTEGER_FIELD (sve_obj, "while_pred_ops", sve.while_pred_ops); - SERIALIZE_INTEGER_FIELD (sve_obj, "int_cmp_pred_ops", sve.int_cmp_pred_ops); - SERIALIZE_INTEGER_FIELD (sve_obj, "fp_cmp_pred_ops", sve.fp_cmp_pred_ops); - SERIALIZE_INTEGER_FIELD (sve_obj, "gather_scatter_pair_general_ops", - sve.gather_scatter_pair_general_ops); - SERIALIZE_INTEGER_FIELD (sve_obj, "gather_scatter_pair_pred_ops", - sve.gather_scatter_pair_pred_ops); - - return sve_obj; -} - -template -static std::unique_ptr -serialize_branch_costs (const T &branch_costs) -{ - auto branch_costs_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (branch_costs_obj, "predictable", - branch_costs.predictable); - SERIALIZE_INTEGER_FIELD (branch_costs_obj, "unpredictable", - branch_costs.unpredictable); - - return branch_costs_obj; -} - -template -static std::unique_ptr -serialize_approx_modes (const T &approx_modes) -{ - auto approx_modes_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (approx_modes_obj, "division", approx_modes.division); - SERIALIZE_INTEGER_FIELD (approx_modes_obj, "sqrt", approx_modes.sqrt); - SERIALIZE_INTEGER_FIELD (approx_modes_obj, "recip_sqrt", - approx_modes.recip_sqrt); - - return approx_modes_obj; -} - -template -static std::unique_ptr -serialize_memmov_cost (const T &memmov_cost) -{ - auto memmov_cost_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "load_int", memmov_cost.load_int); - SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "store_int", memmov_cost.store_int); - SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "load_fp", memmov_cost.load_fp); - SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "store_fp", memmov_cost.store_fp); - SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "load_pred", memmov_cost.load_pred); - SERIALIZE_INTEGER_FIELD (memmov_cost_obj, "store_pred", - memmov_cost.store_pred); - - return memmov_cost_obj; -} - -template -static std::unique_ptr -serialize_prefetch (const T &prefetch) -{ - auto prefetch_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (prefetch_obj, "num_slots", prefetch.num_slots); - SERIALIZE_INTEGER_FIELD (prefetch_obj, "l1_cache_size", - prefetch.l1_cache_size); - SERIALIZE_INTEGER_FIELD (prefetch_obj, "l1_cache_line_size", - prefetch.l1_cache_line_size); - SERIALIZE_INTEGER_FIELD (prefetch_obj, "l2_cache_size", - prefetch.l2_cache_size); - SERIALIZE_BOOLEAN_FIELD (prefetch_obj, "prefetch_dynamic_strides", - prefetch.prefetch_dynamic_strides); - SERIALIZE_INTEGER_FIELD (prefetch_obj, "minimum_stride", - prefetch.minimum_stride); - SERIALIZE_INTEGER_FIELD (prefetch_obj, "default_opt_level", - prefetch.default_opt_level); - - return prefetch_obj; -} - -template -static std::unique_ptr -serialize_insn_extra_cost (const T &insn_extra_cost) -{ - auto insn_extra_cost_obj = std::make_unique (); - - SERIALIZE_OBJECT (insn_extra_cost_obj, "alu", insn_extra_cost.alu, - serialize_insn_extra_cost_alu); - SERIALIZE_ARRAY_FIELD (insn_extra_cost_obj, "mult", insn_extra_cost.mult, 2, - serialize_insn_extra_cost_mult_element); - SERIALIZE_OBJECT (insn_extra_cost_obj, "ldst", insn_extra_cost.ldst, - serialize_insn_extra_cost_ldst); - SERIALIZE_ARRAY_FIELD (insn_extra_cost_obj, "fp", insn_extra_cost.fp, 2, - serialize_insn_extra_cost_fp_element); - SERIALIZE_OBJECT (insn_extra_cost_obj, "vect", insn_extra_cost.vect, - serialize_insn_extra_cost_vect); - - return insn_extra_cost_obj; -} - -template -static std::unique_ptr -serialize_addr_cost (const T &addr_cost) -{ - auto addr_cost_obj = std::make_unique (); - - SERIALIZE_OBJECT (addr_cost_obj, "addr_scale_costs", - addr_cost.addr_scale_costs, - serialize_addr_cost_addr_scale_costs); - SERIALIZE_INTEGER_FIELD (addr_cost_obj, "pre_modify", addr_cost.pre_modify); - SERIALIZE_INTEGER_FIELD (addr_cost_obj, "post_modify", addr_cost.post_modify); - SERIALIZE_INTEGER_FIELD (addr_cost_obj, "post_modify_ld3_st3", - addr_cost.post_modify_ld3_st3); - SERIALIZE_INTEGER_FIELD (addr_cost_obj, "post_modify_ld4_st4", - addr_cost.post_modify_ld4_st4); - SERIALIZE_INTEGER_FIELD (addr_cost_obj, "register_offset", - addr_cost.register_offset); - SERIALIZE_INTEGER_FIELD (addr_cost_obj, "register_sextend", - addr_cost.register_sextend); - SERIALIZE_INTEGER_FIELD (addr_cost_obj, "register_zextend", - addr_cost.register_zextend); - SERIALIZE_INTEGER_FIELD (addr_cost_obj, "imm_offset", addr_cost.imm_offset); - - return addr_cost_obj; -} - -template -static std::unique_ptr -serialize_vec_costs_issue_info (const T &issue_info) -{ - auto issue_info_obj = std::make_unique (); - - SERIALIZE_OBJECT (issue_info_obj, "scalar", issue_info.scalar, - serialize_vec_costs_issue_info_scalar); - SERIALIZE_OBJECT (issue_info_obj, "advsimd", issue_info.advsimd, - serialize_vec_costs_issue_info_advsimd); - SERIALIZE_OBJECT (issue_info_obj, "sve", issue_info.sve, - serialize_vec_costs_issue_info_sve); - - return issue_info_obj; -} - -template -static std::unique_ptr -serialize_vec_costs (const T &vec_costs) -{ - auto vec_costs_obj = std::make_unique (); - - SERIALIZE_INTEGER_FIELD (vec_costs_obj, "scalar_int_stmt_cost", - vec_costs.scalar_int_stmt_cost); - SERIALIZE_INTEGER_FIELD (vec_costs_obj, "scalar_fp_stmt_cost", - vec_costs.scalar_fp_stmt_cost); - SERIALIZE_INTEGER_FIELD (vec_costs_obj, "scalar_load_cost", - vec_costs.scalar_load_cost); - SERIALIZE_INTEGER_FIELD (vec_costs_obj, "scalar_store_cost", - vec_costs.scalar_store_cost); - SERIALIZE_INTEGER_FIELD (vec_costs_obj, "cond_taken_branch_cost", - vec_costs.cond_taken_branch_cost); - SERIALIZE_INTEGER_FIELD (vec_costs_obj, "cond_not_taken_branch_cost", - vec_costs.cond_not_taken_branch_cost); - SERIALIZE_OBJECT (vec_costs_obj, "advsimd", vec_costs.advsimd, - serialize_vec_costs_advsimd); - SERIALIZE_OBJECT (vec_costs_obj, "sve", vec_costs.sve, - serialize_vec_costs_sve); - SERIALIZE_OBJECT (vec_costs_obj, "issue_info", vec_costs.issue_info, - serialize_vec_costs_issue_info); - - return vec_costs_obj; -} - -template -static std::unique_ptr -serialize_tunings (const T &tunings) -{ - auto tunings_obj = std::make_unique (); - - SERIALIZE_OBJECT (tunings_obj, "insn_extra_cost", tunings.insn_extra_cost, - serialize_insn_extra_cost); - SERIALIZE_OBJECT (tunings_obj, "addr_cost", tunings.addr_cost, - serialize_addr_cost); - SERIALIZE_OBJECT (tunings_obj, "regmove_cost", tunings.regmove_cost, - serialize_regmove_cost); - SERIALIZE_OBJECT (tunings_obj, "vec_costs", tunings.vec_costs, - serialize_vec_costs); - SERIALIZE_OBJECT (tunings_obj, "branch_costs", tunings.branch_costs, - serialize_branch_costs); - SERIALIZE_OBJECT (tunings_obj, "approx_modes", tunings.approx_modes, - serialize_approx_modes); - SERIALIZE_INTEGER_FIELD (tunings_obj, "sve_width", tunings.sve_width); - SERIALIZE_OBJECT (tunings_obj, "memmov_cost", tunings.memmov_cost, - serialize_memmov_cost); - SERIALIZE_INTEGER_FIELD (tunings_obj, "issue_rate", tunings.issue_rate); - SERIALIZE_INTEGER_FIELD (tunings_obj, "fusible_ops", tunings.fusible_ops); - SERIALIZE_STRING_FIELD (tunings_obj, "function_align", - tunings.function_align); - SERIALIZE_STRING_FIELD (tunings_obj, "jump_align", tunings.jump_align); - SERIALIZE_STRING_FIELD (tunings_obj, "loop_align", tunings.loop_align); - SERIALIZE_INTEGER_FIELD (tunings_obj, "int_reassoc_width", - tunings.int_reassoc_width); - SERIALIZE_INTEGER_FIELD (tunings_obj, "fp_reassoc_width", - tunings.fp_reassoc_width); - SERIALIZE_INTEGER_FIELD (tunings_obj, "fma_reassoc_width", - tunings.fma_reassoc_width); - SERIALIZE_INTEGER_FIELD (tunings_obj, "vec_reassoc_width", - tunings.vec_reassoc_width); - SERIALIZE_INTEGER_FIELD (tunings_obj, "min_div_recip_mul_sf", - tunings.min_div_recip_mul_sf); - SERIALIZE_INTEGER_FIELD (tunings_obj, "min_div_recip_mul_df", - tunings.min_div_recip_mul_df); - SERIALIZE_INTEGER_FIELD (tunings_obj, "max_case_values", - tunings.max_case_values); - SERIALIZE_ENUM_FIELD (tunings_obj, "autoprefetcher_model", - tunings.autoprefetcher_model, - autoprefetcher_model_mappings); - SERIALIZE_INTEGER_FIELD (tunings_obj, "extra_tuning_flags", - tunings.extra_tuning_flags); - SERIALIZE_OBJECT (tunings_obj, "prefetch", tunings.prefetch, - serialize_prefetch); - SERIALIZE_ENUM_FIELD (tunings_obj, "ldp_policy_model", - tunings.ldp_policy_model, ldp_policy_model_mappings); - SERIALIZE_ENUM_FIELD (tunings_obj, "stp_policy_model", - tunings.stp_policy_model, stp_policy_model_mappings); - - return tunings_obj; -} +/* Include auto-generated printing routines. */ +#include "aarch64-json-tunings-printer-generated.inc" /* Print tune_params structure to JSON file. */ void diff --git a/gcc/config/aarch64/aarch64-opts.h b/gcc/config/aarch64/aarch64-opts.h index a6ca5cf016b0..a25b2170c2df 100644 --- a/gcc/config/aarch64/aarch64-opts.h +++ b/gcc/config/aarch64/aarch64-opts.h @@ -142,10 +142,8 @@ enum aarch64_autovec_preference_enum { - LDP_STP_POLICY_ALWAYS: Emit ldp/stp regardless of alignment. - LDP_STP_POLICY_NEVER: Do not emit ldp/stp. */ enum aarch64_ldp_stp_policy { - AARCH64_LDP_STP_POLICY_DEFAULT, - AARCH64_LDP_STP_POLICY_ALIGNED, - AARCH64_LDP_STP_POLICY_ALWAYS, - AARCH64_LDP_STP_POLICY_NEVER +#define AARCH64_LDP_STP_POLICY(NAME, ENUM_VALUE) ENUM_VALUE, +#include "aarch64-tuning-enums.def" }; /* An enum specifying when the early-ra pass should be run: diff --git a/gcc/config/aarch64/aarch64-protos.h b/gcc/config/aarch64/aarch64-protos.h index c83d1ed910fe..11c2938558d4 100644 --- a/gcc/config/aarch64/aarch64-protos.h +++ b/gcc/config/aarch64/aarch64-protos.h @@ -568,9 +568,8 @@ struct tune_params enum aarch64_autoprefetch_model { - AUTOPREFETCHER_OFF, - AUTOPREFETCHER_WEAK, - AUTOPREFETCHER_STRONG +#define AARCH64_AUTOPREFETCH_MODE(NAME, ENUM_VALUE) ENUM_VALUE, +#include "aarch64-tuning-enums.def" } autoprefetcher_model; unsigned int extra_tuning_flags; diff --git a/gcc/config/aarch64/aarch64-tuning-enums.def b/gcc/config/aarch64/aarch64-tuning-enums.def new file mode 100644 index 000000000000..701b64fe8b5f --- /dev/null +++ b/gcc/config/aarch64/aarch64-tuning-enums.def @@ -0,0 +1,37 @@ +/* AArch64 tuning parameter enum definitions. + Copyright The GNU Toolchain Authors. + + This file is part of GCC. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +/* This file contains the enum definitions for AArch64 tuning parameters + that are used in both the JSON parser/printer and the tuning structures. */ + +#ifdef AARCH64_AUTOPREFETCH_MODE +AARCH64_AUTOPREFETCH_MODE("AUTOPREFETCHER_OFF", AUTOPREFETCHER_OFF) +AARCH64_AUTOPREFETCH_MODE("AUTOPREFETCHER_WEAK", AUTOPREFETCHER_WEAK) +AARCH64_AUTOPREFETCH_MODE("AUTOPREFETCHER_STRONG", AUTOPREFETCHER_STRONG) +#endif + +#ifdef AARCH64_LDP_STP_POLICY +AARCH64_LDP_STP_POLICY("AARCH64_LDP_STP_POLICY_DEFAULT", AARCH64_LDP_STP_POLICY_DEFAULT) +AARCH64_LDP_STP_POLICY("AARCH64_LDP_STP_POLICY_ALIGNED", AARCH64_LDP_STP_POLICY_ALIGNED) +AARCH64_LDP_STP_POLICY("AARCH64_LDP_STP_POLICY_ALWAYS", AARCH64_LDP_STP_POLICY_ALWAYS) +AARCH64_LDP_STP_POLICY("AARCH64_LDP_STP_POLICY_NEVER", AARCH64_LDP_STP_POLICY_NEVER) +#endif + +#undef AARCH64_AUTOPREFETCH_MODE +#undef AARCH64_LDP_STP_POLICY diff --git a/gcc/config/aarch64/t-aarch64 b/gcc/config/aarch64/t-aarch64 index 34eb287adc57..6f63a9f55126 100644 --- a/gcc/config/aarch64/t-aarch64 +++ b/gcc/config/aarch64/t-aarch64 @@ -47,6 +47,12 @@ else endif $(STAMP) s-aarch64-tune-md +# Regenerate the JSON tuning files if the schema has changed +$(srcdir)/config/aarch64/aarch64-json-tunings-%-generated.inc: \ +$(srcdir)/config/aarch64/aarch64-json-schema.h \ +$(srcdir)/config/aarch64/aarch64-generate-json-tuning-routines.py + $(PYTHON) $(srcdir)/config/aarch64/aarch64-generate-json-tuning-routines.py --generate-only $* + s-mddeps: s-aarch64-tune-md aarch64-builtins.o: $(srcdir)/config/aarch64/aarch64-builtins.cc $(CONFIG_H) \ @@ -214,6 +220,7 @@ aarch64-json-tunings-printer.o: $(srcdir)/config/aarch64/aarch64-json-tunings-pr $(CONFIG_H) $(SYSTEM_H) $(CORETYPES_H) $(TM_H) $(DIAGNOSTIC_CORE_H) \ $(PRETTY_PRINT_H) json.h \ $(srcdir)/config/aarch64/aarch64-json-tunings-printer.h \ + $(srcdir)/config/aarch64/aarch64-json-tunings-printer-generated.inc \ $(srcdir)/config/aarch64/aarch64-protos.h \ $(srcdir)/config/arm/aarch-common-protos.h $(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ @@ -224,6 +231,7 @@ aarch64-json-tunings-parser.o: $(srcdir)/config/aarch64/aarch64-json-tunings-par json-parsing.h \ $(srcdir)/config/aarch64/aarch64-json-schema.h \ $(srcdir)/config/aarch64/aarch64-json-tunings-parser.h \ + $(srcdir)/config/aarch64/aarch64-json-tunings-parser-generated.inc \ $(srcdir)/config/aarch64/aarch64-protos.h \ $(srcdir)/config/arm/aarch-common-protos.h $(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ From b1e6fd80c3d64e412b02676b69e8ed3a011beb27 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tomasz=20Kami=C5=84ski?= Date: Wed, 26 Nov 2025 10:27:18 +0100 Subject: [PATCH 032/373] libstdc++: Remove use of __packed name conflicting with newlib. libstdc++-v3/ChangeLog: * include/std/chrono (chrono::__hash): Rename __packed to __res. --- libstdc++-v3/include/std/chrono | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/libstdc++-v3/include/std/chrono b/libstdc++-v3/include/std/chrono index 0cfad2ce1d0c..8dd79799a962 100644 --- a/libstdc++-v3/include/std/chrono +++ b/libstdc++-v3/include/std/chrono @@ -3401,8 +3401,8 @@ namespace __detail return chrono::__int_hash(chrono::__as_int(__vals)...); else { - auto __packed = chrono::__pack_ints(chrono::__as_int(__vals)...); - return chrono::__int_hash(__packed); + auto __res = chrono::__pack_ints(chrono::__as_int(__vals)...); + return chrono::__int_hash(__res); } } } // namespace chrono From 7720e82b3ae67c28a66fba7c0b783565293861fc Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Wed, 26 Nov 2025 10:47:20 +0100 Subject: [PATCH 033/373] Avoid diagnostics about unsupported simdlen This fixes unexpected diagnostics on arm. * gcc.dg/vect/vect-simd-clone-22.c: Add -w. * gcc.dg/vect/vect-simd-clone-23.c: Likewise. --- gcc/testsuite/gcc.dg/vect/vect-simd-clone-22.c | 2 +- gcc/testsuite/gcc.dg/vect/vect-simd-clone-23.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-22.c b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-22.c index 70fa82564480..732d23280e57 100644 --- a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-22.c +++ b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-22.c @@ -1,5 +1,5 @@ /* { dg-require-effective-target vect_simd_clones } */ -/* { dg-additional-options "-fopenmp-simd --param vect-partial-vector-usage=2" } */ +/* { dg-additional-options "-fopenmp-simd --param vect-partial-vector-usage=2 -w" } */ /* { dg-additional-options "-mavx512f" { target avx512f_runtime } } */ /* { dg-add-options ieee } */ /* { dg-require-effective-target fenv_exceptions } */ diff --git a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-23.c b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-23.c index 312ac9f468fa..b673ee097a6a 100644 --- a/gcc/testsuite/gcc.dg/vect/vect-simd-clone-23.c +++ b/gcc/testsuite/gcc.dg/vect/vect-simd-clone-23.c @@ -1,6 +1,6 @@ /* { dg-do compile } */ /* { dg-require-effective-target vect_simd_clones } */ -/* { dg-additional-options "-fopenmp-simd" } */ +/* { dg-additional-options "-fopenmp-simd -w" } */ /* { dg-additional-options "-mavx512bw" { target avx512bw } } */ #pragma omp declare simd simdlen(32) inbranch From d5db22c890df83f84d186916348d16b79f278b33 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Wed, 26 Nov 2025 10:57:37 +0100 Subject: [PATCH 034/373] match.pd: Use get_range_query (cfun) in more simplifications and pass current stmt to range_of_expr [PR119683] The following testcase regressed with r13-3596 which switched over vrp1 to ranger vrp. Before that, I believe vrp1 was registering SSA_NAMEs with ASSERT_EXPRs at the start of bbs and so even when querying the global ranges from match.pd patterns during the vrp1 pass, they saw the local ranges for a particular bb rather than global ranges. In ranger vrp that doesn't happen anymore, so we need to pass a stmt to range_of_expr if we want the local ranges rather than global ones, plus should be using get_range_query (cfun) instead of get_global_range_query () (most patterns actually use the former already). Now, for stmt the following patch attempts to pass the innermost stmt on which that particular capture appears as operand, but because some passes use match.pd folding on expressions not yet in the IL, I've added a helper function which tries to find out from a capture of the LHS operation whether it is a SSA_NAME with SSA_NAME_DEF_STMT which is in the IL right now and only query the ranger with that in that case, otherwise NULL (i.e. what it has been using before). 2025-11-26 Jakub Jelinek PR tree-optimization/119683 * gimple-match.h (gimple_match_ctx): New inline function. * match.pd ((mult (plus:s (mult:s @0 @1) @2) @3)): Capture PLUS, use get_range_query (cfun) instead of get_global_range_query () and pass gimple_match_ctx (@5) as 3rd argument to range_of_expr. ((plus (mult:s (plus:s @0 @1) @2) @3)): Similarly for MULT, with @4 instead of @5. ((t * u) / u -> t): Similarly with @2 instead of @4. ((t * u) / v -> t * (u / v)): Capture MULT, pass gimple_match_ctx (@3) as 3rd argument to range_of_expr. ((X + M*N) / N -> X / N + M): Pass gimple_match_ctx (@3) or gimple_match_ctx (@4) as 3rd arg to some range_of_expr calls. ((X - M*N) / N -> X / N - M): Likewise. ((X + C) / N -> X / N + C / N): Similarly. (((T)(A)) + CST -> (T)(A + CST)): Capture CONVERT, use get_range_query (cfun) instead of get_global_range_query () and pass gimple_match_ctx (@2) as 3rd argument to range_of_expr. (x_5 == cstN ? cst4 : cst3): Capture EQNE and pass gimple_match_ctx (@4) as 3rd argument to range_of_expr. * gcc.dg/tree-ssa/pr119683.c: New test. --- gcc/gimple-match.h | 13 +++++ gcc/match.pd | 64 +++++++++++++++--------- gcc/testsuite/gcc.dg/tree-ssa/pr119683.c | 19 +++++++ 3 files changed, 72 insertions(+), 24 deletions(-) create mode 100644 gcc/testsuite/gcc.dg/tree-ssa/pr119683.c diff --git a/gcc/gimple-match.h b/gcc/gimple-match.h index 70f2f68827b4..a2c931fa60c7 100644 --- a/gcc/gimple-match.h +++ b/gcc/gimple-match.h @@ -427,4 +427,17 @@ bool directly_supported_p (code_helper, tree, tree, internal_fn get_conditional_internal_fn (code_helper, tree); +/* If OP is a SSA_NAME with SSA_NAME_DEF_STMT in the IL, return that + stmt, otherwise NULL. For use in range_of_expr calls. */ + +inline gimple * +gimple_match_ctx (tree op) +{ + if (TREE_CODE (op) == SSA_NAME + && SSA_NAME_DEF_STMT (op) + && gimple_bb (SSA_NAME_DEF_STMT (op))) + return SSA_NAME_DEF_STMT (op); + return NULL; +} + #endif /* GCC_GIMPLE_MATCH_H */ diff --git a/gcc/match.pd b/gcc/match.pd index 2877f81e7a51..05c8b59eb9e8 100644 --- a/gcc/match.pd +++ b/gcc/match.pd @@ -648,7 +648,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) /* Similar to above, but there could be an extra add/sub between successive multuiplications. */ (simplify - (mult (plus:s (mult:s@4 @0 INTEGER_CST@1) INTEGER_CST@2) INTEGER_CST@3) + (mult (plus:s@5 (mult:s@4 @0 INTEGER_CST@1) INTEGER_CST@2) INTEGER_CST@3) (with { bool overflowed = true; wi::overflow_type ovf1, ovf2; @@ -661,7 +661,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) #if GIMPLE int_range_max vr0; if (ovf1 == wi::OVF_NONE && ovf2 == wi::OVF_NONE - && get_global_range_query ()->range_of_expr (vr0, @4) + && get_range_query (cfun)->range_of_expr (vr0, @4, + gimple_match_ctx (@5)) && !vr0.varying_p () && !vr0.undefined_p ()) { wide_int wmin0 = vr0.lower_bound (); @@ -688,7 +689,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) /* Similar to above, but a multiplication between successive additions. */ (simplify - (plus (mult:s (plus:s @0 INTEGER_CST@1) INTEGER_CST@2) INTEGER_CST@3) + (plus (mult:s (plus:s@4 @0 INTEGER_CST@1) INTEGER_CST@2) INTEGER_CST@3) (with { bool overflowed = true; wi::overflow_type ovf1; @@ -702,7 +703,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) #if GIMPLE int_range_max vr0; if (ovf1 == wi::OVF_NONE && ovf2 == wi::OVF_NONE - && get_global_range_query ()->range_of_expr (vr0, @0) + && get_range_query (cfun)->range_of_expr (vr0, @0, + gimple_match_ctx (@4)) && !vr0.varying_p () && !vr0.undefined_p ()) { wide_int wmin0 = vr0.lower_bound (); @@ -1016,15 +1018,17 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (for div (trunc_div ceil_div floor_div round_div exact_div) /* Simplify (t * u) / u -> t. */ (simplify - (div (mult:c @0 @1) @1) + (div (mult:c@2 @0 @1) @1) (if (ANY_INTEGRAL_TYPE_P (type)) (if (TYPE_OVERFLOW_UNDEFINED (type) && !TYPE_OVERFLOW_SANITIZED (type)) @0 #if GIMPLE (with {int_range_max vr0, vr1;} (if (INTEGRAL_TYPE_P (type) - && get_range_query (cfun)->range_of_expr (vr0, @0) - && get_range_query (cfun)->range_of_expr (vr1, @1) + && get_range_query (cfun)->range_of_expr (vr0, @0, + gimple_match_ctx (@2)) + && get_range_query (cfun)->range_of_expr (vr1, @1, + gimple_match_ctx (@2)) && range_op_handler (MULT_EXPR).overflow_free_p (vr0, vr1)) @0)) #endif @@ -1032,13 +1036,14 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) #if GIMPLE /* Simplify (t * u) / v -> t * (u / v) if u is multiple of v. */ (simplify - (div (mult @0 INTEGER_CST@1) INTEGER_CST@2) + (div (mult@3 @0 INTEGER_CST@1) INTEGER_CST@2) (if (INTEGRAL_TYPE_P (type) && wi::multiple_of_p (wi::to_widest (@1), wi::to_widest (@2), SIGNED)) (if (TYPE_OVERFLOW_UNDEFINED (type) && !TYPE_OVERFLOW_SANITIZED (type)) (mult @0 (div! @1 @2)) (with {int_range_max vr0, vr1;} - (if (get_range_query (cfun)->range_of_expr (vr0, @0) + (if (get_range_query (cfun)->range_of_expr (vr0, @0, + gimple_match_ctx (@3)) && get_range_query (cfun)->range_of_expr (vr1, @1) && range_op_handler (MULT_EXPR).overflow_free_p (vr0, vr1)) (mult @0 (div! @1 @2)))) @@ -1046,14 +1051,15 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) #endif /* Simplify (t * u) / (t * v) -> (u / v) if u is multiple of v. */ (simplify - (div (mult @0 INTEGER_CST@1) (mult @0 INTEGER_CST@2)) + (div (mult@3 @0 INTEGER_CST@1) (mult @0 INTEGER_CST@2)) (if (INTEGRAL_TYPE_P (type) && wi::multiple_of_p (wi::to_widest (@1), wi::to_widest (@2), SIGNED)) (if (TYPE_OVERFLOW_UNDEFINED (type) && !TYPE_OVERFLOW_SANITIZED (type)) (div @1 @2) #if GIMPLE (with {int_range_max vr0, vr1, vr2;} - (if (get_range_query (cfun)->range_of_expr (vr0, @0) + (if (get_range_query (cfun)->range_of_expr (vr0, @0, + gimple_match_ctx (@3)) && get_range_query (cfun)->range_of_expr (vr1, @1) && get_range_query (cfun)->range_of_expr (vr2, @2) && range_op_handler (MULT_EXPR).overflow_free_p (vr0, vr1) @@ -1069,12 +1075,16 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (div (plus:c@4 @0 (mult:c@3 @1 @2)) @2) (with {int_range_max vr0, vr1, vr2, vr3, vr4;} (if (INTEGRAL_TYPE_P (type) - && get_range_query (cfun)->range_of_expr (vr1, @1) - && get_range_query (cfun)->range_of_expr (vr2, @2) + && get_range_query (cfun)->range_of_expr (vr1, @1, + gimple_match_ctx (@3)) + && get_range_query (cfun)->range_of_expr (vr2, @2, + gimple_match_ctx (@3)) /* "N*M" doesn't overflow. */ && range_op_handler (MULT_EXPR).overflow_free_p (vr1, vr2) - && get_range_query (cfun)->range_of_expr (vr0, @0) - && get_range_query (cfun)->range_of_expr (vr3, @3) + && get_range_query (cfun)->range_of_expr (vr0, @0, + gimple_match_ctx (@4)) + && get_range_query (cfun)->range_of_expr (vr3, @3, + gimple_match_ctx (@4)) /* "X+(N*M)" doesn't overflow. */ && range_op_handler (PLUS_EXPR).overflow_free_p (vr0, vr3) && get_range_query (cfun)->range_of_expr (vr4, @4) @@ -1090,12 +1100,16 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (div (minus@4 @0 (mult:c@3 @1 @2)) @2) (with {int_range_max vr0, vr1, vr2, vr3, vr4;} (if (INTEGRAL_TYPE_P (type) - && get_range_query (cfun)->range_of_expr (vr1, @1) - && get_range_query (cfun)->range_of_expr (vr2, @2) + && get_range_query (cfun)->range_of_expr (vr1, @1, + gimple_match_ctx (@3)) + && get_range_query (cfun)->range_of_expr (vr2, @2, + gimple_match_ctx (@3)) /* "N * M" doesn't overflow. */ && range_op_handler (MULT_EXPR).overflow_free_p (vr1, vr2) - && get_range_query (cfun)->range_of_expr (vr0, @0) - && get_range_query (cfun)->range_of_expr (vr3, @3) + && get_range_query (cfun)->range_of_expr (vr0, @0, + gimple_match_ctx (@4)) + && get_range_query (cfun)->range_of_expr (vr3, @3, + gimple_match_ctx (@4)) /* "X - (N*M)" doesn't overflow. */ && range_op_handler (MINUS_EXPR).overflow_free_p (vr0, vr3) && get_range_query (cfun)->range_of_expr (vr4, @4) @@ -1124,7 +1138,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) int_range_max vr0, vr1, vr3; } (if (INTEGRAL_TYPE_P (type) - && get_range_query (cfun)->range_of_expr (vr0, @0)) + && get_range_query (cfun)->range_of_expr (vr0, @0, + gimple_match_ctx (@3))) (if (exact_mod (c) && get_range_query (cfun)->range_of_expr (vr1, @1) /* "X+C" doesn't overflow. */ @@ -4451,7 +4466,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) /* ((T)(A)) + CST -> (T)(A + CST) */ #if GIMPLE (simplify - (plus (convert:s SSA_NAME@0) INTEGER_CST@1) + (plus (convert:s@2 SSA_NAME@0) INTEGER_CST@1) (if (TREE_CODE (TREE_TYPE (@0)) == INTEGER_TYPE && TREE_CODE (type) == INTEGER_TYPE && TYPE_PRECISION (type) > TYPE_PRECISION (TREE_TYPE (@0)) @@ -4469,7 +4484,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) TYPE_SIGN (inner_type)); int_range_max vr; - if (get_global_range_query ()->range_of_expr (vr, @0) + if (get_range_query (cfun)->range_of_expr (vr, @0, + gimple_match_ctx (@2)) && !vr.varying_p () && !vr.undefined_p ()) { wide_int wmin0 = vr.lower_bound (); @@ -6540,14 +6556,14 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) This was originally done by two_value_replacement in phiopt (PR 88676). */ (for eqne (ne eq) (simplify - (cond (eqne SSA_NAME@0 INTEGER_CST@1) INTEGER_CST@2 INTEGER_CST@3) + (cond (eqne@4 SSA_NAME@0 INTEGER_CST@1) INTEGER_CST@2 INTEGER_CST@3) (if (INTEGRAL_TYPE_P (TREE_TYPE (@0)) && INTEGRAL_TYPE_P (type) && (wi::to_widest (@2) + 1 == wi::to_widest (@3) || wi::to_widest (@2) == wi::to_widest (@3) + 1)) (with { int_range_max r; - get_range_query (cfun)->range_of_expr (r, @0); + get_range_query (cfun)->range_of_expr (r, @0, gimple_match_ctx (@4)); if (r.undefined_p ()) r.set_varying (TREE_TYPE (@0)); diff --git a/gcc/testsuite/gcc.dg/tree-ssa/pr119683.c b/gcc/testsuite/gcc.dg/tree-ssa/pr119683.c new file mode 100644 index 000000000000..631ab43b7a7b --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/pr119683.c @@ -0,0 +1,19 @@ +/* PR tree-optimization/119683 */ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ +/* { dg-final { scan-tree-dump-times " = c_\[0-9]*\\\(D\\\) \\\+ \(?:\[0-9-]\)+;" 3 "optimized" } } */ + +unsigned +foo (signed char c) +{ + if (c >= '0' && c <= '9') + return c - '0'; + + if (c >= 'a' && c <= 'z') + return c - 'a' + 10; + + if (c >= 'A' && c <= 'Z') + return c - 'A' + 10; + + return -1; +} From f68fe3ddda40d4c238095ff8c76c473b0d1e4827 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Wed, 26 Nov 2025 11:05:42 +0100 Subject: [PATCH 035/373] eh: Invoke cleanups/destructors in asm goto jumps [PR122835] The eh pass lowers try { } finally { } stmts and handles in there e.g. GIMPLE_GOTOs or GIMPLE_CONDs which jump from within the try block out of that by redirecting the jumps to an artificial label with code to perform the cleanups/destructors and then continuing the goto, ultimately to the original label. Now, for computed gotos and non-local gotos, we document we don't invoke destructors (and cleanups as well), that is something we really can't handle, similarly longjmp. This PR is about asm goto though, and in that case I don't see why we shouldn't be performing the cleanups, while the user doesn't specify which particular label will be jumped to, so it is more like GIMPLE_COND (i.e. conditional goto) rather than unconditional GIMPLE_GOTO, even with potentiall more different maybe gotos, there is still list of the potential labels and we can adjust some or all of them to artificial labels performing cleanups and continuing jump towards the user label, we know from where the jumps go (asm goto) and to where (the different LABEL_DECLs). So, the following patch handles asm goto in the eh pass similarly to GIMPLE_COND and GIMPLE_GOTO. 2025-11-26 Jakub Jelinek PR middle-end/122835 * tree-eh.cc (replace_goto_queue_1): Handle GIMPLE_ASM. (maybe_record_in_goto_queue): Likewise. (lower_eh_constructs_2): Likewise. * gcc.dg/torture/pr122835.c: New test. --- gcc/testsuite/gcc.dg/torture/pr122835.c | 79 +++++++++++++++++++++++++ gcc/tree-eh.cc | 59 ++++++++++++++++++ 2 files changed, 138 insertions(+) create mode 100644 gcc/testsuite/gcc.dg/torture/pr122835.c diff --git a/gcc/testsuite/gcc.dg/torture/pr122835.c b/gcc/testsuite/gcc.dg/torture/pr122835.c new file mode 100644 index 000000000000..03efdfa045cb --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr122835.c @@ -0,0 +1,79 @@ +/* PR middle-end/122835 */ +/* { dg-do run { target i?86-*-* x86_64-*-* aarch64-*-* arm*-*-* powerpc*-*-* s390*-*-* } } */ + +#if defined(__x86_64__) || defined(__i386__) +#define JMP "jmp" +#elif defined(__aarch64__) || defined(__arm__) || defined(__powerpc__) +#define JMP "b" +#elif defined(__s390__) +#define JMP "j" +#endif + +int cnt; + +static void +my_cleanup (int *p) +{ + ++cnt; +} + +__attribute__((noipa)) static void +my_abort (void) +{ + __builtin_abort (); +} + +int +main () +{ + { + int x __attribute__((cleanup (my_cleanup))) = 0; + + asm goto (JMP "\t%l0" :::: l1); + + my_abort (); + } + +l1: + if (cnt != 1) + __builtin_abort (); + + { + int x __attribute__((cleanup (my_cleanup))) = 0; + + { + int y __attribute__((cleanup (my_cleanup))) = 0; + + asm goto (JMP "\t%l1" :::: l2, l3); + + my_abort (); + } +l2: + __builtin_abort (); + } +l3: + if (cnt != 3) + __builtin_abort (); + + { + int x __attribute__((cleanup (my_cleanup))) = 0; + + { + int y __attribute__((cleanup (my_cleanup))) = 0; + + asm goto (JMP "\t%l0" :::: l4, l5); + + my_abort (); + } +l4: + if (cnt != 4) + __builtin_abort (); + } + if (0) + { +l5: + __builtin_abort (); + } + if (cnt != 5) + __builtin_abort (); +} diff --git a/gcc/tree-eh.cc b/gcc/tree-eh.cc index 5c62e6bcc385..be85444cd515 100644 --- a/gcc/tree-eh.cc +++ b/gcc/tree-eh.cc @@ -517,6 +517,48 @@ replace_goto_queue_1 (gimple *stmt, struct leh_tf_state *tf, } break; + case GIMPLE_ASM: + if (int n = gimple_asm_nlabels (as_a (stmt))) + { + temp.g = stmt; + gasm *asm_stmt = as_a (stmt); + location_t loc = gimple_location (stmt); + tree bypass_label = NULL_TREE; + for (int i = 0; i < n; ++i) + { + tree elt = gimple_asm_label_op (asm_stmt, i); + temp.tp = &TREE_VALUE (elt); + seq = find_goto_replacement (tf, temp); + if (!seq) + continue; + if (gimple_seq_singleton_p (seq) + && gimple_code (gimple_seq_first_stmt (seq)) == GIMPLE_GOTO) + { + TREE_VALUE (elt) + = gimple_goto_dest (gimple_seq_first_stmt (seq)); + continue; + } + + if (bypass_label == NULL_TREE) + { + bypass_label = create_artificial_label (loc); + gsi_insert_after (gsi, gimple_build_goto (bypass_label), + GSI_CONTINUE_LINKING); + } + + tree label = create_artificial_label (loc); + TREE_VALUE (elt) = label; + gsi_insert_after (gsi, gimple_build_label (label), + GSI_CONTINUE_LINKING); + gsi_insert_seq_after (gsi, gimple_seq_copy (seq), + GSI_CONTINUE_LINKING); + } + if (bypass_label) + gsi_insert_after (gsi, gimple_build_label (bypass_label), + GSI_CONTINUE_LINKING); + } + break; + case GIMPLE_COND: replace_goto_queue_cond_clause (gimple_op_ptr (stmt, 2), tf, gsi); replace_goto_queue_cond_clause (gimple_op_ptr (stmt, 3), tf, gsi); @@ -685,12 +727,28 @@ maybe_record_in_goto_queue (struct leh_state *state, gimple *stmt) EXPR_LOCATION (*new_stmt.tp)); } break; + case GIMPLE_GOTO: new_stmt.g = stmt; record_in_goto_queue_label (tf, new_stmt, gimple_goto_dest (stmt), gimple_location (stmt)); break; + case GIMPLE_ASM: + if (int n = gimple_asm_nlabels (as_a (stmt))) + { + new_stmt.g = stmt; + gasm *asm_stmt = as_a (stmt); + for (int i = 0; i < n; ++i) + { + tree elt = gimple_asm_label_op (asm_stmt, i); + new_stmt.tp = &TREE_VALUE (elt); + record_in_goto_queue_label (tf, new_stmt, TREE_VALUE (elt), + gimple_location (stmt)); + } + } + break; + case GIMPLE_RETURN: tf->may_return = true; new_stmt.g = stmt; @@ -2082,6 +2140,7 @@ lower_eh_constructs_2 (struct leh_state *state, gimple_stmt_iterator *gsi) case GIMPLE_COND: case GIMPLE_GOTO: case GIMPLE_RETURN: + case GIMPLE_ASM: maybe_record_in_goto_queue (state, stmt); break; From 0ea9d760fbf44c6f50c50a4e259d3ef2c756606c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tomasz=20Kami=C5=84ski?= Date: Thu, 20 Nov 2025 11:23:30 +0100 Subject: [PATCH 036/373] libstdc++: Make C++20s operator wrappers operator() static. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The operator() for function objects introduced in C++20 (e.g., std::identity, std::compare_three_way, std::ranges::equal) is now defined as static. Although static operator() is a C++23 feature, it is supported in C++20 by both GCC and clang (since their support was added in clang-16). This change is not user-observable, as all affected operators are template functions. Taking the address of such an operator requires casting to a pointer to member function with a specific signature. The exact signature is unspecified per C++20 [member.functions] p2 (e.g. due to potential parameters with default arguments). libstdc++-v3/ChangeLog: * include/bits/ranges_cmp.h (std::identity::operator()): (ranges::equal_to:operator(), ranges::not_equal_to:operator()) (ranges::greater::operator(), ranges::greater_equal::operator()) (ranges::less::operator(), ranges::less_equal::operator()): Declare as static. * libsupc++/compare (std::compare_three_way::operator()): Declare as static. Reviewed-by: Jonathan Wakely Reviewed-by: Patrick Palka Signed-off-by: Tomasz Kamiński --- libstdc++-v3/include/bits/ranges_cmp.h | 34 +++++++++++++++----------- libstdc++-v3/libsupc++/compare | 7 ++++-- 2 files changed, 25 insertions(+), 16 deletions(-) diff --git a/libstdc++-v3/include/bits/ranges_cmp.h b/libstdc++-v3/include/bits/ranges_cmp.h index cd5f7b8b37a2..a53cd5645635 100644 --- a/libstdc++-v3/include/bits/ranges_cmp.h +++ b/libstdc++-v3/include/bits/ranges_cmp.h @@ -46,11 +46,14 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION /// [func.identity] The identity function. struct identity { +#pragma GCC diagnostic push +#pragma GCC diagnostic ignored "-Wc++23-extensions" // static operator() template [[nodiscard]] - constexpr _Tp&& - operator()(_Tp&& __t) const noexcept + static constexpr _Tp&& + operator()(_Tp&& __t) noexcept { return std::forward<_Tp>(__t); } +#pragma GCC diagnostic pop using is_transparent = __is_transparent; }; @@ -79,13 +82,15 @@ namespace ranges // _GLIBCXX_RESOLVE_LIB_DEFECTS // 3530 BUILTIN-PTR-MEOW should not opt the type out of syntactic checks +#pragma GCC diagnostic push +#pragma GCC diagnostic ignored "-Wc++23-extensions" // static operator() /// ranges::equal_to function object type. struct equal_to { template requires equality_comparable_with<_Tp, _Up> - constexpr bool - operator()(_Tp&& __t, _Up&& __u) const + static constexpr bool + operator()(_Tp&& __t, _Up&& __u) noexcept(noexcept(std::declval<_Tp>() == std::declval<_Up>())) { return std::forward<_Tp>(__t) == std::forward<_Up>(__u); } @@ -97,8 +102,8 @@ namespace ranges { template requires equality_comparable_with<_Tp, _Up> - constexpr bool - operator()(_Tp&& __t, _Up&& __u) const + static constexpr bool + operator()(_Tp&& __t, _Up&& __u) noexcept(noexcept(std::declval<_Tp>() == std::declval<_Up>())) { return !equal_to{}(std::forward<_Tp>(__t), std::forward<_Up>(__u)); } @@ -110,8 +115,8 @@ namespace ranges { template requires totally_ordered_with<_Tp, _Up> - constexpr bool - operator()(_Tp&& __t, _Up&& __u) const + static constexpr bool + operator()(_Tp&& __t, _Up&& __u) noexcept(noexcept(std::declval<_Tp>() < std::declval<_Up>())) { if constexpr (__detail::__less_builtin_ptr_cmp<_Tp, _Up>) @@ -137,8 +142,8 @@ namespace ranges { template requires totally_ordered_with<_Tp, _Up> - constexpr bool - operator()(_Tp&& __t, _Up&& __u) const + static constexpr bool + operator()(_Tp&& __t, _Up&& __u) noexcept(noexcept(std::declval<_Up>() < std::declval<_Tp>())) { return less{}(std::forward<_Up>(__u), std::forward<_Tp>(__t)); } @@ -150,8 +155,8 @@ namespace ranges { template requires totally_ordered_with<_Tp, _Up> - constexpr bool - operator()(_Tp&& __t, _Up&& __u) const + static constexpr bool + operator()(_Tp&& __t, _Up&& __u) noexcept(noexcept(std::declval<_Tp>() < std::declval<_Up>())) { return !less{}(std::forward<_Tp>(__t), std::forward<_Up>(__u)); } @@ -163,13 +168,14 @@ namespace ranges { template requires totally_ordered_with<_Tp, _Up> - constexpr bool - operator()(_Tp&& __t, _Up&& __u) const + static constexpr bool + operator()(_Tp&& __t, _Up&& __u) noexcept(noexcept(std::declval<_Up>() < std::declval<_Tp>())) { return !less{}(std::forward<_Up>(__u), std::forward<_Tp>(__t)); } using is_transparent = __is_transparent; }; +#pragma GCC diagnostic pop } // namespace ranges #endif // __glibcxx_ranges diff --git a/libstdc++-v3/libsupc++/compare b/libstdc++-v3/libsupc++/compare index 458b47c3fcab..08f2b2ba47ed 100644 --- a/libstdc++-v3/libsupc++/compare +++ b/libstdc++-v3/libsupc++/compare @@ -573,10 +573,12 @@ namespace std _GLIBCXX_VISIBILITY(default) // [cmp.object], typename compare_three_way struct compare_three_way { +#pragma GCC diagnostic push +#pragma GCC diagnostic ignored "-Wc++23-extensions" // static operator() template requires three_way_comparable_with<_Tp, _Up> - constexpr auto - operator() [[nodiscard]] (_Tp&& __t, _Up&& __u) const + static constexpr auto + operator() [[nodiscard]] (_Tp&& __t, _Up&& __u) noexcept(noexcept(std::declval<_Tp>() <=> std::declval<_Up>())) { if constexpr (__detail::__3way_builtin_ptr_cmp<_Tp, _Up>) @@ -592,6 +594,7 @@ namespace std _GLIBCXX_VISIBILITY(default) else return static_cast<_Tp&&>(__t) <=> static_cast<_Up&&>(__u); } +#pragma GCC diagnostic pop using is_transparent = void; }; From 9ed821d107f7a183f75b4b5d25b32d7f34ca60b5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tomasz=20Kami=C5=84ski?= Date: Thu, 13 Nov 2025 14:54:11 +0100 Subject: [PATCH 037/373] libstdc++: Optimize functor storage for transform views iterators. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The iterators for transform views (views::transform, views::zip_transform, and views::adjacent_transform) now store a function handle from (from __detail::__func_handle namespace) instead of a pointer to the view object (_M_parent). The following handle templates are defined in __func_handle namespace: * _Inplace: Used if the functor is a function pointer or standard operator wrapper (std::less<>, etc). The functor is stored directly in __func_handle and the iterator. This avoid double indirection through a pointer to the function pointer, and reduce the size of iterator for std wrappers. * _InplaceMemPtr: Used for data or function member pointers. This behaves similarly to _Inplace, but uses __invoke for invocations. * _StaticCall: Used if the operator() selected by overload resolution for the iterator reference is static. In this case, __func_handle is empty, reducing the iterator size. * _ViaPointer: Used for all remaining cases. __func_handle stores a pointer to the functor object stored within the view. Only for this template the cv-qualification of the functor template parameter (_Fn) relevant, and specialization for both const and mutable types are generated. As a consequence of these changes, the iterators of transform views no longer depend on the view object when handle other than __func_handle::_ViaPointer is used. The corresponding views are not marked as borrowed_range, as they are not marked as such in the standard. The use of _Inplace is limited to only set of pre-C++20 standard functors, as for once introduced later operator() was retroactively made static. We do not extent to to any empty fuctor, as it's oprator may still depend on value of this pointer as illustrated by test12 in std/ranges/adaptors/transform.cc test file. Storing function member pointers directly increases the iterator size in that specific case, but this is deemed beneficial for consistent treatment of function and data member pointers. To avoid materializing temporaries when the underlying iterator(s) return a prvalue, the _M_call_deref and _M_call_subscript methods of handles are defined to accept the iterator(s), which are then dereferenced as arguments of the functor. Using _Fd::operator()(*__iters...) inside requires expression is only supported since clang-20, however at the point of GCC-16 release, clang-22 should be already available. libstdc++-v3/ChangeLog: * include/std/ranges (__detail::__is_std_op_template) (__detail::__is_std_op_wrapper, __func_handle::_Inplace) (__func_handle::_InplaceMemPtr, __func_handle::_ViaPointer) (__func_handle::_StaticCall, __detail::__func_handle_t): Define. (transform_view::_Iterator, zip_transform_view::_Iterator) (adjacent_tranform_view::_Iterator): Replace pointer to view (_M_parent) with pointer to functor (_M_fun). Update constructors to construct _M_fun from *__parent->_M_fun. Define operator* and operator[] in terms of _M_call_deref and _M_call_subscript. * testsuite/std/ranges/adaptors/adjacent_transform/1.cc: New tests. * testsuite/std/ranges/adaptors/transform.cc: New tests. * testsuite/std/ranges/zip_transform/1.cc: New tests. Reviewed-by: Jonathan Wakely Reviewed-by: Patrick Palka Signed-off-by: Tomasz Kamiński --- libstdc++-v3/include/std/ranges | 261 ++++++++++++++++-- .../ranges/adaptors/adjacent_transform/1.cc | 41 +++ .../std/ranges/adaptors/transform.cc | 178 +++++++++++- .../testsuite/std/ranges/zip_transform/1.cc | 97 +++++++ 4 files changed, 540 insertions(+), 37 deletions(-) diff --git a/libstdc++-v3/include/std/ranges b/libstdc++-v3/include/std/ranges index ae57b9a08098..7c5ac931e313 100644 --- a/libstdc++-v3/include/std/ranges +++ b/libstdc++-v3/include/std/ranges @@ -286,6 +286,185 @@ namespace ranges operator->() const noexcept { return std::__addressof(_M_value); } }; + + template class> + constexpr bool __is_std_op_template = false; + + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + template<> + inline constexpr bool __is_std_op_template = true; + + + template + constexpr bool __is_std_op_wrapper = false; + + template class _Ft, typename _Tp> + constexpr bool __is_std_op_wrapper<_Ft<_Tp>> + = __is_std_op_template<_Ft>; + + namespace __func_handle + { + template + struct _Inplace + { + _Inplace() = default; + + constexpr explicit + _Inplace(_Fn __func) noexcept + : _M_ptr(__func) + { } + + template + constexpr decltype(auto) + _M_call_deref(const _Iters&... __iters) const + noexcept(noexcept(_M_ptr(*__iters...))) + { return _M_ptr(*__iters...); } + + template + constexpr decltype(auto) + _M_call_subscript(const _DistType __n, const _Iters&... __iters) const + noexcept(noexcept(_M_ptr(__iters[iter_difference_t<_Iters>(__n)]...))) + { return _M_ptr(__iters[iter_difference_t<_Iters>(__n)]...); } + + private: + [[no_unique_address]] _Fn _M_ptr = _Fn(); + }; + + template + struct _InplaceMemPtr + { + _InplaceMemPtr() = default; + + constexpr explicit + _InplaceMemPtr(_Fn __func) noexcept + : _M_ptr(__func) + {} + + template + constexpr decltype(auto) + _M_call_deref(const _Iters&... __iters) const + noexcept(noexcept(std::__invoke(_M_ptr, *__iters...))) + { return std::__invoke(_M_ptr, *__iters...); } + + template + constexpr decltype(auto) + _M_call_subscript(const _DistType __n, const _Iters&... __iters) const + noexcept(noexcept(std::__invoke(_M_ptr, __iters[iter_difference_t<_Iters>(__n)]...))) + { return std::__invoke(_M_ptr, __iters[iter_difference_t<_Iters>(__n)]...); } + + private: + _Fn _M_ptr = nullptr; + }; + + template + struct _ViaPointer + { + _ViaPointer() = default; + + constexpr explicit + _ViaPointer(_Fn& __func) noexcept + : _M_ptr(std::addressof(__func)) + { } + + template + requires (!is_const_v<_Un>) && is_same_v + constexpr + _ViaPointer(_ViaPointer<_Un> __other) noexcept + : _M_ptr(__other._M_ptr) + { } + + template + constexpr decltype(auto) + _M_call_deref(const _Iters&... __iters) const + noexcept(noexcept((*_M_ptr)(*__iters...))) + { return (*_M_ptr)(*__iters...); } + + template + constexpr decltype(auto) + _M_call_subscript(const _DistType __n, const _Iters&... __iters) const + noexcept(noexcept((*_M_ptr)(__iters[iter_difference_t<_Iters>(__n)]...))) + { return (*_M_ptr)(__iters[iter_difference_t<_Iters>(__n)]...); } + + private: + _Fn* _M_ptr = nullptr; + + template + friend struct _ViaPointer; + }; + + template + struct _StaticCall + { + _StaticCall() = default; + + constexpr explicit + _StaticCall(const _Fn&) noexcept + {} + + template + static constexpr decltype(auto) + _M_call_deref(const _Iters&... __iters) + noexcept(noexcept(_Fn::operator()(*__iters...))) + { return _Fn::operator()(*__iters...); } + + template + static constexpr decltype(auto) + _M_call_subscript(_DistType __n, const _Iters&... __iters) + noexcept(noexcept(_Fn::operator()(__iters[iter_difference_t<_Iters>(__n)]...))) + { return _Fn::operator()(__iters[iter_difference_t<_Iters>(__n)]...); } + }; + } // __func_handle + + template + using __func_handle_t = decltype([] { + using _Fd = remove_cv_t<_Fn>; + if constexpr (is_member_pointer_v<_Fd>) + return __func_handle::_InplaceMemPtr<_Fd>(); + else if constexpr (is_function_v>) + return __func_handle::_Inplace<_Fd>(); + else if constexpr (__is_std_op_wrapper<_Fd>) + return __func_handle::_Inplace<_Fd>(); + else if constexpr (requires (const _Iters&... __iters) + { _Fd::operator()(*__iters...); }) + return __func_handle::_StaticCall<_Fd>(); + else + return __func_handle::_ViaPointer<_Fn>(); + }()); } // namespace __detail /// A view that contains exactly one element. @@ -1874,6 +2053,10 @@ namespace views::__adaptor private: using _Parent = __detail::__maybe_const_t<_Const, transform_view>; using _Base = transform_view::_Base<_Const>; + using _Base_iter = iterator_t<_Base>; + using _Func_handle = __detail::__func_handle_t< + __detail::__maybe_const_t<_Const, _Fp>, + _Base_iter>; static auto _S_iter_concept() @@ -1888,10 +2071,8 @@ namespace views::__adaptor return input_iterator_tag{}; } - using _Base_iter = iterator_t<_Base>; - _Base_iter _M_current = _Base_iter(); - _Parent* _M_parent = nullptr; + [[no_unique_address]] _Func_handle _M_fun; public: using iterator_concept = decltype(_S_iter_concept()); @@ -1904,16 +2085,20 @@ namespace views::__adaptor _Iterator() requires default_initializable<_Base_iter> = default; constexpr - _Iterator(_Parent* __parent, _Base_iter __current) - : _M_current(std::move(__current)), - _M_parent(__parent) + _Iterator(_Func_handle __fun, _Base_iter __current) + : _M_current(std::move(__current)), _M_fun(__fun) { } + constexpr + _Iterator(_Parent* __parent, _Base_iter __current) + : _M_current(std::move(__current)), _M_fun(*__parent->_M_fun) + {} + constexpr _Iterator(_Iterator __i) requires _Const && convertible_to, _Base_iter> - : _M_current(std::move(__i._M_current)), _M_parent(__i._M_parent) + : _M_current(std::move(__i._M_current)), _M_fun(__i._M_fun) { } constexpr const _Base_iter& @@ -1926,8 +2111,8 @@ namespace views::__adaptor constexpr decltype(auto) operator*() const - noexcept(noexcept(std::__invoke(*_M_parent->_M_fun, *_M_current))) - { return std::__invoke(*_M_parent->_M_fun, *_M_current); } + noexcept(noexcept(_M_fun._M_call_deref(_M_current))) + { return _M_fun._M_call_deref(_M_current); } constexpr _Iterator& operator++() @@ -1980,7 +2165,7 @@ namespace views::__adaptor constexpr decltype(auto) operator[](difference_type __n) const requires random_access_range<_Base> - { return std::__invoke(*_M_parent->_M_fun, _M_current[__n]); } + { return _M_fun._M_call_subscript(__n, _M_current); } friend constexpr bool operator==(const _Iterator& __x, const _Iterator& __y) @@ -2018,17 +2203,17 @@ namespace views::__adaptor friend constexpr _Iterator operator+(_Iterator __i, difference_type __n) requires random_access_range<_Base> - { return {__i._M_parent, __i._M_current + __n}; } + { return {__i._M_fun, __i._M_current + __n}; } friend constexpr _Iterator operator+(difference_type __n, _Iterator __i) requires random_access_range<_Base> - { return {__i._M_parent, __i._M_current + __n}; } + { return {__i._M_fun, __i._M_current + __n}; } friend constexpr _Iterator operator-(_Iterator __i, difference_type __n) requires random_access_range<_Base> - { return {__i._M_parent, __i._M_current - __n}; } + { return {__i._M_fun, __i._M_current - __n}; } // _GLIBCXX_RESOLVE_LIB_DEFECTS // 3483. transform_view::iterator's difference is overconstrained @@ -5126,13 +5311,21 @@ namespace views::__adaptor class zip_transform_view<_Fp, _Vs...>::_Iterator : public __iter_cat<_Const> { using _Parent = __detail::__maybe_const_t<_Const, zip_transform_view>; + using _Fun_handle = __detail::__func_handle_t< + __detail::__maybe_const_t<_Const, _Fp>, + iterator_t<__detail::__maybe_const_t<_Const, _Vs>>...>; - _Parent* _M_parent = nullptr; + [[no_unique_address]] _Fun_handle _M_fun; __ziperator<_Const> _M_inner; + constexpr + _Iterator(_Fun_handle __fun, __ziperator<_Const> __inner) + : _M_fun(__fun), _M_inner(std::move(__inner)) + { } + constexpr _Iterator(_Parent& __parent, __ziperator<_Const> __inner) - : _M_parent(std::__addressof(__parent)), _M_inner(std::move(__inner)) + : _M_fun(*__parent._M_fun), _M_inner(std::move(__inner)) { } friend class zip_transform_view; @@ -5150,14 +5343,14 @@ namespace views::__adaptor constexpr _Iterator(_Iterator __i) requires _Const && convertible_to<__ziperator, __ziperator<_Const>> - : _M_parent(__i._M_parent), _M_inner(std::move(__i._M_inner)) + : _M_fun(__i._M_fun), _M_inner(std::move(__i._M_inner)) { } constexpr decltype(auto) operator*() const { return std::apply([&](const auto&... __iters) -> decltype(auto) { - return std::__invoke(*_M_parent->_M_fun, *__iters...); + return _M_fun._M_call_deref(__iters...); }, _M_inner._M_current); } @@ -5213,7 +5406,7 @@ namespace views::__adaptor operator[](difference_type __n) const requires random_access_range<_Base<_Const>> { return std::apply([&](const _Is&... __iters) -> decltype(auto) { - return std::__invoke(*_M_parent->_M_fun, __iters[iter_difference_t<_Is>(__n)]...); + return _M_fun._M_call_subscript(__n, __iters...); }, _M_inner._M_current); } @@ -5230,17 +5423,17 @@ namespace views::__adaptor friend constexpr _Iterator operator+(const _Iterator& __i, difference_type __n) requires random_access_range<_Base<_Const>> - { return _Iterator(*__i._M_parent, __i._M_inner + __n); } + { return _Iterator(__i._M_fun, __i._M_inner + __n); } friend constexpr _Iterator operator+(difference_type __n, const _Iterator& __i) requires random_access_range<_Base<_Const>> - { return _Iterator(*__i._M_parent, __i._M_inner + __n); } + { return _Iterator(__i._M_fun, __i._M_inner + __n); } friend constexpr _Iterator operator-(const _Iterator& __i, difference_type __n) requires random_access_range<_Base<_Const>> - { return _Iterator(*__i._M_parent, __i._M_inner - __n); } + { return _Iterator(__i._M_fun, __i._M_inner - __n); } friend constexpr difference_type operator-(const _Iterator& __x, const _Iterator& __y) @@ -5807,13 +6000,23 @@ namespace views::__adaptor { using _Parent = __detail::__maybe_const_t<_Const, adjacent_transform_view>; using _Base = __detail::__maybe_const_t<_Const, _Vp>; + using _Fun_handle = decltype([](std::index_sequence<_Ids...>) { + return __detail::__func_handle_t< + __detail::__maybe_const_t<_Const, _Fp>, + iterator_t<__detail::__maybe_const_t<(_Ids, _Const), _Vp>>...>(); + }(make_index_sequence<_Nm>())); - _Parent* _M_parent = nullptr; + [[no_unique_address]] _Fun_handle _M_fun; _InnerIter<_Const> _M_inner; + constexpr + _Iterator(_Fun_handle __fun, _InnerIter<_Const> __inner) + : _M_fun(__fun), _M_inner(std::move(__inner)) + { } + constexpr _Iterator(_Parent& __parent, _InnerIter<_Const> __inner) - : _M_parent(std::__addressof(__parent)), _M_inner(std::move(__inner)) + : _M_fun(*__parent._M_fun), _M_inner(std::move(__inner)) { } static auto @@ -5854,14 +6057,14 @@ namespace views::__adaptor constexpr _Iterator(_Iterator __i) requires _Const && convertible_to<_InnerIter, _InnerIter<_Const>> - : _M_parent(__i._M_parent), _M_inner(std::move(__i._M_inner)) + : _M_fun(__i._M_fun), _M_inner(std::move(__i._M_inner)) { } constexpr decltype(auto) operator*() const { return std::apply([&](const auto&... __iters) -> decltype(auto) { - return std::__invoke(*_M_parent->_M_fun, *__iters...); + return _M_fun._M_call_deref(__iters...); }, _M_inner._M_current); } @@ -5913,7 +6116,7 @@ namespace views::__adaptor operator[](difference_type __n) const requires random_access_range<_Base> { return std::apply([&](const auto&... __iters) -> decltype(auto) { - return std::__invoke(*_M_parent->_M_fun, __iters[__n]...); + return _M_fun._M_call_subscript(__n, __iters...); }, _M_inner._M_current); } @@ -5950,17 +6153,17 @@ namespace views::__adaptor friend constexpr _Iterator operator+(const _Iterator& __i, difference_type __n) requires random_access_range<_Base> - { return _Iterator(*__i._M_parent, __i._M_inner + __n); } + { return _Iterator(__i._M_fun, __i._M_inner + __n); } friend constexpr _Iterator operator+(difference_type __n, const _Iterator& __i) requires random_access_range<_Base> - { return _Iterator(*__i._M_parent, __i._M_inner + __n); } + { return _Iterator(__i._M_fun, __i._M_inner + __n); } friend constexpr _Iterator operator-(const _Iterator& __i, difference_type __n) requires random_access_range<_Base> - { return _Iterator(*__i._M_parent, __i._M_inner - __n); } + { return _Iterator(__i._M_fun, __i._M_inner - __n); } friend constexpr difference_type operator-(const _Iterator& __x, const _Iterator& __y) diff --git a/libstdc++-v3/testsuite/std/ranges/adaptors/adjacent_transform/1.cc b/libstdc++-v3/testsuite/std/ranges/adaptors/adjacent_transform/1.cc index 772e4b3b6a0d..6890618754b6 100644 --- a/libstdc++-v3/testsuite/std/ranges/adaptors/adjacent_transform/1.cc +++ b/libstdc++-v3/testsuite/std/ranges/adaptors/adjacent_transform/1.cc @@ -113,6 +113,47 @@ test04() static_assert( requires { x | views::pairwise_transform(move_only{}); } ); } +template +void +test05(Fn f) +{ + int x[] = {1,2,3,4,5,6}; + auto v = x | views::pairwise_transform(f); + static_assert(sizeof(v.begin()) == 2*sizeof(int*) + FuncSize); +} + +void +test05all() +{ + test05<0>(std::equal_to<>()); + test05<0>(std::equal_to<>()); + test05<0>(std::not_equal_to<>()); + test05<0>(std::greater<>()); + test05<0>(std::less<>()); + test05<0>(std::greater_equal<>()); + test05<0>(std::less_equal<>()); + + test05<0>(std::ranges::equal_to()); + test05<0>(std::ranges::not_equal_to()); + test05<0>(std::ranges::greater()); + test05<0>(std::ranges::less()); + test05<0>(std::ranges::greater_equal()); + test05<0>(std::ranges::less_equal()); + + test05<0>(std::plus<>()); + test05<0>(std::minus<>()); + test05<0>(std::multiplies<>()); + test05<0>(std::divides<>()); + test05<0>(std::modulus<>()); + + test05<0>(std::logical_and<>()); + test05<0>(std::logical_or<>()); + + test05<0>(std::bit_and<>()); + test05<0>(std::bit_or<>()); + test05<0>(std::bit_xor<>()); +} + int main() { diff --git a/libstdc++-v3/testsuite/std/ranges/adaptors/transform.cc b/libstdc++-v3/testsuite/std/ranges/adaptors/transform.cc index 1788db1ce8d6..3a21a1f0f9c3 100644 --- a/libstdc++-v3/testsuite/std/ranges/adaptors/transform.cc +++ b/libstdc++-v3/testsuite/std/ranges/adaptors/transform.cc @@ -18,6 +18,7 @@ // { dg-do run { target c++20 } } #include +#include #include #include #include @@ -28,12 +29,12 @@ using __gnu_test::random_access_iterator_wrapper; namespace ranges = std::ranges; namespace views = std::ranges::views; +template void -test01() +test01(Fn f) { int x[] = {1,2,3,4,5}; - auto is_odd = [] (int i) { return i%2==1; }; - auto v = x | views::transform(is_odd); + auto v = x | views::transform(f); VERIFY( ranges::equal(v, (int[]){1,0,1,0,1}) ); using R = decltype(v); static_assert(std::same_as); @@ -42,30 +43,124 @@ test01() static_assert(ranges::random_access_range); } +void +test01a() +{ + auto is_odd = [] (int i) { return i%2==1; }; + test01(is_odd); +} + +void +test01b() +{ +#if __cpp_static_call_operator >= 202207L + auto is_odd = [] (int i) static { return i%2==1; }; + test01(is_odd); +#endif +} + +void +test01c() +{ + bool(*is_odd)(int) = [] (int i) { return i%2==1; }; + test01(is_odd); +} + struct X { int i,j; + int& first() { return i; } }; +template void -test02() +test02(Fn f) { X x[] = {{1,2},{3,4},{5,6},{7,8},{9,10}}; test_range rx(x); - auto v = rx | views::transform(&X::i); + auto v = rx | views::transform(f); VERIFY( ranges::size(v) == 5 ); VERIFY( ranges::distance(v.begin(), v.end()) == 5 ); VERIFY( ranges::equal(v, (int[]){1,3,5,7,9}) ); VERIFY( ranges::equal(v | views::reverse, (int[]){9,7,5,3,1}) ); using R = decltype(v); + using It = ranges::iterator_t; static_assert(std::same_as); - static_assert(std::same_as>>); + static_assert(std::same_as>); + static_assert(sizeof(It) == sizeof(rx.begin()) + FuncSize); static_assert(ranges::view); static_assert(ranges::sized_range); static_assert(!ranges::common_range); static_assert(ranges::random_access_range); } +void +test02a() +{ test02(&X::i); } + +void +test02b() +{ test02(&X::first); } + +void +test02c() +{ + auto first = [](X& x) -> int& { return x.i; }; + test02(first); +} + +void +test02d() +{ +#if __cpp_static_call_operator >= 202207L + auto first = [](X& x) static -> int& { return x.i; }; + test02<0>(first); +#endif +} + +void +test02e() +{ + int&(*fptr)(X&) = [](X& x) -> int& { return x.i; }; + test02(fptr); +} + +void +test02f() +{ +#if __cpp_static_call_operator >= 202207L + struct PickStatic + { + static constexpr int& + operator()(X& x) + { return x.i; } + + constexpr int + operator()(char*) const + { return 0; }; + }; + test02<0>(PickStatic{}); +#endif +} + +void +test02g() +{ +#if __cpp_static_call_operator >= 202207L + struct PickObject + { + constexpr int& + operator()(X& x) const + { return x.i; } + + static constexpr int + operator()(char*) + { return 0; }; + }; + test02(PickObject{}); +#endif +} + void test03() { @@ -227,11 +322,75 @@ test11() static_assert(std::same_as); } +void +test12() +{ + struct Obfuscate + { + int operator()(int x) const + { return x + reinterpret_cast(this); } + }; + + int x[]{1, 2, 3, 4, 5}; + auto v = x | views::transform(Obfuscate{}); + VERIFY( ranges::equal(v, v) ); +}; + +void +test13() +{ +#if __cpp_static_call_operator >= 202207L + struct StaticWins { + static int operator()(int i) { return 0; } + int operator()(float f) const { return 1; } + }; + + int x[]{1, 2, 3, 4, 5}; + auto vs = x | views::transform(StaticWins{}); + VERIFY( vs.front() == 0 ); + static_assert( sizeof(vs.begin()) == sizeof(int*) ); + + struct MemberWins { + static int operator()(float f) { return 0; } + int operator()(int i) const { return 1; } + }; + + auto vm = x | views::transform(MemberWins{}); + VERIFY( vm.front() == 1 ); + static_assert( sizeof(vm.begin()) > sizeof(int*) ); +#endif +} + +template +void +test14(Fn f) +{ + int x[] = {1,2,3,4,5,6}; + auto v = x | views::transform(std::negate<>()); + static_assert(sizeof(v.begin()) == sizeof(int*) + FuncSize); +} + +void +test14all() +{ + test14<0>(std::identity()); + test14<0>(std::negate<>()); + test14<0>(std::bit_not<>()); +} + int main() { - test01(); - test02(); + test01a(); + test01b(); + test01c(); + test02a(); + test02b(); + test02c(); + test02d(); + test02e(); + test02f(); + test02g(); test03(); test04(); test05(); @@ -241,4 +400,7 @@ main() test09(); test10(); test11(); + test12(); + test13(); + test14all(); } diff --git a/libstdc++-v3/testsuite/std/ranges/zip_transform/1.cc b/libstdc++-v3/testsuite/std/ranges/zip_transform/1.cc index 9a0ad3814e66..8524a146eaa1 100644 --- a/libstdc++-v3/testsuite/std/ranges/zip_transform/1.cc +++ b/libstdc++-v3/testsuite/std/ranges/zip_transform/1.cc @@ -132,6 +132,97 @@ test04() static_assert( requires { views::zip_transform(move_only{}, x, x); } ); } +struct X +{ + int i; + constexpr int add(int b) const + { return i+b; } +}; + +template +constexpr bool +test05(Fn f) +{ + using namespace __gnu_test; + X x[] = {{1},{2},{3},{4},{5}}; + int y[] = {500,400,300,200,100}; + test_range rx(x); + test_range ry(y); + + auto v = views::zip_transform(f, rx, ry); + VERIFY( ranges::size(v) == 5 ); + VERIFY( ranges::distance(v.begin(), v.end()) == 5 ); + VERIFY( ranges::equal(v, (int[]){501,402,303,204,105}) ); + VERIFY( ranges::equal(v | views::reverse, (int[]){105,204,303,402,501}) ); + using R = decltype(v); + using It = ranges::iterator_t; + static_assert(std::same_as); + static_assert(std::same_as>); + static_assert(sizeof(It) == sizeof(rx.begin()) + sizeof(ry.begin()) + ExtraSize); + static_assert(ranges::view); + static_assert(ranges::sized_range); + static_assert(ranges::common_range); + static_assert(ranges::random_access_range); + return true; +} + +constexpr bool +test05a() +{ + auto add = [](const X& x, int v) { return x.i + v; }; + return test05(add); +} + +constexpr bool +test05b() +{ + auto add = [](const X& x, int v) static { return x.i + v; }; + return test05<0>(add); +} + +constexpr bool +test05c() +{ + int(*ptr)(const X&, int) = [](const X& x, int v) { return x.i + v; }; + return test05(ptr); +} + +constexpr bool +test05d() +{ return test05(&X::add); } + +constexpr bool +test05e() +{ + struct PickStatic + { + static constexpr int + operator()(const X& x1, int v) + { return x1.i + v; } + + constexpr int + operator()(int x, int y) const + { return x + y; }; + }; + return test05<0>(PickStatic{}); +} + +constexpr bool +test05f() +{ + struct PickObject + { + constexpr int + operator()(const X& x1, int v) const + { return x1.i + v; } + + static constexpr int + operator()(int x, int y) + { return x + y; }; + }; + return test05(PickObject{}); +} + int main() { @@ -139,4 +230,10 @@ main() static_assert(test02()); static_assert(test03()); test04(); + static_assert(test05a()); + static_assert(test05b()); + static_assert(test05c()); + static_assert(test05d()); + static_assert(test05e()); + static_assert(test05f()); } From 6828f063b59ddae8eef63529ae27224bdfbf1cbc Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Wed, 26 Nov 2025 12:49:58 +0100 Subject: [PATCH 038/373] Fix loop masked inbranch SIMD clone codegen for AVX512 The following applies the earlier fix for conditional SIMD clone calls to the loop masked case. * tree-vect-stmts.cc (vectorizable_simd_clone_call): Handle AVX512 masking for loop masked SIMD clone call. --- gcc/tree-vect-stmts.cc | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/gcc/tree-vect-stmts.cc b/gcc/tree-vect-stmts.cc index 264475ff0913..476a6e570e82 100644 --- a/gcc/tree-vect-stmts.cc +++ b/gcc/tree-vect-stmts.cc @@ -4820,9 +4820,8 @@ vectorizable_simd_clone_call (vec_info *vinfo, stmt_vec_info stmt_info, tree masktype = bestn->simdclone->args[mask_i].vector_type; if (SCALAR_INT_MODE_P (bestn->simdclone->mask_mode)) - /* Guess the number of lanes represented by masktype. */ callee_nelements = exact_div (bestn->simdclone->simdlen, - bestn->simdclone->nargs - nargs); + bestn->simdclone->args[i].linear_step); else callee_nelements = TYPE_VECTOR_SUBPARTS (masktype); o = vector_unroll_factor (nunits, callee_nelements); @@ -4832,7 +4831,7 @@ vectorizable_simd_clone_call (vec_info *vinfo, stmt_vec_info stmt_info, { vec_loop_masks *loop_masks = &LOOP_VINFO_MASKS (loop_vinfo); mask = vect_get_loop_mask (loop_vinfo, gsi, loop_masks, - ncopies, masktype, j); + ncopies_in, vectype, j); } else mask = vect_build_all_ones_mask (vinfo, stmt_info, masktype); From 4e7213aa081f1c0ca5b7e6a60d4e7ba5bcfb1f8a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tomasz=20Kami=C5=84ski?= Date: Wed, 26 Nov 2025 14:28:39 +0100 Subject: [PATCH 039/373] libstdc++: Fix typo in operator used in __pack_ints [PR122864] `<=` was used instead of `<<`, this was detected by clang warning. PR libstdc++/122864 libstdc++-v3/ChangeLog: * include/std/chrono (chrono::__pack_ints): Replace `<=` with `<<`. --- libstdc++-v3/include/std/chrono | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libstdc++-v3/include/std/chrono b/libstdc++-v3/include/std/chrono index 8dd79799a962..3e0cf42e5491 100644 --- a/libstdc++-v3/include/std/chrono +++ b/libstdc++-v3/include/std/chrono @@ -3355,7 +3355,7 @@ namespace __detail }()); _ResT __res = __v1; - ((__res = (__res <= (sizeof(_Ts) * __CHAR_BIT__) | _ResT(__vs))), ...); + ((__res = (__res << (sizeof(_Ts) * __CHAR_BIT__) | _ResT(__vs))), ...); return __res; } From 004438857554f47eb5491d59b067e56fdacf0e74 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Wed, 26 Nov 2025 15:01:11 +0100 Subject: [PATCH 040/373] Change the default C++ dialect to gnu++20 On Mon, Nov 03, 2025 at 01:34:28PM -0500, Marek Polacek via Gcc wrote: > I would like us to declare that C++20 is no longer experimental and > change the default dialect to gnu++20. Last time we changed the default > was over 5 years ago in GCC 11: > > and before that in 2015 in GCC 6.1, so this happens roughly every 5 years. > > I had been hoping to move to C++20 in GCC 15 (see bug 113920), but at that time > libstdc++ still had incomplete C++20 support and the compiler had issues to iron > out (mangling of concepts, modules work, etc.). Are we ready now? Is anyone > aware of any blockers? Presumably we still wouldn't enable Modules by default. > > I'm willing to do the work if we decide that it's time to switch the default > C++ dialect (that includes updating cxx-status.html and adding a new caveat to > changes.html). I haven't seen a patch posted for this, so just that something is posted during stage1 if we decide to do it, here is a patch. The patch makes -std=gnu++20 the default C++ dialect and documents that -fmodules is still not implied by that or -std=c++20 and modules support is still experimental. 2025-11-26 Jakub Jelinek gcc/ * doc/invoke.texi (gnu++17): Remove comment about the default. (c++20): Remove note about experimental support, except add a note that modules are still experimental and need to be enabled separately. (gnu++20): Likewise. Move here comment about the default. (fcoroutines): Mention it is enabled by default for C++20 and later. * doc/standards.texi: Document that the default for C++ is -std=gnu++20. gcc/c-family/ * c-opts.cc (c_common_init_options): Call set_std_cxx20 rather than set_std_cxx17. * c.opt (std=c++2a): Change description to deprecated option wording. (std=c++20): Remove experimental support part. (std=c++2b): Change description to deprecated option wording. (std=gnu++2a): Likewise. (std=gnu++20): Remove experimental support part. (std=gnu++2b): Change description to deprecated option wording. gcc/testsuite/ * lib/target-supports.exp: Set cxx_default to c++20 rather than c++17. * lib/g++-dg.exp (g++-std-flags): Reorder list to put 20 first and 17 after 26. * g++.dg/debug/pr80461.C (bar): Use v = v + 1; instead of ++v;. * g++.dg/debug/pr94459.C: Add -std=gnu++17 to dg-options. * g++.dg/diagnostic/virtual-constexpr.C: Remove dg-skip-if, instead use { c++11 && c++17_down } effective target instead of c++11. * g++.dg/guality/pr67192.C: Add -std=gnu++17. * g++.dg/torture/pr84961-1.C: Likewise. * g++.dg/torture/pr84961-2.C: Likewise. * g++.dg/torture/pr51482.C (anim_track_bez_wvect::tangent): Cast key_class to int before multiplying it by float. * g++.dg/torture/stackalign/unwind-4.C (foo): Use g_a = g_a + 1; instead of g_a++;. * g++.dg/tree-prof/partition1.C (bar): Use l = l + 1; return l; instead of return ++l;. * obj-c++.dg/exceptions-3.mm: Add -std=gnu++17. * obj-c++.dg/exceptions-5.mm: Likewise. libgomp/ * testsuite/libgomp.c++/atomic-12.C (main): Add ()s around array reference index. * testsuite/libgomp.c++/atomic-13.C: Likewise. * testsuite/libgomp.c++/atomic-8.C: Likewise. * testsuite/libgomp.c++/atomic-9.C: Likewise. * testsuite/libgomp.c++/loop-6.C: Use count = count + 1; return count > 0; instead of return ++count > 0;. * testsuite/libgomp.c++/pr38650.C: Add -std=gnu++17. * testsuite/libgomp.c++/target-lambda-1.C (merge_data_func): Use [=,this] instead of just [=] in lambda captures. * testsuite/libgomp.c-c++-common/target-40.c (f1): Use v += 1; instead of v++;. * testsuite/libgomp.c-c++-common/depend-iterator-2.c: Use v = v + 1; instead of v++. --- gcc/c-family/c-opts.cc | 4 +- gcc/c-family/c.opt | 12 ++--- gcc/doc/invoke.texi | 14 +++--- gcc/doc/standards.texi | 2 +- gcc/testsuite/g++.dg/debug/pr80461.C | 2 +- gcc/testsuite/g++.dg/debug/pr94459.C | 2 +- .../g++.dg/diagnostic/virtual-constexpr.C | 3 +- gcc/testsuite/g++.dg/guality/pr67192.C | 2 +- gcc/testsuite/g++.dg/torture/pr51482.C | 2 +- gcc/testsuite/g++.dg/torture/pr84961-1.C | 1 + gcc/testsuite/g++.dg/torture/pr84961-2.C | 1 + .../g++.dg/torture/stackalign/unwind-4.C | 2 +- gcc/testsuite/g++.dg/tree-prof/partition1.C | 3 +- gcc/testsuite/lib/g++-dg.exp | 2 +- gcc/testsuite/lib/target-supports.exp | 2 +- gcc/testsuite/obj-c++.dg/exceptions-3.mm | 2 +- gcc/testsuite/obj-c++.dg/exceptions-5.mm | 2 +- libgomp/testsuite/libgomp.c++/atomic-12.C | 8 ++-- libgomp/testsuite/libgomp.c++/atomic-13.C | 8 ++-- libgomp/testsuite/libgomp.c++/atomic-8.C | 34 ++++++------- libgomp/testsuite/libgomp.c++/atomic-9.C | 34 ++++++------- libgomp/testsuite/libgomp.c++/loop-6.C | 3 +- libgomp/testsuite/libgomp.c++/pr38650.C | 1 + .../testsuite/libgomp.c++/target-lambda-1.C | 2 +- .../libgomp.c-c++-common/depend-iterator-2.c | 48 +++++++++---------- .../libgomp.c-c++-common/target-40.c | 2 +- 26 files changed, 102 insertions(+), 96 deletions(-) diff --git a/gcc/c-family/c-opts.cc b/gcc/c-family/c-opts.cc index 1e0f0c59ade0..8da51759dfd3 100644 --- a/gcc/c-family/c-opts.cc +++ b/gcc/c-family/c-opts.cc @@ -274,9 +274,9 @@ c_common_init_options (unsigned int decoded_options_count, } } - /* Set C++ standard to C++17 if not specified on the command line. */ + /* Set C++ standard to C++20 if not specified on the command line. */ if (c_dialect_cxx ()) - set_std_cxx17 (/*ISO*/false); + set_std_cxx20 (/*ISO*/false); global_dc->get_source_printing_options ().colorize_source_p = true; } diff --git a/gcc/c-family/c.opt b/gcc/c-family/c.opt index 8da089780c4e..e1576c9c3c37 100644 --- a/gcc/c-family/c.opt +++ b/gcc/c-family/c.opt @@ -2618,15 +2618,15 @@ Conform to the ISO 2017 C++ standard. std=c++2a C++ ObjC++ Alias(std=c++20) Undocumented -Conform to the ISO 2020 C++ standard (experimental and incomplete support). +Deprecated in favor of -std=c++20. std=c++20 C++ ObjC++ -Conform to the ISO 2020 C++ standard (experimental and incomplete support). +Conform to the ISO 2020 C++ standard. std=c++2b C++ ObjC++ Alias(std=c++23) Undocumented -Conform to the ISO 2023 C++ standard (published in 2024; experimental and incomplete support). +Deprecated in favor of -std=c++23. std=c++23 C++ ObjC++ @@ -2720,15 +2720,15 @@ Conform to the ISO 2017 C++ standard with GNU extensions. std=gnu++2a C++ ObjC++ Alias(std=gnu++20) Undocumented -Conform to the ISO 2020 C++ standard with GNU extensions (experimental and incomplete support). +Deprecated in favor of -std=gnu++20. std=gnu++20 C++ ObjC++ -Conform to the ISO 2020 C++ standard with GNU extensions (experimental and incomplete support). +Conform to the ISO 2020 C++ standard with GNU extensions. std=gnu++2b C++ ObjC++ Alias(std=gnu++23) Undocumented -Conform to the ISO 2023 C++ standard with GNU extensions (published in 2024; experimental and incomplete support). +Deprecated in favor of -std=gnu++23. std=gnu++23 C++ ObjC++ diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 06723c2b3b62..45317666bc7e 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -2627,21 +2627,21 @@ The name @samp{c++1z} is deprecated. @item gnu++17 @itemx gnu++1z GNU dialect of @option{-std=c++17}. -This is the default for C++ code. The name @samp{gnu++1z} is deprecated. @item c++20 @itemx c++2a The 2020 ISO C++ standard plus amendments. -Support is experimental, and could change in incompatible ways in -future releases. +C++20 modules support is still experimental and needs to be +enabled with @option{-fmodules} option. The name @samp{c++2a} is deprecated. @item gnu++20 @itemx gnu++2a GNU dialect of @option{-std=c++20}. -Support is experimental, and could change in incompatible ways in -future releases. +This is the default for C++ code. +C++20 modules support is still experimental and needs to be +enabled with @option{-fmodules} option. The name @samp{gnu++2a} is deprecated. @item c++23 @@ -3398,7 +3398,9 @@ called. If the handler returns, execution continues normally. @opindex fcoroutines @item -fcoroutines -Enable support for the C++ coroutines extension (experimental). +Enable support for the C++ coroutines extension. With @option{-std=c++20} +and above, coroutines are part of the language standard, so +@option{-fcoroutines} defaults to on. @opindex fdiagnostics-all-candidates @item -fdiagnostics-all-candidates diff --git a/gcc/doc/standards.texi b/gcc/doc/standards.texi index c7c6f28ee218..2c2063a750a9 100644 --- a/gcc/doc/standards.texi +++ b/gcc/doc/standards.texi @@ -289,7 +289,7 @@ select an extended version of the C++ language explicitly with @option{-std=gnu++23} (for C++23 with GNU extensions). The default, if -no C++ language dialect options are given, is @option{-std=gnu++17}. +no C++ language dialect options are given, is @option{-std=gnu++20}. @section Objective-C and Objective-C++ Languages @cindex Objective-C diff --git a/gcc/testsuite/g++.dg/debug/pr80461.C b/gcc/testsuite/g++.dg/debug/pr80461.C index b472e62c8037..440241da5e8b 100644 --- a/gcc/testsuite/g++.dg/debug/pr80461.C +++ b/gcc/testsuite/g++.dg/debug/pr80461.C @@ -30,7 +30,7 @@ bar () { O q; A

f = q; - v++; + v = v + 1; } void diff --git a/gcc/testsuite/g++.dg/debug/pr94459.C b/gcc/testsuite/g++.dg/debug/pr94459.C index ebc0cf45cc64..6886bdb6e438 100644 --- a/gcc/testsuite/g++.dg/debug/pr94459.C +++ b/gcc/testsuite/g++.dg/debug/pr94459.C @@ -1,6 +1,6 @@ // PR debug/94459 // { dg-do compile { target c++14 } } -// { dg-options "-g -dA" } +// { dg-options "-g -dA -std=gnu++17" } template struct S diff --git a/gcc/testsuite/g++.dg/diagnostic/virtual-constexpr.C b/gcc/testsuite/g++.dg/diagnostic/virtual-constexpr.C index 9223c6927376..1daa86dd902f 100644 --- a/gcc/testsuite/g++.dg/diagnostic/virtual-constexpr.C +++ b/gcc/testsuite/g++.dg/diagnostic/virtual-constexpr.C @@ -1,6 +1,5 @@ // { dg-options "-fdiagnostics-show-caret -pedantic-errors" } -// { dg-do compile { target c++11 } } -// { dg-skip-if "virtual constexpr" { *-*-* } { "-std=gnu++2a" } { "" } } +// { dg-do compile { target { c++11 && c++17_down } } } struct S { diff --git a/gcc/testsuite/g++.dg/guality/pr67192.C b/gcc/testsuite/g++.dg/guality/pr67192.C index c09ecf8dc817..9c30dd7ca9d2 100644 --- a/gcc/testsuite/g++.dg/guality/pr67192.C +++ b/gcc/testsuite/g++.dg/guality/pr67192.C @@ -1,6 +1,6 @@ /* PR debug/67192 */ /* { dg-do run } */ -/* { dg-options "-x c++ -g -Wmisleading-indentation" } */ +/* { dg-options "-x c++ -g -Wmisleading-indentation -std=gnu++17" } */ volatile int cnt = 0; diff --git a/gcc/testsuite/g++.dg/torture/pr51482.C b/gcc/testsuite/g++.dg/torture/pr51482.C index 4032703f7208..d4d6ae45d1f5 100644 --- a/gcc/testsuite/g++.dg/torture/pr51482.C +++ b/gcc/testsuite/g++.dg/torture/pr51482.C @@ -22,7 +22,7 @@ WVECT * anim_track_bez_wvect::tangent(int kn, BEZIER_KEY_CLASS key_class, WVECT g1.y = (p_p1->y - p_p0->y)*bp1; g1.z = (p_p1->z - p_p0->z)*bp1; g1.w = (p_p1->w - p_p0->w)*bp1; - bp1 = (0.5f + key_class*0.5f*continuity); + bp1 = (0.5f + ((int)key_class)*0.5f*continuity); p_tn->x = (g1.x + g3.x*bp1)*tn1; p_tn->y = (g1.y + g3.y*bp1)*tn1; p_tn->z = (g1.z + g3.z*bp1)*tn1; diff --git a/gcc/testsuite/g++.dg/torture/pr84961-1.C b/gcc/testsuite/g++.dg/torture/pr84961-1.C index 6a72ad5134fc..2c372c5e31e5 100644 --- a/gcc/testsuite/g++.dg/torture/pr84961-1.C +++ b/gcc/testsuite/g++.dg/torture/pr84961-1.C @@ -1,5 +1,6 @@ // PR c++/84961 // { dg-do compile } +// { dg-options "-std=gnu++17" } short a; volatile int b; diff --git a/gcc/testsuite/g++.dg/torture/pr84961-2.C b/gcc/testsuite/g++.dg/torture/pr84961-2.C index 0909eedb7f96..7f4fe69d103f 100644 --- a/gcc/testsuite/g++.dg/torture/pr84961-2.C +++ b/gcc/testsuite/g++.dg/torture/pr84961-2.C @@ -1,5 +1,6 @@ // PR c++/84961 // { dg-do compile } +// { dg-options "-std=gnu++17" } short a; volatile int b; diff --git a/gcc/testsuite/g++.dg/torture/stackalign/unwind-4.C b/gcc/testsuite/g++.dg/torture/stackalign/unwind-4.C index fddf27625705..6b9339e7e7ff 100644 --- a/gcc/testsuite/g++.dg/torture/stackalign/unwind-4.C +++ b/gcc/testsuite/g++.dg/torture/stackalign/unwind-4.C @@ -11,7 +11,7 @@ foo() int i; ALTER_REGS(); for (i=0; i < 10; i++) - g_a++; + g_a = g_a + 1; throw g_a; } #endif diff --git a/gcc/testsuite/g++.dg/tree-prof/partition1.C b/gcc/testsuite/g++.dg/tree-prof/partition1.C index 8dd64aa27a51..b3095bd6a508 100644 --- a/gcc/testsuite/g++.dg/tree-prof/partition1.C +++ b/gcc/testsuite/g++.dg/tree-prof/partition1.C @@ -16,7 +16,8 @@ int bar (int i) void *p = __builtin_alloca (i); asm volatile ("" : : "r" (i), "r" (p) : "memory"); if (k) throw 6; - return ++l; + l = l + 1; + return l; } void foo () diff --git a/gcc/testsuite/lib/g++-dg.exp b/gcc/testsuite/lib/g++-dg.exp index 042a9171c756..abecd8877c30 100644 --- a/gcc/testsuite/lib/g++-dg.exp +++ b/gcc/testsuite/lib/g++-dg.exp @@ -78,7 +78,7 @@ proc g++-std-flags { test } { # The order of this list is significant: first $cxx_default, # then the oldest and newest, then others in rough order of # importance based on test coverage and usage. - foreach ver { 17 98 26 11 20 14 23 } { + foreach ver { 20 98 26 17 11 14 23 } { set cmpver $ver if { $ver == 98 } { set cmpver 03 } if { [llength $std_list] < 3 diff --git a/gcc/testsuite/lib/target-supports.exp b/gcc/testsuite/lib/target-supports.exp index c0b8026f8e72..1df80d412da7 100644 --- a/gcc/testsuite/lib/target-supports.exp +++ b/gcc/testsuite/lib/target-supports.exp @@ -12158,7 +12158,7 @@ proc check_effective_target_c++ { } { return 0 } -set cxx_default "c++17" +set cxx_default "c++20" # Check whether the current active language standard supports the features # of C++11/C++14 by checking for the presence of one of the -std flags. # This assumes that the default for the compiler is $cxx_default, and that diff --git a/gcc/testsuite/obj-c++.dg/exceptions-3.mm b/gcc/testsuite/obj-c++.dg/exceptions-3.mm index 7cf77a7821a3..fb6982ca8d04 100644 --- a/gcc/testsuite/obj-c++.dg/exceptions-3.mm +++ b/gcc/testsuite/obj-c++.dg/exceptions-3.mm @@ -1,5 +1,5 @@ /* Contributed by Nicola Pero , November 2010. */ -/* { dg-options "-fobjc-exceptions" } */ +/* { dg-options "-fobjc-exceptions -std=gnu++17" } */ /* { dg-do compile } */ // { dg-additional-options "-Wno-objc-root-class" } diff --git a/gcc/testsuite/obj-c++.dg/exceptions-5.mm b/gcc/testsuite/obj-c++.dg/exceptions-5.mm index 4547a756c740..2423e3068839 100644 --- a/gcc/testsuite/obj-c++.dg/exceptions-5.mm +++ b/gcc/testsuite/obj-c++.dg/exceptions-5.mm @@ -1,5 +1,5 @@ /* Contributed by Nicola Pero , November 2010. */ -/* { dg-options "-fobjc-exceptions" } */ +/* { dg-options "-fobjc-exceptions -std=gnu++17" } */ /* { dg-do compile } */ // { dg-additional-options "-Wno-objc-root-class" } diff --git a/libgomp/testsuite/libgomp.c++/atomic-12.C b/libgomp/testsuite/libgomp.c++/atomic-12.C index d1ae9d8c88ca..5b1a7f3e57ac 100644 --- a/libgomp/testsuite/libgomp.c++/atomic-12.C +++ b/libgomp/testsuite/libgomp.c++/atomic-12.C @@ -15,17 +15,17 @@ main () int v, *p; p = &x; #pragma omp atomic update - p[foo (), 0] = 16 + 6 - p[foo (), 0]; + p[(foo (), 0)] = 16 + 6 - p[(foo (), 0)]; #pragma omp atomic read v = x; if (cnt != 2 || v != 16) abort (); #pragma omp atomic capture - v = p[foo () + foo (), 0] = p[foo () + foo (), 0] + 3; + v = p[(foo () + foo (), 0)] = p[(foo () + foo (), 0)] + 3; if (cnt != 6 || v != 19) abort (); #pragma omp atomic capture - v = p[foo (), 0] = 12 * 1 / 2 + (foo (), 0) + p[foo (), 0]; + v = p[(foo (), 0)] = 12 * 1 / 2 + ((foo (), 0)) + p[(foo (), 0)]; if (cnt != 9 || v != 25) abort (); #pragma omp atomic capture @@ -46,7 +46,7 @@ main () abort (); #pragma omp atomic capture { - v = p[foo (), 0]; p[foo (), 0] = (foo (), 7) ? 13 : foo () + 6; + v = p[(foo (), 0)]; p[(foo (), 0)] = (foo (), 7) ? 13 : foo () + 6; } if (cnt != 19 || v != 1) abort (); diff --git a/libgomp/testsuite/libgomp.c++/atomic-13.C b/libgomp/testsuite/libgomp.c++/atomic-13.C index 0569d1c6deb4..1c271196840d 100644 --- a/libgomp/testsuite/libgomp.c++/atomic-13.C +++ b/libgomp/testsuite/libgomp.c++/atomic-13.C @@ -17,17 +17,17 @@ bar () T v, *p; p = &x; #pragma omp atomic update - p[foo (), 0] = 16 + 6 - p[foo (), 0]; + p[(foo (), 0)] = 16 + 6 - p[(foo (), 0)]; #pragma omp atomic read v = x; if (cnt != 2 || v != 16) abort (); #pragma omp atomic capture - v = p[foo () + foo (), 0] = p[foo () + foo (), 0] + 3; + v = p[(foo () + foo (), 0)] = p[(foo () + foo (), 0)] + 3; if (cnt != 6 || v != 19) abort (); #pragma omp atomic capture - v = p[foo (), 0] = 12 * 1 / 2 + (foo (), 0) + p[foo (), 0]; + v = p[(foo (), 0)] = 12 * 1 / 2 + ((foo (), 0)) + p[(foo (), 0)]; if (cnt != 9 || v != 25) abort (); #pragma omp atomic capture @@ -48,7 +48,7 @@ bar () abort (); #pragma omp atomic capture { - v = p[foo (), 0]; p[foo (), 0] = (foo (), 7) ? 13 : foo () + 6; + v = p[(foo (), 0)]; p[(foo (), 0)] = (foo (), 7) ? 13 : foo () + 6; } if (cnt != 19 || v != 1) abort (); diff --git a/libgomp/testsuite/libgomp.c++/atomic-8.C b/libgomp/testsuite/libgomp.c++/atomic-8.C index 744b3409c97d..9b7fbaa9912c 100644 --- a/libgomp/testsuite/libgomp.c++/atomic-8.C +++ b/libgomp/testsuite/libgomp.c++/atomic-8.C @@ -72,22 +72,22 @@ main () abort (); p = &x; #pragma omp atomic update - p[foo (), 0] = p[foo (), 0] - 16; + p[(foo (), 0)] = p[(foo (), 0)] - 16; #pragma omp atomic read v = x; if (cnt != 2 || v != 0) abort (); #pragma omp atomic capture { - p[foo (), 0] += 6; - v = p[foo (), 0]; + p[(foo (), 0)] += 6; + v = p[(foo (), 0)]; } if (cnt != 4 || v != 6) abort (); #pragma omp atomic capture { - v = p[foo (), 0]; - p[foo (), 0] += 6; + v = p[(foo (), 0)]; + p[(foo (), 0)] += 6; } if (cnt != 6 || v != 6) abort (); @@ -97,15 +97,15 @@ main () abort (); #pragma omp atomic capture { - p[foo (), 0] = p[foo (), 0] + 6; - v = p[foo (), 0]; + p[(foo (), 0)] = p[(foo (), 0)] + 6; + v = p[(foo (), 0)]; } if (cnt != 9 || v != 18) abort (); #pragma omp atomic capture { - v = p[foo (), 0]; - p[foo (), 0] = p[foo (), 0] + 6; + v = p[(foo (), 0)]; + p[(foo (), 0)] = p[(foo (), 0)] + 6; } if (cnt != 12 || v != 18) abort (); @@ -114,23 +114,23 @@ main () if (v != 24) abort (); #pragma omp atomic capture - { v = p[foo (), 0]; p[foo (), 0]++; } + { v = p[(foo (), 0)]; p[(foo (), 0)]++; } #pragma omp atomic capture - { v = p[foo (), 0]; ++p[foo (), 0]; } + { v = p[(foo (), 0)]; ++p[(foo (), 0)]; } #pragma omp atomic capture - { p[foo (), 0]++; v = p[foo (), 0]; } + { p[(foo (), 0)]++; v = p[(foo (), 0)]; } #pragma omp atomic capture - { ++p[foo (), 0]; v = p[foo (), 0]; } + { ++p[(foo (), 0)]; v = p[(foo (), 0)]; } if (cnt != 20 || v != 28) abort (); #pragma omp atomic capture - { v = p[foo (), 0]; p[foo (), 0]--; } + { v = p[(foo (), 0)]; p[(foo (), 0)]--; } #pragma omp atomic capture - { v = p[foo (), 0]; --p[foo (), 0]; } + { v = p[(foo (), 0)]; --p[(foo (), 0)]; } #pragma omp atomic capture - { p[foo (), 0]--; v = p[foo (), 0]; } + { p[(foo (), 0)]--; v = p[(foo (), 0)]; } #pragma omp atomic capture - { --p[foo (), 0]; v = p[foo (), 0]; } + { --p[(foo (), 0)]; v = p[(foo (), 0)]; } if (cnt != 28 || v != 24) abort (); return 0; diff --git a/libgomp/testsuite/libgomp.c++/atomic-9.C b/libgomp/testsuite/libgomp.c++/atomic-9.C index ece1bf3f0290..937cc48f6136 100644 --- a/libgomp/testsuite/libgomp.c++/atomic-9.C +++ b/libgomp/testsuite/libgomp.c++/atomic-9.C @@ -75,22 +75,22 @@ bar () abort (); p = &x; #pragma omp atomic update - p[foo (), 0] = p[foo (), 0] - 16; + p[(foo (), 0)] = p[(foo (), 0)] - 16; #pragma omp atomic read v = x; if (cnt != 2 || v != 0) abort (); #pragma omp atomic capture { - p[foo (), 0] += 6; - v = p[foo (), 0]; + p[(foo (), 0)] += 6; + v = p[(foo (), 0)]; } if (cnt != 4 || v != 6) abort (); #pragma omp atomic capture { - v = p[foo (), 0]; - p[foo (), 0] += 6; + v = p[(foo (), 0)]; + p[(foo (), 0)] += 6; } if (cnt != 6 || v != 6) abort (); @@ -100,15 +100,15 @@ bar () abort (); #pragma omp atomic capture { - p[foo (), 0] = p[foo (), 0] + 6; - v = p[foo (), 0]; + p[(foo (), 0)] = p[(foo (), 0)] + 6; + v = p[(foo (), 0)]; } if (cnt != 9 || v != 18) abort (); #pragma omp atomic capture { - v = p[foo (), 0]; - p[foo (), 0] = p[foo (), 0] + 6; + v = p[(foo (), 0)]; + p[(foo (), 0)] = p[(foo (), 0)] + 6; } if (cnt != 12 || v != 18) abort (); @@ -117,23 +117,23 @@ bar () if (v != 24) abort (); #pragma omp atomic capture - { v = p[foo (), 0]; p[foo (), 0]++; } + { v = p[(foo (), 0)]; p[(foo (), 0)]++; } #pragma omp atomic capture - { v = p[foo (), 0]; ++p[foo (), 0]; } + { v = p[(foo (), 0)]; ++p[(foo (), 0)]; } #pragma omp atomic capture - { p[foo (), 0]++; v = p[foo (), 0]; } + { p[(foo (), 0)]++; v = p[(foo (), 0)]; } #pragma omp atomic capture - { ++p[foo (), 0]; v = p[foo (), 0]; } + { ++p[(foo (), 0)]; v = p[(foo (), 0)]; } if (cnt != 20 || v != 28) abort (); #pragma omp atomic capture - { v = p[foo (), 0]; p[foo (), 0]--; } + { v = p[(foo (), 0)]; p[(foo (), 0)]--; } #pragma omp atomic capture - { v = p[foo (), 0]; --p[foo (), 0]; } + { v = p[(foo (), 0)]; --p[(foo (), 0)]; } #pragma omp atomic capture - { p[foo (), 0]--; v = p[foo (), 0]; } + { p[(foo (), 0)]--; v = p[(foo (), 0)]; } #pragma omp atomic capture - { --p[foo (), 0]; v = p[foo (), 0]; } + { --p[(foo (), 0)]; v = p[(foo (), 0)]; } if (cnt != 28 || v != 24) abort (); } diff --git a/libgomp/testsuite/libgomp.c++/loop-6.C b/libgomp/testsuite/libgomp.c++/loop-6.C index f4a6925a40c6..8c0c2c5225cd 100644 --- a/libgomp/testsuite/libgomp.c++/loop-6.C +++ b/libgomp/testsuite/libgomp.c++/loop-6.C @@ -5,7 +5,8 @@ extern "C" void abort (void); volatile int count; static int test(void) { - return ++count > 0; + count = count + 1; + return count > 0; } int i; diff --git a/libgomp/testsuite/libgomp.c++/pr38650.C b/libgomp/testsuite/libgomp.c++/pr38650.C index ebe221adcd5b..08c8075112d2 100644 --- a/libgomp/testsuite/libgomp.c++/pr38650.C +++ b/libgomp/testsuite/libgomp.c++/pr38650.C @@ -1,5 +1,6 @@ // PR c++/38650 // { dg-do run } +// { dg-additional-options "-std=gnu++17" } #include diff --git a/libgomp/testsuite/libgomp.c++/target-lambda-1.C b/libgomp/testsuite/libgomp.c++/target-lambda-1.C index 8c39abe80e11..e3a71d5db57d 100644 --- a/libgomp/testsuite/libgomp.c++/target-lambda-1.C +++ b/libgomp/testsuite/libgomp.c++/target-lambda-1.C @@ -20,7 +20,7 @@ struct S auto merge_data_func (int *iptr, int &b) { - auto fn = [=](void) -> bool + auto fn = [=,this](void) -> bool { bool mapped; uintptr_t hostptr = (uintptr_t) ptr; diff --git a/libgomp/testsuite/libgomp.c-c++-common/depend-iterator-2.c b/libgomp/testsuite/libgomp.c-c++-common/depend-iterator-2.c index d9cbfdcbe794..da83c6741ca8 100644 --- a/libgomp/testsuite/libgomp.c-c++-common/depend-iterator-2.c +++ b/libgomp/testsuite/libgomp.c-c++-common/depend-iterator-2.c @@ -4,53 +4,53 @@ __attribute__((noipa)) void foo (int *p, int i) { #pragma omp task depend (out: p[0]) - v++; + v = v + 1; #pragma omp task depend (in: p[0]) - v++; + v = v + 1; #pragma omp task depend (inout: p[0]) - v++; + v = v + 1; #pragma omp task depend (mutexinoutset: p[0]) - v++; + v = v + 1; #pragma omp task depend (out: p[0]) depend (in: p[1]) - v++; + v = v + 1; #pragma omp task depend (in: p[0]) depend (inout: p[1]) - v++; + v = v + 1; #pragma omp task depend (inout: p[0]) depend (mutexinoutset: p[1]) - v++; + v = v + 1; #pragma omp task depend (mutexinoutset: p[0]) depend (out: p[1]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:2) , out : p[j]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:2) , in : p[j]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:2) , inout : p[j]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:2) , mutexinoutset : p[j]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:2) , out : p[j]) depend (iterator (j=0:2) , in : p[j + 2]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:2) , in : p[j]) depend (iterator (j=0:2) , inout : p[j + 2]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:2) , inout : p[j]) depend (iterator (j=0:2) , mutexinoutset : p[j + 2]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:2) , mutexinoutset : p[j]) depend (iterator (j=0:2) , out : p[j + 2]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:i) , out : p[j]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:i) , in : p[j]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:i) , inout : p[j]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:i) , mutexinoutset : p[j]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:i) , out : p[j]) depend (iterator (j=0:i) , in : p[j + 2]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:i) , in : p[j]) depend (iterator (j=0:i) , inout : p[j + 2]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:i) , inout : p[j]) depend (iterator (j=0:i) , mutexinoutset : p[j + 2]) - v++; + v = v + 1; #pragma omp task depend (iterator (j=0:i) , mutexinoutset : p[j]) depend (iterator (j=0:i) , out : p[j + 2]) - v++; + v = v + 1; } int diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-40.c b/libgomp/testsuite/libgomp.c-c++-common/target-40.c index b46606930556..554860ab088c 100644 --- a/libgomp/testsuite/libgomp.c-c++-common/target-40.c +++ b/libgomp/testsuite/libgomp.c-c++-common/target-40.c @@ -10,7 +10,7 @@ volatile int v; #pragma omp declare target to (v) typedef void (*fnp1) (void); typedef fnp1 (*fnp2) (void); -void f1 (void) { v++; } +void f1 (void) { v += 1; } void f2 (void) { v += 4; } void f3 (void) { v += 16; f1 (); } fnp1 f4 (void) { v += 64; return f2; } From 327310ba37c528b18f805c387529c4aa4f5f9bdd Mon Sep 17 00:00:00 2001 From: Tamar Christina Date: Wed, 26 Nov 2025 14:19:43 +0000 Subject: [PATCH 041/373] middle-end: Correctly detect unsigned vec_cbranch [PR122861] In emit_cmp_and_jump_insns I tried to detect if the operation is signed or unsigned in order to convert the condition code into an unsigned code. However I did this based on the incoming tree compare, which is done on the boolean result. Since booleans are always signed in tree the result was that we never used an unsigned compare when needed. This checks one of the arguments of the compare instead. Bootstrapped Regtested on aarch64-none-linux-gnu, arm-none-linux-gnueabihf, x86_64-pc-linux-gnu -m32, -m64 and no issues. Ok for master? Ok for master? Thanks, Tamar gcc/ChangeLog: PR tree-optimization/122861 * optabs.cc (emit_cmp_and_jump_insns): Check argument instead of result. gcc/testsuite/ChangeLog: PR tree-optimization/122861 * gcc.target/aarch64/sve/vect-early-break-cbranch_10.c: New test. * gcc.target/aarch64/sve/vect-early-break-cbranch_11.c: New test. * gcc.target/aarch64/sve/vect-early-break-cbranch_12.c: New test. * gcc.target/aarch64/sve/vect-early-break-cbranch_13.c: New test. * gcc.target/aarch64/sve/vect-early-break-cbranch_14.c: New test. * gcc.target/aarch64/sve/vect-early-break-cbranch_15.c: New test. * gcc.target/aarch64/sve/vect-early-break-cbranch_9.c: New test. * gcc.target/aarch64/vect-early-break-cbranch_4.c: New test. * gcc.target/aarch64/vect-early-break-cbranch_5.c: New test. --- gcc/optabs.cc | 8 +- .../aarch64/sve/vect-early-break-cbranch_10.c | 132 ++++++++++++++++ .../aarch64/sve/vect-early-break-cbranch_11.c | 132 ++++++++++++++++ .../aarch64/sve/vect-early-break-cbranch_12.c | 132 ++++++++++++++++ .../aarch64/sve/vect-early-break-cbranch_13.c | 132 ++++++++++++++++ .../aarch64/sve/vect-early-break-cbranch_14.c | 147 ++++++++++++++++++ .../aarch64/sve/vect-early-break-cbranch_15.c | 132 ++++++++++++++++ .../aarch64/sve/vect-early-break-cbranch_9.c | 102 ++++++++++++ .../aarch64/vect-early-break-cbranch_4.c | 122 +++++++++++++++ .../aarch64/vect-early-break-cbranch_5.c | 105 +++++++++++++ 10 files changed, 1141 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_10.c create mode 100644 gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_11.c create mode 100644 gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_12.c create mode 100644 gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_13.c create mode 100644 gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_14.c create mode 100644 gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_15.c create mode 100644 gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_9.c create mode 100644 gcc/testsuite/gcc.target/aarch64/vect-early-break-cbranch_4.c create mode 100644 gcc/testsuite/gcc.target/aarch64/vect-early-break-cbranch_5.c diff --git a/gcc/optabs.cc b/gcc/optabs.cc index 10989a29c514..9882aac0ba9a 100644 --- a/gcc/optabs.cc +++ b/gcc/optabs.cc @@ -4902,8 +4902,10 @@ emit_cmp_and_jump_insns (rtx x, rtx y, enum rtx_code comparison, rtx size, class expand_operand ops[5]; rtx_insn *tmp = NULL; start_sequence (); - rtx op0c = expand_normal (gimple_assign_rhs1 (def_stmt)); - rtx op1c = expand_normal (gimple_assign_rhs2 (def_stmt)); + tree t_op0 = gimple_assign_rhs1 (def_stmt); + tree t_op1 = gimple_assign_rhs2 (def_stmt); + rtx op0c = expand_normal (t_op0); + rtx op1c = expand_normal (t_op1); machine_mode mode2 = GET_MODE (op0c); int nops = masked_op ? 3 : (len_op ? 5 : 2); @@ -4929,7 +4931,7 @@ emit_cmp_and_jump_insns (rtx x, rtx y, enum rtx_code comparison, rtx size, GET_MODE (len_bias_rtx)); } - int unsignedp2 = TYPE_UNSIGNED (TREE_TYPE (val)); + int unsignedp2 = TYPE_UNSIGNED (TREE_TYPE (t_op0)); auto inner_code = gimple_assign_rhs_code (def_stmt); rtx test2 = NULL_RTX; diff --git a/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_10.c b/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_10.c new file mode 100644 index 000000000000..e74f1fa5bd0d --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_10.c @@ -0,0 +1,132 @@ +/* { dg-do run { target aarch64_sve_hw } } */ +/* { dg-options "-O3 --param aarch64-autovec-preference=asimd-only" } */ +/* { dg-require-effective-target lp64 } */ + +#include + +#define N 640 +#ifndef TYPE +#define TYPE unsigned int +#endif +#ifndef FMT +#define FMT "u" +#endif + + +TYPE a[N] = {0}; +TYPE b[N] = {0}; + +char *curr_test; + +/* Macro to define a function with a specific comparison */ +#define DEFINE_TEST_FUNC(NAME, OP) \ + __attribute__((noipa)) \ + void NAME(void) { \ + for (int i = 0; i < N; i++) { \ + b[i] += a[i]; \ + if (a[i] OP 0) \ + break; \ + } \ + } + +/* Generate the six comparisons functions using the macro. */ +DEFINE_TEST_FUNC(f1, >) +DEFINE_TEST_FUNC(f2, >=) +DEFINE_TEST_FUNC(f3, ==) +DEFINE_TEST_FUNC(f4, !=) +DEFINE_TEST_FUNC(f5, <) +DEFINE_TEST_FUNC(f6, <=) + +__attribute__((noreturn)) +static inline void __abort_trace (const char *m, int i, TYPE result, TYPE expected) +{ + printf ("*** [%s] FAIL AT %s:%d in %s - expected %" FMT " but got %" FMT " at pos %d\n", + m, __FILE__, __LINE__, curr_test, expected, result, i); + __builtin_abort (); +} + +/* Array setup macro. */ +#define RESET_ARRAYS(_aval, _idx, _force, _bval) \ + do { \ + _Pragma("GCC novector") \ + for (int i = 0; i < N; ++i) { \ + a[i] = _aval; \ + b[i] = _bval; \ + } \ + if (_idx >= 0 && _idx < N) \ + a[_idx] = _force; \ + } while (0) + +/* Value check macros. */ +#define CHECK_EQ(_i, _val) \ + do { \ + if (b[_i] != _val) \ + __abort_trace ("single", _i, b[_i], _val); \ + } while (0) + +#define CHECK_RANGE_EQ(_start, _end, _val) \ + do { \ + _Pragma("GCC novector") \ + for (int i = _start; i < _end; ++i) \ + if (b[i] != _val) \ + __abort_trace ("range", i, b[i], _val); \ + } while (0) + +#define str(s) #s +#define TEST_FUNC(_func, _aval, _idx, _force, _bval, _check_stmt) \ + do { \ + curr_test = str (_func); \ + RESET_ARRAYS((_aval), (_idx), (_force), (_bval)); \ + _func(); \ + _check_stmt; \ + } while (0) + +int main(void) { + /* Break on random intervals. */ + TEST_FUNC (f1, 1, 0, 1, 10, CHECK_EQ (0, 11); CHECK_EQ (1, 10)); + TEST_FUNC (f2, 6, 5, 0, 10, CHECK_EQ (0, 16); CHECK_EQ (5, 10)); + TEST_FUNC (f3, 3, 3, 0, 0, CHECK_EQ (0, 3); CHECK_EQ (3, 0)); + TEST_FUNC (f4, 0, 4, 1, 1, CHECK_EQ (4, 2); CHECK_EQ (5, 1)); + TEST_FUNC (f5, 2, 6, 0, 5, CHECK_EQ (6, 5); CHECK_EQ (7, 7)); + TEST_FUNC (f6, 2, 10, 0, 7, CHECK_EQ (10, 7); CHECK_EQ (11, 7)); + + /* Break on last iteration. */ + TEST_FUNC (f1, 0, N-1, 1, 1, + CHECK_RANGE_EQ (0, N-1, 1); CHECK_EQ (N-1, 2)); + + TEST_FUNC (f2, 0, N-1, 0, 4, + CHECK_RANGE_EQ (0, N-1, 4); CHECK_EQ (N-1, 4)); + + TEST_FUNC (f3, 2, N-1, 0, 0, + CHECK_RANGE_EQ(0, N-1, 2); CHECK_EQ (N-1, 0)); + + TEST_FUNC (f4, 0, N-1, 2, 1, + CHECK_RANGE_EQ (0, N-1, 1); CHECK_EQ (N-1, 3)); + + TEST_FUNC (f5, 4, N-1, 1, 6, + CHECK_RANGE_EQ (0, N-1, 10); CHECK_EQ (N-1, 7)); + + TEST_FUNC (f6, 5, N-1, 0, 7, + CHECK_RANGE_EQ (0, N-1, 12); CHECK_EQ (N-1, 7)); + + /* Condition never met — full loop executes. */ + TEST_FUNC (f1, 0, -1, 0, 2, + CHECK_RANGE_EQ (0, N, 2)); + + TEST_FUNC (f2, 0, -1, 0, 3, + CHECK_RANGE_EQ (0, N, 3)); + + TEST_FUNC (f3, 1, -1, 0, 0, + CHECK_RANGE_EQ (0, N, 1)); + + TEST_FUNC (f4, 0, -1, 0, 7, + CHECK_RANGE_EQ (0, N, 7)); + + TEST_FUNC (f5, 1, -1, 0, 4, + CHECK_RANGE_EQ (0, N, 5)); + + TEST_FUNC (f6, 5, -1, 0, 3, + CHECK_RANGE_EQ (0, N, 8)); + + return 0; +} diff --git a/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_11.c b/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_11.c new file mode 100644 index 000000000000..72423279f4c6 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_11.c @@ -0,0 +1,132 @@ +/* { dg-do run { target aarch64_sve_hw } } */ +/* { dg-options "-O3 --param aarch64-autovec-preference=sve-only" } */ +/* { dg-require-effective-target lp64 } */ + +#include + +#define N 640 +#ifndef TYPE +#define TYPE unsigned int +#endif +#ifndef FMT +#define FMT "u" +#endif + + +TYPE a[N] = {0}; +TYPE b[N] = {0}; + +char *curr_test; + +/* Macro to define a function with a specific comparison */ +#define DEFINE_TEST_FUNC(NAME, OP) \ + __attribute__((noipa)) \ + void NAME(void) { \ + for (int i = 0; i < N; i++) { \ + b[i] += a[i]; \ + if (a[i] OP 0) \ + break; \ + } \ + } + +/* Generate the six comparisons functions using the macro. */ +DEFINE_TEST_FUNC(f1, >) +DEFINE_TEST_FUNC(f2, >=) +DEFINE_TEST_FUNC(f3, ==) +DEFINE_TEST_FUNC(f4, !=) +DEFINE_TEST_FUNC(f5, <) +DEFINE_TEST_FUNC(f6, <=) + +__attribute__((noreturn)) +static inline void __abort_trace (const char *m, int i, TYPE result, TYPE expected) +{ + printf ("*** [%s] FAIL AT %s:%d in %s - expected %" FMT " but got %" FMT " at pos %d\n", + m, __FILE__, __LINE__, curr_test, expected, result, i); + __builtin_abort (); +} + +/* Array setup macro. */ +#define RESET_ARRAYS(_aval, _idx, _force, _bval) \ + do { \ + _Pragma("GCC novector") \ + for (int i = 0; i < N; ++i) { \ + a[i] = _aval; \ + b[i] = _bval; \ + } \ + if (_idx >= 0 && _idx < N) \ + a[_idx] = _force; \ + } while (0) + +/* Value check macros. */ +#define CHECK_EQ(_i, _val) \ + do { \ + if (b[_i] != _val) \ + __abort_trace ("single", _i, b[_i], _val); \ + } while (0) + +#define CHECK_RANGE_EQ(_start, _end, _val) \ + do { \ + _Pragma("GCC novector") \ + for (int i = _start; i < _end; ++i) \ + if (b[i] != _val) \ + __abort_trace ("range", i, b[i], _val); \ + } while (0) + +#define str(s) #s +#define TEST_FUNC(_func, _aval, _idx, _force, _bval, _check_stmt) \ + do { \ + curr_test = str (_func); \ + RESET_ARRAYS((_aval), (_idx), (_force), (_bval)); \ + _func(); \ + _check_stmt; \ + } while (0) + +int main(void) { + /* Break on random intervals. */ + TEST_FUNC (f1, 1, 0, 1, 10, CHECK_EQ (0, 11); CHECK_EQ (1, 10)); + TEST_FUNC (f2, 6, 5, 0, 10, CHECK_EQ (0, 16); CHECK_EQ (5, 10)); + TEST_FUNC (f3, 3, 3, 0, 0, CHECK_EQ (0, 3); CHECK_EQ (3, 0)); + TEST_FUNC (f4, 0, 4, 1, 1, CHECK_EQ (4, 2); CHECK_EQ (5, 1)); + TEST_FUNC (f5, 2, 6, 0, 5, CHECK_EQ (6, 5); CHECK_EQ (7, 7)); + TEST_FUNC (f6, 2, 10, 0, 7, CHECK_EQ (10, 7); CHECK_EQ (11, 7)); + + /* Break on last iteration. */ + TEST_FUNC (f1, 0, N-1, 1, 1, + CHECK_RANGE_EQ (0, N-1, 1); CHECK_EQ (N-1, 2)); + + TEST_FUNC (f2, 0, N-1, 0, 4, + CHECK_RANGE_EQ (0, N-1, 4); CHECK_EQ (N-1, 4)); + + TEST_FUNC (f3, 2, N-1, 0, 0, + CHECK_RANGE_EQ(0, N-1, 2); CHECK_EQ (N-1, 0)); + + TEST_FUNC (f4, 0, N-1, 2, 1, + CHECK_RANGE_EQ (0, N-1, 1); CHECK_EQ (N-1, 3)); + + TEST_FUNC (f5, 4, N-1, 1, 6, + CHECK_RANGE_EQ (0, N-1, 10); CHECK_EQ (N-1, 7)); + + TEST_FUNC (f6, 5, N-1, 0, 7, + CHECK_RANGE_EQ (0, N-1, 12); CHECK_EQ (N-1, 7)); + + /* Condition never met — full loop executes. */ + TEST_FUNC (f1, 0, -1, 0, 2, + CHECK_RANGE_EQ (0, N, 2)); + + TEST_FUNC (f2, 0, -1, 0, 3, + CHECK_RANGE_EQ (0, N, 3)); + + TEST_FUNC (f3, 1, -1, 0, 0, + CHECK_RANGE_EQ (0, N, 1)); + + TEST_FUNC (f4, 0, -1, 0, 7, + CHECK_RANGE_EQ (0, N, 7)); + + TEST_FUNC (f5, 1, -1, 0, 4, + CHECK_RANGE_EQ (0, N, 5)); + + TEST_FUNC (f6, 5, -1, 0, 3, + CHECK_RANGE_EQ (0, N, 8)); + + return 0; +} diff --git a/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_12.c b/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_12.c new file mode 100644 index 000000000000..e2290e9161cf --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_12.c @@ -0,0 +1,132 @@ +/* { dg-do run { target aarch64_sve_hw } } */ +/* { dg-options "-O3 --param aarch64-autovec-preference=asimd-only" } */ +/* { dg-require-effective-target lp64 } */ + +#include + +#define N 640 +#ifndef TYPE +#define TYPE float +#endif +#ifndef FMT +#define FMT ".6f" +#endif + + +TYPE a[N] = {0}; +TYPE b[N] = {0}; + +char *curr_test; + +/* Macro to define a function with a specific comparison */ +#define DEFINE_TEST_FUNC(NAME, OP) \ + __attribute__((noipa)) \ + void NAME(void) { \ + for (int i = 0; i < N; i++) { \ + b[i] += a[i]; \ + if (a[i] OP 0) \ + break; \ + } \ + } + +/* Generate the six comparisons functions using the macro. */ +DEFINE_TEST_FUNC(f1, >) +DEFINE_TEST_FUNC(f2, >=) +DEFINE_TEST_FUNC(f3, ==) +DEFINE_TEST_FUNC(f4, !=) +DEFINE_TEST_FUNC(f5, <) +DEFINE_TEST_FUNC(f6, <=) + +__attribute__((noreturn)) +static inline void __abort_trace (const char *m, int i, TYPE result, TYPE expected) +{ + printf ("*** [%s] FAIL AT %s:%d in %s - expected %" FMT " but got %" FMT " at pos %d\n", + m, __FILE__, __LINE__, curr_test, expected, result, i); + __builtin_abort (); +} + +/* Array setup macro. */ +#define RESET_ARRAYS(_aval, _idx, _force, _bval) \ + do { \ + _Pragma("GCC novector") \ + for (int i = 0; i < N; ++i) { \ + a[i] = _aval; \ + b[i] = _bval; \ + } \ + if (_idx >= 0 && _idx < N) \ + a[_idx] = _force; \ + } while (0) + +/* Value check macros. */ +#define CHECK_EQ(_i, _val) \ + do { \ + if (b[_i] != _val) \ + __abort_trace ("single", _i, b[_i], _val); \ + } while (0) + +#define CHECK_RANGE_EQ(_start, _end, _val) \ + do { \ + _Pragma("GCC novector") \ + for (int i = _start; i < _end; ++i) \ + if (b[i] != _val) \ + __abort_trace ("range", i, b[i], _val); \ + } while (0) + +#define str(s) #s +#define TEST_FUNC(_func, _aval, _idx, _force, _bval, _check_stmt) \ + do { \ + curr_test = str (_func); \ + RESET_ARRAYS((_aval), (_idx), (_force), (_bval)); \ + _func(); \ + _check_stmt; \ + } while (0) + +int main(void) { + /* Break on random intervals. */ + TEST_FUNC (f1, 1, 0, 1, 10, CHECK_EQ (0, 11); CHECK_EQ (1, 10)); + TEST_FUNC (f2, -1, 5, 0, 10, CHECK_EQ (0, 9); CHECK_EQ (5, 10)); + TEST_FUNC (f3, 3, 3, 0, 0, CHECK_EQ (0, 3); CHECK_EQ (3, 0)); + TEST_FUNC (f4, 0, 4, 1, 1, CHECK_EQ (4, 2); CHECK_EQ (5, 1)); + TEST_FUNC (f5, 1, 6, -1, 5, CHECK_EQ (6, 4); CHECK_EQ (7, 5)); + TEST_FUNC (f6, 2, 10, 0, 7, CHECK_EQ (10, 7); CHECK_EQ (11, 7)); + + /* Break on last iteration. */ + TEST_FUNC (f1, 0, N-1, 1, 1, + CHECK_RANGE_EQ (0, N-1, 1); CHECK_EQ (N-1, 2)); + + TEST_FUNC (f2, -5, N-1, 0, 9, + CHECK_RANGE_EQ (0, N-1, 4); CHECK_EQ (N-1, 9)); + + TEST_FUNC (f3, 2, N-1, 0, 0, + CHECK_RANGE_EQ(0, N-1, 2); CHECK_EQ (N-1, 0)); + + TEST_FUNC (f4, 0, N-1, 2, 1, + CHECK_RANGE_EQ (0, N-1, 1); CHECK_EQ (N-1, 3)); + + TEST_FUNC (f5, 2, N-1, -3, 6, + CHECK_RANGE_EQ (0, N-1, 8); CHECK_EQ (N-1, 3)); + + TEST_FUNC (f6, 5, N-1, 0, 7, + CHECK_RANGE_EQ (0, N-1, 12); CHECK_EQ (N-1, 7)); + + /* Condition never met — full loop executes. */ + TEST_FUNC (f1, 0, -1, 0, 2, + CHECK_RANGE_EQ (0, N, 2)); + + TEST_FUNC (f2, -2, -1, 0, 5, + CHECK_RANGE_EQ (0, N, 3)); + + TEST_FUNC (f3, 1, -1, 0, 0, + CHECK_RANGE_EQ (0, N, 1)); + + TEST_FUNC (f4, 0, -1, 0, 7, + CHECK_RANGE_EQ (0, N, 7)); + + TEST_FUNC (f5, 1, -1, 0, 4, + CHECK_RANGE_EQ (0, N, 5)); + + TEST_FUNC (f6, 5, -1, 0, 3, + CHECK_RANGE_EQ (0, N, 8)); + + return 0; +} diff --git a/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_13.c b/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_13.c new file mode 100644 index 000000000000..eb2295f8ea93 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_13.c @@ -0,0 +1,132 @@ +/* { dg-do run { target aarch64_sve_hw } } */ +/* { dg-options "-O3 --param aarch64-autovec-preference=sve-only" } */ +/* { dg-require-effective-target lp64 } */ + +#include + +#define N 640 +#ifndef TYPE +#define TYPE float +#endif +#ifndef FMT +#define FMT ".6f" +#endif + + +TYPE a[N] = {0}; +TYPE b[N] = {0}; + +char *curr_test; + +/* Macro to define a function with a specific comparison */ +#define DEFINE_TEST_FUNC(NAME, OP) \ + __attribute__((noipa)) \ + void NAME(void) { \ + for (int i = 0; i < N; i++) { \ + b[i] += a[i]; \ + if (a[i] OP 0) \ + break; \ + } \ + } + +/* Generate the six comparisons functions using the macro. */ +DEFINE_TEST_FUNC(f1, >) +DEFINE_TEST_FUNC(f2, >=) +DEFINE_TEST_FUNC(f3, ==) +DEFINE_TEST_FUNC(f4, !=) +DEFINE_TEST_FUNC(f5, <) +DEFINE_TEST_FUNC(f6, <=) + +__attribute__((noreturn)) +static inline void __abort_trace (const char *m, int i, TYPE result, TYPE expected) +{ + printf ("*** [%s] FAIL AT %s:%d in %s - expected %" FMT " but got %" FMT " at pos %d\n", + m, __FILE__, __LINE__, curr_test, expected, result, i); + __builtin_abort (); +} + +/* Array setup macro. */ +#define RESET_ARRAYS(_aval, _idx, _force, _bval) \ + do { \ + _Pragma("GCC novector") \ + for (int i = 0; i < N; ++i) { \ + a[i] = _aval; \ + b[i] = _bval; \ + } \ + if (_idx >= 0 && _idx < N) \ + a[_idx] = _force; \ + } while (0) + +/* Value check macros. */ +#define CHECK_EQ(_i, _val) \ + do { \ + if (b[_i] != _val) \ + __abort_trace ("single", _i, b[_i], _val); \ + } while (0) + +#define CHECK_RANGE_EQ(_start, _end, _val) \ + do { \ + _Pragma("GCC novector") \ + for (int i = _start; i < _end; ++i) \ + if (b[i] != _val) \ + __abort_trace ("range", i, b[i], _val); \ + } while (0) + +#define str(s) #s +#define TEST_FUNC(_func, _aval, _idx, _force, _bval, _check_stmt) \ + do { \ + curr_test = str (_func); \ + RESET_ARRAYS((_aval), (_idx), (_force), (_bval)); \ + _func(); \ + _check_stmt; \ + } while (0) + +int main(void) { + /* Break on random intervals. */ + TEST_FUNC (f1, 1, 0, 1, 10, CHECK_EQ (0, 11); CHECK_EQ (1, 10)); + TEST_FUNC (f2, -1, 5, 0, 10, CHECK_EQ (0, 9); CHECK_EQ (5, 10)); + TEST_FUNC (f3, 3, 3, 0, 0, CHECK_EQ (0, 3); CHECK_EQ (3, 0)); + TEST_FUNC (f4, 0, 4, 1, 1, CHECK_EQ (4, 2); CHECK_EQ (5, 1)); + TEST_FUNC (f5, 1, 6, -1, 5, CHECK_EQ (6, 4); CHECK_EQ (7, 5)); + TEST_FUNC (f6, 2, 10, 0, 7, CHECK_EQ (10, 7); CHECK_EQ (11, 7)); + + /* Break on last iteration. */ + TEST_FUNC (f1, 0, N-1, 1, 1, + CHECK_RANGE_EQ (0, N-1, 1); CHECK_EQ (N-1, 2)); + + TEST_FUNC (f2, -5, N-1, 0, 9, + CHECK_RANGE_EQ (0, N-1, 4); CHECK_EQ (N-1, 9)); + + TEST_FUNC (f3, 2, N-1, 0, 0, + CHECK_RANGE_EQ(0, N-1, 2); CHECK_EQ (N-1, 0)); + + TEST_FUNC (f4, 0, N-1, 2, 1, + CHECK_RANGE_EQ (0, N-1, 1); CHECK_EQ (N-1, 3)); + + TEST_FUNC (f5, 2, N-1, -3, 6, + CHECK_RANGE_EQ (0, N-1, 8); CHECK_EQ (N-1, 3)); + + TEST_FUNC (f6, 5, N-1, 0, 7, + CHECK_RANGE_EQ (0, N-1, 12); CHECK_EQ (N-1, 7)); + + /* Condition never met — full loop executes. */ + TEST_FUNC (f1, 0, -1, 0, 2, + CHECK_RANGE_EQ (0, N, 2)); + + TEST_FUNC (f2, -2, -1, 0, 5, + CHECK_RANGE_EQ (0, N, 3)); + + TEST_FUNC (f3, 1, -1, 0, 0, + CHECK_RANGE_EQ (0, N, 1)); + + TEST_FUNC (f4, 0, -1, 0, 7, + CHECK_RANGE_EQ (0, N, 7)); + + TEST_FUNC (f5, 1, -1, 0, 4, + CHECK_RANGE_EQ (0, N, 5)); + + TEST_FUNC (f6, 5, -1, 0, 3, + CHECK_RANGE_EQ (0, N, 8)); + + return 0; +} diff --git a/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_14.c b/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_14.c new file mode 100644 index 000000000000..5cc4d6a3858d --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_14.c @@ -0,0 +1,147 @@ +/* { dg-do run { target aarch64_sve_hw } } */ +/* { dg-options "-Ofast --param aarch64-autovec-preference=asimd-only" } */ +/* { dg-require-effective-target lp64 } */ + +#include +#include + +#define N 640 +#ifndef TYPE +#define TYPE double +#endif +#ifndef FMT +#define FMT ".6f" +#endif + +TYPE a[N] = {0}; +TYPE b[N] = {0}; + +char *curr_test; + +/* Macro to define a function with a specific comparison */ +#define DEFINE_TEST_FUNC(NAME, OP) \ + __attribute__((noipa)) \ + void NAME(void) { \ + for (int i = 0; i < N; i++) { \ + b[i] += a[i]; \ + if (a[i] OP 0) \ + break; \ + } \ + } + +/* Generate comparison functions */ +DEFINE_TEST_FUNC(f1, >) +DEFINE_TEST_FUNC(f2, >=) +DEFINE_TEST_FUNC(f3, ==) +DEFINE_TEST_FUNC(f4, !=) +DEFINE_TEST_FUNC(f5, <) +DEFINE_TEST_FUNC(f6, <=) + +/* Example unordered-sensitive loop: breaks if a[i] is unordered with 0 */ +__attribute__((noipa)) +void f7(void) { + for (int i = 0; i < N; i++) { + b[i] += a[i]; + if (__builtin_isunordered(a[i], 0.0)) + break; + } +} + +__attribute__((noreturn)) +static inline void __abort_trace(const char *m, int i, TYPE result, TYPE expected) { + printf("*** [%s] FAIL AT %s:%d in %s - expected %" FMT " but got %" FMT " at pos %d\n", + m, __FILE__, __LINE__, curr_test, expected, result, i); + __builtin_abort(); +} + +/* Array setup */ +#define RESET_ARRAYS(_aval, _idx, _force, _bval) \ + do { \ + _Pragma("GCC novector") \ + for (int i = 0; i < N; ++i) { \ + a[i] = _aval; \ + b[i] = _bval; \ + } \ + if (_idx >= 0 && _idx < N) \ + a[_idx] = _force; \ + } while (0) + +/* Floating-point comparison macros (with unordered handling) */ +#define CHECK_EQ(_i, _val) do { \ + if (__builtin_isnan (_val) != __builtin_isnan (b[_i]) \ + && b[_i] != _val) \ + __abort_trace ("single", _i, b[_i], _val); \ +} while (0) + +#define CHECK_RANGE_EQ(_start, _end, _val) do { \ + _Pragma("GCC novector") \ + for (int i = _start; i < _end; ++i) \ + if (__builtin_isnan (_val) != __builtin_isnan (b[i]) \ + && b[i] != _val) \ + __abort_trace ("range", i, b[i], _val); \ +} while (0) + +#define str(s) #s +#define TEST_FUNC(_func, _aval, _idx, _force, _bval, _check_stmt) \ + do { \ + curr_test = str (_func); \ + RESET_ARRAYS((_aval), (_idx), (_force), (_bval)); \ + _func(); \ + _check_stmt; \ + } while (0) + +int main(void) { + /* Break on random intervals. */ + TEST_FUNC(f1, 1.0, 0, 1.0, 10.0, CHECK_EQ(0, 11.0); CHECK_EQ(1, 10.0)); + TEST_FUNC(f2, -1.0, 5, 0.0, 10.0, CHECK_EQ(0, 9.0); CHECK_EQ(5, 10.0)); + TEST_FUNC(f3, 3.0, 3, 0.0, 0.0, CHECK_EQ(0, 3.0); CHECK_EQ(3, 0.0)); + TEST_FUNC(f4, 0.0, 4, 1.0, 1.0, CHECK_EQ(4, 2.0); CHECK_EQ(5, 1.0)); + TEST_FUNC(f5, 1.0, 6, -1.0, 5.0, CHECK_EQ(6, 4.0); CHECK_EQ(7, 5.0)); + TEST_FUNC(f6, 2.0, 10, 0.0, 7.0, CHECK_EQ(10, 7.0); CHECK_EQ(11, 7.0)); + + /* Break on last iteration. */ + TEST_FUNC(f1, 0.0, N - 1, 1.0, 1.0, + CHECK_RANGE_EQ(0, N - 1, 1.0); CHECK_EQ(N - 1, 2.0)); + + TEST_FUNC(f2, -5.0, N - 1, 0.0, 9.0, + CHECK_RANGE_EQ(0, N - 1, 4.0); CHECK_EQ(N - 1, 9.0)); + + TEST_FUNC(f3, 2.0, N - 1, 0.0, 0.0, + CHECK_RANGE_EQ(0, N - 1, 2.0); CHECK_EQ(N - 1, 0.0)); + + TEST_FUNC(f4, 0.0, N - 1, 2.0, 1.0, + CHECK_RANGE_EQ(0, N - 1, 1.0); CHECK_EQ(N - 1, 3.0)); + + TEST_FUNC(f5, 2.0, N - 1, -3.0, 6.0, + CHECK_RANGE_EQ(0, N - 1, 8.0); CHECK_EQ(N - 1, 3.0)); + + TEST_FUNC(f6, 5.0, N - 1, 0.0, 7.0, + CHECK_RANGE_EQ(0, N - 1, 12.0); CHECK_EQ(N - 1, 7.0)); + + /* Condition never met — full loop executes. */ + TEST_FUNC(f1, 0.0, -1, 0.0, 2.0, + CHECK_RANGE_EQ(0, N, 2.0)); + + TEST_FUNC(f2, -2.0, -1, 0.0, 5.0, + CHECK_RANGE_EQ(0, N, 3.0)); + + TEST_FUNC(f3, 1.0, -1, 0.0, 0.0, + CHECK_RANGE_EQ(0, N, 1.0)); + + TEST_FUNC(f4, 0.0, -1, 0.0, 7.0, + CHECK_RANGE_EQ(0, N, 7.0)); + + TEST_FUNC(f5, 1.0, -1, 0.0, 4.0, + CHECK_RANGE_EQ(0, N, 5.0)); + + TEST_FUNC(f6, 5.0, -1, 0.0, 3.0, + CHECK_RANGE_EQ(0, N, 8.0)); + +#if !defined(__FAST_MATH__) + /* Unordered break (NAN in a[i]) */ + TEST_FUNC(f7, 1.0, 123, NAN, 2.0, + CHECK_RANGE_EQ(0, 123, 3.0); CHECK_EQ(123, NAN)); +#endif + + return 0; +} diff --git a/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_15.c b/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_15.c new file mode 100644 index 000000000000..3dd7a60225e0 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_15.c @@ -0,0 +1,132 @@ +/* { dg-do run { target aarch64_sve_hw } } */ +/* { dg-options "-Ofast --param aarch64-autovec-preference=asimd-only" } */ +/* { dg-require-effective-target lp64 } */ + +#include + +#define N 640 +#ifndef TYPE +#define TYPE float +#endif +#ifndef FMT +#define FMT ".6f" +#endif + + +TYPE a[N] = {0}; +TYPE b[N] = {0}; + +char *curr_test; + +/* Macro to define a function with a specific comparison */ +#define DEFINE_TEST_FUNC(NAME, OP) \ + __attribute__((noipa)) \ + void NAME(void) { \ + for (int i = 0; i < N; i++) { \ + b[i] += a[i]; \ + if (a[i] OP 0) \ + break; \ + } \ + } + +/* Generate the six comparisons functions using the macro. */ +DEFINE_TEST_FUNC(f1, >) +DEFINE_TEST_FUNC(f2, >=) +DEFINE_TEST_FUNC(f3, ==) +DEFINE_TEST_FUNC(f4, !=) +DEFINE_TEST_FUNC(f5, <) +DEFINE_TEST_FUNC(f6, <=) + +__attribute__((noreturn)) +static inline void __abort_trace (const char *m, int i, TYPE result, TYPE expected) +{ + printf ("*** [%s] FAIL AT %s:%d in %s - expected %" FMT " but got %" FMT " at pos %d\n", + m, __FILE__, __LINE__, curr_test, expected, result, i); + __builtin_abort (); +} + +/* Array setup macro. */ +#define RESET_ARRAYS(_aval, _idx, _force, _bval) \ + do { \ + _Pragma("GCC novector") \ + for (int i = 0; i < N; ++i) { \ + a[i] = _aval; \ + b[i] = _bval; \ + } \ + if (_idx >= 0 && _idx < N) \ + a[_idx] = _force; \ + } while (0) + +/* Value check macros. */ +#define CHECK_EQ(_i, _val) \ + do { \ + if (b[_i] != _val) \ + __abort_trace ("single", _i, b[_i], _val); \ + } while (0) + +#define CHECK_RANGE_EQ(_start, _end, _val) \ + do { \ + _Pragma("GCC novector") \ + for (int i = _start; i < _end; ++i) \ + if (b[i] != _val) \ + __abort_trace ("range", i, b[i], _val); \ + } while (0) + +#define str(s) #s +#define TEST_FUNC(_func, _aval, _idx, _force, _bval, _check_stmt) \ + do { \ + curr_test = str (_func); \ + RESET_ARRAYS((_aval), (_idx), (_force), (_bval)); \ + _func(); \ + _check_stmt; \ + } while (0) + +int main(void) { + /* Break on random intervals. */ + TEST_FUNC (f1, 1, 0, 1, 10, CHECK_EQ (0, 11); CHECK_EQ (1, 10)); + TEST_FUNC (f2, -1, 5, 0, 10, CHECK_EQ (0, 9); CHECK_EQ (5, 10)); + TEST_FUNC (f3, 3, 3, 0, 0, CHECK_EQ (0, 3); CHECK_EQ (3, 0)); + TEST_FUNC (f4, 0, 4, 1, 1, CHECK_EQ (4, 2); CHECK_EQ (5, 1)); + TEST_FUNC (f5, 1, 6, -1, 5, CHECK_EQ (6, 4); CHECK_EQ (7, 5)); + TEST_FUNC (f6, 2, 10, 0, 7, CHECK_EQ (10, 7); CHECK_EQ (11, 7)); + + /* Break on last iteration. */ + TEST_FUNC (f1, 0, N-1, 1, 1, + CHECK_RANGE_EQ (0, N-1, 1); CHECK_EQ (N-1, 2)); + + TEST_FUNC (f2, -5, N-1, 0, 9, + CHECK_RANGE_EQ (0, N-1, 4); CHECK_EQ (N-1, 9)); + + TEST_FUNC (f3, 2, N-1, 0, 0, + CHECK_RANGE_EQ(0, N-1, 2); CHECK_EQ (N-1, 0)); + + TEST_FUNC (f4, 0, N-1, 2, 1, + CHECK_RANGE_EQ (0, N-1, 1); CHECK_EQ (N-1, 3)); + + TEST_FUNC (f5, 2, N-1, -3, 6, + CHECK_RANGE_EQ (0, N-1, 8); CHECK_EQ (N-1, 3)); + + TEST_FUNC (f6, 5, N-1, 0, 7, + CHECK_RANGE_EQ (0, N-1, 12); CHECK_EQ (N-1, 7)); + + /* Condition never met — full loop executes. */ + TEST_FUNC (f1, 0, -1, 0, 2, + CHECK_RANGE_EQ (0, N, 2)); + + TEST_FUNC (f2, -2, -1, 0, 5, + CHECK_RANGE_EQ (0, N, 3)); + + TEST_FUNC (f3, 1, -1, 0, 0, + CHECK_RANGE_EQ (0, N, 1)); + + TEST_FUNC (f4, 0, -1, 0, 7, + CHECK_RANGE_EQ (0, N, 7)); + + TEST_FUNC (f5, 1, -1, 0, 4, + CHECK_RANGE_EQ (0, N, 5)); + + TEST_FUNC (f6, 5, -1, 0, 3, + CHECK_RANGE_EQ (0, N, 8)); + + return 0; +} diff --git a/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_9.c b/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_9.c new file mode 100644 index 000000000000..ec4f7a647c65 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/sve/vect-early-break-cbranch_9.c @@ -0,0 +1,102 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -fno-schedule-insns -fno-reorder-blocks -fno-schedule-insns2" } */ +/* { dg-final { check-function-bodies "**" "" "" { target lp64 } } } */ +#define N 640 +unsigned int a[N] = {0}; +unsigned int b[N] = {0}; +/* +** f1: +** ... +** cmphi p[0-9]+.s, p[0-9]+/z, z[0-9]+.s, #1 +** b(\.?eq|\.none) \.L[0-9]+ +** ... +*/ +void f1 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] > 1) + break; + } +} +/* +** f2: +** ... +** cmphi p[0-9]+.s, p[0-9]+/z, z[0-9]+.s, #1 +** b(\.?eq|\.none) \.L[0-9]+ +** ... +*/ +void f2 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] >= 2) + break; + } +} +/* +** f3: +** ... +** cmpeq p[0-9]+.s, p[0-9]+/z, z[0-9]+.s, #1 +** b(\.?eq|\.none) \.L[0-9]+ +** ... +*/ +void f3 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] == 1) + break; + } +} +/* +** f4: +** ... +** cmpne p[0-9]+.s, p[0-9]+/z, z[0-9]+.s, #1 +** b(\.?eq|\.none) \.L[0-9]+ +** ... +*/ +void f4 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] != 1) + break; + } +} +/* +** f5: +** ... +** cmpls p[0-9]+.s, p7/z, z[0-9]+.s, #1 +** b(\.?eq|\.none) .L[0-9]+ +** ... +*/ +void f5 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] < 2) + break; + } +} +/* +** f6: +** ... +** cmpls p[0-9]+.s, p[0-9]+/z, z[0-9]+.s, #1 +** b(\.?eq|\.none) \.L[0-9]+ +** ... +*/ +void f6 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] <= 1) + break; + } +} diff --git a/gcc/testsuite/gcc.target/aarch64/vect-early-break-cbranch_4.c b/gcc/testsuite/gcc.target/aarch64/vect-early-break-cbranch_4.c new file mode 100644 index 000000000000..a49e7963cfa1 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vect-early-break-cbranch_4.c @@ -0,0 +1,122 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -fno-schedule-insns -fno-reorder-blocks -fno-schedule-insns2" } */ +/* { dg-final { check-function-bodies "**" "" "" { target lp64 } } } */ + +#pragma GCC target "+nosve" + +#define N 640 +unsigned int a[N] = {0}; +unsigned int b[N] = {0}; + + +/* +** f1: +** ... +** cmhi v[0-9]+.4s, v[0-9]+.4s, v[0-9]+.4s +** umaxp v[0-9]+.4s, v[0-9]+.4s, v[0-9]+.4s +** fmov x[0-9]+, d[0-9]+ +** cbn?z x[0-9]+, \.L[0-9]+ +** ... +*/ +void f1 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] > 1) + break; + } +} + +/* +** f2: +** ... +** cmtst v[0-9]+.4s, v[0-9]+.4s, v[0-9]+.4s +** umaxp v[0-9]+.4s, v[0-9]+.4s, v[0-9]+.4s +** fmov x[0-9]+, d[0-9]+ +** cbn?z x[0-9]+, \.L[0-9]+ +** ... +*/ +void f2 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] >= 1) + break; + } +} + +/* +** f3: +** ... +** umaxp v[0-9]+.4s, v[0-9]+.4s, v[0-9]+.4s +** fmov x[0-9]+, d[0-9]+ +** cbn?z x[0-9]+, \.L[0-9]+ +** ... +*/ +void f3 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] == 1) + break; + } +} + +/* +** f4: +** ... +** umaxp v[0-9]+.4s, v[0-9]+.4s, v[0-9]+.4s +** fmov x[0-9]+, d[0-9]+ +** cbn?z x[0-9]+, \.L[0-9]+ +** ... +*/ +void f4 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] != 1) + break; + } +} + +/* +** f5: +** ... +** cmhs v[0-9]+.4s, v[0-9]+.4s, v[0-9]+.4s +** umaxp v[0-9]+.4s, v[0-9]+.4s, v[0-9]+.4s +** fmov x[0-9]+, d[0-9]+ +** cbn?z x[0-9]+, \.L[0-9]+ +** ... +*/ +void f5 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] < 2) + break; + } +} + +/* +** f6: +** ... +** cmhs v[0-9]+.4s, v[0-9]+.4s, v[0-9]+.4s +** umaxp v[0-9]+.4s, v[0-9]+.4s, v[0-9]+.4s +** fmov x[0-9]+, d[0-9]+ +** cbn?z x[0-9]+, \.L[0-9]+ +** ... +*/ +void f6 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] <= 2) + break; + } +} diff --git a/gcc/testsuite/gcc.target/aarch64/vect-early-break-cbranch_5.c b/gcc/testsuite/gcc.target/aarch64/vect-early-break-cbranch_5.c new file mode 100644 index 000000000000..c28969dde1ff --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/vect-early-break-cbranch_5.c @@ -0,0 +1,105 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -fno-schedule-insns -fno-reorder-blocks -fno-schedule-insns2 --param aarch64-autovec-preference=asimd-only" } */ +/* { dg-final { check-function-bodies "**" "" "" { target lp64 } } } */ + +#pragma GCC target "+sve" + +#define N 640 +unsigned int a[N] = {0}; +unsigned int b[N] = {0}; +/* +** f1: +** ... +** cmphi p[0-9]+.s, p[0-9]+/z, z[0-9]+.s, #2 +** b(\.?eq|\.none) \.L[0-9]+ +** ... +*/ +void f1 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] > 2) + break; + } +} +/* +** f2: +** ... +** cmphi p[0-9]+.s, p[0-9]+/z, z[0-9]+.s, #1 +** b(\.?eq|\.none) \.L[0-9]+ +** ... +*/ +void f2 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] >= 2) + break; + } +} +/* +** f3: +** ... +** cmpeq p[0-9]+.s, p[0-9]+/z, z[0-9]+.s, #1 +** b(\.?eq|\.none) \.L[0-9]+ +** ... +*/ +void f3 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] == 1) + break; + } +} +/* +** f4: +** ... +** cmpne p[0-9]+.s, p[0-9]+/z, z[0-9]+.s, #1 +** b(\.?eq|\.none) \.L[0-9]+ +** ... +*/ +void f4 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] != 1) + break; + } +} +/* +** f5: +** ... +** cmpls p[0-9]+.s, p7/z, z[0-9]+.s, #1 +** b(\.?eq|\.none) .L[0-9]+ +** ... +*/ +void f5 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] < 2) + break; + } +} +/* +** f6: +** ... +** cmpls p[0-9]+.s, p[0-9]+/z, z[0-9]+.s, #1 +** b(\.?eq|\.none) \.L[0-9]+ +** ... +*/ +void f6 () +{ + for (int i = 0; i < N; i++) + { + b[i] += a[i]; + if (a[i] <= 1) + break; + } +} From b7942104794a754f9927916dfc8931d4bd515648 Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Wed, 26 Nov 2025 13:54:12 +0100 Subject: [PATCH 042/373] tree-optimization/110571 - fix vect_need_peeling_or_partial_vectors_p The following avoids re-calling of vect_need_peeling_or_partial_vectors_p after peeling. This was neccesary because the function does not properly handle being called for epilogues since it looks for the applied prologue peeling not in the main vector loop but the current one operated on. PR tree-optimization/110571 * tree-vectorizer.h (vect_need_peeling_or_partial_vectors_p): Remove. * tree-vect-loop.cc (vect_need_peeling_or_partial_vectors_p): Fix when called on epilog loops. Make static. * tree-vect-loop-manip.cc (vect_do_peeling): Do not re-compute LOOP_VINFO_PEELING_FOR_NITER. --- gcc/tree-vect-loop-manip.cc | 6 ------ gcc/tree-vect-loop.cc | 12 ++++++++---- gcc/tree-vectorizer.h | 2 -- 3 files changed, 8 insertions(+), 12 deletions(-) diff --git a/gcc/tree-vect-loop-manip.cc b/gcc/tree-vect-loop-manip.cc index a9fe14b31855..9ddf9acf2f19 100644 --- a/gcc/tree-vect-loop-manip.cc +++ b/gcc/tree-vect-loop-manip.cc @@ -3727,12 +3727,6 @@ vect_do_peeling (loop_vec_info loop_vinfo, tree niters, tree nitersm1, = fold_build2 (MINUS_EXPR, TREE_TYPE (epilogue_niters), epilogue_niters, build_one_cst (TREE_TYPE (epilogue_niters))); - - /* ??? During analysis phase this is computed wrongly, re-do it - here. */ - LOOP_VINFO_PEELING_FOR_NITER (epilogue_vinfo) - = (!LOOP_VINFO_USING_PARTIAL_VECTORS_P (epilogue_vinfo) - && vect_need_peeling_or_partial_vectors_p (epilogue_vinfo)); } adjust_vec.release (); diff --git a/gcc/tree-vect-loop.cc b/gcc/tree-vect-loop.cc index 6b6dc206c59e..fe78107fe04c 100644 --- a/gcc/tree-vect-loop.cc +++ b/gcc/tree-vect-loop.cc @@ -937,7 +937,7 @@ vect_min_prec_for_max_niters (loop_vec_info loop_vinfo, unsigned int factor) /* True if the loop needs peeling or partial vectors when vectorized. */ -bool +static bool vect_need_peeling_or_partial_vectors_p (loop_vec_info loop_vinfo) { unsigned HOST_WIDE_INT const_vf; @@ -949,19 +949,23 @@ vect_need_peeling_or_partial_vectors_p (loop_vec_info loop_vinfo) th = LOOP_VINFO_COST_MODEL_THRESHOLD (LOOP_VINFO_ORIG_LOOP_INFO (loop_vinfo)); + loop_vec_info main_loop_vinfo + = (LOOP_VINFO_EPILOGUE_P (loop_vinfo) + ? LOOP_VINFO_MAIN_LOOP_INFO (loop_vinfo) : loop_vinfo); if (LOOP_VINFO_NITERS_KNOWN_P (loop_vinfo) - && LOOP_VINFO_PEELING_FOR_ALIGNMENT (loop_vinfo) >= 0) + && LOOP_VINFO_PEELING_FOR_ALIGNMENT (main_loop_vinfo) >= 0) { /* Work out the (constant) number of iterations that need to be peeled for reasons other than niters. */ - unsigned int peel_niter = LOOP_VINFO_PEELING_FOR_ALIGNMENT (loop_vinfo); + unsigned int peel_niter + = LOOP_VINFO_PEELING_FOR_ALIGNMENT (main_loop_vinfo); if (LOOP_VINFO_PEELING_FOR_GAPS (loop_vinfo)) peel_niter += 1; if (!multiple_p (LOOP_VINFO_INT_NITERS (loop_vinfo) - peel_niter, LOOP_VINFO_VECT_FACTOR (loop_vinfo))) return true; } - else if (LOOP_VINFO_PEELING_FOR_ALIGNMENT (loop_vinfo) + else if (LOOP_VINFO_PEELING_FOR_ALIGNMENT (main_loop_vinfo) /* ??? When peeling for gaps but not alignment, we could try to check whether the (variable) niters is known to be VF * N + 1. That's something of a niche case though. */ diff --git a/gcc/tree-vectorizer.h b/gcc/tree-vectorizer.h index ad36f400418b..5d125afa6bc5 100644 --- a/gcc/tree-vectorizer.h +++ b/gcc/tree-vectorizer.h @@ -2635,8 +2635,6 @@ extern tree vect_create_addr_base_for_vector_ref (vec_info *, extern tree neutral_op_for_reduction (tree, code_helper, tree, bool = true); extern widest_int vect_iv_limit_for_partial_vectors (loop_vec_info loop_vinfo); bool vect_rgroup_iv_might_wrap_p (loop_vec_info, rgroup_controls *); -/* Used in tree-vect-loop-manip.cc */ -extern bool vect_need_peeling_or_partial_vectors_p (loop_vec_info); /* Used in gimple-loop-interchange.c and tree-parloops.cc. */ extern bool check_reduction_path (dump_user_location_t, loop_p, gphi *, tree, enum tree_code); From e97550a7d0e1a8b31a76b0877c0e90a0163da7ee Mon Sep 17 00:00:00 2001 From: Richard Earnshaw Date: Tue, 25 Nov 2025 15:47:05 +0000 Subject: [PATCH 043/373] arm: handle long-range CBZ/CBNZ patterns [PR122867] The CBN?Z instructions have a very small range (just 128 bytes forwards). The compiler knows how to handle cases where we exceed that, but only if the range remains within that which a condition branch can support. When compiling some machine generated code it is not too difficult to exceed this limit, so arrange to fall back to a conditional branch over an unconditional one in this extreme case. gcc/ChangeLog: PR target/122867 * config/arm/arm.cc (arm_print_operand): Use %- to emit LOCAL_LABEL_PREFIX. (arm_print_operand_punct_valid_p): Allow %- for punct and make %_ valid for all compilation variants. * config/arm/thumb2.md (*thumb2_cbz): Handle very large branch ranges that exceed the limit of b. (*thumb2_cbnz): Likewise. gcc/testsuite/ChangeLog: PR target/122867 * gcc.target/arm/cbz-range.c: New test. --- gcc/config/arm/arm.cc | 11 ++- gcc/config/arm/thumb2.md | 38 +++++--- gcc/testsuite/gcc.target/arm/cbz-range.c | 114 +++++++++++++++++++++++ 3 files changed, 146 insertions(+), 17 deletions(-) create mode 100644 gcc/testsuite/gcc.target/arm/cbz-range.c diff --git a/gcc/config/arm/arm.cc b/gcc/config/arm/arm.cc index 07d24d1f67ed..20d3f1f4578b 100644 --- a/gcc/config/arm/arm.cc +++ b/gcc/config/arm/arm.cc @@ -24064,7 +24064,7 @@ arm_print_condition (FILE *stream) /* Globally reserved letters: acln - Puncutation letters currently used: @_|?().!# + Puncutation letters currently used: @_-|?().!# Lower case letters currently used: bcdefhimpqtvwxyz Upper case letters currently used: ABCDEFGHIJKLMOPQRSTUV Letters previously used, but now deprecated/obsolete: sNWXYZ. @@ -24097,6 +24097,11 @@ arm_print_operand (FILE *stream, rtx x, int code) case '_': fputs (user_label_prefix, stream); return; + case '-': +#ifdef LOCAL_LABEL_PREFIX + fputs (LOCAL_LABEL_PREFIX, stream); +#endif + return; case '|': fputs (REGISTER_PREFIX, stream); @@ -24913,9 +24918,9 @@ arm_print_operand_punct_valid_p (unsigned char code) { return (code == '@' || code == '|' || code == '.' || code == '(' || code == ')' || code == '#' + || code == '-' || code == '_' || (TARGET_32BIT && (code == '?')) - || (TARGET_THUMB2 && (code == '!')) - || (TARGET_THUMB && (code == '_'))); + || (TARGET_THUMB2 && (code == '!'))); } /* Target hook for assembling integer objects. The ARM version needs to diff --git a/gcc/config/arm/thumb2.md b/gcc/config/arm/thumb2.md index 40c0e052946c..c3539958f8a3 100644 --- a/gcc/config/arm/thumb2.md +++ b/gcc/config/arm/thumb2.md @@ -1464,19 +1464,24 @@ (pc))) (clobber (reg:CC CC_REGNUM))] "TARGET_THUMB2" - "* - if (get_attr_length (insn) == 2) - return \"cbz\\t%0, %l1\"; - else - return \"cmp\\t%0, #0\;beq\\t%l1\"; - " + { + int offset = (INSN_ADDRESSES (INSN_UID (operands[1])) + - INSN_ADDRESSES (INSN_UID (insn))); + if (get_attr_length (insn) == 2) + return "cbz\t%0, %l1"; + else if (offset >= -1048564 && offset <= 1048576) + return "cmp\t%0, #0\;beq\t%l1"; + else if (which_alternative == 0) + return "cbnz\t%0, %-LCB%=\;b\t%l1\n%-LCB%=:"; + return "cmp\t%0, #0\;bne\t%-LCB%=\;b\t%l1\n%-LCB%=:"; + } [(set (attr "length") (if_then_else (and (ge (minus (match_dup 1) (pc)) (const_int 2)) (le (minus (match_dup 1) (pc)) (const_int 128)) (not (match_test "which_alternative"))) (const_int 2) - (const_int 8))) + (const_int 10))) (set_attr "type" "branch,multiple")] ) @@ -1488,19 +1493,24 @@ (pc))) (clobber (reg:CC CC_REGNUM))] "TARGET_THUMB2" - "* - if (get_attr_length (insn) == 2) - return \"cbnz\\t%0, %l1\"; - else - return \"cmp\\t%0, #0\;bne\\t%l1\"; - " + { + int offset = (INSN_ADDRESSES (INSN_UID (operands[1])) + - INSN_ADDRESSES (INSN_UID (insn))); + if (get_attr_length (insn) == 2) + return "cbnz\t%0, %l1"; + else if (offset >= -1048564 && offset <= 1048576) + return "cmp\t%0, #0\;bne\t%l1"; + else if (which_alternative == 0) + return "cbz\t%0, %-LCB%=\;b\t%l1\n%-LCB%=:"; + return "cmp\t%0, #0\;beq\t%-LCB%=\;b\t%l1\n%-LCB%=:"; + } [(set (attr "length") (if_then_else (and (ge (minus (match_dup 1) (pc)) (const_int 2)) (le (minus (match_dup 1) (pc)) (const_int 128)) (not (match_test "which_alternative"))) (const_int 2) - (const_int 8))) + (const_int 10))) (set_attr "type" "branch,multiple")] ) diff --git a/gcc/testsuite/gcc.target/arm/cbz-range.c b/gcc/testsuite/gcc.target/arm/cbz-range.c new file mode 100644 index 000000000000..3b23888a42a9 --- /dev/null +++ b/gcc/testsuite/gcc.target/arm/cbz-range.c @@ -0,0 +1,114 @@ +/* { dg-do assemble } */ +/* { dg-require-effective-target arm_arch_v7a_ok } */ +/* { dg-options "-O -mthumb" } */ +/* { dg-add-options arm_arch_v7a } */ + +#define f "movw r0, #0;movw r0, #0;movw r0, #0;" +#define f2 f f +#define f4 f2 f2 +#define f8 f4 f4 +#define f16 f8 f8 +#define f32 f16 f16 +#define f64 f32 f32 +#define f128 f64 f64 +#define f256 f128 f128 +#define f512 f256 f256 +#define f1024 f512 f512 +#define f2048 f1024 f1024 +#define f4096 f2048 f2048 +#define f8192 f4096 f4096 +#define f16384 f8192 f8192 +#define f32768 f16384 f16384 +#define f65536 f32768 f32768 +#define f131072 f65536 f65536 +int a; + +int cbz1(int g) +{ + if (g) + asm(f8); + return a; +} + +int cbz2(int g) +{ + asm ("": "+h"(g)); + if (g) + asm(f8); + return a; +} + +int cbz3(int g) +{ + if (g) + asm(f16); + return a; +} + +int cbz4(int g) +{ + asm ("": "+h"(g)); + if (g) + asm(f16); + return a; +} + +int cbz5(int g) +{ + if (g) + asm(f131072); + return a; +} + +int cbz6(int g) +{ + asm ("": "+h"(g)); + if (g) + asm(f131072); + return a; +} + +int cbnz1(int g) +{ + if (!g) + asm(f8); + return a; +} + +int cbnz2(int g) +{ + asm ("": "+h"(g)); + if (!g) + asm(f8); + return a; +} + +int cbnz3(int g) +{ + if (!g) + asm(f16); + return a; +} + +int cbnz4(int g) +{ + asm ("": "+h"(g)); + if (!g) + asm(f16); + return a; +} + +int cbnz5(int g) +{ + if (!g) + asm(f131072); + return a; +} + +int cbnz6(int g) +{ + asm ("": "+h"(g)); + if (!g) + asm(f131072); + return a; +} From 856fae983bca6a934b74f47c7cd21e6919035fc0 Mon Sep 17 00:00:00 2001 From: Marek Polacek Date: Mon, 24 Nov 2025 17:31:22 -0500 Subject: [PATCH 044/373] c++: fix crash with pack indexing in noexcept [PR121325] In my r15-6792 patch I added a call to tsubst in tsubst_pack_index to fully instantiate args#N in the pack. Here we are in an unevaluated context, but since the pack is a TREE_VEC, we call tsubst_template_args which has cp_evaluated at the beginning. That causes a crash because we trip on the assert in tsubst_expr/PARM_DECL: gcc_assert (cp_unevaluated_operand); because retrieve_local_specialization didn't find anything (becase there are no local_specializations yet). We can avoid the cp_evaluated by calling the new tsubst_tree_vec, which creates a new TREE_VEC and substitutes each element. PR c++/121325 gcc/cp/ChangeLog: * pt.cc (tsubst_tree_vec): New. (tsubst_pack_index): Call it. gcc/testsuite/ChangeLog: * g++.dg/cpp26/pack-indexing18.C: New test. Reviewed-by: Patrick Palka --- gcc/cp/pt.cc | 21 ++++++++++++- gcc/testsuite/g++.dg/cpp26/pack-indexing18.C | 32 ++++++++++++++++++++ 2 files changed, 52 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/g++.dg/cpp26/pack-indexing18.C diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc index e74e34d81499..4dc8f980d0d0 100644 --- a/gcc/cp/pt.cc +++ b/gcc/cp/pt.cc @@ -14203,6 +14203,25 @@ tsubst_pack_expansion (tree t, tree args, tsubst_flags_t complain, return result; } +/* Substitute ARGS into T, which is a TREE_VEC. This function creates a new + TREE_VEC rather than substituting the elements in-place. */ + +static tree +tsubst_tree_vec (tree t, tree args, tsubst_flags_t complain, tree in_decl) +{ + const int len = TREE_VEC_LENGTH (t); + tree r = make_tree_vec (len); + for (int i = 0; i < len; ++i) + { + tree arg = TREE_VEC_ELT (t, i); + if (TYPE_P (arg)) + TREE_VEC_ELT (r, i) = tsubst (arg, args, complain, in_decl); + else + TREE_VEC_ELT (r, i) = tsubst_expr (arg, args, complain, in_decl); + } + return r; +} + /* Substitute ARGS into T, which is a pack index (i.e., PACK_INDEX_TYPE or PACK_INDEX_EXPR). Returns a single type or expression, a PACK_INDEX_* node if only a partial substitution could be performed, or ERROR_MARK_NODE @@ -14220,7 +14239,7 @@ tsubst_pack_index (tree t, tree args, tsubst_flags_t complain, tree in_decl) a partially instantiated closure. Let tsubst find the fully-instantiated one. */ gcc_assert (TREE_CODE (pack) == TREE_VEC); - pack = tsubst (pack, args, complain, in_decl); + pack = tsubst_tree_vec (pack, args, complain, in_decl); } if (TREE_CODE (pack) == TREE_VEC && TREE_VEC_LENGTH (pack) == 0) { diff --git a/gcc/testsuite/g++.dg/cpp26/pack-indexing18.C b/gcc/testsuite/g++.dg/cpp26/pack-indexing18.C new file mode 100644 index 000000000000..d3e3730408cb --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp26/pack-indexing18.C @@ -0,0 +1,32 @@ +// PR c++/121325 +// { dg-do compile { target c++26 } } + +void f(auto... a) requires requires { [] noexcept(noexcept(a...[i])) { }(); } {} +void g(auto... a) requires requires { [] { static_assert(noexcept(a...[i])); }(); } {} + +void +h () +{ + f (0); + g (0); +} + +void foo () {} +void bar () noexcept {} +template +void baz () noexcept(B) {} + +template +void +x (Ts... ts) noexcept (noexcept (ts...[0]())) +{ +} + +void +y () +{ + static_assert (!noexcept (x (foo))); + static_assert (noexcept (x (bar))); + static_assert (noexcept (x (baz))); + static_assert (!noexcept (x (baz))); +} From 26d41e245dbba3e2267c0bd432f31c6d1fb81361 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 26 Nov 2025 21:47:18 +0100 Subject: [PATCH 045/373] OpenMP/Fortran: 'declare target' fix + parse 'local' clause; parse groupprivate Declare target's 'link' clause disallows 'nohost'; check for it. Additionally, some other cleanups have been done. The 'local' clause to 'declare target' is now supported in the FE, but a 'sorry, unimplemented' is printed at TREE generation time. This commit also adds the 'groupprivate' directive, which implies 'declare target' with the 'local' clause. And for completeness also the 'dyn_groupprivate' clause to 'target'. However, all those new features will eventually print 'sorry, unimplemented' for now. gcc/fortran/ChangeLog: * dump-parse-tree.cc (show_attr): Handle OpenMP's 'local' clause and the 'groupprivate' directive. (show_omp_clauses): Handle dyn_groupprivate. * frontend-passes.cc (gfc_code_walker): Walk dyn_groupprivate. * gfortran.h (enum gfc_statement): Add ST_OMP_GROUPPRIVATE. (enum gfc_omp_fallback, gfc_add_omp_groupprivate, gfc_add_omp_declare_target_local): New. * match.h (gfc_match_omp_groupprivate): New. * module.cc (enum ab_attribute, mio_symbol_attribute, load_commons, write_common_0): Handle 'groupprivate' + declare target's 'local'. * openmp.cc (gfc_omp_directives): Add 'groupprivate'. (gfc_free_omp_clauses): Free dyn_groupprivate. (enum omp_mask2): Add OMP_CLAUSE_LOCAL and OMP_CLAUSE_DYN_GROUPPRIVATE. (gfc_match_omp_clauses): Match them. (OMP_TARGET_CLAUSES): Add OMP_CLAUSE_DYN_GROUPPRIVATE. (OMP_DECLARE_TARGET_CLAUSES): Add OMP_CLAUSE_LOCAL. (gfc_match_omp_declare_target): Handle groupprivate + fixes. (gfc_match_omp_threadprivate): Code move to and calling now ... (gfc_match_omp_thread_group_private): ... this new function. Also handle groupprivate. (gfc_match_omp_groupprivate): New. (resolve_omp_clauses): Resolve dyn_groupprivate. * parse.cc (decode_omp_directive): Match groupprivate. (case_omp_decl, parse_spec, gfc_ascii_statement): Handle it. * resolve.cc (resolve_symbol): Handle groupprivate. * symbol.cc (gfc_check_conflict, gfc_copy_attr): Handle 'local' and 'groupprivate'. (gfc_add_omp_groupprivate, gfc_add_omp_declare_target_local): New. * trans-common.cc (build_common_decl, accumulate_equivalence_attributes): Print 'sorry' for groupprivate and declare target's local. * trans-decl.cc (add_attributes_to_decl): Likewise.. * trans-openmp.cc (gfc_trans_omp_clauses): Print 'sorry' for dyn_groupprivate. (fallback): Process declare target with link/local as done for 'enter'. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/crayptr2.f90: Move dg-error line. * gfortran.dg/gomp/declare-target-2.f90: Extend. * gfortran.dg/gomp/declare-target-4.f90: Update comment, enable one test. * gfortran.dg/gomp/declare-target-5.f90: Update dg- wording, add new test. * gfortran.dg/gomp/declare-target-indirect-2.f90: Expect 'device_type(any)' in scan-tree-dump. * gfortran.dg/gomp/declare-target-6.f90: New test. * gfortran.dg/gomp/dyn_groupprivate-1.f90: New test. * gfortran.dg/gomp/dyn_groupprivate-2.f90: New test. * gfortran.dg/gomp/groupprivate-1.f90: New test. * gfortran.dg/gomp/groupprivate-2.f90: New test. * gfortran.dg/gomp/groupprivate-3.f90: New test. * gfortran.dg/gomp/groupprivate-4.f90: New test. * gfortran.dg/gomp/groupprivate-5.f90: New test. * gfortran.dg/gomp/groupprivate-6.f90: New test. --- gcc/fortran/dump-parse-tree.cc | 18 + gcc/fortran/frontend-passes.cc | 1 + gcc/fortran/gfortran.h | 19 + gcc/fortran/match.h | 1 + gcc/fortran/module.cc | 20 +- gcc/fortran/openmp.cc | 359 ++++++++++++++---- gcc/fortran/parse.cc | 10 +- gcc/fortran/resolve.cc | 19 +- gcc/fortran/symbol.cc | 64 +++- gcc/fortran/trans-common.cc | 31 +- gcc/fortran/trans-decl.cc | 26 +- gcc/fortran/trans-openmp.cc | 23 +- gcc/testsuite/gfortran.dg/gomp/crayptr2.f90 | 4 +- .../gfortran.dg/gomp/declare-target-2.f90 | 4 + .../gfortran.dg/gomp/declare-target-4.f90 | 9 +- .../gfortran.dg/gomp/declare-target-5.f90 | 37 +- .../gfortran.dg/gomp/declare-target-6.f90 | 15 + .../gomp/declare-target-indirect-2.f90 | 4 +- .../gfortran.dg/gomp/dyn_groupprivate-1.f90 | 20 + .../gfortran.dg/gomp/dyn_groupprivate-2.f90 | 23 ++ .../gfortran.dg/gomp/groupprivate-1.f90 | 23 ++ .../gfortran.dg/gomp/groupprivate-2.f90 | 37 ++ .../gfortran.dg/gomp/groupprivate-3.f90 | 16 + .../gfortran.dg/gomp/groupprivate-4.f90 | 25 ++ .../gfortran.dg/gomp/groupprivate-5.f90 | 58 +++ .../gfortran.dg/gomp/groupprivate-6.f90 | 34 ++ 26 files changed, 778 insertions(+), 122 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-target-6.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/dyn_groupprivate-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/dyn_groupprivate-2.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/groupprivate-2.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/groupprivate-3.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/groupprivate-5.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/groupprivate-6.f90 diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index eda0659d6e23..2a4ebb0fa0f9 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -843,6 +843,8 @@ show_attr (symbol_attribute *attr, const char * module) fputs (" VALUE", dumpfile); if (attr->volatile_) fputs (" VOLATILE", dumpfile); + if (attr->omp_groupprivate) + fputs (" GROUPPRIVATE", dumpfile); if (attr->threadprivate) fputs (" THREADPRIVATE", dumpfile); if (attr->temporary) @@ -938,6 +940,8 @@ show_attr (symbol_attribute *attr, const char * module) fputs (" OMP-DECLARE-TARGET", dumpfile); if (attr->omp_declare_target_link) fputs (" OMP-DECLARE-TARGET-LINK", dumpfile); + if (attr->omp_declare_target_local) + fputs (" OMP-DECLARE-TARGET-LOCAL", dumpfile); if (attr->omp_declare_target_indirect) fputs (" OMP-DECLARE-TARGET-INDIRECT", dumpfile); if (attr->omp_device_type == OMP_DEVICE_TYPE_HOST) @@ -2211,6 +2215,20 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) fputs (" DEPEND(source)", dumpfile); if (omp_clauses->doacross_source) fputs (" DOACROSS(source:)", dumpfile); + if (omp_clauses->dyn_groupprivate) + { + fputs (" DYN_GROUPPRIVATE(", dumpfile); + if (omp_clauses->fallback != OMP_FALLBACK_NONE) + fputs ("FALLBACK(", dumpfile); + if (omp_clauses->fallback == OMP_FALLBACK_ABORT) + fputs ("ABORT):", dumpfile); + else if (omp_clauses->fallback == OMP_FALLBACK_DEFAULT_MEM) + fputs ("DEFAULT_MEM):", dumpfile); + else if (omp_clauses->fallback == OMP_FALLBACK_NULL) + fputs ("NULL):", dumpfile); + show_expr (omp_clauses->dyn_groupprivate); + fputc (')', dumpfile); + } if (omp_clauses->capture) fputs (" CAPTURE", dumpfile); if (omp_clauses->depobj_update != OMP_DEPEND_UNSET) diff --git a/gcc/fortran/frontend-passes.cc b/gcc/fortran/frontend-passes.cc index 595c5095eaf9..b699231e971e 100644 --- a/gcc/fortran/frontend-passes.cc +++ b/gcc/fortran/frontend-passes.cc @@ -5645,6 +5645,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, WALK_SUBEXPR (co->ext.omp_clauses->num_tasks); WALK_SUBEXPR (co->ext.omp_clauses->priority); WALK_SUBEXPR (co->ext.omp_clauses->detach); + WALK_SUBEXPR (co->ext.omp_clauses->dyn_groupprivate); WALK_SUBEXPR (co->ext.omp_clauses->novariants); WALK_SUBEXPR (co->ext.omp_clauses->nocontext); for (idx = 0; idx < ARRAY_SIZE (list_types); idx++) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 2997c0326ca1..72aecfb83794 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -311,6 +311,7 @@ enum gfc_statement ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_SCAN, ST_OMP_DEPOBJ, ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND, ST_OMP_REQUIRES, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL, + ST_OMP_GROUPPRIVATE, ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST, ST_EVENT_WAIT, ST_FAIL_IMAGE, ST_FORM_TEAM, ST_CHANGE_TEAM, ST_END_TEAM, ST_SYNC_TEAM, ST_OMP_PARALLEL_MASTER, @@ -1042,8 +1043,10 @@ typedef struct /* Mentioned in OMP DECLARE TARGET. */ unsigned omp_declare_target:1; unsigned omp_declare_target_link:1; + unsigned omp_declare_target_local:1; unsigned omp_declare_target_indirect:1; ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2; + unsigned omp_groupprivate:1; unsigned omp_allocate:1; /* Mentioned in OACC DECLARE. */ @@ -1488,6 +1491,7 @@ enum OMP_LIST_TASK_REDUCTION, OMP_LIST_DEVICE_RESIDENT, OMP_LIST_LINK, + OMP_LIST_LOCAL, OMP_LIST_USE_DEVICE, OMP_LIST_CACHE, OMP_LIST_IS_DEVICE_PTR, @@ -1614,6 +1618,14 @@ enum gfc_omp_bind_type OMP_BIND_THREAD }; +enum gfc_omp_fallback +{ + OMP_FALLBACK_NONE, + OMP_FALLBACK_ABORT, + OMP_FALLBACK_DEFAULT_MEM, + OMP_FALLBACK_NULL +}; + typedef struct gfc_omp_assumptions { int n_absent, n_contains; @@ -1649,6 +1661,7 @@ typedef struct gfc_omp_clauses struct gfc_expr *detach; struct gfc_expr *depobj; struct gfc_expr *dist_chunk_size; + struct gfc_expr *dyn_groupprivate; struct gfc_expr *message; struct gfc_expr *novariants; struct gfc_expr *nocontext; @@ -1681,6 +1694,7 @@ typedef struct gfc_omp_clauses ENUM_BITFIELD (gfc_omp_at_type) at:2; ENUM_BITFIELD (gfc_omp_severity_type) severity:2; ENUM_BITFIELD (gfc_omp_sched_kind) dist_sched_kind:3; + ENUM_BITFIELD (gfc_omp_fallback) fallback:2; /* OpenACC. */ struct gfc_expr *async_expr; @@ -2118,6 +2132,8 @@ typedef struct gfc_common_head char use_assoc, saved, threadprivate; unsigned char omp_declare_target : 1; unsigned char omp_declare_target_link : 1; + unsigned char omp_declare_target_local : 1; + unsigned char omp_groupprivate : 1; ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2; /* Provide sufficient space to hold "symbol.symbol.eq.1234567890". */ char name[2*GFC_MAX_SYMBOL_LEN + 1 + 14 + 1]; @@ -3717,6 +3733,9 @@ bool gfc_add_threadprivate (symbol_attribute *, const char *, locus *); bool gfc_add_omp_declare_target (symbol_attribute *, const char *, locus *); bool gfc_add_omp_declare_target_link (symbol_attribute *, const char *, locus *); +bool gfc_add_omp_declare_target_local (symbol_attribute *, const char *, + locus *); +bool gfc_add_omp_groupprivate (symbol_attribute *, const char *, locus *); bool gfc_add_target (symbol_attribute *, locus *); bool gfc_add_dummy (symbol_attribute *, const char *, locus *); bool gfc_add_generic (symbol_attribute *, const char *, locus *); diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 410361c4bd1c..314be6baa92e 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -174,6 +174,7 @@ match gfc_match_omp_do_simd (void); match gfc_match_omp_loop (void); match gfc_match_omp_error (void); match gfc_match_omp_flush (void); +match gfc_match_omp_groupprivate (void); match gfc_match_omp_interop (void); match gfc_match_omp_masked (void); match gfc_match_omp_masked_taskloop (void); diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc index c489decec8dc..262f72b8e7c3 100644 --- a/gcc/fortran/module.cc +++ b/gcc/fortran/module.cc @@ -2092,7 +2092,8 @@ enum ab_attribute AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE, AB_OACC_DECLARE_CREATE, AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR, AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK, - AB_OMP_DECLARE_TARGET_LINK, AB_PDT_KIND, AB_PDT_LEN, AB_PDT_TYPE, + AB_OMP_DECLARE_TARGET_LINK, AB_OMP_DECLARE_TARGET_LOCAL, + AB_PDT_KIND, AB_PDT_LEN, AB_PDT_TYPE, AB_PDT_COMP, AB_PDT_TEMPLATE, AB_PDT_ARRAY, AB_PDT_STRING, AB_OACC_ROUTINE_LOP_GANG, AB_OACC_ROUTINE_LOP_WORKER, AB_OACC_ROUTINE_LOP_VECTOR, AB_OACC_ROUTINE_LOP_SEQ, @@ -2102,7 +2103,7 @@ enum ab_attribute AB_OMP_REQ_MEM_ORDER_SEQ_CST, AB_OMP_REQ_MEM_ORDER_ACQ_REL, AB_OMP_REQ_MEM_ORDER_ACQUIRE, AB_OMP_REQ_MEM_ORDER_RELEASE, AB_OMP_REQ_MEM_ORDER_RELAXED, AB_OMP_DEVICE_TYPE_NOHOST, - AB_OMP_DEVICE_TYPE_HOST, AB_OMP_DEVICE_TYPE_ANY + AB_OMP_DEVICE_TYPE_HOST, AB_OMP_DEVICE_TYPE_ANY, AB_OMP_GROUPPRIVATE }; static const mstring attr_bits[] = @@ -2166,6 +2167,8 @@ static const mstring attr_bits[] = minit ("OACC_DECLARE_DEVICE_RESIDENT", AB_OACC_DECLARE_DEVICE_RESIDENT), minit ("OACC_DECLARE_LINK", AB_OACC_DECLARE_LINK), minit ("OMP_DECLARE_TARGET_LINK", AB_OMP_DECLARE_TARGET_LINK), + minit ("OMP_DECLARE_TARGET_LOCAL", AB_OMP_DECLARE_TARGET_LOCAL), + minit ("OMP_GROUPPRIVATE", AB_OMP_GROUPPRIVATE), minit ("PDT_KIND", AB_PDT_KIND), minit ("PDT_LEN", AB_PDT_LEN), minit ("PDT_TYPE", AB_PDT_TYPE), @@ -2399,6 +2402,10 @@ mio_symbol_attribute (symbol_attribute *attr) MIO_NAME (ab_attribute) (AB_OACC_DECLARE_LINK, attr_bits); if (attr->omp_declare_target_link) MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET_LINK, attr_bits); + if (attr->omp_declare_target_local) + MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET_LOCAL, attr_bits); + if (attr->omp_groupprivate) + MIO_NAME (ab_attribute) (AB_OMP_GROUPPRIVATE, attr_bits); if (attr->pdt_kind) MIO_NAME (ab_attribute) (AB_PDT_KIND, attr_bits); if (attr->pdt_len) @@ -2654,6 +2661,12 @@ mio_symbol_attribute (symbol_attribute *attr) case AB_OMP_DECLARE_TARGET_LINK: attr->omp_declare_target_link = 1; break; + case AB_OMP_DECLARE_TARGET_LOCAL: + attr->omp_declare_target_local = 1; + break; + case AB_OMP_GROUPPRIVATE: + attr->omp_groupprivate = 1; + break; case AB_ARRAY_OUTER_DEPENDENCY: attr->array_outer_dependency =1; break; @@ -5268,6 +5281,8 @@ load_commons (void) if (flags & 2) p->threadprivate = 1; p->omp_device_type = (gfc_omp_device_type) ((flags >> 2) & 3); + if ((flags >> 4) & 1) + p->omp_groupprivate = 1; p->use_assoc = 1; /* Get whether this was a bind(c) common or not. */ @@ -6191,6 +6206,7 @@ write_common_0 (gfc_symtree *st, bool this_module) if (p->threadprivate) flags |= 2; flags |= p->omp_device_type << 2; + flags |= p->omp_groupprivate << 4; mio_integer (&flags); /* Write out whether the common block is bind(c) or not. */ diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 81d624b7b54a..f047028187f6 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -84,6 +84,7 @@ static const struct gfc_omp_directive gfc_omp_directives[] = { /* {"flatten", GFC_OMP_DIR_EXECUTABLE, ST_OMP_FLATTEN}, */ {"flush", GFC_OMP_DIR_EXECUTABLE, ST_OMP_FLUSH}, /* {"fuse", GFC_OMP_DIR_EXECUTABLE, ST_OMP_FLUSE}, */ + {"groupprivate", GFC_OMP_DIR_DECLARATIVE, ST_OMP_GROUPPRIVATE}, /* {"interchange", GFC_OMP_DIR_EXECUTABLE, ST_OMP_INTERCHANGE}, */ {"interop", GFC_OMP_DIR_EXECUTABLE, ST_OMP_INTEROP}, {"loop", GFC_OMP_DIR_EXECUTABLE, ST_OMP_LOOP}, @@ -195,6 +196,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->num_teams_lower); gfc_free_expr (c->num_teams_upper); gfc_free_expr (c->device); + gfc_free_expr (c->dyn_groupprivate); gfc_free_expr (c->thread_limit); gfc_free_expr (c->dist_chunk_size); gfc_free_expr (c->grainsize); @@ -1172,6 +1174,8 @@ enum omp_mask2 OMP_CLAUSE_NOVARIANTS, /* OpenMP 5.1 */ OMP_CLAUSE_NOCONTEXT, /* OpenMP 5.1 */ OMP_CLAUSE_INTEROP, /* OpenMP 5.1 */ + OMP_CLAUSE_LOCAL, /* OpenMP 6.0 */ + OMP_CLAUSE_DYN_GROUPPRIVATE, /* OpenMP 6.1 */ /* This must come last. */ OMP_MASK2_LAST }; @@ -3096,6 +3100,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, else continue; } + if ((mask & OMP_CLAUSE_DYN_GROUPPRIVATE) + && gfc_match_dupl_check (!c->dyn_groupprivate, + "dyn_groupprivate", true) == MATCH_YES) + { + if (gfc_match ("fallback ( abort ) : ") == MATCH_YES) + c->fallback = OMP_FALLBACK_ABORT; + else if (gfc_match ("fallback ( default_mem ) : ") == MATCH_YES) + c->fallback = OMP_FALLBACK_DEFAULT_MEM; + else if (gfc_match ("fallback ( null ) : ") == MATCH_YES) + c->fallback = OMP_FALLBACK_NULL; + if (gfc_match_expr (&c->dyn_groupprivate) != MATCH_YES) + return MATCH_ERROR; + if (gfc_match (" )") != MATCH_YES) + goto error; + continue; + } break; case 'e': if ((mask & OMP_CLAUSE_ENTER)) @@ -3567,6 +3587,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, &c->lists[OMP_LIST_LINK]) == MATCH_YES)) continue; + if ((mask & OMP_CLAUSE_LOCAL) + && (gfc_match_omp_to_link ("local (", &c->lists[OMP_LIST_LOCAL]) + == MATCH_YES)) + continue; break; case 'm': if ((mask & OMP_CLAUSE_MAP) @@ -5064,7 +5088,8 @@ gfc_match_oacc_routine (void) | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP \ | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION \ | OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_ALLOCATE \ - | OMP_CLAUSE_HAS_DEVICE_ADDR | OMP_CLAUSE_USES_ALLOCATORS) + | OMP_CLAUSE_HAS_DEVICE_ADDR | OMP_CLAUSE_USES_ALLOCATORS \ + | OMP_CLAUSE_DYN_GROUPPRIVATE) #define OMP_TARGET_DATA_CLAUSES \ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ | OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR) @@ -5092,7 +5117,7 @@ gfc_match_oacc_routine (void) (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD) #define OMP_DECLARE_TARGET_CLAUSES \ (omp_mask (OMP_CLAUSE_ENTER) | OMP_CLAUSE_LINK | OMP_CLAUSE_DEVICE_TYPE \ - | OMP_CLAUSE_TO | OMP_CLAUSE_INDIRECT) + | OMP_CLAUSE_TO | OMP_CLAUSE_INDIRECT | OMP_CLAUSE_LOCAL) #define OMP_ATOMIC_CLAUSES \ (omp_mask (OMP_CLAUSE_ATOMIC) | OMP_CLAUSE_CAPTURE | OMP_CLAUSE_HINT \ | OMP_CLAUSE_MEMORDER | OMP_CLAUSE_COMPARE | OMP_CLAUSE_FAIL \ @@ -6113,7 +6138,7 @@ gfc_match_omp_declare_target (void) gfc_buffer_error (false); static const int to_enter_link_lists[] - = { OMP_LIST_TO, OMP_LIST_ENTER, OMP_LIST_LINK }; + = { OMP_LIST_TO, OMP_LIST_ENTER, OMP_LIST_LINK, OMP_LIST_LOCAL }; for (size_t listn = 0; listn < ARRAY_SIZE (to_enter_link_lists) && (list = to_enter_link_lists[listn], true); ++listn) for (n = c->lists[list]; n; n = n->next) @@ -6122,6 +6147,8 @@ gfc_match_omp_declare_target (void) else if (n->u.common->head) n->u.common->head->mark = 0; + if (c->device_type == OMP_DEVICE_TYPE_UNSET) + c->device_type = OMP_DEVICE_TYPE_ANY; for (size_t listn = 0; listn < ARRAY_SIZE (to_enter_link_lists) && (list = to_enter_link_lists[listn], true); ++listn) for (n = c->lists[list]; n; n = n->next) @@ -6130,105 +6157,161 @@ gfc_match_omp_declare_target (void) if (n->sym->attr.in_common) gfc_error_now ("OMP DECLARE TARGET variable at %L is an " "element of a COMMON block", &n->where); + else if (n->sym->attr.omp_groupprivate && list != OMP_LIST_LOCAL) + gfc_error_now ("List item %qs at %L not appear in the %qs clause " + "as it was previously specified in a GROUPPRIVATE " + "directive", n->sym->name, &n->where, + list == OMP_LIST_LINK + ? "link" : list == OMP_LIST_TO ? "to" : "enter"); else if (n->sym->mark) gfc_error_now ("Variable at %L mentioned multiple times in " "clauses of the same OMP DECLARE TARGET directive", &n->where); - else if (n->sym->attr.omp_declare_target - && n->sym->attr.omp_declare_target_link - && list != OMP_LIST_LINK) + else if ((n->sym->attr.omp_declare_target_link + || n->sym->attr.omp_declare_target_local) + && list != OMP_LIST_LINK + && list != OMP_LIST_LOCAL) gfc_error_now ("OMP DECLARE TARGET variable at %L previously " - "mentioned in LINK clause and later in %s clause", - &n->where, list == OMP_LIST_TO ? "TO" : "ENTER"); + "mentioned in %s clause and later in %s clause", + &n->where, + n->sym->attr.omp_declare_target_link ? "LINK" + : "LOCAL", + list == OMP_LIST_TO ? "TO" : "ENTER"); else if (n->sym->attr.omp_declare_target - && !n->sym->attr.omp_declare_target_link - && list == OMP_LIST_LINK) + && (list == OMP_LIST_LINK || list == OMP_LIST_LOCAL)) gfc_error_now ("OMP DECLARE TARGET variable at %L previously " "mentioned in TO or ENTER clause and later in " - "LINK clause", &n->where); - else if (gfc_add_omp_declare_target (&n->sym->attr, n->sym->name, - &n->sym->declared_at)) + "%s clause", &n->where, + list == OMP_LIST_LINK ? "LINK" : "LOCAL"); + else { + if (list == OMP_LIST_TO || list == OMP_LIST_ENTER) + gfc_add_omp_declare_target (&n->sym->attr, n->sym->name, + &n->sym->declared_at); if (list == OMP_LIST_LINK) gfc_add_omp_declare_target_link (&n->sym->attr, n->sym->name, &n->sym->declared_at); + if (list == OMP_LIST_LOCAL) + gfc_add_omp_declare_target_local (&n->sym->attr, n->sym->name, + &n->sym->declared_at); + } + if (n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET + && n->sym->attr.omp_device_type != c->device_type) + { + const char *dt = "any"; + if (n->sym->attr.omp_device_type == OMP_DEVICE_TYPE_NOHOST) + dt = "nohost"; + else if (n->sym->attr.omp_device_type == OMP_DEVICE_TYPE_HOST) + dt = "host"; + if (n->sym->attr.omp_groupprivate) + gfc_error_now ("List item %qs at %L set in previous OMP " + "GROUPPRIVATE directive to the different " + "DEVICE_TYPE %qs", n->sym->name, &n->where, dt); + else + gfc_error_now ("List item %qs at %L set in previous OMP " + "DECLARE TARGET directive to the different " + "DEVICE_TYPE %qs", n->sym->name, &n->where, dt); } - if (c->device_type != OMP_DEVICE_TYPE_UNSET) - { - if (n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET - && n->sym->attr.omp_device_type != c->device_type) - gfc_error_now ("List item %qs at %L set in previous OMP DECLARE " - "TARGET directive to a different DEVICE_TYPE", - n->sym->name, &n->where); - n->sym->attr.omp_device_type = c->device_type; - } - if (c->indirect) + n->sym->attr.omp_device_type = c->device_type; + if (c->indirect && c->device_type != OMP_DEVICE_TYPE_ANY) { - if (n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET - && n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_ANY) - gfc_error_now ("DEVICE_TYPE must be ANY when used with " - "INDIRECT at %L", &n->where); - n->sym->attr.omp_declare_target_indirect = c->indirect; + gfc_error_now ("DEVICE_TYPE must be ANY when used with INDIRECT " + "at %L", &n->where); + c->indirect = 0; } - + n->sym->attr.omp_declare_target_indirect = c->indirect; + if (list == OMP_LIST_LINK && c->device_type == OMP_DEVICE_TYPE_NOHOST) + gfc_error_now ("List item %qs at %L set with NOHOST specified may " + "not appear in a LINK clause", n->sym->name, + &n->where); n->sym->mark = 1; } - else if (n->u.common->omp_declare_target - && n->u.common->omp_declare_target_link - && list != OMP_LIST_LINK) - gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously " - "mentioned in LINK clause and later in %s clause", - &n->where, list == OMP_LIST_TO ? "TO" : "ENTER"); - else if (n->u.common->omp_declare_target - && !n->u.common->omp_declare_target_link - && list == OMP_LIST_LINK) - gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously " - "mentioned in TO or ENTER clause and later in " - "LINK clause", &n->where); - else if (n->u.common->head && n->u.common->head->mark) - gfc_error_now ("COMMON at %L mentioned multiple times in " - "clauses of the same OMP DECLARE TARGET directive", - &n->where); - else - { - n->u.common->omp_declare_target = 1; - n->u.common->omp_declare_target_link = (list == OMP_LIST_LINK); + else /* common block */ + { + if (n->u.common->omp_groupprivate && list != OMP_LIST_LOCAL) + gfc_error_now ("Common block % at %L not appear in the %qs " + "clause as it was previously specified in a " + "GROUPPRIVATE directive", + n->u.common->name, &n->where, + list == OMP_LIST_LINK + ? "link" : list == OMP_LIST_TO ? "to" : "enter"); + else if (n->u.common->head && n->u.common->head->mark) + gfc_error_now ("Common block % at %L mentioned multiple " + "times in clauses of the same OMP DECLARE TARGET " + "directive", n->u.common->name, &n->where); + else if ((n->u.common->omp_declare_target_link + || n->u.common->omp_declare_target_local) + && list != OMP_LIST_LINK + && list != OMP_LIST_LOCAL) + gfc_error_now ("Common block % at %L previously mentioned " + "in %s clause and later in %s clause", + n->u.common->name, &n->where, + n->u.common->omp_declare_target_link ? "LINK" + : "LOCAL", + list == OMP_LIST_TO ? "TO" : "ENTER"); + else if (n->u.common->omp_declare_target + && (list == OMP_LIST_LINK || list == OMP_LIST_LOCAL)) + gfc_error_now ("Common block % at %L previously mentioned " + "in TO or ENTER clause and later in %s clause", + n->u.common->name, &n->where, + list == OMP_LIST_LINK ? "LINK" : "LOCAL"); if (n->u.common->omp_device_type != OMP_DEVICE_TYPE_UNSET && n->u.common->omp_device_type != c->device_type) - gfc_error_now ("COMMON at %L set in previous OMP DECLARE " - "TARGET directive to a different DEVICE_TYPE", - &n->where); + { + const char *dt = "any"; + if (n->u.common->omp_device_type == OMP_DEVICE_TYPE_NOHOST) + dt = "nohost"; + else if (n->u.common->omp_device_type == OMP_DEVICE_TYPE_HOST) + dt = "host"; + if (n->u.common->omp_groupprivate) + gfc_error_now ("Common block % at %L set in previous OMP " + "GROUPPRIVATE directive to the different " + "DEVICE_TYPE %qs", n->u.common->name, &n->where, + dt); + else + gfc_error_now ("Common block % at %L set in previous OMP " + "DECLARE TARGET directive to the different " + "DEVICE_TYPE %qs", n->u.common->name, &n->where, + dt); + } n->u.common->omp_device_type = c->device_type; + if (c->indirect && c->device_type != OMP_DEVICE_TYPE_ANY) + { + gfc_error_now ("DEVICE_TYPE must be ANY when used with INDIRECT " + "at %L", &n->where); + c->indirect = 0; + } + if (list == OMP_LIST_LINK && c->device_type == OMP_DEVICE_TYPE_NOHOST) + gfc_error_now ("Common block % at %L set with NOHOST " + "specified may not appear in a LINK clause", + n->u.common->name, &n->where); + + if (list == OMP_LIST_TO || list == OMP_LIST_ENTER) + n->u.common->omp_declare_target = 1; + if (list == OMP_LIST_LINK) + n->u.common->omp_declare_target_link = 1; + if (list == OMP_LIST_LOCAL) + n->u.common->omp_declare_target_local = 1; + for (s = n->u.common->head; s; s = s->common_next) { s->mark = 1; - if (gfc_add_omp_declare_target (&s->attr, s->name, - &s->declared_at)) - { - if (list == OMP_LIST_LINK) - gfc_add_omp_declare_target_link (&s->attr, s->name, - &s->declared_at); - } - if (s->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET - && s->attr.omp_device_type != c->device_type) - gfc_error_now ("List item %qs at %L set in previous OMP DECLARE" - " TARGET directive to a different DEVICE_TYPE", - s->name, &n->where); + if (list == OMP_LIST_TO || list == OMP_LIST_ENTER) + gfc_add_omp_declare_target (&s->attr, s->name, &n->where); + if (list == OMP_LIST_LINK) + gfc_add_omp_declare_target_link (&s->attr, s->name, &n->where); + if (list == OMP_LIST_LOCAL) + gfc_add_omp_declare_target_local (&s->attr, s->name, &n->where); s->attr.omp_device_type = c->device_type; - - if (c->indirect - && s->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET - && s->attr.omp_device_type != OMP_DEVICE_TYPE_ANY) - gfc_error_now ("DEVICE_TYPE must be ANY when used with " - "INDIRECT at %L", &n->where); s->attr.omp_declare_target_indirect = c->indirect; } } if ((c->device_type || c->indirect) && !c->lists[OMP_LIST_ENTER] && !c->lists[OMP_LIST_TO] - && !c->lists[OMP_LIST_LINK]) + && !c->lists[OMP_LIST_LINK] + && !c->lists[OMP_LIST_LOCAL]) gfc_warning_now (OPT_Wopenmp, "OMP DECLARE TARGET directive at %L with only " "DEVICE_TYPE or INDIRECT clauses is ignored", @@ -7108,32 +7191,44 @@ gfc_match_omp_metadirective (void) return match_omp_metadirective (false); } -match -gfc_match_omp_threadprivate (void) +/* Match 'omp threadprivate' or 'omp groupprivate'. */ +static match +gfc_match_omp_thread_group_private (bool is_groupprivate) { locus old_loc; char n[GFC_MAX_SYMBOL_LEN+1]; gfc_symbol *sym; match m; gfc_symtree *st; + struct sym_loc_t { gfc_symbol *sym; gfc_common_head *com; locus loc; }; + auto_vec syms; old_loc = gfc_current_locus; - m = gfc_match (" ("); + m = gfc_match (" ( "); if (m != MATCH_YES) return m; for (;;) { + locus sym_loc = gfc_current_locus; m = gfc_match_symbol (&sym, 0); switch (m) { case MATCH_YES: if (sym->attr.in_common) - gfc_error_now ("Threadprivate variable at %C is an element of " - "a COMMON block"); - else if (!gfc_add_threadprivate (&sym->attr, sym->name, &sym->declared_at)) + gfc_error_now ("%qs variable at %L is an element of a COMMON block", + is_groupprivate ? "groupprivate" : "threadprivate", + &sym_loc); + else if (!is_groupprivate + && !gfc_add_threadprivate (&sym->attr, sym->name, &sym_loc)) goto cleanup; + else if (is_groupprivate) + { + if (!gfc_add_omp_groupprivate (&sym->attr, sym->name, &sym_loc)) + goto cleanup; + syms.safe_push ({sym, nullptr, sym_loc}); + } goto next_item; case MATCH_NO: break; @@ -7150,12 +7245,20 @@ gfc_match_omp_threadprivate (void) st = gfc_find_symtree (gfc_current_ns->common_root, n); if (st == NULL) { - gfc_error ("COMMON block /%s/ not found at %C", n); + gfc_error ("COMMON block /%s/ not found at %L", n, &sym_loc); goto cleanup; } - st->n.common->threadprivate = 1; + syms.safe_push ({nullptr, st->n.common, sym_loc}); + if (is_groupprivate) + st->n.common->omp_groupprivate = 1; + else + st->n.common->threadprivate = 1; for (sym = st->n.common->head; sym; sym = sym->common_next) - if (!gfc_add_threadprivate (&sym->attr, sym->name, &sym->declared_at)) + if (!is_groupprivate + && !gfc_add_threadprivate (&sym->attr, sym->name, &sym_loc)) + goto cleanup; + else if (is_groupprivate + && !gfc_add_omp_groupprivate (&sym->attr, sym->name, &sym_loc)) goto cleanup; next_item: @@ -7165,16 +7268,89 @@ gfc_match_omp_threadprivate (void) goto syntax; } + if (is_groupprivate) + { + gfc_omp_clauses *c; + m = gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_DEVICE_TYPE)); + if (m == MATCH_ERROR) + return MATCH_ERROR; + + if (c->device_type == OMP_DEVICE_TYPE_UNSET) + c->device_type = OMP_DEVICE_TYPE_ANY; + + for (size_t i = 0; i < syms.length (); i++) + if (syms[i].sym) + { + sym_loc_t &n = syms[i]; + if (n.sym->attr.in_common) + gfc_error_now ("Variable %qs at %L is an element of a COMMON " + "block", n.sym->name, &n.loc); + else if (n.sym->attr.omp_declare_target + || n.sym->attr.omp_declare_target_link) + gfc_error_now ("List item %qs at %L implies OMP DECLARE TARGET " + "with the LOCAL clause, but it has been specified" + " with a different clause before", + n.sym->name, &n.loc); + if (n.sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET + && n.sym->attr.omp_device_type != c->device_type) + { + const char *dt = "any"; + if (n.sym->attr.omp_device_type == OMP_DEVICE_TYPE_HOST) + dt = "host"; + else if (n.sym->attr.omp_device_type == OMP_DEVICE_TYPE_NOHOST) + dt = "nohost"; + gfc_error_now ("List item %qs at %L set in previous OMP DECLARE " + "TARGET directive to the different DEVICE_TYPE %qs", + n.sym->name, &n.loc, dt); + } + gfc_add_omp_declare_target_local (&n.sym->attr, n.sym->name, + &n.loc); + n.sym->attr.omp_device_type = c->device_type; + } + else /* Common block. */ + { + sym_loc_t &n = syms[i]; + if (n.com->omp_declare_target + || n.com->omp_declare_target_link) + gfc_error_now ("List item % at %L implies OMP DECLARE " + "TARGET with the LOCAL clause, but it has been " + "specified with a different clause before", + n.com->name, &n.loc); + if (n.com->omp_device_type != OMP_DEVICE_TYPE_UNSET + && n.com->omp_device_type != c->device_type) + { + const char *dt = "any"; + if (n.com->omp_device_type == OMP_DEVICE_TYPE_HOST) + dt = "host"; + else if (n.com->omp_device_type == OMP_DEVICE_TYPE_NOHOST) + dt = "nohost"; + gfc_error_now ("List item %qs at %L set in previous OMP DECLARE" + " TARGET directive to the different DEVICE_TYPE " + "%qs", n.com->name, &n.loc, dt); + } + n.com->omp_declare_target_local = 1; + n.com->omp_device_type = c->device_type; + for (gfc_symbol *s = n.com->head; s; s = s->common_next) + { + gfc_add_omp_declare_target_local (&s->attr, s->name, &n.loc); + s->attr.omp_device_type = c->device_type; + } + } + free (c); + } + if (gfc_match_omp_eos () != MATCH_YES) { - gfc_error ("Unexpected junk after OMP THREADPRIVATE at %C"); + gfc_error ("Unexpected junk after OMP %s at %C", + is_groupprivate ? "GROUPPRIVATE" : "THREADPRIVATE"); goto cleanup; } return MATCH_YES; syntax: - gfc_error ("Syntax error in !$OMP THREADPRIVATE list at %C"); + gfc_error ("Syntax error in !$OMP %s list at %C", + is_groupprivate ? "GROUPPRIVATE" : "THREADPRIVATE"); cleanup: gfc_current_locus = old_loc; @@ -7182,6 +7358,20 @@ gfc_match_omp_threadprivate (void) } +match +gfc_match_omp_groupprivate (void) +{ + return gfc_match_omp_thread_group_private (true); +} + + +match +gfc_match_omp_threadprivate (void) +{ + return gfc_match_omp_thread_group_private (false); +} + + match gfc_match_omp_parallel (void) { @@ -8554,7 +8744,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "TO", "FROM", "INCLUSIVE", "EXCLUSIVE", "REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/, "IN_REDUCTION", "TASK_REDUCTION", - "DEVICE_RESIDENT", "LINK", "USE_DEVICE", + "DEVICE_RESIDENT", "LINK", "LOCAL", "USE_DEVICE", "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR", "NONTEMPORAL", "ALLOCATE", "HAS_DEVICE_ADDR", "ENTER", "USES_ALLOCATORS", "INIT", "USE", "DESTROY", "INTEROP", "ADJUST_ARGS" }; @@ -8761,6 +8951,9 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } if (omp_clauses->num_threads) resolve_positive_int_expr (omp_clauses->num_threads, "NUM_THREADS"); + if (omp_clauses->dyn_groupprivate) + resolve_positive_int_expr (omp_clauses->dyn_groupprivate, + "DYN_GROUPPRIVATE"); if (omp_clauses->chunk_size) { gfc_expr *expr = omp_clauses->chunk_size; diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index e4d65200f3ab..3fd45b9518ec 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -1195,6 +1195,9 @@ decode_omp_directive (void) case 'f': matcho ("flush", gfc_match_omp_flush, ST_OMP_FLUSH); break; + case 'g': + matchdo ("groupprivate", gfc_match_omp_groupprivate, ST_OMP_GROUPPRIVATE); + break; case 'i': matcho ("interop", gfc_match_omp_interop, ST_OMP_INTEROP); break; @@ -1990,7 +1993,8 @@ next_statement (void) #define case_omp_decl case ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: \ case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION: \ case ST_OMP_DECLARE_VARIANT: case ST_OMP_ALLOCATE: case ST_OMP_ASSUMES: \ - case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE + case ST_OMP_REQUIRES: case ST_OMP_GROUPPRIVATE: \ + case ST_OACC_ROUTINE: case ST_OACC_DECLARE /* OpenMP statements that are followed by a structured block. */ @@ -2909,6 +2913,9 @@ gfc_ascii_statement (gfc_statement st, bool strip_sentinel) case ST_OMP_FLUSH: p = "!$OMP FLUSH"; break; + case ST_OMP_GROUPPRIVATE: + p = "!$OMP GROUPPRIVATE"; + break; case ST_OMP_INTEROP: p = "!$OMP INTEROP"; break; @@ -4437,6 +4444,7 @@ parse_spec (gfc_statement st) case ST_EQUIVALENCE: case ST_IMPLICIT: case ST_IMPLICIT_NONE: + case ST_OMP_GROUPPRIVATE: case ST_OMP_THREADPRIVATE: case ST_PARAMETER: case ST_STRUCTURE_DECL: diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index e4e7751dbf04..9f3ce1d2ad61 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -18714,17 +18714,30 @@ resolve_symbol (gfc_symbol *sym) } /* Check threadprivate restrictions. */ - if (sym->attr.threadprivate + if ((sym->attr.threadprivate || sym->attr.omp_groupprivate) && !(sym->attr.save || sym->attr.data || sym->attr.in_common) && !(sym->ns->save_all && !sym->attr.automatic) && sym->module == NULL && (sym->ns->proc_name == NULL || (sym->ns->proc_name->attr.flavor != FL_MODULE && !sym->ns->proc_name->attr.is_main_program))) - gfc_error ("Threadprivate at %L isn't SAVEd", &sym->declared_at); + { + if (sym->attr.threadprivate) + gfc_error ("Threadprivate at %L isn't SAVEd", &sym->declared_at); + else + gfc_error ("OpenMP groupprivate variable %qs at %L must have the SAVE " + "attribute", sym->name, &sym->declared_at); + } + + if (sym->attr.omp_groupprivate && sym->value) + gfc_error ("!$OMP GROUPPRIVATE variable %qs at %L must not have an " + "initializer", sym->name, &sym->declared_at); /* Check omp declare target restrictions. */ - if (sym->attr.omp_declare_target + if ((sym->attr.omp_declare_target + || sym->attr.omp_declare_target_link + || sym->attr.omp_declare_target_local) + && !sym->attr.omp_groupprivate /* already warned. */ && sym->attr.flavor == FL_VARIABLE && !sym->attr.save && !(sym->ns->save_all && !sym->attr.automatic) diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc index becaaf394509..62925c028e6c 100644 --- a/gcc/fortran/symbol.cc +++ b/gcc/fortran/symbol.cc @@ -458,8 +458,10 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where) *contiguous = "CONTIGUOUS", *generic = "GENERIC", *automatic = "AUTOMATIC", *pdt_len = "LEN", *pdt_kind = "KIND"; static const char *threadprivate = "THREADPRIVATE"; + static const char *omp_groupprivate = "OpenMP GROUPPRIVATE"; static const char *omp_declare_target = "OMP DECLARE TARGET"; static const char *omp_declare_target_link = "OMP DECLARE TARGET LINK"; + static const char *omp_declare_target_local = "OMP DECLARE TARGET LOCAL"; static const char *oacc_declare_copyin = "OACC DECLARE COPYIN"; static const char *oacc_declare_create = "OACC DECLARE CREATE"; static const char *oacc_declare_deviceptr = "OACC DECLARE DEVICEPTR"; @@ -553,8 +555,10 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (dummy, entry); conf (dummy, intrinsic); conf (dummy, threadprivate); + conf (dummy, omp_groupprivate); conf (dummy, omp_declare_target); conf (dummy, omp_declare_target_link); + conf (dummy, omp_declare_target_local); conf (pointer, target); conf (pointer, intrinsic); conf (pointer, elemental); @@ -604,8 +608,10 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (in_equivalence, entry); conf (in_equivalence, allocatable); conf (in_equivalence, threadprivate); + conf (in_equivalence, omp_groupprivate); conf (in_equivalence, omp_declare_target); conf (in_equivalence, omp_declare_target_link); + conf (in_equivalence, omp_declare_target_local); conf (in_equivalence, oacc_declare_create); conf (in_equivalence, oacc_declare_copyin); conf (in_equivalence, oacc_declare_deviceptr); @@ -616,6 +622,7 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (entry, result); conf (generic, result); conf (generic, omp_declare_target); + conf (generic, omp_declare_target_local); conf (generic, omp_declare_target_link); conf (function, subroutine); @@ -661,8 +668,10 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (cray_pointee, in_common); conf (cray_pointee, in_equivalence); conf (cray_pointee, threadprivate); + conf (cray_pointee, omp_groupprivate); conf (cray_pointee, omp_declare_target); conf (cray_pointee, omp_declare_target_link); + conf (cray_pointee, omp_declare_target_local); conf (cray_pointee, oacc_declare_create); conf (cray_pointee, oacc_declare_copyin); conf (cray_pointee, oacc_declare_deviceptr); @@ -720,9 +729,11 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where) conf (proc_pointer, abstract) conf (proc_pointer, omp_declare_target) + conf (proc_pointer, omp_declare_target_local) conf (proc_pointer, omp_declare_target_link) conf (entry, omp_declare_target) + conf (entry, omp_declare_target_local) conf (entry, omp_declare_target_link) conf (entry, oacc_declare_create) conf (entry, oacc_declare_copyin) @@ -782,8 +793,10 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where) conf2 (function); conf2 (subroutine); conf2 (threadprivate); + conf2 (omp_groupprivate); conf2 (omp_declare_target); conf2 (omp_declare_target_link); + conf2 (omp_declare_target_local); conf2 (oacc_declare_create); conf2 (oacc_declare_copyin); conf2 (oacc_declare_deviceptr); @@ -828,7 +841,10 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where) conf2 (dimension); conf2 (function); if (!attr->proc_pointer) - conf2 (threadprivate); + { + conf2 (threadprivate); + conf2 (omp_groupprivate); + } } /* Procedure pointers in COMMON blocks are allowed in F03, @@ -836,6 +852,7 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where) if (!attr->proc_pointer || (gfc_option.allow_std & GFC_STD_F2008)) conf2 (in_common); + conf2 (omp_declare_target_local); conf2 (omp_declare_target_link); switch (attr->proc) @@ -852,6 +869,7 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where) case PROC_DUMMY: conf2 (result); conf2 (threadprivate); + conf2 (omp_groupprivate); break; default: @@ -872,8 +890,10 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where) conf2 (function); conf2 (subroutine); conf2 (threadprivate); + conf2 (omp_groupprivate); conf2 (result); conf2 (omp_declare_target); + conf2 (omp_declare_target_local); conf2 (omp_declare_target_link); conf2 (oacc_declare_create); conf2 (oacc_declare_copyin); @@ -905,6 +925,7 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where) conf2 (volatile_); conf2 (asynchronous); conf2 (threadprivate); + conf2 (omp_groupprivate); conf2 (value); conf2 (codimension); conf2 (result); @@ -1406,6 +1427,25 @@ gfc_add_asynchronous (symbol_attribute *attr, const char *name, locus *where) } +bool +gfc_add_omp_groupprivate (symbol_attribute *attr, const char *name, + locus *where) +{ + + if (check_used (attr, name, where)) + return false; + + if (attr->omp_groupprivate) + { + duplicate_attr ("OpenMP GROUPPRIVATE", where); + return false; + } + + attr->omp_groupprivate = true; + return gfc_check_conflict (attr, name, where); +} + + bool gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where) { @@ -1456,6 +1496,22 @@ gfc_add_omp_declare_target_link (symbol_attribute *attr, const char *name, } +bool +gfc_add_omp_declare_target_local (symbol_attribute *attr, const char *name, + locus *where) +{ + + if (check_used (attr, name, where)) + return false; + + if (attr->omp_declare_target_local) + return true; + + attr->omp_declare_target_local = 1; + return gfc_check_conflict (attr, name, where); +} + + bool gfc_add_oacc_declare_create (symbol_attribute *attr, const char *name, locus *where) @@ -2110,6 +2166,9 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where) goto fail; if (src->asynchronous && !gfc_add_asynchronous (dest, NULL, where)) goto fail; + if (src->omp_groupprivate + && !gfc_add_omp_groupprivate (dest, NULL, where)) + goto fail; if (src->threadprivate && !gfc_add_threadprivate (dest, NULL, where)) goto fail; @@ -2119,6 +2178,9 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where) if (src->omp_declare_target_link && !gfc_add_omp_declare_target_link (dest, NULL, where)) goto fail; + if (src->omp_declare_target_local + && !gfc_add_omp_declare_target_local (dest, NULL, where)) + goto fail; if (src->oacc_declare_create && !gfc_add_oacc_declare_create (dest, NULL, where)) goto fail; diff --git a/gcc/fortran/trans-common.cc b/gcc/fortran/trans-common.cc index 135d3047a154..6439a1530c63 100644 --- a/gcc/fortran/trans-common.cc +++ b/gcc/fortran/trans-common.cc @@ -488,6 +488,27 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init) } omp_clauses = c; } + /* Also check trans-decl.cc when updating/removing the following; + also update f95.c's gfc_gnu_attributes. + For the warning, see also OpenMP spec issue 4663. */ + if (com->omp_groupprivate && com->threadprivate) + { + /* Unset this flag; implicit 'declare target local(...)' remains. */ + com->omp_groupprivate = 0; + gfc_warning (OPT_Wopenmp, + "Ignoring the % attribute for " + "% common block % declared at %L", + com->name, &com->where); + } + if (com->omp_groupprivate) + gfc_error ("Sorry, OMP GROUPPRIVATE not implemented, used by common " + "block % declared at %L", com->name, &com->where); + else if (com->omp_declare_target_local) + /* Use 'else if' as groupprivate implies 'local'. */ + gfc_error ("Sorry, OMP DECLARE TARGET with LOCAL clause not implemented" + ", used by common block % declared at %L", + com->name, &com->where); + if (com->omp_declare_target_link) DECL_ATTRIBUTES (decl) = tree_cons (get_identifier ("omp declare target link"), @@ -497,10 +518,12 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init) = tree_cons (get_identifier ("omp declare target"), omp_clauses, DECL_ATTRIBUTES (decl)); - if (com->omp_declare_target_link || com->omp_declare_target) + if (com->omp_declare_target_link || com->omp_declare_target + /* FIXME: || com->omp_declare_target_local */) { - /* Add to offload_vars; get_create does so for omp_declare_target, - omp_declare_target_link requires manual work. */ + /* Add to offload_vars; get_create does so for omp_declare_target + and omp_declare_target_local, omp_declare_target_link requires + manual work. */ gcc_assert (symtab_node::get (decl) == 0); symtab_node *node = symtab_node::get_create (decl); if (node != NULL && com->omp_declare_target_link) @@ -1045,8 +1068,10 @@ accumulate_equivalence_attributes (symbol_attribute *dummy_symbol, gfc_equiv *e) dummy_symbol->generic |= attr.generic; dummy_symbol->automatic |= attr.automatic; dummy_symbol->threadprivate |= attr.threadprivate; + dummy_symbol->omp_groupprivate |= attr.omp_groupprivate; dummy_symbol->omp_declare_target |= attr.omp_declare_target; dummy_symbol->omp_declare_target_link |= attr.omp_declare_target_link; + dummy_symbol->omp_declare_target_local |= attr.omp_declare_target_local; dummy_symbol->oacc_declare_copyin |= attr.oacc_declare_copyin; dummy_symbol->oacc_declare_create |= attr.oacc_declare_create; dummy_symbol->oacc_declare_deviceptr |= attr.oacc_declare_deviceptr; diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 419de2c63cf2..2164b37e4cb2 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -1560,7 +1560,11 @@ add_attributes_to_decl (tree *decl_p, const gfc_symbol *sym) clauses = c; } - if (sym_attr.omp_device_type != OMP_DEVICE_TYPE_UNSET) + /* FIXME: 'declare_target_link' permits both any and host, but + will fail if one sets OMP_CLAUSE_DEVICE_TYPE_KIND. */ + if (sym_attr.omp_device_type != OMP_DEVICE_TYPE_UNSET + && !sym_attr.omp_declare_target_link + && !sym_attr.omp_declare_target_indirect /* implies 'any' */) { tree c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_DEVICE_TYPE); switch (sym_attr.omp_device_type) @@ -1581,6 +1585,26 @@ add_attributes_to_decl (tree *decl_p, const gfc_symbol *sym) clauses = c; } + /* Also check trans-common.cc when updating/removing the following; + also update f95.c's gfc_gnu_attributes. + For the warning, see also OpenMP spec issue 4663. */ + if (sym_attr.omp_groupprivate && sym_attr.threadprivate) + { + /* Unset this flag; implicit 'declare target local(...)' remains. */ + sym_attr.omp_groupprivate = 0; + gfc_warning (OPT_Wopenmp, + "Ignoring the % attribute for " + "% variable %qs declared at %L", + sym->name, &sym->declared_at); + } + if (sym_attr.omp_groupprivate) + gfc_error ("Sorry, OMP GROUPPRIVATE not implemented, " + "used by %qs declared at %L", sym->name, &sym->declared_at); + else if (sym_attr.omp_declare_target_local) + /* Use 'else if' as groupprivate implies 'local'. */ + gfc_error ("Sorry, OMP DECLARE TARGET with LOCAL clause not implemented, " + "used by %qs declared at %L", sym->name, &sym->declared_at); + bool has_declare = true; if (sym_attr.omp_declare_target_link || sym_attr.oacc_declare_link) diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc index 69a70d7138cf..c0a8ed927d9d 100644 --- a/gcc/fortran/trans-openmp.cc +++ b/gcc/fortran/trans-openmp.cc @@ -4180,7 +4180,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, tree type = TREE_TYPE (decl); if (n->sym->ts.type == BT_CHARACTER && n->sym->ts.deferred - && n->sym->attr.omp_declare_target + && (n->sym->attr.omp_declare_target + || n->sym->attr.omp_declare_target_link + || n->sym->attr.omp_declare_target_local) && (always_modifier || n->sym->attr.pointer) && op != EXEC_OMP_TARGET_EXIT_DATA && n->u.map.op != OMP_MAP_DELETE @@ -5263,6 +5265,25 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + if (clauses->dyn_groupprivate) + { + sorry_at (gfc_get_location (&where), "% clause"); +#if 0 /* FIXME: Handle it, including 'fallback(abort/default_mem/null)' */ + tree dyn_groupprivate; + + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->dyn_groupprivate); + gfc_add_block_to_block (block, &se.pre); + dyn_groupprivate = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + + c = build_omp_clause (gfc_get_location (&where), + OMP_CLAUSE_DYN_GROUPPRIVATE); + OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads; + omp_clauses = gfc_trans_add_clause (c, omp_clauses); +#endif + } + chunk_size = NULL_TREE; if (clauses->chunk_size) { diff --git a/gcc/testsuite/gfortran.dg/gomp/crayptr2.f90 b/gcc/testsuite/gfortran.dg/gomp/crayptr2.f90 index 476d7b9e771c..06ac60424e9a 100644 --- a/gcc/testsuite/gfortran.dg/gomp/crayptr2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/crayptr2.f90 @@ -3,7 +3,7 @@ ! { dg-require-effective-target tls } module crayptr2 - integer :: e ! { dg-error "CRAY POINTEE attribute conflicts with THREADPRIVATE" } + integer :: e pointer (ip5, e) ! The standard is not very clear about this. @@ -12,6 +12,6 @@ module crayptr2 ! be if they are module variables. But threadprivate pointees don't ! make any sense anyway. -!$omp threadprivate (e) +!$omp threadprivate (e) ! { dg-error "CRAY POINTEE attribute conflicts with THREADPRIVATE" } end module crayptr2 diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-2.f90 index 93075fb147ea..b4f1e52f7251 100644 --- a/gcc/testsuite/gfortran.dg/gomp/declare-target-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-2.f90 @@ -24,7 +24,11 @@ integer function f2 (a) end interface end subroutine bar + !$omp declare target enter (q) ! { dg-error "isn.t SAVEd" } + !$omp declare target link (r) ! { dg-error "isn.t SAVEd" } + !$omp declare target local (s) ! { dg-error "isn.t SAVEd" } !$omp declare target link (baz) ! { dg-error "isn.t SAVEd" } + integer :: q, r, s call baz ! { dg-error "attribute conflicts" } end subroutine subroutine foo ! { dg-error "attribute conflicts" } diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 index 55534d8fe998..296c0dbd869d 100644 --- a/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 @@ -42,15 +42,14 @@ module mymod !$omp declare target to(a) device_type(nohost) !$omp declare target to(b) device_type(host) !$omp declare target to(c) device_type(any) - ! Fails in ME with "Error: wrong number of arguments specified for 'omp declare target link' attribute" - ! !$omp declare target link(e) device_type(nohost) - ! !$omp declare target link(f) device_type(host) - ! !$omp declare target link(g) device_type(any) + ! !$omp declare target link(e) device_type(nohost) ! -> invalid: only 'any' is permitted + ! !$omp declare target link(f) device_type(host) ! -> invalid: only 'any' is permitted + !$omp declare target link(g) device_type(any) !$omp declare target to(/block1/) device_type(nohost) !$omp declare target to(/block2/) device_type(host) !$omp declare target to(/block3/) device_type(any) - !$omp declare target link(/block4/) device_type(nohost) + ! !$omp declare target link(/block4/) device_type(nohost) ! -> invalid, link requires host or any !$omp declare target link(/block5/) device_type(host) !$omp declare target link(/block6/) device_type(any) contains diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90 index 76687d476d5b..0dacb8952295 100644 --- a/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90 @@ -4,9 +4,15 @@ subroutine foo() subroutine bar() !$omp declare target to(bar) device_type(nohost) - !$omp declare target to(bar) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } + !$omp declare target to(bar) device_type(host) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'nohost'" } end +module invalid + implicit none + integer :: d + !$omp declare target link(d) device_type(nohost) ! { dg-error "set with NOHOST specified may not appear in a LINK clause" } +end module + module mymod_one implicit none integer :: a, b, c, d, e ,f @@ -17,24 +23,21 @@ module mymod_one !$omp declare target to(a) device_type(nohost) !$omp declare target to(b) device_type(any) !$omp declare target to(c) device_type(host) - !$omp declare target link(d) device_type(nohost) !$omp declare target link(e) device_type(any) !$omp declare target link(f) device_type(host) !$omp declare target to(c) device_type(host) - !$omp declare target link(d) device_type(nohost) end module module mtest use mymod_one ! { dg-error "Cannot change attributes of USE-associated symbol" } implicit none - !$omp declare target to(a) device_type(any) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } - !$omp declare target to(b) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } - !$omp declare target to(c) device_type(nohost) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } - !$omp declare target link(d) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } - !$omp declare target link(e) device_type(nohost) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } - !$omp declare target link(f) device_type(any) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } + !$omp declare target to(a) device_type(any) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'nohost'" } + !$omp declare target to(b) device_type(host) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'any'" } + !$omp declare target to(c) device_type(nohost) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" } + !$omp declare target link(e) device_type(host) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'any'" } + !$omp declare target link(f) device_type(any) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" } end module module mymod @@ -47,17 +50,15 @@ module mymod !$omp declare target to(a) device_type(nohost) !$omp declare target to(b) device_type(any) !$omp declare target to(c) device_type(host) - !$omp declare target link(d) device_type(nohost) + !$omp declare target link(d) device_type(nohost) ! { dg-error "set with NOHOST specified may not appear in a LINK clause" } !$omp declare target link(e) device_type(any) !$omp declare target link(f) device_type(host) !$omp declare target to(c) device_type(host) - !$omp declare target link(d) device_type(nohost) - - !$omp declare target to(a) device_type(any) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } - !$omp declare target to(b) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } - !$omp declare target to(c) device_type(nohost) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } - !$omp declare target link(d) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } - !$omp declare target link(e) device_type(nohost) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } - !$omp declare target link(f) device_type(any) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } + + !$omp declare target to(a) device_type(any) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'nohost'" } + !$omp declare target to(b) device_type(host) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'any'" } + !$omp declare target to(c) device_type(nohost) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" } + !$omp declare target link(e) device_type(host) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'any'" } + !$omp declare target link(f) device_type(any) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" } end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-6.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-6.f90 new file mode 100644 index 000000000000..21970e6fbb43 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-6.f90 @@ -0,0 +1,15 @@ +subroutine sub ! { dg-error "SUBROUTINE attribute conflicts with OMP DECLARE TARGET LINK attribute in 'sub'" } + !$omp declare target link(sub) +end subroutine sub + +subroutine sub2 ! { dg-error "SUBROUTINE attribute conflicts with OMP DECLARE TARGET LOCAL attribute in 'sub2'" } + !$omp declare target local(sub2) +end subroutine sub2 + +integer function func() ! { dg-error "PROCEDURE attribute conflicts with OMP DECLARE TARGET LINK attribute in 'func'" } + !$omp declare target link(func) +end + +integer function func2() ! { dg-error "PROCEDURE attribute conflicts with OMP DECLARE TARGET LOCAL attribute in 'func2'" } + !$omp declare target local(func2) +end diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 index f6b3ae178564..4345c69b74bb 100644 --- a/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 @@ -11,7 +11,7 @@ subroutine sub1 subroutine sub2 !$omp declare target indirect (.false.) to (sub2) end subroutine - ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\n.*\\\nvoid sub2" "gimple" } } + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target \\(device_type\\(any\\)\\)\\\)\\\)\\\n.*\\\nvoid sub2" "gimple" } } subroutine sub3 !$omp declare target indirect (.true.) to (sub3) @@ -21,5 +21,5 @@ subroutine sub3 subroutine sub4 !$omp declare target indirect (.false.) enter (sub4) end subroutine - ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\n.*\\\nvoid sub4" "gimple" } } + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target \\(device_type\\(any\\)\\)\\\)\\\)\\\n.*\\\nvoid sub4" "gimple" } } end module diff --git a/gcc/testsuite/gfortran.dg/gomp/dyn_groupprivate-1.f90 b/gcc/testsuite/gfortran.dg/gomp/dyn_groupprivate-1.f90 new file mode 100644 index 000000000000..2e09febe18c2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/dyn_groupprivate-1.f90 @@ -0,0 +1,20 @@ +implicit none + +integer :: N +N = 1024 + +!$omp target dyn_groupprivate(1024) ! { dg-message "sorry, unimplemented: 'dyn_groupprivate' clause" } +!$omp end target + +!$omp target dyn_groupprivate (1024 * N) ! { dg-message "sorry, unimplemented: 'dyn_groupprivate' clause" } +!$omp end target + +!$omp target dyn_groupprivate ( fallback ( abort ) : N) ! { dg-message "sorry, unimplemented: 'dyn_groupprivate' clause" } +!$omp end target + +!$omp target dyn_groupprivate ( fallback ( null ) : N) ! { dg-message "sorry, unimplemented: 'dyn_groupprivate' clause" } +!$omp end target + +!$omp target dyn_groupprivate ( fallback ( default_mem ) : N) ! { dg-message "sorry, unimplemented: 'dyn_groupprivate' clause" } +!$omp end target +end diff --git a/gcc/testsuite/gfortran.dg/gomp/dyn_groupprivate-2.f90 b/gcc/testsuite/gfortran.dg/gomp/dyn_groupprivate-2.f90 new file mode 100644 index 000000000000..0a5a644b9f40 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/dyn_groupprivate-2.f90 @@ -0,0 +1,23 @@ +implicit none + +integer, parameter :: M = 1024 +integer :: N, A(1) + +N = 1024 + +!$omp target dyn_groupprivate(-123) ! { dg-warning "INTEGER expression of DYN_GROUPPRIVATE clause at .1. must be positive \\\[-Wopenmp\\\]" } +block; end block + +!$omp target dyn_groupprivate (0 * M) ! { dg-warning "INTEGER expression of DYN_GROUPPRIVATE clause at .1. must be positive \\\[-Wopenmp\\\]" } +block; end block + +!$omp target dyn_groupprivate ( fallback ( other ) : N) ! { dg-error "Failed to match clause" } +block; end block + +!$omp target dyn_groupprivate ( A ) ! { dg-error "DYN_GROUPPRIVATE clause at .1. requires a scalar INTEGER expression" } +block; end block + +!$omp target dyn_groupprivate ( 1024. ) ! { dg-error "DYN_GROUPPRIVATE clause at .1. requires a scalar INTEGER expression" } +block; end block + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90 b/gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90 new file mode 100644 index 000000000000..f776c0875dd0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90 @@ -0,0 +1,23 @@ +module m + implicit none + integer :: ii + integer :: x, y(20), z, v, u, k ! { dg-warning "Ignoring the 'groupprivate' attribute for 'threadprivate' variable 'k' declared at .1. \\\[-Wopenmp\\\]" } +! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'x' declared at .1." "" { target *-*-* } .-1 } +! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'y' declared at .1." "" { target *-*-* } .-2 } +! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'z' declared at .1." "" { target *-*-* } .-3 } +! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'v' declared at .1." "" { target *-*-* } .-4 } +! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'u' declared at .1." "" { target *-*-* } .-5 } +! +! Note:Error different as 'groupprivate' flag is overwritten by 'threadprivate', cf. warning above. +! { dg-error "Sorry, OMP DECLARE TARGET with LOCAL clause not implemented, used by 'k' declared at .1." "" { target *-*-* } .-8 } + !$omp groupprivate(x, z) device_Type( any ) + !$omp declare target local(x) device_type ( any ) + !$omp declare target enter( ii) ,local(y), device_type ( host ) + !$omp groupprivate(y) device_type( host) + !$omp groupprivate(v) device_type (nohost ) + !$omp groupprivate(u) + + ! See also (currently unresolved) OpenMP Specification Issue 4663. + !$omp groupprivate(k) + !$omp threadprivate(k) +end module diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-2.f90 b/gcc/testsuite/gfortran.dg/gomp/groupprivate-2.f90 new file mode 100644 index 000000000000..922d229bf89f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-2.f90 @@ -0,0 +1,37 @@ +module m + implicit none + integer :: ii + integer :: x, y(20), z, v, q, r,o, b2,c + + !$omp groupprivate(x, z, o) device_Type( any ) + !$omp declare target enter(x) device_type ( any ) ! { dg-error "List item 'x' at .1. not appear in the 'enter' clause as it was previously specified in a GROUPPRIVATE directive" } + !$omp declare target to(z) device_type ( any ) ! { dg-error "List item 'z' at .1. not appear in the 'to' clause as it was previously specified in a GROUPPRIVATE directive" } + !$omp declare target link(o) device_type ( any ) ! { dg-error "List item 'o' at .1. not appear in the 'link' clause as it was previously specified in a GROUPPRIVATE directive" } + !$omp declare target enter( ii) ,local(y,c), link(r), to(q) device_type ( host ) + !$omp groupprivate(r,q) device_type(host) +! { dg-error "List item 'q' at .1. implies OMP DECLARE TARGET with the LOCAL clause, but it has been specified with a different clause before" "" { target *-*-* } .-1 } +! { dg-error "List item 'r' at .1. implies OMP DECLARE TARGET with the LOCAL clause, but it has been specified with a different clause before" "" { target *-*-* } .-2 } + !$omp groupprivate(c) ! { dg-error "List item 'c' at .1. set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" } + !$omp groupprivate(y) device_type( any) ! { dg-error "List item 'y' at .1. set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" } + !$omp groupprivate(v) device_type (nohost ) + !$omp groupprivate(v) ! { dg-error "Duplicate OpenMP GROUPPRIVATE attribute specified" } + + !$omp declare target link(b2) device_type(nohost) ! { dg-error "List item 'b2' at .1. set with NOHOST specified may not appear in a LINK clause" } +end module + +subroutine sub() + implicit none + integer, save :: x0,x1,x2,x3,x4 + !$omp groupprivate(x0) + !$omp groupprivate(x1) + !$omp groupprivate(x2) device_type ( any) + !$omp groupprivate(x3) device_type (host ) + !$omp groupprivate(x4) device_type( nohost) + + !$omp declare target(x0) ! { dg-error "List item 'x0' at .1. not appear in the 'enter' clause as it was previously specified in a GROUPPRIVATE directive" } + !$omp declare target device_type(any) to(x1) ! { dg-error "List item 'x1' at .1. not appear in the 'to' clause as it was previously specified in a GROUPPRIVATE directive" } + !$omp declare target device_type(any) enter(x2) ! { dg-error "List item 'x2' at .1. not appear in the 'enter' clause as it was previously specified in a GROUPPRIVATE directive" } + !$omp declare target device_type(host) link(x3) ! { dg-error "List item 'x3' at .1. not appear in the 'link' clause as it was previously specified in a GROUPPRIVATE directive" } + !$omp declare target device_type(host) local(x4) ! { dg-error "List item 'x4' at .1. set in previous OMP GROUPPRIVATE directive to the different DEVICE_TYPE 'nohost'" } + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-3.f90 b/gcc/testsuite/gfortran.dg/gomp/groupprivate-3.f90 new file mode 100644 index 000000000000..d7ccbe292d5e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-3.f90 @@ -0,0 +1,16 @@ +module m +implicit none +integer :: y = 5 ! { dg-error "!.OMP GROUPPRIVATE variable 'y' at .1. must not have an initializer" } +!$omp groupprivate(y) +end + +subroutine sub + integer :: k ! { dg-error "OpenMP groupprivate variable 'k' at .1. must have the SAVE attribute" } + !$omp groupprivate(k) +end + +subroutine sub2 + !$omp groupprivate(q) + integer, save :: q + !$omp groupprivate(q) ! { dg-error "Duplicate OpenMP GROUPPRIVATE attribute specified at .1." } +end diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90 new file mode 100644 index 000000000000..2a3a054483e8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90 @@ -0,0 +1,25 @@ +module m + implicit none + integer :: ii + integer :: x, y(20), z, v, u, k + + common /b_ii/ ii + common /b_x/ x ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_x/' declared at .1." } + common /b_y/ y ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_y/' declared at .1." } + common /b_z/ z ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_z/' declared at .1." } + common /b_v/ v ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_v/' declared at .1." } + common /b_u/ u ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_u/' declared at .1." } + common /b_k/ k ! { dg-warning "Ignoring the 'groupprivate' attribute for 'threadprivate' common block '/b_k/' declared at .1. \\\[-Wopenmp\\\]" } +! { dg-error "Sorry, OMP DECLARE TARGET with LOCAL clause not implemented, used by common block '/b_k/' declared at .1." "" { target *-*-* } .-1 } + + !$omp groupprivate(/b_x/, /b_z/) device_Type( any ) + !$omp declare target local(/b_x/) device_type ( any ) + !$omp declare target enter( /b_ii/) ,local(/b_y/), device_type ( host ) + !$omp groupprivate(/b_y/) device_type( host) + !$omp groupprivate(/b_v/) device_type (nohost ) + !$omp groupprivate(/b_u/) + + ! See also (currently unresolved) OpenMP Specification Issue 4663. + !$omp groupprivate(/b_k/) + !$omp threadprivate(/b_k/) +end module diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-5.f90 b/gcc/testsuite/gfortran.dg/gomp/groupprivate-5.f90 new file mode 100644 index 000000000000..c9f89feb4aa5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-5.f90 @@ -0,0 +1,58 @@ +module m + implicit none + integer :: ii + integer :: x, y(20), z, v, q, r,o, b2,c + + common /b_ii/ ii + common /b_x/ x + common /b_y/ y + common /b_z/ z + common /b_v/ v + common /b_q/ q + common /b_r/ r + common /b_o/ o + common /b_b2/ b2 + common /b_c/ c + + !$omp groupprivate(/b_x/, /b_z/, /b_o/) device_Type( any ) + !$omp declare target enter(/b_x/) device_type ( any ) ! { dg-error "Common block '/b_x/' at .1. not appear in the 'enter' clause as it was previously specified in a GROUPPRIVATE directive" } + !$omp declare target to(/b_z/) device_type ( any ) ! { dg-error "Common block '/b_z/' at .1. not appear in the 'to' clause as it was previously specified in a GROUPPRIVATE directive" } + !$omp declare target link(/b_o/) device_type ( any ) ! { dg-error "Common block '/b_o/' at .1. not appear in the 'link' clause as it was previously specified in a GROUPPRIVATE directive" } + !$omp declare target enter( / b_ii / ) ,local(/b_y/ , /b_c/), link(/b_r/), to(/b_q/) device_type ( host ) + !$omp groupprivate( /b_r/ ,/b_q/) device_type(host) +! { dg-error "List item '/b_r/' at .1. implies OMP DECLARE TARGET with the LOCAL clause, but it has been specified with a different clause before" "" { target *-*-* } .-1 } +! { dg-error "List item '/b_q/' at .1. implies OMP DECLARE TARGET with the LOCAL clause, but it has been specified with a different clause before" "" { target *-*-* } .-2 } + !$omp groupprivate(/b_c/) ! { dg-error "List item 'b_c' at .1. set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" } + !$omp groupprivate(/b_y/) device_type( any) ! { dg-error "List item 'b_y' at .1. set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" } + !$omp groupprivate(/b_v/) device_type (nohost ) + !$omp groupprivate(/b_v/) ! { dg-error "Duplicate OpenMP GROUPPRIVATE attribute specified at .1." } + + !$omp declare target link(/b_b2/) device_type(nohost) ! { dg-error "Common block '/b_b2/' at .1. set with NOHOST specified may not appear in a LINK clause" } +end module + +subroutine sub() + implicit none + integer, save :: xx + integer :: x0,x1,x2,x3,x4 + + common /b_xx/ xx ! { dg-error "COMMON attribute conflicts with SAVE attribute in 'xx' at .1." } + common /b_x0/ x0 + common /b_x1/ x1 + common /b_x2/ x2 + common /b_x3/ x3 + common /b_x4/ x4 + + !$omp groupprivate(/b_xx/) ! { dg-error "COMMON attribute conflicts with SAVE attribute in 'xx' at .1." } + !$omp groupprivate(/b_x0/) + !$omp groupprivate(/b_x1/) + !$omp groupprivate(/b_x2/) device_type ( any) + !$omp groupprivate(/b_x3/) device_type (host ) + !$omp groupprivate(/b_x4/) device_type( nohost) + + !$omp declare target(/b_x0/) ! { dg-error "Common block '/b_x0/' at .1. not appear in the 'enter' clause as it was previously specified in a GROUPPRIVATE directive" } + !$omp declare target device_type(any) to(/b_x1/) ! { dg-error "Common block '/b_x1/' at .1. not appear in the 'to' clause as it was previously specified in a GROUPPRIVATE directive" } + !$omp declare target device_type(any) enter(/b_x2/) ! { dg-error "Common block '/b_x2/' at .1. not appear in the 'enter' clause as it was previously specified in a GROUPPRIVATE directive" } + !$omp declare target device_type(host) link(/b_x3/) ! { dg-error "Common block '/b_x3/' at .1. not appear in the 'link' clause as it was previously specified in a GROUPPRIVATE directive" } + !$omp declare target device_type(host) local(/b_x4/) ! { dg-error "Common block '/b_x4/' at .1. set in previous OMP GROUPPRIVATE directive to the different DEVICE_TYPE 'nohost'" } + +end diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/groupprivate-6.f90 new file mode 100644 index 000000000000..6ae5b3dc59b1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-6.f90 @@ -0,0 +1,34 @@ +module m +implicit none +integer :: y = 5 ! { dg-error "!.OMP GROUPPRIVATE variable 'y' at .1. must not have an initializer" } +common /b_y/ y +!$omp groupprivate(/b_y/) +end + +subroutine sub + integer, save :: k + common /b_k/ k ! { dg-error "COMMON attribute conflicts with SAVE attribute in 'k' at .1." } + !$omp groupprivate(/b_k/) ! { dg-error "COMMON attribute conflicts with SAVE attribute in 'k' at .1." } +end + +subroutine sub2 + common /b_q/ q + !$omp groupprivate(/b_q/) + integer :: q + !$omp groupprivate(/b_q/) ! { dg-error "Duplicate OpenMP GROUPPRIVATE attribute specified at .1." } +end + +subroutine dupl + integer :: a,b,c,d + integer :: u,v,w,x + common /b_a/ a + common /b_b/ b + common /b_c/ c + common /b_d/ d + + !$omp groupprivate(/b_a/,u,/b_a/) ! { dg-error "Duplicate OpenMP GROUPPRIVATE attribute specified" } + !$omp groupprivate(v,/b_b/,v) ! { dg-error "Duplicate OpenMP GROUPPRIVATE attribute specified" } + + !$omp threadprivate(/b_a/,u,/b_a/) ! { dg-error "Duplicate THREADPRIVATE attribute specified" } + !$omp threadprivate(v,/b_b/,v) ! { dg-error "Duplicate THREADPRIVATE attribute specified" } +end From edb025aebf799d539d9a0f56993f3cc48f9beb5b Mon Sep 17 00:00:00 2001 From: Jeff Law Date: Wed, 26 Nov 2025 14:52:11 -0700 Subject: [PATCH 046/373] [RISC-V][PR rtl-optimization/122735] Avoid bogus calls to simplify_subreg Recent changes to simplify_binary_operation_1 reassociate a SUBREG expression in useful ways. But they fail to account for the asserts at the beginning of simplify_subreg. In particular simplify_subreg asserts that the mode can not be VOID or BLK -- the former being the problem here as it's used on CONST_INT nodes which may appear in an unsimplified REG_EQUAL note like: > (sign_extend:DI (lshiftrt:SI (const_int 19 [0x13]) > (subreg:QI (reg:SI 144 [ _2 ]) 0))) The extension will get canoncialized and simplified by expand_compound_operation resulting in a call to simplify_binary_operation where op0 is: > (subreg:DI (lshiftrt:SI (const_int 19 [0x13]) > (const_int 32 [0x20])) 0) That triggers the new code in simplify-rtx to push the subreg into an inner object. In particular it'll try to push the subreg to the first operand of the LSHIFTRT. We pass that to simplify_subreg via simplify_gen_subreg and boom! You could legitimately ask why the original note wasn't simplified further or removed. That approach could certainly be used to fix this specific problem. But we've never had that kind of requirement on REG_EQUAL notes and I think it opens up a huge can of worms if we impose it now. So I chose to make the newer simplify-rtx code more robust. Bootstrapped and regression tested on x86_64 and riscv and tested on the various embedded targets without regressions. I'll wait for the pre-commit CI tester before committing. PR rtl-optimization/122735 gcc/ * simplify-rtx.cc (simplify_binary_operation_1): When moving a SUBREG from an outer expression to an inner operand, make sure to avoid trying to create invalid SUBREGs. gcc/testsuite/ * gcc.dg/torture/pr122735.c: New test. --- gcc/simplify-rtx.cc | 7 +++++++ gcc/testsuite/gcc.dg/torture/pr122735.c | 7 +++++++ 2 files changed, 14 insertions(+) create mode 100644 gcc/testsuite/gcc.dg/torture/pr122735.c diff --git a/gcc/simplify-rtx.cc b/gcc/simplify-rtx.cc index 86baeb06ad48..3aaabdc9b055 100644 --- a/gcc/simplify-rtx.cc +++ b/gcc/simplify-rtx.cc @@ -4193,6 +4193,13 @@ simplify_context::simplify_binary_operation_1 (rtx_code code, and no precision is lost. */ if (SUBREG_P (op0) && subreg_lowpart_p (op0) && GET_CODE (XEXP (op0, 0)) == LSHIFTRT + /* simplify_subreg asserts the object being accessed is not + VOIDmode or BLKmode. We may have a REG_EQUAL note which + is not simplified and the source operand is a constant, + and thus VOIDmode. Guard against that. */ + && GET_MODE (XEXP (XEXP (op0, 0), 0)) != VOIDmode + && GET_MODE (XEXP (XEXP (op0, 0), 0)) != BLKmode + && !CONST_INT_P (XEXP (XEXP (op0, 0), 0)) && CONST_INT_P (XEXP (XEXP (op0, 0), 1)) && INTVAL (XEXP (XEXP (op0, 0), 1)) >= 0 && INTVAL (XEXP (XEXP (op0, 0), 1)) < HOST_BITS_PER_WIDE_INT diff --git a/gcc/testsuite/gcc.dg/torture/pr122735.c b/gcc/testsuite/gcc.dg/torture/pr122735.c new file mode 100644 index 000000000000..9499ce4607b0 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr122735.c @@ -0,0 +1,7 @@ +/* { dg-do compile } */ +int a; +void b() { + int c; + unsigned d = c + 19; + a = d >> 32 + 19 + d + 255 - 293; +} From b11ae5fb5efcf9e0977cd54538765e1d40b1b107 Mon Sep 17 00:00:00 2001 From: Tamar Christina Date: Wed, 26 Nov 2025 22:00:07 +0000 Subject: [PATCH 047/373] middle-end: guard against non-single use compares in emit_cmp_and_jump_insns When I wrote this optimization my patch stack included a change in tree-out-of-ssa that would duplicate the compares such that the use is always single use and get_gimple_for_ssa_name would always succeed. However I have dropped that for GCC 16 since I didn't expect the vectorizer to be able to produce duplicate uses of the same compare results. But I neglected that you can get it by other means. So this simply checks that get_gimple_for_ssa_name succeeds for the LEN cases. The non-LEN cases already check it earlier on. To still get the optimization in this case the tree-out-of-ssa change is needed, which is staged for next stage-1. gcc/ChangeLog: * optabs.cc (emit_cmp_and_jump_insns): Check for non-single use. --- gcc/optabs.cc | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gcc/optabs.cc b/gcc/optabs.cc index 9882aac0ba9a..0f1495545a49 100644 --- a/gcc/optabs.cc +++ b/gcc/optabs.cc @@ -4895,7 +4895,8 @@ emit_cmp_and_jump_insns (rtx x, rtx y, enum rtx_code comparison, rtx size, } enum insn_code icode; - if (is_gimple_assign (def_stmt) + if (def_stmt + && is_gimple_assign (def_stmt) && TREE_CODE_CLASS (gimple_assign_rhs_code (def_stmt)) == tcc_comparison) { From acbe4fd145a2d6f5537553a43ec67dfd46739438 Mon Sep 17 00:00:00 2001 From: Alejandro Colomar Date: Wed, 26 Nov 2025 01:12:49 +0100 Subject: [PATCH 048/373] c: Add _Maxof and _Minof operators Link: These operators have not yet been accepted by the C Committee, so this is implemented as a GNU extension. gcc/ChangeLog: * doc/extend.texi (Syntax Extensions): Document _Maxof & _Minof. gcc/c-family/ChangeLog: * c-common.cc (c_common_reswords): Add _Maxof & _Minof keywords. (c_maxof_type, c_minof_type): New functions. * c-common.def (MAXOF_EXPR, MINOF_EXPR): New trees. * c-common.h (enum rid): Add RID_MAXOF & RID_MINOF constants. (c_maxof_type, c_minof_type): New prototypes. gcc/c/ChangeLog: * c-parser.cc (c_parser_maxof_or_minof_expression): New func. (c_parser_unary_expression): Add RID_MAXOF & RID_MINOF cases. * c-tree.h (c_expr_maxof_type): New prototype. (c_expr_minof_type): New prototype. * c-typeck.cc (c_expr_maxof_type): New function. (c_expr_minof_type): New function. gcc/testsuite/ChangeLog: * gcc.dg/maxof-bitint.c: New test. * gcc.dg/maxof-bitint575.c: New test. * gcc.dg/maxof-compile.c: New test. * gcc.dg/maxof-pedantic-errors.c: New test. * gcc.dg/maxof-pedantic.c: New test. Signed-off-by: Alejandro Colomar --- gcc/c-family/c-common.cc | 44 ++++++ gcc/c-family/c-common.def | 6 + gcc/c-family/c-common.h | 4 +- gcc/c/c-parser.cc | 67 ++++++++ gcc/c/c-tree.h | 2 + gcc/c/c-typeck.cc | 54 +++++++ gcc/doc/extend.texi | 20 +++ gcc/testsuite/gcc.dg/maxof-bitint.c | 20 +++ gcc/testsuite/gcc.dg/maxof-bitint575.c | 39 +++++ gcc/testsuite/gcc.dg/maxof-compile.c | 158 +++++++++++++++++++ gcc/testsuite/gcc.dg/maxof-pedantic-errors.c | 5 + gcc/testsuite/gcc.dg/maxof-pedantic.c | 5 + 12 files changed, 423 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gcc.dg/maxof-bitint.c create mode 100644 gcc/testsuite/gcc.dg/maxof-bitint575.c create mode 100644 gcc/testsuite/gcc.dg/maxof-compile.c create mode 100644 gcc/testsuite/gcc.dg/maxof-pedantic-errors.c create mode 100644 gcc/testsuite/gcc.dg/maxof-pedantic.c diff --git a/gcc/c-family/c-common.cc b/gcc/c-family/c-common.cc index ef1ce62068dd..3cec729c901c 100644 --- a/gcc/c-family/c-common.cc +++ b/gcc/c-family/c-common.cc @@ -397,6 +397,8 @@ const struct c_common_resword c_common_reswords[] = { "_Alignas", RID_ALIGNAS, D_CONLY }, { "_Alignof", RID_ALIGNOF, D_CONLY }, { "_Countof", RID_COUNTOF, D_CONLY }, + { "_Maxof", RID_MAXOF, D_CONLY }, + { "_Minof", RID_MINOF, D_CONLY }, { "_Atomic", RID_ATOMIC, D_CONLY }, { "_BitInt", RID_BITINT, D_CONLY }, { "_Bool", RID_BOOL, D_CONLY }, @@ -4164,6 +4166,48 @@ c_countof_type (location_t loc, tree type) return value; } +/* Implement the _Maxof operator: + Return the maximum representable value of an integer type. */ + +tree +c_maxof_type (location_t loc, tree type) +{ + if (!INTEGRAL_TYPE_P (type)) + { + error_at (loc, "invalid application of %<_Maxof%> to type %qT", type); + return error_mark_node; + } + if (!COMPLETE_TYPE_P (type)) + { + error_at (loc, "invalid application of %<_Maxof%> to incomplete type %qT", + type); + return error_mark_node; + } + + return TYPE_MAX_VALUE (type); +} + +/* Implement the _Minof operator: + Return the minimum representable value of an integer type. */ + +tree +c_minof_type (location_t loc, tree type) +{ + if (!INTEGRAL_TYPE_P (type)) + { + error_at (loc, "invalid application of %<_Minof%> to type %qT", type); + return error_mark_node; + } + if (!COMPLETE_TYPE_P (type)) + { + error_at (loc, "invalid application of %<_Minof%> to incomplete type %qT", + type); + return error_mark_node; + } + + return TYPE_MIN_VALUE (type); +} + /* Handle C and C++ default attributes. */ enum built_in_attribute diff --git a/gcc/c-family/c-common.def b/gcc/c-family/c-common.def index 0bcc4998afe6..9b1f034579b7 100644 --- a/gcc/c-family/c-common.def +++ b/gcc/c-family/c-common.def @@ -53,6 +53,12 @@ DEFTREECODE (USERDEF_LITERAL, "userdef_literal", tcc_exceptional, 3) /* Represents a 'countof' expression. */ DEFTREECODE (COUNTOF_EXPR, "countof_expr", tcc_expression, 1) +/* Represents a 'maxof' expression. */ +DEFTREECODE (MAXOF_EXPR, "maxof_expr", tcc_expression, 1) + +/* Represents a 'minof' expression. */ +DEFTREECODE (MINOF_EXPR, "minof_expr", tcc_expression, 1) + /* Represents a 'sizeof' expression during C++ template expansion, or for the purpose of -Wsizeof-pointer-memaccess warning. */ DEFTREECODE (SIZEOF_EXPR, "sizeof_expr", tcc_expression, 1) diff --git a/gcc/c-family/c-common.h b/gcc/c-family/c-common.h index 8b7f4ae44717..6a92bd6ef762 100644 --- a/gcc/c-family/c-common.h +++ b/gcc/c-family/c-common.h @@ -105,7 +105,7 @@ enum rid /* C extensions */ RID_ASM, RID_TYPEOF, RID_TYPEOF_UNQUAL, RID_ALIGNOF, RID_ATTRIBUTE, - RID_COUNTOF, + RID_COUNTOF, RID_MAXOF, RID_MINOF, RID_C23_VA_START, RID_VA_ARG, RID_EXTENSION, RID_IMAGPART, RID_REALPART, RID_LABEL, RID_CHOOSE_EXPR, RID_TYPES_COMPATIBLE_P, RID_BUILTIN_COMPLEX, RID_BUILTIN_SHUFFLE, @@ -893,6 +893,8 @@ extern void c_apply_type_quals_to_decl (int, tree); extern tree c_sizeof_or_alignof_type (location_t, tree, bool, bool, int); extern tree c_alignof_expr (location_t, tree); extern tree c_countof_type (location_t, tree); +extern tree c_maxof_type (location_t, tree); +extern tree c_minof_type (location_t, tree); /* Print an error message for invalid operands to arith operation CODE. NOP_EXPR is used as a special case (see truthvalue_conversion). */ extern void binary_op_error (rich_location *, enum tree_code, tree, tree); diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc index aa7b50c8a234..b4dc741c6fd4 100644 --- a/gcc/c/c-parser.cc +++ b/gcc/c/c-parser.cc @@ -1865,6 +1865,7 @@ static struct c_expr c_parser_unary_expression (c_parser *); static struct c_expr c_parser_sizeof_or_countof_expression (c_parser *, enum rid); static struct c_expr c_parser_alignof_expression (c_parser *); +static struct c_expr c_parser_maxof_or_minof_expression (c_parser *, enum rid); static struct c_expr c_parser_postfix_expression (c_parser *); static struct c_expr c_parser_postfix_expression_after_paren_type (c_parser *, struct c_declspecs *, @@ -10642,6 +10643,8 @@ c_parser_cast_expression (c_parser *parser, struct c_expr *after) unary-expression: __alignof__ unary-expression __alignof__ ( type-name ) + _Maxof ( type-name ) + _Minof ( type-name ) && identifier (C11 permits _Alignof with type names only.) @@ -10774,6 +10777,9 @@ c_parser_unary_expression (c_parser *parser) return c_parser_sizeof_or_countof_expression (parser, rid); case RID_ALIGNOF: return c_parser_alignof_expression (parser); + case RID_MAXOF: + case RID_MINOF: + return c_parser_maxof_or_minof_expression (parser, rid); case RID_BUILTIN_HAS_ATTRIBUTE: return c_parser_has_attribute_expression (parser); case RID_EXTENSION: @@ -11017,6 +11023,67 @@ c_parser_alignof_expression (c_parser *parser) } } +/* Parse a _Maxof or _Minof expression. */ + +static struct c_expr +c_parser_maxof_or_minof_expression (c_parser *parser, enum rid rid) +{ + const char *op_name = (rid == RID_MAXOF) ? "_Maxof" : "_Minof"; + struct c_expr result; + location_t expr_loc; + struct c_type_name *type_name; + matching_parens parens; + gcc_assert (c_parser_next_token_is_keyword (parser, rid)); + + location_t start; + location_t finish = UNKNOWN_LOCATION; + + start = c_parser_peek_token (parser)->location; + + pedwarn (start, OPT_Wpedantic, "ISO C does not support %qs", op_name); + + c_parser_consume_token (parser); + c_inhibit_evaluation_warnings++; + if (!c_parser_next_token_is (parser, CPP_OPEN_PAREN)) + { + c_parser_error (parser, "expected %<(%>"); + goto fail; + } + parens.consume_open (parser); + expr_loc = c_parser_peek_token (parser)->location; + if (!c_token_starts_typename (c_parser_peek_token (parser))) + { + error_at (expr_loc, "invalid application of %qs to something not a type", op_name); + parens.skip_until_found_close (parser); + goto fail; + } + type_name = c_parser_type_name (parser, true); + if (type_name == NULL) + { + // c_parser_type_name() has already diagnosed the error. + parens.skip_until_found_close (parser); + goto fail; + } + parens.skip_until_found_close (parser); + finish = parser->tokens_buf[0].location; + if (type_name->specs->alignas_p) + error_at (type_name->specs->locations[cdw_alignas], + "alignment specified for type name in %qs", op_name); + c_inhibit_evaluation_warnings--; + if (rid == RID_MAXOF) + result = c_expr_maxof_type (expr_loc, type_name); + else + result = c_expr_minof_type (expr_loc, type_name); + set_c_expr_source_range (&result, start, finish); + return result; +fail: + c_inhibit_evaluation_warnings--; + result.set_error (); + result.original_code = ERROR_MARK; + result.original_type = NULL; + return result; +} + /* Parse the __builtin_has_attribute ([expr|type], attribute-spec) expression. */ diff --git a/gcc/c/c-tree.h b/gcc/c/c-tree.h index ff63d69e85d5..80b147154032 100644 --- a/gcc/c/c-tree.h +++ b/gcc/c/c-tree.h @@ -856,6 +856,8 @@ extern struct c_expr c_expr_sizeof_type (location_t, struct c_type_name *); extern struct c_expr c_expr_countof_expr (location_t, struct c_expr); extern struct c_expr c_expr_countof_type (location_t loc, struct c_type_name *); +extern struct c_expr c_expr_maxof_type (location_t loc, struct c_type_name *); +extern struct c_expr c_expr_minof_type (location_t loc, struct c_type_name *); extern struct c_expr parser_build_unary_op (location_t, enum tree_code, struct c_expr); extern struct c_expr parser_build_binary_op (location_t, diff --git a/gcc/c/c-typeck.cc b/gcc/c/c-typeck.cc index e1d2d1173dc7..7eb413885b87 100644 --- a/gcc/c/c-typeck.cc +++ b/gcc/c/c-typeck.cc @@ -4120,6 +4120,60 @@ c_expr_countof_type (location_t loc, struct c_type_name *t) return ret; } +/* Return the result of maxof applied to T, a structure for the type + name passed to maxof (rather than the type itself). LOC is the + location of the original expression. */ + +struct c_expr +c_expr_maxof_type (location_t loc, struct c_type_name *t) +{ + tree type; + struct c_expr ret; + tree type_expr = NULL_TREE; + bool type_expr_const = true; + type = groktypename (t, &type_expr, &type_expr_const); + ret.value = c_maxof_type (loc, type); + c_last_sizeof_arg = type; + c_last_sizeof_loc = loc; + ret.original_code = MAXOF_EXPR; + ret.original_type = NULL; + ret.m_decimal = 0; + if (type == error_mark_node) + { + ret.value = error_mark_node; + ret.original_code = ERROR_MARK; + } + pop_maybe_used (type != error_mark_node); + return ret; +} + +/* Return the result of minof applied to T, a structure for the type + name passed to minof (rather than the type itself). LOC is the + location of the original expression. */ + +struct c_expr +c_expr_minof_type (location_t loc, struct c_type_name *t) +{ + tree type; + struct c_expr ret; + tree type_expr = NULL_TREE; + bool type_expr_const = true; + type = groktypename (t, &type_expr, &type_expr_const); + ret.value = c_minof_type (loc, type); + c_last_sizeof_arg = type; + c_last_sizeof_loc = loc; + ret.original_code = MINOF_EXPR; + ret.original_type = NULL; + ret.m_decimal = 0; + if (type == error_mark_node) + { + ret.value = error_mark_node; + ret.original_code = ERROR_MARK; + } + pop_maybe_used (type != error_mark_node); + return ret; +} + /* Build a function call to function FUNCTION with parameters PARAMS. The function call is at LOC. PARAMS is a list--a chain of TREE_LIST nodes--in which the diff --git a/gcc/doc/extend.texi b/gcc/doc/extend.texi index b9d1a6aac75a..cc414313884b 100644 --- a/gcc/doc/extend.texi +++ b/gcc/doc/extend.texi @@ -13567,6 +13567,7 @@ C and/or C++ standards, while others remain specific to GNU C. * Nested Functions:: Nested functions in GNU C. * Typeof:: @code{typeof}: referring to the type of an expression. * _Countof:: Determining the number of elements of arrays +* _Maxof and _Minof:: The maximum and minimum representable values of a type. * Offsetof:: Special syntax for @code{offsetof}. * Alignment:: Determining the alignment of a function, type or variable. * Enum Extensions:: Forward declarations and specifying the underlying type. @@ -14233,6 +14234,25 @@ _Countof (int [7][n++]); // integer constant expression _Countof (int [n++][7]); // run-time value; n++ is evaluated @end smallexample +@node _Maxof and _Minof +@subsection The maximum and minimum representable values of a type +@findex _Maxof +@findex _Minof + +The keywords @code{_Maxof} and @code{_Minof} determine +the maximum and minimum representable values of an integer type. +Their syntax is similar to @code{sizeof}. +The operand must be +a parenthesized integer type. +The result of these operators is an integer constant expression +of the same type as the operand. +For example: + +@smallexample +_Maxof (int); // returns '(int) INT_MAX' +_Minof (short); // returns '(short) SHRT_MIN' +@end smallexample + @node Offsetof @subsection Support for @code{offsetof} @findex __builtin_offsetof diff --git a/gcc/testsuite/gcc.dg/maxof-bitint.c b/gcc/testsuite/gcc.dg/maxof-bitint.c new file mode 100644 index 000000000000..647909c97aaa --- /dev/null +++ b/gcc/testsuite/gcc.dg/maxof-bitint.c @@ -0,0 +1,20 @@ +/* { dg-do compile { target bitint } } */ +/* { dg-options "-std=gnu2y" } */ + +void +limits (void) +{ + _Static_assert (_Maxof (_BitInt (5)) == 15); + _Static_assert (_Minof (_BitInt (5)) == -16); + _Static_assert (_Maxof (unsigned _BitInt (5)) == 31); + _Static_assert (_Minof (unsigned _BitInt (5)) == 0); +} + +void +type (void) +{ + _Generic (_Maxof (_BitInt (5)), _BitInt (5): 0); + _Generic (_Minof (_BitInt (5)), _BitInt (5): 0); + _Generic (_Maxof (unsigned _BitInt (5)), unsigned _BitInt (5): 0); + _Generic (_Minof (unsigned _BitInt (5)), unsigned _BitInt (5): 0); +} diff --git a/gcc/testsuite/gcc.dg/maxof-bitint575.c b/gcc/testsuite/gcc.dg/maxof-bitint575.c new file mode 100644 index 000000000000..f43951a51f06 --- /dev/null +++ b/gcc/testsuite/gcc.dg/maxof-bitint575.c @@ -0,0 +1,39 @@ +/* { dg-do run { target bitint575 } } */ +/* { dg-options "-std=gnu2y" } */ + +#define assert(e) ((e) ? (void) 0 : __builtin_abort ()) + +void limits (void); + +int +main (void) +{ + limits (); +} + +void +limits (void) +{ + unsigned _BitInt (500) u; + _BitInt (500) i; + + u = 0; + u--; + + assert (_Maxof (unsigned _BitInt (500)) == u); + assert (_Minof (unsigned _BitInt (500)) == 0); + + i = u >> 1; + + assert (_Maxof (_BitInt (500)) == i); + assert (_Minof (_BitInt (500)) == -i-1); +} + +void +type (void) +{ + _Generic (_Maxof (_BitInt (500)), _BitInt (500): 0); + _Generic (_Minof (_BitInt (500)), _BitInt (500): 0); + _Generic (_Maxof (unsigned _BitInt (500)), unsigned _BitInt (500): 0); + _Generic (_Minof (unsigned _BitInt (500)), unsigned _BitInt (500): 0); +} diff --git a/gcc/testsuite/gcc.dg/maxof-compile.c b/gcc/testsuite/gcc.dg/maxof-compile.c new file mode 100644 index 000000000000..098cade1426f --- /dev/null +++ b/gcc/testsuite/gcc.dg/maxof-compile.c @@ -0,0 +1,158 @@ +/* { dg-do compile } */ +/* { dg-options "-std=gnu2y" } */ + +#define SCHAR_MAX __SCHAR_MAX__ +#define SCHAR_MIN (-SCHAR_MAX - 1) +#define UCHAR_MAX (SCHAR_MAX * 2 + 1) + +#define SHRT_MAX __SHRT_MAX__ +#define SHRT_MIN (-SHRT_MAX - 1) +#define USHRT_MAX (SHRT_MAX * 2U + 1) + +#define INT_MAX __INT_MAX__ +#define INT_MIN (-INT_MAX - 1) +#define UINT_MAX (INT_MAX * 2U + 1) + +#define LONG_MAX __LONG_MAX__ +#define LONG_MIN (-LONG_MAX - 1L) +#define ULONG_MAX (LONG_MAX * 2LU + 1) + +void +integer (void) +{ + _Static_assert (_Maxof (char) == SCHAR_MAX || _Maxof (char) == UCHAR_MAX); + _Static_assert (_Minof (char) == SCHAR_MIN || _Minof (char) == 0); + + _Static_assert (_Maxof (signed char) == SCHAR_MAX); + _Static_assert (_Maxof (short) == SHRT_MAX); + _Static_assert (_Maxof (int) == INT_MAX); + _Static_assert (_Maxof (long) == LONG_MAX); + _Static_assert (_Maxof (long long) >= LONG_MAX); + + _Static_assert (_Minof (signed char) == SCHAR_MIN); + _Static_assert (_Minof (short) == SHRT_MIN); + _Static_assert (_Minof (int) == INT_MIN); + _Static_assert (_Minof (long) == LONG_MIN); + _Static_assert (_Minof (long long) <= LONG_MIN); + + _Static_assert (_Maxof (unsigned char) == UCHAR_MAX); + _Static_assert (_Maxof (unsigned short) == USHRT_MAX); + _Static_assert (_Maxof (unsigned int) == UINT_MAX); + _Static_assert (_Maxof (unsigned long) == ULONG_MAX); + _Static_assert (_Maxof (unsigned long long) >= ULONG_MAX); + + _Static_assert (_Minof (unsigned char) == 0); + _Static_assert (_Minof (unsigned short) == 0); + _Static_assert (_Minof (unsigned int) == 0); + _Static_assert (_Minof (unsigned long) == 0); + _Static_assert (_Minof (unsigned long long) == 0); + + _Static_assert (_Maxof (bool) == true); + _Static_assert (_Minof (bool) == false); +} + +void +enums (void) +{ + enum e1 { E1 }; + enum e2 : short { E2 }; + + _Maxof (enum e1); + _Minof (enum e1); + _Static_assert (_Maxof (enum e2) == SHRT_MAX); + _Static_assert (_Minof (enum e2) == SHRT_MIN); +} + +void +expr (void) +{ + int x; + + _Maxof (x); /* { dg-error "to something not a type" } */ + /* { dg-error "expected '\\)'" "syntax error" { target *-*-* } .-1 } */ + _Minof (x); /* { dg-error "to something not a type" } */ + /* { dg-error "expected '\\)'" "syntax error" { target *-*-* } .-1 } */ + _Maxof (1); /* { dg-error "to something not a type" } */ + /* { dg-error "expected '\\)'" "syntax error" { target *-*-* } .-1 } */ + _Minof (1); /* { dg-error "to something not a type" } */ + /* { dg-error "expected '\\)'" "syntax error" { target *-*-* } .-1 } */ + _Maxof 1; /* { dg-error "expected '\\('" } */ + _Minof 1; /* { dg-error "expected '\\('" } */ + _Maxof (int) {1}; /* { dg-error "expected ';'" } */ + _Minof (int) {1}; /* { dg-error "expected ';'" } */ +} + +void +incomplete (void) +{ + _Maxof (enum e); /* { dg-error "to incomplete type" } */ + _Minof (enum e); /* { dg-error "to incomplete type" } */ +} + +void +non_int (void) +{ + struct s {int x;}; + union u {int x;}; + + _Maxof (struct s); /* { dg-error "to type" } */ + _Minof (struct s); /* { dg-error "to type" } */ + _Maxof (union u); /* { dg-error "to type" } */ + _Minof (union u); /* { dg-error "to type" } */ + _Maxof (int [1]); /* { dg-error "to type" } */ + _Minof (int [1]); /* { dg-error "to type" } */ +} + +void +specs (void) +{ + _Maxof (static int); /* { dg-error "to something not a type" } */ + /* { dg-error "expected '\\)'" "syntax error" { target *-*-* } .-1 } */ + _Minof (static int); /* { dg-error "to something not a type" } */ + /* { dg-error "expected '\\)'" "syntax error" { target *-*-* } .-1 } */ + _Maxof (alignas(8) int); /* { dg-error "alignment specified" } */ + _Minof (alignas(8) int); /* { dg-error "alignment specified" } */ +} + +void +bogus (void) +{ + _Maxof (int x); /* { dg-error "expected '\\)'" } */ + _Minof (int x); /* { dg-error "expected '\\)'" } */ + _Maxof (int (!)); /* { dg-error "expected '\\)'" } */ + _Minof (int (!)); /* { dg-error "expected '\\)'" } */ +} + +void +type (void) +{ + _Generic (_Maxof (char), char: 0); + _Generic (_Minof (char), char: 0); + + _Generic (_Maxof (signed char), signed char: 0); + _Generic (_Maxof (short), short: 0); + _Generic (_Maxof (int), int: 0); + _Generic (_Maxof (long), long: 0); + _Generic (_Maxof (long long), long long: 0); + + _Generic (_Minof (signed char), signed char: 0); + _Generic (_Minof (short), short: 0); + _Generic (_Minof (int), int: 0); + _Generic (_Minof (long), long: 0); + _Generic (_Minof (long long), long long: 0); + + _Generic (_Maxof (unsigned char), unsigned char: 0); + _Generic (_Maxof (unsigned short), unsigned short: 0); + _Generic (_Maxof (unsigned int), unsigned int: 0); + _Generic (_Maxof (unsigned long), unsigned long: 0); + _Generic (_Maxof (unsigned long long), unsigned long long: 0); + + _Generic (_Minof (unsigned char), unsigned char: 0); + _Generic (_Minof (unsigned short), unsigned short: 0); + _Generic (_Minof (unsigned int), unsigned int: 0); + _Generic (_Minof (unsigned long), unsigned long: 0); + _Generic (_Minof (unsigned long long), unsigned long long: 0); + + _Generic (_Maxof (bool), bool: 0); + _Generic (_Minof (bool), bool: 0); +} diff --git a/gcc/testsuite/gcc.dg/maxof-pedantic-errors.c b/gcc/testsuite/gcc.dg/maxof-pedantic-errors.c new file mode 100644 index 000000000000..dcb64bb06bb5 --- /dev/null +++ b/gcc/testsuite/gcc.dg/maxof-pedantic-errors.c @@ -0,0 +1,5 @@ +/* { dg-do compile } */ +/* { dg-options "-std=c23 -pedantic-errors" } */ + +int a[_Maxof(char)]; /* { dg-error "ISO C does not support" } */ +int b[1 + _Minof(unsigned char)]; /* { dg-error "ISO C does not support" } */ diff --git a/gcc/testsuite/gcc.dg/maxof-pedantic.c b/gcc/testsuite/gcc.dg/maxof-pedantic.c new file mode 100644 index 000000000000..fa2582c2baa5 --- /dev/null +++ b/gcc/testsuite/gcc.dg/maxof-pedantic.c @@ -0,0 +1,5 @@ +/* { dg-do compile } */ +/* { dg-options "-std=c23 -pedantic" } */ + +int a[_Maxof(char)]; /* { dg-warning "ISO C does not support" } */ +int b[1 + _Minof(unsigned char)]; /* { dg-warning "ISO C does not support" } */ From fa90e72e49260a85f04d7830d98ca3534934da34 Mon Sep 17 00:00:00 2001 From: Jeff Law Date: Wed, 26 Nov 2025 15:29:28 -0700 Subject: [PATCH 049/373] Revert "[PATCH v3] RISC-V: Implement RISC-V profile macro support" This reverts commit 79b8f23a7099a0ff4b4f8796894814f2112c4289. --- gcc/common/config/riscv/riscv-common.cc | 41 ------------------- gcc/config/riscv/riscv-c.cc | 9 ---- gcc/config/riscv/riscv-subset.h | 2 - .../gcc.target/riscv/predef-profiles-1.c | 11 ----- .../gcc.target/riscv/predef-profiles-2.c | 11 ----- .../gcc.target/riscv/predef-profiles-3.c | 11 ----- .../gcc.target/riscv/predef-profiles-4.c | 11 ----- .../gcc.target/riscv/predef-profiles-5.c | 11 ----- .../gcc.target/riscv/predef-profiles-6.c | 11 ----- .../gcc.target/riscv/predef-profiles-7.c | 11 ----- .../gcc.target/riscv/predef-profiles-8.c | 11 ----- 11 files changed, 140 deletions(-) delete mode 100644 gcc/testsuite/gcc.target/riscv/predef-profiles-1.c delete mode 100644 gcc/testsuite/gcc.target/riscv/predef-profiles-2.c delete mode 100644 gcc/testsuite/gcc.target/riscv/predef-profiles-3.c delete mode 100644 gcc/testsuite/gcc.target/riscv/predef-profiles-4.c delete mode 100644 gcc/testsuite/gcc.target/riscv/predef-profiles-5.c delete mode 100644 gcc/testsuite/gcc.target/riscv/predef-profiles-6.c delete mode 100644 gcc/testsuite/gcc.target/riscv/predef-profiles-7.c delete mode 100644 gcc/testsuite/gcc.target/riscv/predef-profiles-8.c diff --git a/gcc/common/config/riscv/riscv-common.cc b/gcc/common/config/riscv/riscv-common.cc index adfd22019a92..efa2a45a6404 100644 --- a/gcc/common/config/riscv/riscv-common.cc +++ b/gcc/common/config/riscv/riscv-common.cc @@ -1404,47 +1404,6 @@ riscv_subset_list::parse (const char *arch, location_t *loc) return NULL; } -/* Get the profile that best matches the current architecture string, - where best is defined as the most expansive profile. */ - -const char * -riscv_subset_list::get_profile_name () const -{ - const char *best_profile = NULL; - int max_ext_count = -1; - - for (int i = 0; riscv_profiles_table[i].profile_name != nullptr; ++i) - { - riscv_subset_list *subset_list = riscv_subset_list::parse ( - riscv_profiles_table[i].profile_string, NULL); - if (!subset_list) - continue; - if (subset_list->xlen () == this->xlen ()) - { - int ext_count = 0; - bool all_found = true; - for (riscv_subset_t *p = subset_list->m_head; p != NULL; - p = p->next, ++ext_count) - { - if (!this->lookup (p->name.c_str (), - p->major_version, - p->minor_version)) - { - all_found = false; - break; - } - } - if (all_found && ext_count > max_ext_count) - { - max_ext_count = ext_count; - best_profile = riscv_profiles_table[i].profile_name; - } - } - delete subset_list; - } - return best_profile; -} - /* Clone whole subset list. */ riscv_subset_list * diff --git a/gcc/config/riscv/riscv-c.cc b/gcc/config/riscv/riscv-c.cc index d497326e0611..4fc052817824 100644 --- a/gcc/config/riscv/riscv-c.cc +++ b/gcc/config/riscv/riscv-c.cc @@ -165,15 +165,6 @@ riscv_cpu_cpp_builtins (cpp_reader *pfile) if (!subset_list) return; - /* Define profile macro if a profile was used. */ - const char *profile_name = subset_list->get_profile_name (); - if (profile_name) - { - char *profile_macro = (char *)alloca (strlen (profile_name) + 10); - sprintf (profile_macro, "__riscv_%s", profile_name); - builtin_define (profile_macro); - } - size_t max_ext_len = 0; /* Figure out the max length of extension name for reserving buffer. */ diff --git a/gcc/config/riscv/riscv-subset.h b/gcc/config/riscv/riscv-subset.h index 1887ed7cc1c3..4cd860fee59b 100644 --- a/gcc/config/riscv/riscv-subset.h +++ b/gcc/config/riscv/riscv-subset.h @@ -105,8 +105,6 @@ class riscv_subset_list unsigned xlen () const {return m_xlen;}; - const char *get_profile_name () const; - riscv_subset_list *clone () const; static riscv_subset_list *parse (const char *, location_t *); diff --git a/gcc/testsuite/gcc.target/riscv/predef-profiles-1.c b/gcc/testsuite/gcc.target/riscv/predef-profiles-1.c deleted file mode 100644 index 5fc17abf118a..000000000000 --- a/gcc/testsuite/gcc.target/riscv/predef-profiles-1.c +++ /dev/null @@ -1,11 +0,0 @@ -/* { dg-do compile } */ -/* { dg-options "-march=rvi20u64 -mabi=lp64" } */ - -int main () { - -#ifndef __riscv_rvi20u64 -#error "__riscv_rvi20u64" -#endif - - return 0; -} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/riscv/predef-profiles-2.c b/gcc/testsuite/gcc.target/riscv/predef-profiles-2.c deleted file mode 100644 index 86f2771edeff..000000000000 --- a/gcc/testsuite/gcc.target/riscv/predef-profiles-2.c +++ /dev/null @@ -1,11 +0,0 @@ -/* { dg-do compile } */ -/* { dg-options "-march=rvi20u32 -mabi=ilp32" } */ - -int main () { - -#ifndef __riscv_rvi20u32 -#error "__riscv_rvi20u32" -#endif - - return 0; -} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/riscv/predef-profiles-3.c b/gcc/testsuite/gcc.target/riscv/predef-profiles-3.c deleted file mode 100644 index 7787549c79f4..000000000000 --- a/gcc/testsuite/gcc.target/riscv/predef-profiles-3.c +++ /dev/null @@ -1,11 +0,0 @@ -/* { dg-do compile } */ -/* { dg-options "-march=rva20u64 -mabi=lp64d" } */ - -int main () { - -#ifndef __riscv_rva20u64 -#error "__riscv_rva20u64" -#endif - - return 0; -} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/riscv/predef-profiles-4.c b/gcc/testsuite/gcc.target/riscv/predef-profiles-4.c deleted file mode 100644 index abb20b7d14fc..000000000000 --- a/gcc/testsuite/gcc.target/riscv/predef-profiles-4.c +++ /dev/null @@ -1,11 +0,0 @@ -/* { dg-do compile } */ -/* { dg-options "-march=rva22u64 -mabi=lp64d" } */ - -int main () { - -#ifndef __riscv_rva22u64 -#error "__riscv_rva22u64" -#endif - - return 0; -} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/riscv/predef-profiles-5.c b/gcc/testsuite/gcc.target/riscv/predef-profiles-5.c deleted file mode 100644 index 0840cdc3de03..000000000000 --- a/gcc/testsuite/gcc.target/riscv/predef-profiles-5.c +++ /dev/null @@ -1,11 +0,0 @@ -/* { dg-do compile } */ -/* { dg-options "-march=rva23u64 -mabi=lp64d" } */ - -int main () { - -#ifndef __riscv_rva23u64 -#error "__riscv_rva23u64" -#endif - - return 0; -} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/riscv/predef-profiles-6.c b/gcc/testsuite/gcc.target/riscv/predef-profiles-6.c deleted file mode 100644 index 71597804c991..000000000000 --- a/gcc/testsuite/gcc.target/riscv/predef-profiles-6.c +++ /dev/null @@ -1,11 +0,0 @@ -/* { dg-do compile } */ -/* { dg-options "-march=rva23s64 -mabi=lp64d" } */ - -int main () { - -#ifndef __riscv_rva23s64 -#error "__riscv_rva23s64" -#endif - - return 0; -} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/riscv/predef-profiles-7.c b/gcc/testsuite/gcc.target/riscv/predef-profiles-7.c deleted file mode 100644 index 1366159e9d38..000000000000 --- a/gcc/testsuite/gcc.target/riscv/predef-profiles-7.c +++ /dev/null @@ -1,11 +0,0 @@ -/* { dg-do compile } */ -/* { dg-options "-march=rvb23u64 -mabi=lp64d" } */ - -int main () { - -#ifndef __riscv_rvb23u64 -#error "__riscv_rvb23u64" -#endif - - return 0; -} \ No newline at end of file diff --git a/gcc/testsuite/gcc.target/riscv/predef-profiles-8.c b/gcc/testsuite/gcc.target/riscv/predef-profiles-8.c deleted file mode 100644 index c0c50034b6c4..000000000000 --- a/gcc/testsuite/gcc.target/riscv/predef-profiles-8.c +++ /dev/null @@ -1,11 +0,0 @@ -/* { dg-do compile } */ -/* { dg-options "-march=rvb23s64 -mabi=lp64d" } */ - -int main () { - -#ifndef __riscv_rvb23s64 -#error "__riscv_rvb23s64" -#endif - - return 0; -} \ No newline at end of file From 2593a2424102b48327250aa0bd0bd12a4b3a85a9 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Thu, 27 Nov 2025 00:20:22 +0000 Subject: [PATCH 050/373] Daily bump. --- gcc/ChangeLog | 196 ++++++++++++++++++++++++++++++++++++++++ gcc/DATESTAMP | 2 +- gcc/c-family/ChangeLog | 19 ++++ gcc/c/ChangeLog | 9 ++ gcc/cp/ChangeLog | 6 ++ gcc/fortran/ChangeLog | 57 ++++++++++++ gcc/testsuite/ChangeLog | 188 ++++++++++++++++++++++++++++++++++++++ libgomp/ChangeLog | 17 ++++ libstdc++-v3/ChangeLog | 52 +++++++++++ 9 files changed, 545 insertions(+), 1 deletion(-) diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 2c098e384cf8..2333706380ae 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,199 @@ +2025-11-26 Jeff Law + + Revert: + 2025-10-14 Zhongyao Chen + + * common/config/riscv/riscv-common.cc (riscv_subset_list::get_profile_name): + New function. + * config/riscv/riscv-c.cc (riscv_cpu_cpp_builtins): Define + profile macro if a profile is detected. + * config/riscv/riscv-subset.h (riscv_subset_list::get_profile_name): Declare. + +2025-11-26 Alejandro Colomar + + * doc/extend.texi (Syntax Extensions): Document _Maxof & _Minof. + +2025-11-26 Tamar Christina + + * optabs.cc (emit_cmp_and_jump_insns): Check for non-single use. + +2025-11-26 Jeff Law + + PR rtl-optimization/122735 + * simplify-rtx.cc (simplify_binary_operation_1): When moving a SUBREG + from an outer expression to an inner operand, make sure to avoid + trying to create invalid SUBREGs. + +2025-11-26 Richard Earnshaw + + PR target/122867 + * config/arm/arm.cc (arm_print_operand): Use %- to + emit LOCAL_LABEL_PREFIX. + (arm_print_operand_punct_valid_p): Allow %- for punct + and make %_ valid for all compilation variants. + * config/arm/thumb2.md (*thumb2_cbz): Handle very + large branch ranges that exceed the limit of b. + (*thumb2_cbnz): Likewise. + +2025-11-26 Richard Biener + + PR tree-optimization/110571 + * tree-vectorizer.h (vect_need_peeling_or_partial_vectors_p): Remove. + * tree-vect-loop.cc (vect_need_peeling_or_partial_vectors_p): + Fix when called on epilog loops. Make static. + * tree-vect-loop-manip.cc (vect_do_peeling): Do not + re-compute LOOP_VINFO_PEELING_FOR_NITER. + +2025-11-26 Tamar Christina + + PR tree-optimization/122861 + * optabs.cc (emit_cmp_and_jump_insns): Check argument instead of result. + +2025-11-26 Jakub Jelinek + + * doc/invoke.texi (gnu++17): Remove comment about the default. + (c++20): Remove note about experimental support, except add a note + that modules are still experimental and need to be enabled separately. + (gnu++20): Likewise. Move here comment about the default. + (fcoroutines): Mention it is enabled by default for C++20 and later. + * doc/standards.texi: Document that the default for C++ is + -std=gnu++20. + +2025-11-26 Richard Biener + + * tree-vect-stmts.cc (vectorizable_simd_clone_call): Handle + AVX512 masking for loop masked SIMD clone call. + +2025-11-26 Jakub Jelinek + + PR middle-end/122835 + * tree-eh.cc (replace_goto_queue_1): Handle GIMPLE_ASM. + (maybe_record_in_goto_queue): Likewise. + (lower_eh_constructs_2): Likewise. + +2025-11-26 Jakub Jelinek + + PR tree-optimization/119683 + * gimple-match.h (gimple_match_ctx): New inline function. + * match.pd ((mult (plus:s (mult:s @0 @1) @2) @3)): Capture + PLUS, use get_range_query (cfun) instead of + get_global_range_query () and pass gimple_match_ctx (@5) + as 3rd argument to range_of_expr. + ((plus (mult:s (plus:s @0 @1) @2) @3)): Similarly for MULT, + with @4 instead of @5. + ((t * u) / u -> t): Similarly with @2 instead of @4. + ((t * u) / v -> t * (u / v)): Capture MULT, pass gimple_match_ctx (@3) + as 3rd argument to range_of_expr. + ((X + M*N) / N -> X / N + M): Pass gimple_match_ctx (@3) or + gimple_match_ctx (@4) as 3rd arg to some range_of_expr calls. + ((X - M*N) / N -> X / N - M): Likewise. + ((X + C) / N -> X / N + C / N): Similarly. + (((T)(A)) + CST -> (T)(A + CST)): Capture CONVERT, use + get_range_query (cfun) instead of get_global_range_query () + and pass gimple_match_ctx (@2) as 3rd argument to range_of_expr. + (x_5 == cstN ? cst4 : cst3): Capture EQNE and pass + gimple_match_ctx (@4) as 3rd argument to range_of_expr. + +2025-11-26 Soumya AR + + * config/aarch64/aarch64-json-tunings-parser.cc: Include + aarch64-json-tunings-parser-generated.inc. + * config/aarch64/aarch64-json-tunings-printer.cc: Include + aarch64-json-tunings-printer-generated.inc. + * config/aarch64/aarch64-opts.h (AARCH64_LDP_STP_POLICY): Use + aarch64-tuning-enums.def. + * config/aarch64/aarch64-protos.h (AARCH64_AUTOPREFETCH_MODE): Use + aarch64-tuning-enums.def. + * config/aarch64/t-aarch64: Invoke + aarch64-generate-json-tuning-routines.py if the schema is modified. + * config/aarch64/aarch64-generate-json-tuning-routines.py: New + maintenance script to generate JSON parser/printer routines. + * config/aarch64/aarch64-json-tunings-parser-generated.inc: New file. + * config/aarch64/aarch64-json-tunings-printer-generated.inc: New file. + * config/aarch64/aarch64-tuning-enums.def: New file. + +2025-11-26 Soumya AR + + * config.gcc: Add aarch64-json-tunings-parser.o. + * config/aarch64/aarch64.cc (aarch64_override_options_internal): Invoke + aarch64_load_tuning_params_from_json if -muser-provided-CPU= is + (aarch64_json_tunings_tests): Extern aarch64_json_tunings_tests(). + (aarch64_run_selftests): Add aarch64_json_tunings_tests(). + * config/aarch64/aarch64.opt: New option. + * config/aarch64/t-aarch64 (aarch64-json-tunings-parser.o): New define. + * config/aarch64/aarch64-json-schema.h: New file. + * config/aarch64/aarch64-json-tunings-parser.cc: New file. + * config/aarch64/aarch64-json-tunings-parser.h: New file. + +2025-11-26 Soumya AR + + * json.h (class object): Add get_map () method. + (is_a_helper, is_a_helper): + New template specializations. + +2025-11-26 Soumya AR + + * config.gcc: Add aarch64-json-tunings-printer.o. + * config/aarch64/aarch64.cc (aarch64_override_options_internal): Invoke + aarch64_print_tune_params if -fdump-tuning-model= is specified. + * config/aarch64/aarch64.opt: New option. + * config/aarch64/t-aarch64 (aarch64-json-tunings-printer.o): New define. + * config/aarch64/aarch64-json-tunings-printer.cc: New file. + * config/aarch64/aarch64-json-tunings-printer.h: New file. + +2025-11-26 Soumya AR + + * config/aarch64/aarch64-protos.h + (struct scale_addr_mode_cost): Remove const from struct members. + (struct cpu_addrcost_table): Likewise. + (struct cpu_regmove_cost): Likewise. + (struct simd_vec_cost): Likewise. + (struct sve_vec_cost): Likewise. + (struct aarch64_base_vec_issue_info): Likewise. + (struct aarch64_simd_vec_issue_info): Likewise. + (struct aarch64_sve_vec_issue_info): Likewise. + (struct aarch64_vec_issue_info): Likewise. + (struct cpu_vector_cost): Likewise. + (struct cpu_branch_cost): Likewise. + (struct cpu_approx_modes): Likewise. + (struct cpu_prefetch_tune): Likewise. + * config/arm/aarch-common-protos.h + (struct alu_cost_table): Remove const from struct members. + (struct mult_cost_table): Likewise. + (struct mem_cost_table): Likewise. + (struct fp_cost_table): Likewise. + (struct vector_cost_table): Likewise. + (struct cpu_cost_table): Likewise. + +2025-11-26 Dhruv Chawla + + PR middle-end/116815 + * config/aarch64/aarch64.md + (*aarch64_plus_within_3_): New pattern. + (*aarch64_minus_within_3): Likewise. + * config/aarch64/iterators.md (ovf_add_cmp): New code attribute. + (udf_sub_cmp): Likewise. + (UMAXMIN): New code iterator. + (ovf_commutate): New iterator. + (ovf_comm_opp): New int attribute. + +2025-11-26 Pan Li + + * match.pd: Add pattern for SAT_MUL form 7 include + mul and widen_mul. + +2025-11-26 Andrew Pinski + + * tree-ssa-phiprop.cc (propagate_with_phi): Only + calculate on demand post dom info when the new store + might trap. + +2025-11-26 Andrew Pinski + + PR tree-optimization/122847 + * tree-ssa-phiprop.cc (propagate_with_phi): Add type + check for reuse of the phi for the delayed statements. + 2025-11-25 Rainer Orth * configure.ac (gcc_cv_header_zstd_h): Save, restore CXXFLAGS, diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 913858765e79..d8e427a9c3e1 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20251126 +20251127 diff --git a/gcc/c-family/ChangeLog b/gcc/c-family/ChangeLog index ba0e3c6af34b..888ed516d0ee 100644 --- a/gcc/c-family/ChangeLog +++ b/gcc/c-family/ChangeLog @@ -1,3 +1,22 @@ +2025-11-26 Alejandro Colomar + + * c-common.cc (c_common_reswords): Add _Maxof & _Minof keywords. + (c_maxof_type, c_minof_type): New functions. + * c-common.def (MAXOF_EXPR, MINOF_EXPR): New trees. + * c-common.h (enum rid): Add RID_MAXOF & RID_MINOF constants. + (c_maxof_type, c_minof_type): New prototypes. + +2025-11-26 Jakub Jelinek + + * c-opts.cc (c_common_init_options): Call set_std_cxx20 rather than + set_std_cxx17. + * c.opt (std=c++2a): Change description to deprecated option wording. + (std=c++20): Remove experimental support part. + (std=c++2b): Change description to deprecated option wording. + (std=gnu++2a): Likewise. + (std=gnu++20): Remove experimental support part. + (std=gnu++2b): Change description to deprecated option wording. + 2025-11-25 Jason Merrill * c.opt: Add --compile-std-module. diff --git a/gcc/c/ChangeLog b/gcc/c/ChangeLog index 07472e7202fd..bda28d1c64a8 100644 --- a/gcc/c/ChangeLog +++ b/gcc/c/ChangeLog @@ -1,3 +1,12 @@ +2025-11-26 Alejandro Colomar + + * c-parser.cc (c_parser_maxof_or_minof_expression): New func. + (c_parser_unary_expression): Add RID_MAXOF & RID_MINOF cases. + * c-tree.h (c_expr_maxof_type): New prototype. + (c_expr_minof_type): New prototype. + * c-typeck.cc (c_expr_maxof_type): New function. + (c_expr_minof_type): New function. + 2025-11-22 Sandra Loosemore Julian Brown diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 7560da06fbeb..61f8b6c41f95 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,9 @@ +2025-11-26 Marek Polacek + + PR c++/121325 + * pt.cc (tsubst_tree_vec): New. + (tsubst_pack_index): Call it. + 2025-11-25 Nathaniel Shead PR c++/122699 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3d6ed745e4cd..344d47fddeb3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,60 @@ +2025-11-26 Tobias Burnus + + * dump-parse-tree.cc (show_attr): Handle OpenMP's 'local' clause + and the 'groupprivate' directive. + (show_omp_clauses): Handle dyn_groupprivate. + * frontend-passes.cc (gfc_code_walker): Walk dyn_groupprivate. + * gfortran.h (enum gfc_statement): Add ST_OMP_GROUPPRIVATE. + (enum gfc_omp_fallback, gfc_add_omp_groupprivate, + gfc_add_omp_declare_target_local): New. + * match.h (gfc_match_omp_groupprivate): New. + * module.cc (enum ab_attribute, mio_symbol_attribute, load_commons, + write_common_0): Handle 'groupprivate' + declare target's 'local'. + * openmp.cc (gfc_omp_directives): Add 'groupprivate'. + (gfc_free_omp_clauses): Free dyn_groupprivate. + (enum omp_mask2): Add OMP_CLAUSE_LOCAL and OMP_CLAUSE_DYN_GROUPPRIVATE. + (gfc_match_omp_clauses): Match them. + (OMP_TARGET_CLAUSES): Add OMP_CLAUSE_DYN_GROUPPRIVATE. + (OMP_DECLARE_TARGET_CLAUSES): Add OMP_CLAUSE_LOCAL. + (gfc_match_omp_declare_target): Handle groupprivate + fixes. + (gfc_match_omp_threadprivate): Code move to and calling now ... + (gfc_match_omp_thread_group_private): ... this new function. + Also handle groupprivate. + (gfc_match_omp_groupprivate): New. + (resolve_omp_clauses): Resolve dyn_groupprivate. + * parse.cc (decode_omp_directive): Match groupprivate. + (case_omp_decl, parse_spec, gfc_ascii_statement): Handle it. + * resolve.cc (resolve_symbol): Handle groupprivate. + * symbol.cc (gfc_check_conflict, gfc_copy_attr): Handle 'local' + and 'groupprivate'. + (gfc_add_omp_groupprivate, gfc_add_omp_declare_target_local): New. + * trans-common.cc (build_common_decl, + accumulate_equivalence_attributes): Print 'sorry' for + groupprivate and declare target's local. + * trans-decl.cc (add_attributes_to_decl): Likewise.. + * trans-openmp.cc (gfc_trans_omp_clauses): Print 'sorry' for + dyn_groupprivate. + (fallback): Process declare target with link/local as + done for 'enter'. + +2025-11-26 Paul Thomas + + PR fortran/104650 + * decl.cc (gfc_get_pdt_instance): If the PDT template has + finalizers, make a new f2k_derived namespace for this intance + and copy the template namespace into it. Set the instance + template_sym field to point to the template. + * expr.cc (gfc_check_pointer_assign): Allow array value pointer + lvalues to point to scalar null expressions in initialization. + * gfortran.h : Add the template_sym field to gfc_symbol. + * resolve.cc (gfc_resolve_finalizers): For a pdt_type, copy the + final subroutines with the same type argument into the pdt_type + finalizer list. Prevent final subroutine type checking and + creation of the vtab for pdt_templates. + * symbol.cc (gfc_free_symbol): Do not call gfc_free_namespace + for pdt_type with finalizers. Instead, free the finalizers and + the namespace. + 2025-11-24 Paul Thomas PR fortran/122766 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 32abfa1665fc..f28baf01803d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,191 @@ +2025-11-26 Jeff Law + + Revert: + 2025-11-26 Zhongyao Chen + + * gcc.target/riscv/predef-profiles-1.c: New test for __riscv_rvi20u64. + * gcc.target/riscv/predef-profiles-2.c: New test for __riscv_rvi20u32. + * gcc.target/riscv/predef-profiles-3.c: New test for __riscv_rva20u64. + * gcc.target/riscv/predef-profiles-4.c: New test for __riscv_rva22u64. + * gcc.target/riscv/predef-profiles-5.c: New test for __riscv_rva23u64. + * gcc.target/riscv/predef-profiles-6.c: New test for __riscv_rva23s64. + * gcc.target/riscv/predef-profiles-7.c: New test for __riscv_rvb23u64. + * gcc.target/riscv/predef-profiles-8.c: New test for __riscv_rvb23s64. + +2025-11-26 Alejandro Colomar + + * gcc.dg/maxof-bitint.c: New test. + * gcc.dg/maxof-bitint575.c: New test. + * gcc.dg/maxof-compile.c: New test. + * gcc.dg/maxof-pedantic-errors.c: New test. + * gcc.dg/maxof-pedantic.c: New test. + +2025-11-26 Jeff Law + + PR rtl-optimization/122735 + * gcc.dg/torture/pr122735.c: New test. + +2025-11-26 Tobias Burnus + + * gfortran.dg/gomp/crayptr2.f90: Move dg-error line. + * gfortran.dg/gomp/declare-target-2.f90: Extend. + * gfortran.dg/gomp/declare-target-4.f90: Update comment, + enable one test. + * gfortran.dg/gomp/declare-target-5.f90: Update dg- wording, + add new test. + * gfortran.dg/gomp/declare-target-indirect-2.f90: Expect + 'device_type(any)' in scan-tree-dump. + * gfortran.dg/gomp/declare-target-6.f90: New test. + * gfortran.dg/gomp/dyn_groupprivate-1.f90: New test. + * gfortran.dg/gomp/dyn_groupprivate-2.f90: New test. + * gfortran.dg/gomp/groupprivate-1.f90: New test. + * gfortran.dg/gomp/groupprivate-2.f90: New test. + * gfortran.dg/gomp/groupprivate-3.f90: New test. + * gfortran.dg/gomp/groupprivate-4.f90: New test. + * gfortran.dg/gomp/groupprivate-5.f90: New test. + * gfortran.dg/gomp/groupprivate-6.f90: New test. + +2025-11-26 Marek Polacek + + PR c++/121325 + * g++.dg/cpp26/pack-indexing18.C: New test. + +2025-11-26 Richard Earnshaw + + PR target/122867 + * gcc.target/arm/cbz-range.c: New test. + +2025-11-26 Tamar Christina + + PR tree-optimization/122861 + * gcc.target/aarch64/sve/vect-early-break-cbranch_10.c: New test. + * gcc.target/aarch64/sve/vect-early-break-cbranch_11.c: New test. + * gcc.target/aarch64/sve/vect-early-break-cbranch_12.c: New test. + * gcc.target/aarch64/sve/vect-early-break-cbranch_13.c: New test. + * gcc.target/aarch64/sve/vect-early-break-cbranch_14.c: New test. + * gcc.target/aarch64/sve/vect-early-break-cbranch_15.c: New test. + * gcc.target/aarch64/sve/vect-early-break-cbranch_9.c: New test. + * gcc.target/aarch64/vect-early-break-cbranch_4.c: New test. + * gcc.target/aarch64/vect-early-break-cbranch_5.c: New test. + +2025-11-26 Jakub Jelinek + + * lib/target-supports.exp: Set cxx_default to c++20 rather than + c++17. + * lib/g++-dg.exp (g++-std-flags): Reorder list to put 20 first + and 17 after 26. + * g++.dg/debug/pr80461.C (bar): Use v = v + 1; instead of ++v;. + * g++.dg/debug/pr94459.C: Add -std=gnu++17 to dg-options. + * g++.dg/diagnostic/virtual-constexpr.C: Remove dg-skip-if, + instead use { c++11 && c++17_down } effective target instead of + c++11. + * g++.dg/guality/pr67192.C: Add -std=gnu++17. + * g++.dg/torture/pr84961-1.C: Likewise. + * g++.dg/torture/pr84961-2.C: Likewise. + * g++.dg/torture/pr51482.C (anim_track_bez_wvect::tangent): Cast + key_class to int before multiplying it by float. + * g++.dg/torture/stackalign/unwind-4.C (foo): Use g_a = g_a + 1; + instead of g_a++;. + * g++.dg/tree-prof/partition1.C (bar): Use l = l + 1; return l; + instead of return ++l;. + * obj-c++.dg/exceptions-3.mm: Add -std=gnu++17. + * obj-c++.dg/exceptions-5.mm: Likewise. + +2025-11-26 Jakub Jelinek + + PR middle-end/122835 + * gcc.dg/torture/pr122835.c: New test. + +2025-11-26 Jakub Jelinek + + PR tree-optimization/119683 + * gcc.dg/tree-ssa/pr119683.c: New test. + +2025-11-26 Richard Biener + + * gcc.dg/vect/vect-simd-clone-22.c: Add -w. + * gcc.dg/vect/vect-simd-clone-23.c: Likewise. + +2025-11-26 Soumya AR + + * gcc.target/aarch64/aarch64-json-tunings/aarch64-json-tunings.exp: New test. + * gcc.target/aarch64/aarch64-json-tunings/boolean-1.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/boolean-1.json: New test. + * gcc.target/aarch64/aarch64-json-tunings/boolean-2.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/boolean-2.json: New test. + * gcc.target/aarch64/aarch64-json-tunings/empty-brackets.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/empty-brackets.json: New test. + * gcc.target/aarch64/aarch64-json-tunings/empty.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/empty.json: New test. + * gcc.target/aarch64/aarch64-json-tunings/enum-1.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/enum-1.json: New test. + * gcc.target/aarch64/aarch64-json-tunings/enum-2.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/enum-2.json: New test. + * gcc.target/aarch64/aarch64-json-tunings/integer-1.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/integer-1.json: New test. + * gcc.target/aarch64/aarch64-json-tunings/integer-2.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/integer-2.json: New test. + * gcc.target/aarch64/aarch64-json-tunings/integer-3.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/integer-3.json: New test. + * gcc.target/aarch64/aarch64-json-tunings/string-1.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/string-1.json: New test. + * gcc.target/aarch64/aarch64-json-tunings/string-2.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/string-2.json: New test. + * gcc.target/aarch64/aarch64-json-tunings/test-all.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/test-all.json: New test. + * gcc.target/aarch64/aarch64-json-tunings/unidentified-key.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/unidentified-key.json: New test. + * gcc.target/aarch64/aarch64-json-tunings/unsigned-1.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/unsigned-1.json: New test. + * gcc.target/aarch64/aarch64-json-tunings/unsigned-2.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/unsigned-2.json: New test. + * gcc.target/aarch64/aarch64-json-tunings/unsigned-3.c: New test. + * gcc.target/aarch64/aarch64-json-tunings/unsigned-3.json: New test. + +2025-11-26 Paul Thomas + + PR fortran/104650 + * gfortran.dg/pdt_70.f03: New test. + +2025-11-26 Dhruv Chawla + + PR middle-end/116815 + * gcc.target/aarch64/pr116815-1.c: New test. + * gcc.target/aarch64/pr116815-2.c: Likewise. + * gcc.target/aarch64/pr116815-3.c: Likewise. + +2025-11-26 Pan Li + + * gcc.target/riscv/sat/sat_arith.h: Add test helper macros. + * gcc.target/riscv/sat/sat_u_mul-8-u16-from-u128.c: New test. + * gcc.target/riscv/sat/sat_u_mul-8-u16-from-u32.c: New test. + * gcc.target/riscv/sat/sat_u_mul-8-u16-from-u64.rv32.c: New test. + * gcc.target/riscv/sat/sat_u_mul-8-u16-from-u64.rv64.c: New test. + * gcc.target/riscv/sat/sat_u_mul-8-u32-from-u128.c: New test. + * gcc.target/riscv/sat/sat_u_mul-8-u32-from-u64.rv32.c: New test. + * gcc.target/riscv/sat/sat_u_mul-8-u32-from-u64.rv64.c: New test. + * gcc.target/riscv/sat/sat_u_mul-8-u64-from-u128.c: New test. + * gcc.target/riscv/sat/sat_u_mul-8-u8-from-u128.c: New test. + * gcc.target/riscv/sat/sat_u_mul-8-u8-from-u16.c: New test. + * gcc.target/riscv/sat/sat_u_mul-8-u8-from-u32.c: New test. + * gcc.target/riscv/sat/sat_u_mul-8-u8-from-u64.rv32.c: New test. + * gcc.target/riscv/sat/sat_u_mul-8-u8-from-u64.rv64.c: New test. + * gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u128.c: New test. + * gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u32.c: New test. + * gcc.target/riscv/sat/sat_u_mul-run-8-u16-from-u64.c: New test. + * gcc.target/riscv/sat/sat_u_mul-run-8-u32-from-u128.c: New test. + * gcc.target/riscv/sat/sat_u_mul-run-8-u32-from-u64.c: New test. + * gcc.target/riscv/sat/sat_u_mul-run-8-u64-from-u128.c: New test. + * gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u128.c: New test. + * gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u16.c: New test. + * gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u32.c: New test. + * gcc.target/riscv/sat/sat_u_mul-run-8-u8-from-u64.c: New test. + +2025-11-26 Andrew Pinski + + PR tree-optimization/122847 + * gcc.dg/torture/pr122847-1.c: New test. + 2025-11-25 Lúcio Boari Fleury * rust/compile/macros/mbe/macro-issue3608.rs: New Test. The test skips an issue at line 11 diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index f9b1a769b7c9..4f6e756b50a2 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,20 @@ +2025-11-26 Jakub Jelinek + + * testsuite/libgomp.c++/atomic-12.C (main): Add ()s around array + reference index. + * testsuite/libgomp.c++/atomic-13.C: Likewise. + * testsuite/libgomp.c++/atomic-8.C: Likewise. + * testsuite/libgomp.c++/atomic-9.C: Likewise. + * testsuite/libgomp.c++/loop-6.C: Use count = count + 1; + return count > 0; instead of return ++count > 0;. + * testsuite/libgomp.c++/pr38650.C: Add -std=gnu++17. + * testsuite/libgomp.c++/target-lambda-1.C (merge_data_func): + Use [=,this] instead of just [=] in lambda captures. + * testsuite/libgomp.c-c++-common/target-40.c (f1): Use v += 1; + instead of v++;. + * testsuite/libgomp.c-c++-common/depend-iterator-2.c: Use v = v + 1; + instead of v++. + 2025-11-25 Frank Scheiner * affinity-fmt.c: Make char *q a pointer to a const char. diff --git a/libstdc++-v3/ChangeLog b/libstdc++-v3/ChangeLog index 99eadd725049..833ba0a6d1ba 100644 --- a/libstdc++-v3/ChangeLog +++ b/libstdc++-v3/ChangeLog @@ -1,3 +1,55 @@ +2025-11-26 Tomasz Kamiński + + PR libstdc++/122864 + * include/std/chrono (chrono::__pack_ints): Replace `<=` + with `<<`. + +2025-11-26 Tomasz Kamiński + + * include/std/ranges (__detail::__is_std_op_template) + (__detail::__is_std_op_wrapper, __func_handle::_Inplace) + (__func_handle::_InplaceMemPtr, __func_handle::_ViaPointer) + (__func_handle::_StaticCall, __detail::__func_handle_t): Define. + (transform_view::_Iterator, zip_transform_view::_Iterator) + (adjacent_tranform_view::_Iterator): Replace pointer to view + (_M_parent) with pointer to functor (_M_fun). Update constructors + to construct _M_fun from *__parent->_M_fun. Define operator* and + operator[] in terms of _M_call_deref and _M_call_subscript. + * testsuite/std/ranges/adaptors/adjacent_transform/1.cc: New tests. + * testsuite/std/ranges/adaptors/transform.cc: New tests. + * testsuite/std/ranges/zip_transform/1.cc: New tests. + +2025-11-26 Tomasz Kamiński + + * include/bits/ranges_cmp.h (std::identity::operator()): + (ranges::equal_to:operator(), ranges::not_equal_to:operator()) + (ranges::greater::operator(), ranges::greater_equal::operator()) + (ranges::less::operator(), ranges::less_equal::operator()): + Declare as static. + * libsupc++/compare (std::compare_three_way::operator()): + Declare as static. + +2025-11-26 Tomasz Kamiński + + * include/std/chrono (chrono::__hash): Rename __packed to + __res. + +2025-11-26 Tomasz Kamiński + Giuseppe D'Angelo + + PR libstdc++/110357 + * include/bits/version.def (chrono, chrono_cxx20): Bump values. + * include/bits/version.h: Regenerate. + * include/std/chrono (__is_nothrow_copy_hashable) + (chrono::__pack_ints, chrono::__as_int, chrono::__int_hash) + (chrono::__hash): Define. + (std::hash): Define partial specialization for duration, time_point, + and zoned_time, and full specializations for calendar types and + leap_second. + (std::__is_fast_hash): Define partial specializations for duration, + time_point, zoned_time. + * testsuite/std/time/hash.cc: New test. + 2025-11-25 Jonathan Wakely * acinclude.m4 (libtool_VERSION): Bump version. From ca0dea756cd0f85f3fb4fbd9fbdefa1c3de6f85f Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Thu, 27 Nov 2025 01:25:33 +0000 Subject: [PATCH 051/373] doc: Add --compile-std-module to option summary Commit 3ad2e2d707c3d6b0c6bd8c3ef0df4f7aaee1c3c added documentation for this new C++ option, but missed also adding it to the corresponding Option Summary list. gcc/ChangeLog * doc/invoke.texi (Option Summary) : Add --compile-std-module. --- gcc/doc/invoke.texi | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 45317666bc7e..071aa6d65742 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -215,7 +215,8 @@ in the following sections. @item C++ Language Options @xref{C++ Dialect Options,,Options Controlling C++ Dialect}. -@gccoptlist{-fabi-compat-version=@var{n} -fabi-version=@var{n} +@gccoptlist{--compile-std-module +-fabi-compat-version=@var{n} -fabi-version=@var{n} -fno-access-control -faligned-new=@r{[}@var{n}@r{]} -fno-assume-sane-operators-new-delete -fchar8_t -fcheck-new From c3858c51a48c719f096e1425d1cfb13cc86a1c80 Mon Sep 17 00:00:00 2001 From: Lulu Cheng Date: Mon, 24 Nov 2025 17:03:49 +0800 Subject: [PATCH 052/373] LoongArch: fmv: Fix compilation errors when using glibc versions earlier than 2.38. The macros HWCAP_LOONGARCH_LSX and HWCAP_LOONGARCH_LASX were defined in glibc 2.38. However, r16-5155 uses these two macros directly without checking whether they are defined. This causes errors when compiling libgcc with glibc versions earlier than 2.38. gcc/ChangeLog: * doc/extend.texi: Remove the incorrect prompt message. libgcc/ChangeLog: * config/loongarch/cpuinfo.c (HWCAP_LOONGARCH_LSX): Define it if it is not defined. (HWCAP_LOONGARCH_LASX): Likewise. --- gcc/doc/extend.texi | 2 -- libgcc/config/loongarch/cpuinfo.c | 11 +++++++++++ 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/gcc/doc/extend.texi b/gcc/doc/extend.texi index cc414313884b..11f6b02db366 100644 --- a/gcc/doc/extend.texi +++ b/gcc/doc/extend.texi @@ -5015,8 +5015,6 @@ from the code model of the callee function. Like attribute @code{target}, these options also reflect the behavior of similar command line options. -Note that this attribute requires GLIBC2.38 and newer that support HWCAP. - @code{string} can take the following values: @itemize @bullet diff --git a/libgcc/config/loongarch/cpuinfo.c b/libgcc/config/loongarch/cpuinfo.c index 293eb52f047a..a398bcbff122 100644 --- a/libgcc/config/loongarch/cpuinfo.c +++ b/libgcc/config/loongarch/cpuinfo.c @@ -73,6 +73,17 @@ __init_loongarch_features_resolver (void) if (CPUCFG3 & CPUCFG3_LD_SEQ_SA) setCPUFeature (FEAT_LD_SEQ_SA); +/* The macros HWCAP_LOONGARCH_LSX and HWCAP_LOONGARCH_LASX are not defined + in glibc versions earlier than 2.38. If these two macros are not defined, + define them with reference to asm/hwcap.h. */ +#ifndef HWCAP_LOONGARCH_LSX +#define HWCAP_LOONGARCH_LSX (1 << 4) +#endif + +#ifndef HWCAP_LOONGARCH_LASX +#define HWCAP_LOONGARCH_LASX (1 << 5) +#endif + /* LSX and LASX can be disabled/enabled by kernel: on some old kernel versions the vector context switch wasn't implemented and so they are always disabled, and on Linux >= 6.18-rc1 the user can pass simd= From 319a956cd25ccc05c9447d55d76f0c98e8f6b598 Mon Sep 17 00:00:00 2001 From: liuhongt Date: Mon, 24 Nov 2025 21:33:46 -0800 Subject: [PATCH 053/373] Refactor mgather/mscatter implementation. Current implementation is an alias to -mtune-crtl=(Alias(mtune-ctrl=, use_gather, ^use_gather)), and maybe override by another -mtune-crtl= .i.e -mgather -mscatter will only enable mscatter The patch fixes the issue. gcc/ChangeLog: * config/i386/i386-options.cc (set_ix86_tune_features): Set gather/scatter tune if OPTION_SET_P. * config/i386/i386.opt: Refactor mgather/mscatter. --- gcc/config/i386/i386-options.cc | 15 +++++++++++++++ gcc/config/i386/i386.opt | 4 ++-- 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/gcc/config/i386/i386-options.cc b/gcc/config/i386/i386-options.cc index ba598a817f30..35064d83a007 100644 --- a/gcc/config/i386/i386-options.cc +++ b/gcc/config/i386/i386-options.cc @@ -1837,6 +1837,21 @@ set_ix86_tune_features (struct gcc_options *opts, } parse_mtune_ctrl_str (opts, dump); + + /* mgather/mscatter option would overwrite -mtune-crtl option. */ + if (OPTION_SET_P (ix86_use_gather)) + { + ix86_tune_features[X86_TUNE_USE_GATHER_2PARTS] = ix86_use_gather; + ix86_tune_features[X86_TUNE_USE_GATHER_4PARTS] = ix86_use_gather; + ix86_tune_features[X86_TUNE_USE_GATHER_8PARTS] = ix86_use_gather; + } + + if (OPTION_SET_P (ix86_use_scatter)) + { + ix86_tune_features[X86_TUNE_USE_SCATTER_2PARTS] = ix86_use_scatter; + ix86_tune_features[X86_TUNE_USE_SCATTER_4PARTS] = ix86_use_scatter; + ix86_tune_features[X86_TUNE_USE_SCATTER_8PARTS] = ix86_use_scatter; + } } diff --git a/gcc/config/i386/i386.opt b/gcc/config/i386/i386.opt index 844945023451..c0093ef12436 100644 --- a/gcc/config/i386/i386.opt +++ b/gcc/config/i386/i386.opt @@ -1290,11 +1290,11 @@ Support MMX, SSE, SSE2, SSE3, SSSE3, SSE4.1, SSE4.2, AVX and SM4 built-in functions and code generation. mgather -Target Alias(mtune-ctrl=, use_gather, ^use_gather) +Target Var(ix86_use_gather) Init(0) Optimization. Enable vectorization for gather instruction. mscatter -Target Alias(mtune-ctrl=, use_scatter, ^use_scatter) +Target Var(ix86_use_scatter) Init(0) Optimization Enable vectorization for scatter instruction. mapxf From 89552346e3cef8ef32e2ebe643bb96d085447e68 Mon Sep 17 00:00:00 2001 From: Jonathan Wakely Date: Wed, 26 Nov 2025 14:44:03 +0000 Subject: [PATCH 054/373] libstdc++: Fix std::counting_semaphore<> default max value MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit My recent (uncommitted) changes to support a 64-bit __platform_wait_t for FreeBSD and Darwin revealed a problem in std::counting_semaphore. When the default template argument is used and __platform_wait_t is a 64-bit type, the numeric_limits<__platform_wait_t>::max() value doesn't fit in ptrdiff_t and so we get ptrdiff_t(-1), which fails a static_assert in the class body. The solution is to cap the value to PTRDIFF_MAX instead of allowing it to go negative. libstdc++-v3/ChangeLog: * include/bits/semaphore_base.h (__platform_semaphore::_S_max): Limit to PTRDIFF_MAX to avoid negative values. * testsuite/30_threads/semaphore/least_max_value.cc: New test. Reviewed-by: Tomasz Kamiński --- libstdc++-v3/include/bits/semaphore_base.h | 14 ++++++++++++-- .../30_threads/semaphore/least_max_value.cc | 9 +++++++++ 2 files changed, 21 insertions(+), 2 deletions(-) create mode 100644 libstdc++-v3/testsuite/30_threads/semaphore/least_max_value.cc diff --git a/libstdc++-v3/include/bits/semaphore_base.h b/libstdc++-v3/include/bits/semaphore_base.h index 82871ce3518b..cb815d340aca 100644 --- a/libstdc++-v3/include/bits/semaphore_base.h +++ b/libstdc++-v3/include/bits/semaphore_base.h @@ -173,8 +173,18 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION { using __count_type = __detail::__platform_wait_t; - static constexpr ptrdiff_t _S_max - = _Binary ? 1 : __gnu_cxx::__int_traits<__count_type>::__max; + static consteval ptrdiff_t + _S_calc_max() + { + if (_Binary) + return 1; + else if ((ptrdiff_t)__gnu_cxx::__int_traits<__count_type>::__max < 0) + return __gnu_cxx::__int_traits::__max; + else + return __gnu_cxx::__int_traits<__count_type>::__max; + } + + static constexpr ptrdiff_t _S_max = _S_calc_max(); constexpr explicit __platform_semaphore_impl(__count_type __count) noexcept diff --git a/libstdc++-v3/testsuite/30_threads/semaphore/least_max_value.cc b/libstdc++-v3/testsuite/30_threads/semaphore/least_max_value.cc new file mode 100644 index 000000000000..67fa1258b7f0 --- /dev/null +++ b/libstdc++-v3/testsuite/30_threads/semaphore/least_max_value.cc @@ -0,0 +1,9 @@ +// { dg-do compile { target c++20 } } +// { dg-require-effective-target gthreads { target { ! *-*-linux* } } } +// { dg-require-effective-target hosted } + +#include + +std::counting_semaphore<> sem(0); +std::counting_semaphore<> sem2(2); +std::counting_semaphore sem3(3); From d07b9e7fe42026cf9ca9a53dc354dfe9e5528612 Mon Sep 17 00:00:00 2001 From: Jonathan Wakely Date: Sat, 15 Nov 2025 18:19:28 +0000 Subject: [PATCH 055/373] libstdc++: Future-proof C++20 atomic wait/notify MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This will allow us to extend atomic waiting functions to support a possible future 64-bit version of futex, as well as supporting futex-like wait/wake primitives on other targets (e.g. macOS has os_sync_wait_on_address and FreeBSD has _umtx_op). Before this change, the decision of whether to do a proxy wait or to wait on the atomic variable itself was made in the header at compile-time, which makes it an ABI property that would not have been possible to change later. That would have meant that std::atomic would always have to do a proxy wait even if Linux gains support for 64-bit futex2(2) calls at some point in the future. The disadvantage of proxy waits is that several distinct atomic objects can share the same proxy state, leading to contention between threads even when they are not waiting on the same atomic object, similar to false sharing. It also result in spurious wake-ups because doing a notify on an atomic object that uses a proxy wait will wake all waiters sharing the proxy. For types that are known to definitely not need a proxy wait (e.g. int on Linux) the header can still choose a more efficient path at compile-time. But for other types, the decision of whether to do a proxy wait is deferred to runtime, inside the library internals. This will make it possible for future versions of libstdc++.so to extend the set of types which don't need to use proxy waits, without ABI changes. The way the change works is to stop using the __proxy_wait flag that was set by the inline code in the headers. Instead the __wait_args struct has an extra pointer member which the library internals populate with either the address of the atomic object or the _M_ver counter in the proxy state. There is also a new _M_obj_size member which stores the size of the atomic object, so that the library can decide whether a proxy is needed. So for example if linux gains 64-bit futex support then the library can decide not to use a proxy when _M_obj_size == 8. Finally, the _M_old member of the __wait_args struct is changed to uint64_t so that it has room to store 64-bit values, not just whatever size the __platform_wait_t type is (which is a 32-bit int on Linux). Similarly, the _M_val member of __wait_result_type changes to uint64_t too. libstdc++-v3/ChangeLog: * config/abi/pre/gnu.ver: Adjust exports. * include/bits/atomic_timed_wait.h (_GLIBCXX_HAVE_PLATFORM_TIMED_WAIT): Do not define this macro. (__atomic_wait_address_until_v, __atomic_wait_address_for_v): Adjust assertions to check that __platform_wait_uses_type is true. * include/bits/atomic_wait.h (__waitable): New concept. (__platform_wait_uses_type): Different separately for platforms with and without platform wait. (_GLIBCXX_HAVE_PLATFORM_WAIT): Do not define this macro. (__wait_value_type): New typedef. (__wait_result_type): Change _M_val to __wait_value_type. (__wait_flags): Remove __proxy_wait enumerator. Reduce range reserved for ABI version by the commented-out value. (__wait_args_base::_M_old): Change type to __wait_args_base. (__wait_args_base::_M_obj, __wait_args_base::_M_obj_size): New data members. (__wait_args::__wait_args): Set _M_obj and _M_obj_size on construction. (__wait_args::_M_setup_wait): Change void* parameter to deduced type. Adjust bit_cast to work for types of different sizes. (__wait_args::_M_load_proxy_wait_val): Remove function, replace with ... (__wait_args::_M_setup_proxy_wait): New function. (__wait_args::_S_flags_for): Do not set __proxy_wait flag. (__atomic_wait_address_v): Adjust assertion to check that __platform_wait_uses_type is true. * src/c++20/atomic.cc (_GLIBCXX_HAVE_PLATFORM_WAIT): Define here instead of in header. Check _GLIBCXX_HAVE_PLATFORM_WAIT instead of _GLIBCXX_HAVE_PLATFORM_TIMED_WAIT. (__platform_wait, __platform_notify, __platform_wait_until): Add unused parameter for _M_obj_size. (__spin_impl): Adjust for 64-bit __wait_args_base::_M_old. (use_proxy_wait): New function. (__wait_args::_M_load_proxy_wait_val): Replace with ... (__wait_args::_M_setup_proxy_wait): New function. Call use_proxy_wait to decide at runtime whether to wait on the pointer directly instead of using a proxy. If a proxy is needed, set _M_obj and _M_obj_size to refer to its _M_ver member. Adjust for change to type of _M_old. (__wait_impl): Wait on _M_obj unconditionally. Pass _M_obj_size to __platform_wait. (__notify_impl): Call use_proxy_wait to decide whether to notify on the address parameter or a proxy (__spin_until_impl): Adjust for change to type of _M_val. (__wait_until_impl): Wait on _M_obj unconditionally. Pass _M_obj_size to __platform_wait_until. Reviewed-by: Tomasz Kamiński --- libstdc++-v3/config/abi/pre/gnu.ver | 2 +- libstdc++-v3/include/bits/atomic_timed_wait.h | 20 +- libstdc++-v3/include/bits/atomic_wait.h | 157 ++++++++---- libstdc++-v3/src/c++20/atomic.cc | 240 ++++++++++-------- 4 files changed, 254 insertions(+), 165 deletions(-) diff --git a/libstdc++-v3/config/abi/pre/gnu.ver b/libstdc++-v3/config/abi/pre/gnu.ver index 2e48241d51f9..4713ff2208d1 100644 --- a/libstdc++-v3/config/abi/pre/gnu.ver +++ b/libstdc++-v3/config/abi/pre/gnu.ver @@ -2553,7 +2553,7 @@ GLIBCXX_3.4.35 { _ZNSt8__detail11__wait_implEPKvRNS_16__wait_args_baseE; _ZNSt8__detail13__notify_implEPKvbRKNS_16__wait_args_baseE; _ZNSt8__detail17__wait_until_implEPKvRNS_16__wait_args_baseERKNSt6chrono8durationI[lx]St5ratioIL[lx]1EL[lx]1000000000EEEE; - _ZNSt8__detail11__wait_args22_M_load_proxy_wait_valEPKv; + _ZNSt8__detail11__wait_args19_M_setup_proxy_waitEPKv; # std::chrono::gps_clock::now, tai_clock::now _ZNSt6chrono9gps_clock3nowEv; diff --git a/libstdc++-v3/include/bits/atomic_timed_wait.h b/libstdc++-v3/include/bits/atomic_timed_wait.h index 30f7ff616840..5b3158050668 100644 --- a/libstdc++-v3/include/bits/atomic_timed_wait.h +++ b/libstdc++-v3/include/bits/atomic_timed_wait.h @@ -75,14 +75,6 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION return chrono::ceil<__w_dur>(__atime); } -#ifdef _GLIBCXX_HAVE_LINUX_FUTEX -#define _GLIBCXX_HAVE_PLATFORM_TIMED_WAIT -#else -// define _GLIBCXX_HAVE_PLATFORM_TIMED_WAIT and implement __platform_wait_until -// if there is a more efficient primitive supported by the platform -// (e.g. __ulock_wait) which is better than pthread_cond_clockwait. -#endif // ! HAVE_LINUX_FUTEX - __wait_result_type __wait_until_impl(const void* __addr, __wait_args_base& __args, const __wait_clock_t::duration& __atime); @@ -156,9 +148,9 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION const chrono::time_point<_Clock, _Dur>& __atime, bool __bare_wait = false) noexcept { -#ifndef _GLIBCXX_HAVE_PLATFORM_TIMED_WAIT - __glibcxx_assert(false); // This function can't be used for proxy wait. -#endif + // This function must not be used if __wait_impl might use a proxy wait: + __glibcxx_assert(__platform_wait_uses_type<__detail::__platform_wait_t>); + __detail::__wait_args __args{ __addr, __old, __order, __bare_wait }; auto __res = __detail::__wait_until(__addr, __args, __atime); return !__res._M_timeout; // C++26 will also return last observed __val @@ -208,9 +200,9 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION const chrono::duration<_Rep, _Period>& __rtime, bool __bare_wait = false) noexcept { -#ifndef _GLIBCXX_HAVE_PLATFORM_TIMED_WAIT - __glibcxx_assert(false); // This function can't be used for proxy wait. -#endif + // This function must not be used if __wait_impl might use a proxy wait: + __glibcxx_assert(__platform_wait_uses_type<__detail::__platform_wait_t>); + __detail::__wait_args __args{ __addr, __old, __order, __bare_wait }; auto __res = __detail::__wait_for(__addr, __args, __rtime); return !__res._M_timeout; // C++26 will also return last observed __val diff --git a/libstdc++-v3/include/bits/atomic_wait.h b/libstdc++-v3/include/bits/atomic_wait.h index 95151479c120..6d8c0de4af68 100644 --- a/libstdc++-v3/include/bits/atomic_wait.h +++ b/libstdc++-v3/include/bits/atomic_wait.h @@ -45,35 +45,51 @@ namespace std _GLIBCXX_VISIBILITY(default) { _GLIBCXX_BEGIN_NAMESPACE_VERSION + + namespace __detail + { + // TODO: this needs to be false for types with padding, e.g. __int20. + // TODO: should this be true only for integral, enum, and pointer types? + template + concept __waitable + = is_scalar_v<_Tp> && __builtin_popcountg(sizeof(_Tp)) == 1 + && (sizeof(_Tp) <= sizeof(__UINT64_TYPE__)); + } + +#if defined _GLIBCXX_HAVE_LINUX_FUTEX namespace __detail { -#ifdef _GLIBCXX_HAVE_LINUX_FUTEX -#define _GLIBCXX_HAVE_PLATFORM_WAIT 1 + // Use futex syscall on int objects. using __platform_wait_t = int; inline constexpr size_t __platform_wait_alignment = 4; + } + // Defined to true for a subset of __waitable types which are statically + // known to definitely be able to use futex, not a proxy wait. + template + inline constexpr bool __platform_wait_uses_type + = __detail::__waitable<_Tp> + && sizeof(_Tp) == sizeof(int) && alignof(_Tp) >= 4; #else // define _GLIBCX_HAVE_PLATFORM_WAIT and implement __platform_wait() // and __platform_notify() if there is a more efficient primitive supported // by the platform (e.g. __ulock_wait()/__ulock_wake()) which is better than // a mutex/condvar based wait. + namespace __detail + { # if ATOMIC_LONG_LOCK_FREE == 2 using __platform_wait_t = unsigned long; # else using __platform_wait_t = unsigned int; # endif inline constexpr size_t __platform_wait_alignment - = __alignof__(__platform_wait_t); -#endif + = sizeof(__platform_wait_t) < __alignof__(__platform_wait_t) + ? __alignof__(__platform_wait_t) : sizeof(__platform_wait_t); } // namespace __detail - template - inline constexpr bool __platform_wait_uses_type -#ifdef _GLIBCXX_HAVE_PLATFORM_WAIT - = is_scalar_v<_Tp> - && ((sizeof(_Tp) == sizeof(__detail::__platform_wait_t)) - && (alignof(_Tp) >= __detail::__platform_wait_alignment)); -#else - = false; + // This must be false for the general case where we don't know of any + // futex-like syscall. + template + inline constexpr bool __platform_wait_uses_type = false; #endif namespace __detail @@ -105,10 +121,13 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION return __builtin_memcmp(&__a, &__b, sizeof(_Tp)) == 0; } - // lightweight std::optional<__platform_wait_t> + // Storage for up to 64 bits of value, should be considered opaque bits. + using __wait_value_type = __UINT64_TYPE__; + + // lightweight std::optional<__wait_value_type> struct __wait_result_type { - __platform_wait_t _M_val; + __wait_value_type _M_val; unsigned char _M_has_val : 1; // _M_val value was loaded before return. unsigned char _M_timeout : 1; // Waiting function ended with timeout. unsigned char _M_unused : 6; // padding @@ -116,12 +135,12 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION enum class __wait_flags : __UINT_LEAST32_TYPE__ { - __abi_version = 0, - __proxy_wait = 1, + __abi_version = 0x00000000, + // currently unused = 1, __track_contention = 2, __do_spin = 4, __spin_only = 8, // Ignored unless __do_spin is also set. - // __abi_version_mask = 0xffff0000, + // __abi_version_mask = 0xff000000, }; [[__gnu__::__always_inline__]] @@ -143,8 +162,10 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION { __wait_flags _M_flags; int _M_order = __ATOMIC_ACQUIRE; - __platform_wait_t _M_old = 0; + __wait_value_type _M_old = 0; void* _M_wait_state = nullptr; + const void* _M_obj = nullptr; // The address of the object to wait on. + unsigned char _M_obj_size = 0; // The size of that object. // Test whether _M_flags & __flags is non-zero. bool @@ -162,53 +183,88 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION explicit __wait_args(const _Tp* __addr, bool __bare_wait = false) noexcept : __wait_args_base{ _S_flags_for(__addr, __bare_wait) } - { } + { + _M_obj = __addr; // Might be replaced by _M_setup_wait + if constexpr (__waitable<_Tp>) + // __wait_impl might be able to wait directly on __addr + // instead of using a proxy, depending on its size. + _M_obj_size = sizeof(_Tp); + } __wait_args(const __platform_wait_t* __addr, __platform_wait_t __old, int __order, bool __bare_wait = false) noexcept - : __wait_args_base{ _S_flags_for(__addr, __bare_wait), __order, __old } - { } + : __wait_args(__addr, __bare_wait) + { + _M_order = __order; + _M_old = __old; + } __wait_args(const __wait_args&) noexcept = default; __wait_args& operator=(const __wait_args&) noexcept = default; - template()())>> + template _Tp - _M_setup_wait(const void* __addr, _ValFn __vfn, + _M_setup_wait(const _Tp* __addr, _ValFn __vfn, __wait_result_type __res = {}) { - if constexpr (__platform_wait_uses_type<_Tp>) - { - // If the wait is not proxied, the value we check when waiting - // is the value of the atomic variable itself. + static_assert(is_same_v<_Tp, decay_t>); - if (__res._M_has_val) // The previous wait loaded a recent value. + if (__res._M_has_val) // A previous wait loaded a recent value. + { + _M_old = __res._M_val; + if constexpr (!__platform_wait_uses_type<_Tp>) { - _M_old = __res._M_val; - return __builtin_bit_cast(_Tp, __res._M_val); + // __res._M_val might be the value of a proxy wait object, + // not the value of *__addr. Call __vfn() to get new value. + return __vfn(); } - else // Load the value from __vfn + // Not a proxy wait, so the value in __res._M_val was loaded + // from *__addr and we don't need to call __vfn(). + else if constexpr (sizeof(_Tp) == sizeof(__UINT32_TYPE__)) + return __builtin_bit_cast(_Tp, (__UINT32_TYPE__)_M_old); + else if constexpr (sizeof(_Tp) == sizeof(__UINT64_TYPE__)) + return __builtin_bit_cast(_Tp, (__UINT64_TYPE__)_M_old); + else { - _Tp __val = __vfn(); - _M_old = __builtin_bit_cast(__platform_wait_t, __val); - return __val; + static_assert(false); // Unsupported size + return {}; } } - else // It's a proxy wait and the proxy's _M_ver is used. - { - if (__res._M_has_val) // The previous wait loaded a recent value. - _M_old = __res._M_val; - else // Load _M_ver from the proxy (must happen before __vfn()). - _M_load_proxy_wait_val(__addr); - return __vfn(); - } + + if constexpr (!__platform_wait_uses_type<_Tp>) + if (_M_setup_proxy_wait(__addr)) + { + // We will use a proxy wait for this object. + // The library has set _M_obj and _M_obj_size and _M_old. + // Call __vfn to load the current value from *__addr + // (which must happen after the call to _M_setup_proxy_wait). + return __vfn(); + } + + // We will use a futex-like operation to wait on this object, + // and so can just load the value and store it into _M_old. + auto __val = __vfn(); + // We have to consider various sizes, because a future libstdc++.so + // might enable non-proxy waits for additional sizes. + if constexpr (sizeof(_Tp) == sizeof(__UINT64_TYPE__)) + _M_old = __builtin_bit_cast(__UINT64_TYPE__, __val); + else if constexpr (sizeof(_Tp) == sizeof(__UINT32_TYPE__)) + _M_old = __builtin_bit_cast(__UINT32_TYPE__, __val); + else if constexpr (sizeof(_Tp) == sizeof(__UINT16_TYPE__)) + _M_old = __builtin_bit_cast(__UINT16_TYPE__, __val); + else if constexpr (sizeof(_Tp) == sizeof(__UINT8_TYPE__)) + _M_old = __builtin_bit_cast(__UINT8_TYPE__, __val); + else // _M_setup_proxy_wait should have returned true for this type! + __glibcxx_assert(false); + return __val; } private: - // Populates _M_wait_state and _M_old from the proxy for __addr. - void - _M_load_proxy_wait_val(const void* __addr); + // Returns true if a proxy wait will be used for __addr, false otherwise. + // If true, _M_wait_state, _M_obj, _M_obj_size, and _M_old are set. + // If false, data members are unchanged. + bool + _M_setup_proxy_wait(const void* __addr); template static constexpr __wait_flags @@ -218,8 +274,6 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION __wait_flags __res = __abi_version | __do_spin; if (!__bare_wait) __res |= __track_contention; - if constexpr (!__platform_wait_uses_type<_Tp>) - __res |= __proxy_wait; return __res; } }; @@ -234,6 +288,7 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION // Wait on __addr while __pred(__vfn()) is false. // If __bare_wait is false, increment a counter while waiting. // For callers that keep their own count of waiters, use __bare_wait=true. + // The effect of __vfn() must be an atomic load from __addr and nothing else. template void __atomic_wait_address(const _Tp* __addr, _Pred&& __pred, _ValFn&& __vfn, @@ -255,9 +310,9 @@ _GLIBCXX_BEGIN_NAMESPACE_VERSION __detail::__platform_wait_t __old, int __order, bool __bare_wait = false) { -#ifndef _GLIBCXX_HAVE_PLATFORM_WAIT - __glibcxx_assert(false); // This function can't be used for proxy wait. -#endif + // This function must not be used if __wait_impl might use a proxy wait: + __glibcxx_assert(__platform_wait_uses_type<__detail::__platform_wait_t>); + __detail::__wait_args __args{ __addr, __old, __order, __bare_wait }; // C++26 will not ignore the return value here __detail::__wait_impl(__addr, __args); diff --git a/libstdc++-v3/src/c++20/atomic.cc b/libstdc++-v3/src/c++20/atomic.cc index e280045b619d..80915617f0bf 100644 --- a/libstdc++-v3/src/c++20/atomic.cc +++ b/libstdc++-v3/src/c++20/atomic.cc @@ -27,25 +27,18 @@ #if __glibcxx_atomic_wait #include #include -#include -#include +#include // uint32_t, uint64_t +#include // INT_MAX +#include // errno, ETIMEDOUT, etc. #include // std::mutex, std::__condvar +#include // __throw_system_error +#include #ifdef _GLIBCXX_HAVE_LINUX_FUTEX -# include -# include # include # include -# include -# include -#endif - -#ifdef _GLIBCXX_HAVE_PLATFORM_WAIT -# ifndef _GLIBCXX_HAVE_PLATFORM_TIMED_WAIT -// __waitable_state assumes that we consistently use the same implementation -// (i.e. futex vs mutex+condvar) for timed and untimed waiting. -# error "This configuration is not currently supported" -# endif +# include // timespec +# define _GLIBCXX_HAVE_PLATFORM_WAIT 1 #endif #pragma GCC diagnostic ignored "-Wmissing-field-initializers" @@ -77,25 +70,45 @@ namespace }; void - __platform_wait(const int* __addr, int __val) noexcept + __platform_wait(const int* addr, int val, int /* obj_size */) noexcept { - auto __e = syscall (SYS_futex, __addr, - static_cast(__futex_wait_flags::__wait_private), - __val, nullptr); - if (!__e || errno == EAGAIN) - return; - if (errno != EINTR) - __throw_system_error(errno); + if (syscall(SYS_futex, addr, + static_cast(__futex_wait_flags::__wait_private), + val, nullptr)) + if (errno != EAGAIN && errno != EINTR) + __throw_system_error(errno); } void - __platform_notify(const int* __addr, bool __all) noexcept + __platform_notify(const int* addr, bool all, int) noexcept { - syscall (SYS_futex, __addr, - static_cast(__futex_wait_flags::__wake_private), - __all ? INT_MAX : 1); + syscall(SYS_futex, addr, + static_cast(__futex_wait_flags::__wake_private), + all ? INT_MAX : 1); } -#endif + + // returns true if wait ended before timeout + bool + __platform_wait_until(const __platform_wait_t* addr, + __platform_wait_t val, + const __wait_clock_t::time_point& __atime, + int /* obj_size */) noexcept + { + struct timespec timeout = chrono::__to_timeout_timespec(__atime); + + if (syscall(SYS_futex, addr, + static_cast(__futex_wait_flags::__wait_bitset_private), + val, &timeout, nullptr, + static_cast(__futex_wait_flags::__bitset_match_any))) + { + if (errno == ETIMEDOUT) + return false; + if (errno != EAGAIN && errno != EINTR) + __throw_system_error(errno); + } + return true; + } +#endif // HAVE_LINUX_FUTEX // The state used by atomic waiting and notifying functions. struct __waitable_state @@ -107,7 +120,7 @@ namespace // Count of threads blocked waiting on this state. alignas(_S_align) __platform_wait_t _M_waiters = 0; -#ifndef _GLIBCXX_HAVE_PLATFORM_TIMED_WAIT +#ifndef _GLIBCXX_HAVE_PLATFORM_WAIT mutex _M_mtx; // This type meets the Cpp17BasicLockable requirements. @@ -123,7 +136,7 @@ namespace // use this for waiting and notifying functions instead. alignas(_S_align) __platform_wait_t _M_ver = 0; -#ifndef _GLIBCXX_HAVE_PLATFORM_TIMED_WAIT +#ifndef _GLIBCXX_HAVE_PLATFORM_WAIT __condvar _M_cv; #endif @@ -215,18 +228,18 @@ namespace __wait_result_type __spin_impl(const __platform_wait_t* __addr, const __wait_args_base& __args) { - __platform_wait_t __val{}; + __wait_value_type wval; for (auto __i = 0; __i < __atomic_spin_count; ++__i) { - __atomic_load(__addr, &__val, __args._M_order); - if (__val != __args._M_old) - return { ._M_val = __val, ._M_has_val = true, ._M_timeout = false }; + wval = __atomic_load_n(__addr, __args._M_order); + if (wval != __args._M_old) + return { ._M_val = wval, ._M_has_val = true, ._M_timeout = false }; if (__i < __atomic_spin_count_relax) __thread_relax(); else __thread_yield(); } - return { ._M_val = __val, ._M_has_val = true, ._M_timeout = true }; + return { ._M_val = wval, ._M_has_val = true, ._M_timeout = true }; } inline __waitable_state* @@ -237,32 +250,70 @@ namespace return static_cast<__waitable_state*>(args._M_wait_state); } + [[gnu::always_inline]] + inline bool + use_proxy_wait([[maybe_unused]] const __wait_args_base& args, + [[maybe_unused]] const void* /* addr */) + { +#ifdef _GLIBCXX_HAVE_PLATFORM_WAIT + if constexpr (__platform_wait_uses_type) + if (args._M_obj_size == sizeof(uint32_t)) + return false; + + if constexpr (__platform_wait_uses_type) + if (args._M_obj_size == sizeof(uint64_t)) + return false; + + // __wait_args::_M_old can only hold 64 bits, so larger types + // must always use a proxy wait. + if (args._M_obj_size > sizeof(uint64_t)) + return true; + + // __wait_args::_M_setup_wait only knows how to store 1/2/4/8 byte types, + // so anything else must always use a proxy wait. + if (__builtin_popcountg(args._M_obj_size) != 1) + return true; +#endif + + // Currently use proxy wait for everything else: + return true; + } + } // namespace -// Called for a proxy wait -void -__wait_args::_M_load_proxy_wait_val(const void* addr) +// Return false (and don't change any data members) if we can do a non-proxy +// wait for the object of size `_M_obj_size` at address `addr`. +// Otherwise, the object at addr needs to use a proxy wait. Set _M_wait_state, +// set _M_obj and _M_obj_size to refer to the _M_wait_state->_M_ver proxy, +// load the current value from _M_obj and store it in _M_old, then return true. +bool +__wait_args::_M_setup_proxy_wait(const void* addr) { - // __glibcxx_assert( *this & __wait_flags::__proxy_wait ); + if (!use_proxy_wait(*this, addr)) // We can wait on this address directly. + { + // Ensure the caller set _M_obj correctly, as that's what we'll wait on: + __glibcxx_assert(_M_obj == addr); + return false; + } - // We always need a waitable state for proxy waits. + // This will be a proxy wait, so get a waitable state. auto state = set_wait_state(addr, *this); + // The address we will wait on is the version count of the waitable state: + _M_obj = &state->_M_ver; + // __wait_impl and __wait_until_impl need to know this size: + _M_obj_size = sizeof(state->_M_ver); + // Read the value of the _M_ver counter. - __atomic_load(&state->_M_ver, &_M_old, __ATOMIC_ACQUIRE); + _M_old = __atomic_load_n(&state->_M_ver, __ATOMIC_ACQUIRE); + + return true; } __wait_result_type -__wait_impl(const void* __addr, __wait_args_base& __args) +__wait_impl([[maybe_unused]] const void* __addr, __wait_args_base& __args) { - auto __state = static_cast<__waitable_state*>(__args._M_wait_state); - - const __platform_wait_t* __wait_addr; - - if (__args & __wait_flags::__proxy_wait) - __wait_addr = &__state->_M_ver; - else - __wait_addr = static_cast(__addr); + auto* __wait_addr = static_cast(__args._M_obj); if (__args & __wait_flags::__do_spin) { @@ -277,7 +328,7 @@ __wait_impl(const void* __addr, __wait_args_base& __args) if (__args & __wait_flags::__track_contention) set_wait_state(__addr, __args); // scoped_wait needs a __waitable_state scoped_wait s(__args); - __platform_wait(__wait_addr, __args._M_old); + __platform_wait(__wait_addr, __args._M_old, __args._M_obj_size); // We haven't loaded a new value so return _M_has_val=false return { ._M_val = __args._M_old, ._M_has_val = false, ._M_timeout = false }; #else @@ -286,6 +337,7 @@ __wait_impl(const void* __addr, __wait_args_base& __args) __atomic_load(__wait_addr, &__val, __args._M_order); if (__val == __args._M_old) { + auto __state = static_cast<__waitable_state*>(__args._M_wait_state); __state->_M_cv.wait(__state->_M_mtx); return { ._M_val = __val, ._M_has_val = false, ._M_timeout = false }; } @@ -294,24 +346,40 @@ __wait_impl(const void* __addr, __wait_args_base& __args) } void -__notify_impl(const void* __addr, [[maybe_unused]] bool __all, +__notify_impl([[maybe_unused]] const void* __addr, [[maybe_unused]] bool __all, const __wait_args_base& __args) { - auto __state = static_cast<__waitable_state*>(__args._M_wait_state); - if (!__state) - __state = &__waitable_state::_S_state_for(__addr); + const bool __track_contention = __args & __wait_flags::__track_contention; + const bool proxy_wait = use_proxy_wait(__args, __addr); + + [[maybe_unused]] auto* __wait_addr + = static_cast(__addr); + +#ifdef _GLIBCXX_HAVE_PLATFORM_WAIT + // Check whether it would be a non-proxy wait for this object. + // This condition must match the one in _M_setup_wait_impl to ensure that + // the address used for the notify matches the one used for the wait. + if (!proxy_wait) + { + if (__track_contention) + if (!__waitable_state::_S_state_for(__addr)._M_waiting()) + return; + + __platform_notify(__wait_addr, __all, __args._M_obj_size); + return; + } +#endif + + // Either a proxy wait or we don't have platform wait/wake primitives. - [[maybe_unused]] const __platform_wait_t* __wait_addr; + auto __state = &__waitable_state::_S_state_for(__addr); // Lock mutex so that proxied waiters cannot race with incrementing _M_ver // and see the old value, then sleep after the increment and notify_all(). lock_guard __l{ *__state }; - if (__args & __wait_flags::__proxy_wait) + if (proxy_wait) { - // Waiting for *__addr is actually done on the proxy's _M_ver. - __wait_addr = &__state->_M_ver; - // Increment _M_ver so that waiting threads see something changed. // This has to be atomic because the load in _M_load_proxy_wait_val // is done without the mutex locked. @@ -322,18 +390,18 @@ __notify_impl(const void* __addr, [[maybe_unused]] bool __all, // they can re-evaluate their conditions to see if they should // stop waiting or should wait again. __all = true; + + __wait_addr = &__state->_M_ver; } - else // Use the atomic variable's own address. - __wait_addr = static_cast(__addr); - if (__args & __wait_flags::__track_contention) + if (__track_contention) { if (!__state->_M_waiting()) return; } #ifdef _GLIBCXX_HAVE_PLATFORM_WAIT - __platform_notify(__wait_addr, __all); + __platform_notify(__wait_addr, __all, sizeof(__state->_M_ver)); #else __state->_M_cv.notify_all(); #endif @@ -343,30 +411,7 @@ __notify_impl(const void* __addr, [[maybe_unused]] bool __all, namespace { -#ifdef _GLIBCXX_HAVE_LINUX_FUTEX -// returns true if wait ended before timeout -bool -__platform_wait_until(const __platform_wait_t* __addr, - __platform_wait_t __old, - const __wait_clock_t::time_point& __atime) noexcept -{ - struct timespec __rt = chrono::__to_timeout_timespec(__atime); - - if (syscall (SYS_futex, __addr, - static_cast(__futex_wait_flags::__wait_bitset_private), - __old, &__rt, nullptr, - static_cast(__futex_wait_flags::__bitset_match_any))) - { - if (errno == ETIMEDOUT) - return false; - if (errno != EINTR && errno != EAGAIN) - __throw_system_error(errno); - } - return true; -} -#endif // HAVE_LINUX_FUTEX - -#ifndef _GLIBCXX_HAVE_PLATFORM_TIMED_WAIT +#ifndef _GLIBCXX_HAVE_PLATFORM_WAIT bool __cond_wait_until(__condvar& __cv, mutex& __mx, const __wait_clock_t::time_point& __atime) @@ -381,7 +426,7 @@ __cond_wait_until(__condvar& __cv, mutex& __mx, __cv.wait_until(__mx, __ts); return __wait_clock_t::now() < __atime; } -#endif // ! HAVE_PLATFORM_TIMED_WAIT +#endif // ! HAVE_PLATFORM_WAIT // Unlike __spin_impl, does not always return _M_has_val == true. // If the deadline has already passed then no fresh value is loaded. @@ -414,7 +459,7 @@ __spin_until_impl(const __platform_wait_t* __addr, return __res; } - __atomic_load(__addr, &__res._M_val, __args._M_order); + __res._M_val = __atomic_load_n(__addr, __args._M_order); __res._M_has_val = true; if (__res._M_val != __args._M_old) { @@ -428,16 +473,11 @@ __spin_until_impl(const __platform_wait_t* __addr, } // namespace __wait_result_type -__wait_until_impl(const void* __addr, __wait_args_base& __args, +__wait_until_impl([[maybe_unused]] const void* __addr, __wait_args_base& __args, const __wait_clock_t::duration& __time) { const __wait_clock_t::time_point __atime(__time); - auto __state = static_cast<__waitable_state*>(__args._M_wait_state); - const __platform_wait_t* __wait_addr; - if (__args & __wait_flags::__proxy_wait) - __wait_addr = &__state->_M_ver; - else - __wait_addr = static_cast(__addr); + auto* __wait_addr = static_cast(__args._M_obj); if (__args & __wait_flags::__do_spin) { @@ -448,11 +488,12 @@ __wait_until_impl(const void* __addr, __wait_args_base& __args, return __res; } -#ifdef _GLIBCXX_HAVE_PLATFORM_TIMED_WAIT +#ifdef _GLIBCXX_HAVE_PLATFORM_WAIT if (__args & __wait_flags::__track_contention) - set_wait_state(__addr, __args); + set_wait_state(__addr, __args); // scoped_wait needs a __waitable_state scoped_wait s(__args); - bool timeout = !__platform_wait_until(__wait_addr, __args._M_old, __atime); + bool timeout = !__platform_wait_until(__wait_addr, __args._M_old, __atime, + __args._M_obj_size); return { ._M_val = __args._M_old, ._M_has_val = false, ._M_timeout = timeout }; #else waiter_lock l(__args); @@ -460,6 +501,7 @@ __wait_until_impl(const void* __addr, __wait_args_base& __args, __atomic_load(__wait_addr, &__val, __args._M_order); if (__val == __args._M_old) { + auto __state = static_cast<__waitable_state*>(__args._M_wait_state); bool timeout = !__cond_wait_until(__state->_M_cv, __state->_M_mtx, __atime); return { ._M_val = __val, ._M_has_val = false, ._M_timeout = timeout }; } From b5ffe35f12e15e29b508eb937251d067febe18fe Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Thu, 27 Nov 2025 10:04:19 +0100 Subject: [PATCH 056/373] tree-optimization/122885 - avoid re-using accumulator for some bool vectors When boolean vectors do not use vector integer modes we are not set up to produce the partial epilog in a correctly typed way, so avoid this situation. For the integer mode case we are able to pun things correctly, so keep that working. PR tree-optimization/122885 * tree-vect-loop.cc (vect_find_reusable_accumulator): Reject mask vectors which do not use integer vector modes. (vect_create_partial_epilog): Assert the same. * gcc.dg/torture/pr122873.c: New testcase. --- gcc/testsuite/gcc.dg/torture/pr122873.c | 13 +++++++++++++ gcc/tree-vect-loop.cc | 9 +++++++++ 2 files changed, 22 insertions(+) create mode 100644 gcc/testsuite/gcc.dg/torture/pr122873.c diff --git a/gcc/testsuite/gcc.dg/torture/pr122873.c b/gcc/testsuite/gcc.dg/torture/pr122873.c new file mode 100644 index 000000000000..1eadceedcd85 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr122873.c @@ -0,0 +1,13 @@ +/* { dg-do compile } */ +/* { dg-additional-options "-march=armv9-a -msve-vector-bits=128" { target { aarch64-*-* } } } */ +/* { dg-additional-options "-mavx512bw -mavx512vl --param vect-partial-vector-usage=1" { target { avx512bw && avx512vl } } } */ + +char *b; +bool c(int l) +{ + bool d = true; + for (int a = 0; a < l; a++) + if (b[a]) + d = false; + return d; +} diff --git a/gcc/tree-vect-loop.cc b/gcc/tree-vect-loop.cc index fe78107fe04c..ab6c0f084703 100644 --- a/gcc/tree-vect-loop.cc +++ b/gcc/tree-vect-loop.cc @@ -5026,6 +5026,12 @@ vect_find_reusable_accumulator (loop_vec_info loop_vinfo, if (VECT_REDUC_INFO_TYPE (reduc_info) != TREE_CODE_REDUCTION) return false; + /* We are not set up to handle vector bools when they are not mapped + to vector integer data types. */ + if (VECTOR_BOOLEAN_TYPE_P (vectype) + && GET_MODE_CLASS (TYPE_MODE (vectype)) != MODE_VECTOR_INT) + return false; + unsigned int num_phis = VECT_REDUC_INFO_INITIAL_VALUES (reduc_info).length (); auto_vec main_loop_results (num_phis); auto_vec initial_values (num_phis); @@ -5126,6 +5132,9 @@ static tree vect_create_partial_epilog (tree vec_def, tree vectype, code_helper code, gimple_seq *seq) { + gcc_assert (!VECTOR_BOOLEAN_TYPE_P (TREE_TYPE (vec_def)) + || (GET_MODE_CLASS (TYPE_MODE (TREE_TYPE (vec_def))) + == MODE_VECTOR_INT)); unsigned nunits = TYPE_VECTOR_SUBPARTS (TREE_TYPE (vec_def)).to_constant (); unsigned nunits1 = TYPE_VECTOR_SUBPARTS (vectype).to_constant (); tree stype = TREE_TYPE (vectype); From 7d73dbb6322671c597930044a76e24436aaa6cd5 Mon Sep 17 00:00:00 2001 From: Christophe Lyon Date: Thu, 27 Nov 2025 10:52:54 +0000 Subject: [PATCH 057/373] arm: Remove spurious 'volatile' qualifier Remove the 'volatile' qualifier which looks like an oversight and is causing build errors: '++' expression of 'volatile'-qualified type is deprecated. gcc/ChangeLog: * config/arm/arm-builtins.cc (arm_init_mve_builtins): Remove volatile qualifier. --- gcc/config/arm/arm-builtins.cc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/config/arm/arm-builtins.cc b/gcc/config/arm/arm-builtins.cc index b0bbb32644c5..b421cac51cfe 100644 --- a/gcc/config/arm/arm-builtins.cc +++ b/gcc/config/arm/arm-builtins.cc @@ -1449,7 +1449,7 @@ arm_init_cde_builtins (void) static void arm_init_mve_builtins (void) { - volatile unsigned int i, fcode = ARM_BUILTIN_MVE_PATTERN_START; + unsigned int i, fcode = ARM_BUILTIN_MVE_PATTERN_START; arm_init_simd_builtin_scalar_types (); arm_init_simd_builtin_types (); From b7169019d7d75d7bdc93cfce86ee161627df3c22 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Thu, 27 Nov 2025 11:54:43 +0100 Subject: [PATCH 058/373] match.pd: Introduce gimple_match_range_of_expr [PR119683] On Wed, Nov 26, 2025 at 09:52:50AM +0100, Richard Biener wrote: > I wonder if it makes sense to wrap > get_range_query (cfun)->range_of_expr (r, @0, gimple_match_ctx (@4)) > into sth like gimple_match_range_of_expr (r, @0, @4)? It does make sense, so the following patch implements that. Note, gimple-match.h is a bad location for that helper, because lots of users use it without having value-range.h included and it is for APIs to use the gimple folders, not for match.pd helpers themselves, so I've moved there gimple_match_ctx as well. 2025-11-27 Jakub Jelinek PR tree-optimization/119683 * gimple-match.h (gimple_match_ctx): Move to ... * gimple-match-head.cc (gimple_match_ctx): ... here. Make static. (gimple_match_range_of_expr): New static inline. * match.pd ((mult (plus:s (mult:s @0 @1) @2) @3)): Use gimple_match_range_of_expr. ((plus (mult:s (plus:s @0 @1) @2) @3)): Likewise. ((t * u) / u -> t): Likewise. ((t * u) / v -> t * (u / v)): Likewise. ((X + M*N) / N -> X / N + M): Likewise. ((X - M*N) / N -> X / N - M): Likewise. ((X + C) / N -> X / N + C / N): Likewise. (((T)(A)) + CST -> (T)(A + CST)): Likewise (x_5 == cstN ? cst4 : cst3): Likewise. Do r.set_varying even when gimple_match_range_of_expr failed. --- gcc/gimple-match-head.cc | 26 ++++++++++++++++ gcc/gimple-match.h | 13 -------- gcc/match.pd | 66 +++++++++++++++------------------------- 3 files changed, 51 insertions(+), 54 deletions(-) diff --git a/gcc/gimple-match-head.cc b/gcc/gimple-match-head.cc index 6b3c5febbea7..f8d0acf81462 100644 --- a/gcc/gimple-match-head.cc +++ b/gcc/gimple-match-head.cc @@ -507,3 +507,29 @@ match_cond_with_binary_phi (gphi *phi, tree *true_arg, tree *false_arg) return cond; } + +/* If OP is a SSA_NAME with SSA_NAME_DEF_STMT in the IL, return that + stmt, otherwise NULL. For use in range_of_expr calls. */ + +static inline gimple * +gimple_match_ctx (tree op) +{ + if (TREE_CODE (op) == SSA_NAME + && SSA_NAME_DEF_STMT (op) + && gimple_bb (SSA_NAME_DEF_STMT (op))) + return SSA_NAME_DEF_STMT (op); + return NULL; +} + +/* Helper to shorten range queries in match.pd. R is the range to + be queried, OP tree on which it should be queried and CTX is some + capture on which gimple_match_ctx should be called, or NULL for + global range. */ + +static inline bool +gimple_match_range_of_expr (vrange &r, tree op, tree ctx = NULL_TREE) +{ + return get_range_query (cfun)->range_of_expr (r, op, + ctx ? gimple_match_ctx (ctx) + : NULL); +} diff --git a/gcc/gimple-match.h b/gcc/gimple-match.h index a2c931fa60c7..70f2f68827b4 100644 --- a/gcc/gimple-match.h +++ b/gcc/gimple-match.h @@ -427,17 +427,4 @@ bool directly_supported_p (code_helper, tree, tree, internal_fn get_conditional_internal_fn (code_helper, tree); -/* If OP is a SSA_NAME with SSA_NAME_DEF_STMT in the IL, return that - stmt, otherwise NULL. For use in range_of_expr calls. */ - -inline gimple * -gimple_match_ctx (tree op) -{ - if (TREE_CODE (op) == SSA_NAME - && SSA_NAME_DEF_STMT (op) - && gimple_bb (SSA_NAME_DEF_STMT (op))) - return SSA_NAME_DEF_STMT (op); - return NULL; -} - #endif /* GCC_GIMPLE_MATCH_H */ diff --git a/gcc/match.pd b/gcc/match.pd index 05c8b59eb9e8..c76238a27f76 100644 --- a/gcc/match.pd +++ b/gcc/match.pd @@ -661,8 +661,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) #if GIMPLE int_range_max vr0; if (ovf1 == wi::OVF_NONE && ovf2 == wi::OVF_NONE - && get_range_query (cfun)->range_of_expr (vr0, @4, - gimple_match_ctx (@5)) + && gimple_match_range_of_expr (vr0, @4, @5) && !vr0.varying_p () && !vr0.undefined_p ()) { wide_int wmin0 = vr0.lower_bound (); @@ -703,8 +702,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) #if GIMPLE int_range_max vr0; if (ovf1 == wi::OVF_NONE && ovf2 == wi::OVF_NONE - && get_range_query (cfun)->range_of_expr (vr0, @0, - gimple_match_ctx (@4)) + && gimple_match_range_of_expr (vr0, @0, @4) && !vr0.varying_p () && !vr0.undefined_p ()) { wide_int wmin0 = vr0.lower_bound (); @@ -1025,10 +1023,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) #if GIMPLE (with {int_range_max vr0, vr1;} (if (INTEGRAL_TYPE_P (type) - && get_range_query (cfun)->range_of_expr (vr0, @0, - gimple_match_ctx (@2)) - && get_range_query (cfun)->range_of_expr (vr1, @1, - gimple_match_ctx (@2)) + && gimple_match_range_of_expr (vr0, @0, @2) + && gimple_match_range_of_expr (vr1, @1, @2) && range_op_handler (MULT_EXPR).overflow_free_p (vr0, vr1)) @0)) #endif @@ -1042,9 +1038,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (if (TYPE_OVERFLOW_UNDEFINED (type) && !TYPE_OVERFLOW_SANITIZED (type)) (mult @0 (div! @1 @2)) (with {int_range_max vr0, vr1;} - (if (get_range_query (cfun)->range_of_expr (vr0, @0, - gimple_match_ctx (@3)) - && get_range_query (cfun)->range_of_expr (vr1, @1) + (if (gimple_match_range_of_expr (vr0, @0, @3) + && gimple_match_range_of_expr (vr1, @1) && range_op_handler (MULT_EXPR).overflow_free_p (vr0, vr1)) (mult @0 (div! @1 @2)))) ))) @@ -1058,10 +1053,9 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (div @1 @2) #if GIMPLE (with {int_range_max vr0, vr1, vr2;} - (if (get_range_query (cfun)->range_of_expr (vr0, @0, - gimple_match_ctx (@3)) - && get_range_query (cfun)->range_of_expr (vr1, @1) - && get_range_query (cfun)->range_of_expr (vr2, @2) + (if (gimple_match_range_of_expr (vr0, @0, @3) + && gimple_match_range_of_expr (vr1, @1) + && gimple_match_range_of_expr (vr2, @2) && range_op_handler (MULT_EXPR).overflow_free_p (vr0, vr1) && range_op_handler (MULT_EXPR).overflow_free_p (vr0, vr2)) (div @1 @2))) @@ -1075,19 +1069,15 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (div (plus:c@4 @0 (mult:c@3 @1 @2)) @2) (with {int_range_max vr0, vr1, vr2, vr3, vr4;} (if (INTEGRAL_TYPE_P (type) - && get_range_query (cfun)->range_of_expr (vr1, @1, - gimple_match_ctx (@3)) - && get_range_query (cfun)->range_of_expr (vr2, @2, - gimple_match_ctx (@3)) + && gimple_match_range_of_expr (vr1, @1, @3) + && gimple_match_range_of_expr (vr2, @2, @3) /* "N*M" doesn't overflow. */ && range_op_handler (MULT_EXPR).overflow_free_p (vr1, vr2) - && get_range_query (cfun)->range_of_expr (vr0, @0, - gimple_match_ctx (@4)) - && get_range_query (cfun)->range_of_expr (vr3, @3, - gimple_match_ctx (@4)) + && gimple_match_range_of_expr (vr0, @0, @4) + && gimple_match_range_of_expr (vr3, @3, @4) /* "X+(N*M)" doesn't overflow. */ && range_op_handler (PLUS_EXPR).overflow_free_p (vr0, vr3) - && get_range_query (cfun)->range_of_expr (vr4, @4) + && gimple_match_range_of_expr (vr4, @4) && !vr4.undefined_p () /* "X+N*M" is not with opposite sign as "X". */ && (TYPE_UNSIGNED (type) @@ -1100,19 +1090,15 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (div (minus@4 @0 (mult:c@3 @1 @2)) @2) (with {int_range_max vr0, vr1, vr2, vr3, vr4;} (if (INTEGRAL_TYPE_P (type) - && get_range_query (cfun)->range_of_expr (vr1, @1, - gimple_match_ctx (@3)) - && get_range_query (cfun)->range_of_expr (vr2, @2, - gimple_match_ctx (@3)) + && gimple_match_range_of_expr (vr1, @1, @3) + && gimple_match_range_of_expr (vr2, @2, @3) /* "N * M" doesn't overflow. */ && range_op_handler (MULT_EXPR).overflow_free_p (vr1, vr2) - && get_range_query (cfun)->range_of_expr (vr0, @0, - gimple_match_ctx (@4)) - && get_range_query (cfun)->range_of_expr (vr3, @3, - gimple_match_ctx (@4)) + && gimple_match_range_of_expr (vr0, @0, @4) + && gimple_match_range_of_expr (vr3, @3, @4) /* "X - (N*M)" doesn't overflow. */ && range_op_handler (MINUS_EXPR).overflow_free_p (vr0, vr3) - && get_range_query (cfun)->range_of_expr (vr4, @4) + && gimple_match_range_of_expr (vr4, @4) && !vr4.undefined_p () /* "X-N*M" is not with opposite sign as "X". */ && (TYPE_UNSIGNED (type) @@ -1138,13 +1124,12 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) int_range_max vr0, vr1, vr3; } (if (INTEGRAL_TYPE_P (type) - && get_range_query (cfun)->range_of_expr (vr0, @0, - gimple_match_ctx (@3))) + && gimple_match_range_of_expr (vr0, @0, @3)) (if (exact_mod (c) - && get_range_query (cfun)->range_of_expr (vr1, @1) + && gimple_match_range_of_expr (vr1, @1) /* "X+C" doesn't overflow. */ && range_op_handler (PLUS_EXPR).overflow_free_p (vr0, vr1) - && get_range_query (cfun)->range_of_expr (vr3, @3) + && gimple_match_range_of_expr (vr3, @3) && !vr3.undefined_p () /* "X+C" and "X" are not of opposite sign. */ && (TYPE_UNSIGNED (type) @@ -4484,8 +4469,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) TYPE_SIGN (inner_type)); int_range_max vr; - if (get_range_query (cfun)->range_of_expr (vr, @0, - gimple_match_ctx (@2)) + if (gimple_match_range_of_expr (vr, @0, @2) && !vr.varying_p () && !vr.undefined_p ()) { wide_int wmin0 = vr.lower_bound (); @@ -6563,8 +6547,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) || wi::to_widest (@2) == wi::to_widest (@3) + 1)) (with { int_range_max r; - get_range_query (cfun)->range_of_expr (r, @0, gimple_match_ctx (@4)); - if (r.undefined_p ()) + if (!gimple_match_range_of_expr (r, @0, @4) + || r.undefined_p ()) r.set_varying (TREE_TYPE (@0)); wide_int min = r.lower_bound (); From d151a11ee04ff11fb9378434b1e223aae22edd66 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Thu, 27 Nov 2025 11:57:02 +0100 Subject: [PATCH 059/373] fold-const, match.pd: Pass stmt to expr_not_equal if possible The following patch is a small extension of the previous patch to pass stmt context to the ranger queries from match.pd where possible, so that we can use local ranges on a particular statement rather than global ones. expr_not_equal_to also uses the ranger, so when possible this passes it the statement context. 2025-11-27 Jakub Jelinek * fold-const.h (expr_not_equal_to): Add gimple * argument defaulted to NULL. * fold-const.cc (expr_not_equal_to): Likewise, pass it through to range_of_expr. * generic-match-head.cc (gimple_match_ctx): New static inline. * match.pd (X % -Y -> X % Y): Capture NEGATE and pass gimple_match_ctx (@2) as new 3rd argument to expr_not_equal_to. ((A * C) +- (B * C) -> (A+-B) * C): Pass gimple_match_ctx (@3) as new 3rd argument to expr_not_equal_to. (a rrotate (bitsize-b) -> a lrotate b): Likewise. --- gcc/fold-const.cc | 8 +++++--- gcc/fold-const.h | 2 +- gcc/generic-match-head.cc | 6 ++++++ gcc/match.pd | 28 ++++++++++++++++++---------- 4 files changed, 30 insertions(+), 14 deletions(-) diff --git a/gcc/fold-const.cc b/gcc/fold-const.cc index 85e7da595c6a..535377737f3e 100644 --- a/gcc/fold-const.cc +++ b/gcc/fold-const.cc @@ -10938,10 +10938,12 @@ tree_expr_nonzero_p (tree t) return ret; } -/* Return true if T is known not to be equal to an integer W. */ +/* Return true if T is known not to be equal to an integer W. + If STMT is specified, the check is if T on STMT is not equal + to W. */ bool -expr_not_equal_to (tree t, const wide_int &w) +expr_not_equal_to (tree t, const wide_int &w, gimple *stmt /* = NULL */) { int_range_max vr; switch (TREE_CODE (t)) @@ -10953,7 +10955,7 @@ expr_not_equal_to (tree t, const wide_int &w) if (!INTEGRAL_TYPE_P (TREE_TYPE (t))) return false; - get_range_query (cfun)->range_of_expr (vr, t); + get_range_query (cfun)->range_of_expr (vr, t, stmt); if (!vr.undefined_p () && !vr.contains_p (w)) return true; /* If T has some known zero bits and W has any of those bits set, diff --git a/gcc/fold-const.h b/gcc/fold-const.h index 149992d1f107..c80dbcff32f7 100644 --- a/gcc/fold-const.h +++ b/gcc/fold-const.h @@ -223,7 +223,7 @@ extern bool merge_ranges (int *, tree *, tree *, int, tree, tree, int, extern tree sign_bit_p (tree, const_tree); extern bool simple_condition_p (tree); extern tree exact_inverse (tree, tree); -extern bool expr_not_equal_to (tree t, const wide_int &); +extern bool expr_not_equal_to (tree t, const wide_int &, gimple * = NULL); extern tree const_unop (enum tree_code, tree, tree); extern tree vector_const_binop (enum tree_code, tree, tree, tree (*) (enum tree_code, tree, tree)); diff --git a/gcc/generic-match-head.cc b/gcc/generic-match-head.cc index ea4a958686db..1a9b490f2ee9 100644 --- a/gcc/generic-match-head.cc +++ b/gcc/generic-match-head.cc @@ -203,3 +203,9 @@ bitwise_inverted_equal_p (tree expr1, tree expr2, bool &wascmp) } return false; } + +static inline gimple * +gimple_match_ctx (tree) +{ + return NULL; +} diff --git a/gcc/match.pd b/gcc/match.pd index c76238a27f76..fec546a29ed1 100644 --- a/gcc/match.pd +++ b/gcc/match.pd @@ -918,7 +918,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) /* X % -Y is the same as X % Y. */ (simplify - (trunc_mod @0 (convert? (negate @1))) + (trunc_mod @0 (convert? (negate@2 @1))) (if (INTEGRAL_TYPE_P (type) && !TYPE_UNSIGNED (type) && !TYPE_OVERFLOW_TRAPS (type) @@ -928,7 +928,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) INT_MIN % -(-1) into invalid INT_MIN % -1. */ && (expr_not_equal_to (@0, wi::to_wide (TYPE_MIN_VALUE (type))) || expr_not_equal_to (@1, wi::minus_one (TYPE_PRECISION - (TREE_TYPE (@1)))))) + (TREE_TYPE (@1))), + gimple_match_ctx (@2)))) (trunc_mod @0 (convert @1)))) /* X - (X / Y) * Y is the same as X % Y. */ @@ -4695,7 +4696,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) || TYPE_OVERFLOW_WRAPS (type) || (INTEGRAL_TYPE_P (type) && tree_expr_nonzero_p (@0) - && expr_not_equal_to (@0, wi::minus_one (TYPE_PRECISION (type))))) + && expr_not_equal_to (@0, wi::minus_one (TYPE_PRECISION (type)), + gimple_match_ctx (@3)))) (if (single_use (@3) || single_use (@4)) /* If @1 +- @2 is constant require a hard single-use on either original operand (but not on both). */ @@ -4715,16 +4717,19 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) || (INTEGRAL_TYPE_P (type) && ((tree_expr_nonzero_p (@0) && expr_not_equal_to (@0, - wi::minus_one (TYPE_PRECISION (type)))) + wi::minus_one (TYPE_PRECISION (type)), + gimple_match_ctx (@3))) || (plusminus == PLUS_EXPR ? expr_not_equal_to (@2, - wi::max_value (TYPE_PRECISION (type), SIGNED)) + wi::max_value (TYPE_PRECISION (type), SIGNED), + gimple_match_ctx (@3)) /* Let's ignore the @0 -1 and @2 min case. */ : (expr_not_equal_to (@2, - wi::min_value (TYPE_PRECISION (type), SIGNED)) + wi::min_value (TYPE_PRECISION (type), SIGNED), + gimple_match_ctx (@3)) && expr_not_equal_to (@2, wi::min_value (TYPE_PRECISION (type), SIGNED) - + 1)))))) + + 1, gimple_match_ctx (@3))))))) && single_use (@3)) (mult (plusminus { build_one_cst (type); } @2) @0))) (simplify @@ -4739,11 +4744,13 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) && ((tree_expr_nonzero_p (@0) && (plusminus == MINUS_EXPR || expr_not_equal_to (@0, - wi::minus_one (TYPE_PRECISION (type))))) + wi::minus_one (TYPE_PRECISION (type)), + gimple_match_ctx (@3)))) || expr_not_equal_to (@2, (plusminus == PLUS_EXPR ? wi::max_value (TYPE_PRECISION (type), SIGNED) - : wi::min_value (TYPE_PRECISION (type), SIGNED)))))) + : wi::min_value (TYPE_PRECISION (type), SIGNED)), + gimple_match_ctx (@3))))) && single_use (@3)) (mult (plusminus @2 { build_one_cst (type); }) @0))))) /* (A * B) + (-C) -> (B - C/A) * A, if C is a multiple of A. */ @@ -5344,7 +5351,8 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (if (prec == wi::to_wide (@1)) (switch (if (expr_not_equal_to (@2, wi::uhwi (prec, - TYPE_PRECISION (TREE_TYPE (@2))))) + TYPE_PRECISION (TREE_TYPE (@2))), + gimple_match_ctx (@3))) (orotate @0 @2)) (if (single_use (@3) && pow2p_hwi (prec) From 862d4309dcb342adde13bfe3daca54255906fc70 Mon Sep 17 00:00:00 2001 From: Dhruv Chawla Date: Thu, 27 Nov 2025 12:12:33 +0100 Subject: [PATCH 060/373] remove patterns for (y << x) {<,<=,>,>=} x [PR122733] These patterns should not be in match.pd as they require range information checks that ideally belong in VRP. They were also causing breakages as the checks weren't tight enough. PR tree-optimization/122733 * match.pd ((y << x) {<,<=,>,>=} x): Remove. ((y << x) {==,!=} x): Call constant_boolean_node instead of build_one_cst/build_zero_cst and combine into one pattern. * gcc.dg/match-shift-cmp-1.c: Update test to only check equality. * gcc.dg/match-shift-cmp-2.c: Likewise. * gcc.dg/match-shift-cmp-3.c: Likewise. * gcc.dg/match-shift-cmp-4.c: Removed. Signed-off-by: Dhruv Chawla --- gcc/match.pd | 34 +++------------- gcc/testsuite/gcc.dg/match-shift-cmp-1.c | 11 +---- gcc/testsuite/gcc.dg/match-shift-cmp-2.c | 23 ++--------- gcc/testsuite/gcc.dg/match-shift-cmp-3.c | 27 ++++++------- gcc/testsuite/gcc.dg/match-shift-cmp-4.c | 51 ------------------------ 5 files changed, 23 insertions(+), 123 deletions(-) delete mode 100644 gcc/testsuite/gcc.dg/match-shift-cmp-4.c diff --git a/gcc/match.pd b/gcc/match.pd index fec546a29ed1..4ebf394d4a4a 100644 --- a/gcc/match.pd +++ b/gcc/match.pd @@ -1340,37 +1340,13 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) (if (INTEGRAL_TYPE_P (type)) (rshift (op @0 @2) @1)))) -/* (y << x) == x -> 0 when y != 0. */ -(simplify - (eq:c (nop_convert1? (lshift @0 @1)) (nop_convert2? @1)) - (if (INTEGRAL_TYPE_P (TREE_TYPE (@1)) - && tree_expr_nonzero_p (@0)) - { build_zero_cst (type); })) - -/* (y << x) {<,<=} x -> 0 when y > 0. */ -(for cmp (lt le) - (simplify - (cmp:c (nop_convert1? (lshift @0 @1)) (nop_convert2? @1)) - (if (INTEGRAL_TYPE_P (TREE_TYPE (@1)) - && tree_expr_nonzero_p (@0) - && tree_expr_nonnegative_p (@0)) - { build_zero_cst (type); }))) - -/* (y << x) != x -> 1 when y != 0. */ -(simplify - (ne:c (nop_convert1? (lshift @0 @1)) (nop_convert2? @1)) +/* (y << x) == x -> false and (y << x) != x -> true when y != 0. */ +(for cmp (eq ne) + (simplify + (cmp:c (nop_convert1? (lshift @0 @1)) (nop_convert2? @1)) (if (INTEGRAL_TYPE_P (TREE_TYPE (@1)) && tree_expr_nonzero_p (@0)) - { build_one_cst (type); })) - -/* (y << x) {>,>=} x -> 1 when y > 0. */ -(for cmp (gt ge) - (simplify - (cmp:c (nop_convert1? (lshift @0 @1)) (nop_convert2? @1)) - (if (INTEGRAL_TYPE_P (TREE_TYPE (@1)) - && tree_expr_nonzero_p (@0) - && tree_expr_nonnegative_p (@0)) - { build_one_cst (type); }))) + { constant_boolean_node (cmp != EQ_EXPR, type); }))) /* Fold (1 << (C - x)) where C = precision(type) - 1 into ((1 << C) >> x). */ diff --git a/gcc/testsuite/gcc.dg/match-shift-cmp-1.c b/gcc/testsuite/gcc.dg/match-shift-cmp-1.c index b22d57d370f1..7a69cd194376 100644 --- a/gcc/testsuite/gcc.dg/match-shift-cmp-1.c +++ b/gcc/testsuite/gcc.dg/match-shift-cmp-1.c @@ -34,17 +34,8 @@ typedef enum TEST_OP_CST (eq, ==, 1) TEST_OP_CST (ne, !=, 2) -TEST_OP_CST (lt, <, 3) -TEST_OP_CST (gt, >, 4) -TEST_OP_CST (le, <=, 5) -TEST_OP_CST (ge, >=, 6) TEST_OP (eq, ==) TEST_OP (ne, !=) -TEST_OP (lt, <) -TEST_OP (gt, >) -TEST_OP (le, <=) -TEST_OP (ge, >=) -/* FIXME: The lt, le, gt and ge cases for int and enum don't get optimized. */ -/* { dg-final { scan-tree-dump-times "<<" 8 optimized } } */ +/* { dg-final { scan-tree-dump-not "<<" optimized } } */ diff --git a/gcc/testsuite/gcc.dg/match-shift-cmp-2.c b/gcc/testsuite/gcc.dg/match-shift-cmp-2.c index 96a2fd954f63..3d514ba1ee1b 100644 --- a/gcc/testsuite/gcc.dg/match-shift-cmp-2.c +++ b/gcc/testsuite/gcc.dg/match-shift-cmp-2.c @@ -36,27 +36,12 @@ typedef enum TEST_OP_CST (eq, ==, 0) TEST_OP_CST (ne, !=, 0) -TEST_OP_CST (lt, <, 0) -TEST_OP_CST (gt, >, 0) -TEST_OP_CST (le, <=, 0) -TEST_OP_CST (ge, >=, 0) TEST_OP (eq, ==) TEST_OP (ne, !=) -TEST_OP (lt, <) -TEST_OP (gt, >) -TEST_OP (le, <=) -TEST_OP (ge, >=) /* These end up getting folded by other patterns. */ -/* { dg-final { scan-tree-dump-times "x_\\d\\(D\\) == 0" 8 optimized } } */ -/* { dg-final { scan-tree-dump-times "x_\\d\\(D\\) != 0" 8 optimized } } */ -/* { dg-final { scan-tree-dump-times "x_\\d\\(D\\) > 0" 4 optimized } } */ -/* { dg-final { scan-tree-dump-times "x_\\d\\(D\\) < 0" 4 optimized } } */ -/* { dg-final { scan-tree-dump-times "x_\\d\\(D\\) >= 0" 4 optimized } } */ -/* { dg-final { scan-tree-dump-times "x_\\d\\(D\\) <= 0" 4 optimized } } */ -/* { dg-final { scan-tree-dump-times "~x_\\d\\(D\\)" 4 optimized } } */ -/* { dg-final { scan-tree-dump-times "return x_\\d\\(D\\);" 4 optimized } } */ -/* { dg-final { scan-tree-dump-times "return 0;" 4 optimized } } */ -/* { dg-final { scan-tree-dump-times "return 1;" 4 optimized } } */ -/* Total: 48. */ +/* { dg-final { scan-tree-dump-times "x_\\d\\(D\\) == 0" 6 optimized } } */ +/* { dg-final { scan-tree-dump-times "x_\\d\\(D\\) != 0" 6 optimized } } */ +/* { dg-final { scan-tree-dump-times "~x_\\d\\(D\\)" 2 optimized } } */ +/* { dg-final { scan-tree-dump-times "return x_\\d\\(D\\);" 2 optimized } } */ diff --git a/gcc/testsuite/gcc.dg/match-shift-cmp-3.c b/gcc/testsuite/gcc.dg/match-shift-cmp-3.c index 34380cfeb969..e46ac30b905f 100644 --- a/gcc/testsuite/gcc.dg/match-shift-cmp-3.c +++ b/gcc/testsuite/gcc.dg/match-shift-cmp-3.c @@ -1,25 +1,27 @@ /* { dg-do compile } */ /* { dg-options "-O2 -fdump-tree-optimized" } */ -/* The fold (y << x) x -> 0|1 shouldn't trigger when y is negative or - zero unsigned (except for == and !=). */ +/* The fold (y << x) x -> 0|1 should trigger when y is negative + unsigned. */ #define TEST_ONE_CST(n, op, type, cst) \ - bool lshift_cst_##type##_##n (type x) { return ((cst << x) op x); } + bool lshift_cst_##type##_##n (type x) { return ((unsigned) (cst) << x) op x; } #define TEST_OP_CST(n, op, cst) \ + TEST_ONE_CST (n, op, unsigned, cst) \ TEST_ONE_CST (n, op, int, cst) \ TEST_ONE_CST (n, op, test_enum, cst) #define TEST_ONE(n, op, type) \ bool lshift_##type##_##n (type x, type y) \ { \ - if (y > 0) \ + if ((int) y <= 0) \ __builtin_unreachable (); \ - return ((y << x) op x); \ + return ((unsigned) (y) << x) op x; \ } #define TEST_OP(n, op) \ + TEST_ONE (n, op, unsigned) \ TEST_ONE (n, op, int) \ TEST_ONE (n, op, test_enum) @@ -31,14 +33,11 @@ typedef enum TWO = 2 } test_enum; -TEST_OP_CST (lt, <, -1) -TEST_OP_CST (gt, >, -2) -TEST_OP_CST (le, <=, -3) -TEST_OP_CST (ge, >=, -4) +TEST_OP_CST (eq, ==, -1) +TEST_OP_CST (ne, !=, -2) -TEST_OP (lt, <) -TEST_OP (gt, >) -TEST_OP (le, <=) -TEST_OP (ge, >=) +TEST_OP (eq, ==) +TEST_OP (ne, !=) -/* { dg-final { scan-tree-dump-times "<<" 16 optimized } } */ +/* { dg-final { scan-tree-dump-times "return 0;" 6 optimized } } */ +/* { dg-final { scan-tree-dump-times "return 1;" 6 optimized } } */ diff --git a/gcc/testsuite/gcc.dg/match-shift-cmp-4.c b/gcc/testsuite/gcc.dg/match-shift-cmp-4.c deleted file mode 100644 index 629e2a376d11..000000000000 --- a/gcc/testsuite/gcc.dg/match-shift-cmp-4.c +++ /dev/null @@ -1,51 +0,0 @@ -/* { dg-do compile } */ -/* { dg-options "-O2 -fdump-tree-optimized" } */ - -/* The fold (y << x) x -> 0|1 should trigger when y is negative - unsigned. */ - -#define TEST_ONE_CST(n, op, type, cst) \ - bool lshift_cst_##type##_##n (type x) { return ((unsigned) (cst) << x) op x; } - -#define TEST_OP_CST(n, op, cst) \ - TEST_ONE_CST (n, op, unsigned, cst) \ - TEST_ONE_CST (n, op, int, cst) \ - TEST_ONE_CST (n, op, test_enum, cst) - -#define TEST_ONE(n, op, type) \ - bool lshift_##type##_##n (type x, type y) \ - { \ - if ((int) y <= 0) \ - __builtin_unreachable (); \ - return ((unsigned) (y) << x) op x; \ - } - -#define TEST_OP(n, op) \ - TEST_ONE (n, op, unsigned) \ - TEST_ONE (n, op, int) \ - TEST_ONE (n, op, test_enum) - -typedef enum -{ - MONE = -1, - ZERO = 0, - ONE = 1, - TWO = 2 -} test_enum; - -TEST_OP_CST (eq, ==, -1) -TEST_OP_CST (ne, !=, -2) -TEST_OP_CST (lt, <, -3) -TEST_OP_CST (gt, >, -4) -TEST_OP_CST (le, <=, -5) -TEST_OP_CST (ge, >=, -6) - -TEST_OP (eq, ==) -TEST_OP (ne, !=) -TEST_OP (lt, <) -TEST_OP (gt, >) -TEST_OP (le, <=) -TEST_OP (ge, >=) - -/* { dg-final { scan-tree-dump-times "return 0;" 18 optimized } } */ -/* { dg-final { scan-tree-dump-times "return 1;" 18 optimized } } */ From fd743aab3bc8c521e0e8cd1742a71c2d713e2c76 Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Thu, 27 Nov 2025 10:56:43 +0100 Subject: [PATCH 061/373] Fix OMP SIMD clone mask record/get again Post-CI checkin detected aarch64 fallout for the last change. AARCH64 has ABI twists that run into a case where an unmasked call when loop masked allows for a mask that has different shape than that of the return value which in turn has different type than that of an actual argument. While we do not support a mismatch of call mask shape with the OMP SIMD ABI mask shape when there's no call mask we have no such restriction. So the following fixes the record/get of a loop mask in the unmasked call case, also fixing a latent issue present before. In particular do not record a random scalar operand as representing the mask. A testcase is in gcc.target/aarch64/vect-simd-clone-4.c. * tree-vect-stmts.cc (vectorizable_simd_clone_call): Fix recording of the mask type again. Adjust placing of mask arguments for non-masked calls. --- gcc/tree-vect-stmts.cc | 78 ++++++++++++++++++++++++++++++------------ 1 file changed, 56 insertions(+), 22 deletions(-) diff --git a/gcc/tree-vect-stmts.cc b/gcc/tree-vect-stmts.cc index 476a6e570e82..de28316ddc66 100644 --- a/gcc/tree-vect-stmts.cc +++ b/gcc/tree-vect-stmts.cc @@ -4047,7 +4047,6 @@ vectorizable_simd_clone_call (vec_info *vinfo, stmt_vec_info stmt_info, { tree vec_dest; tree scalar_dest; - tree op; tree vec_oprnd0 = NULL_TREE; tree vectype; poly_uint64 nunits; @@ -4121,6 +4120,7 @@ vectorizable_simd_clone_call (vec_info *vinfo, stmt_vec_info stmt_info, { simd_call_arg_info thisarginfo; affine_iv iv; + tree op; thisarginfo.linear_step = 0; thisarginfo.align = 0; @@ -4435,9 +4435,39 @@ vectorizable_simd_clone_call (vec_info *vinfo, stmt_vec_info stmt_info, case SIMD_CLONE_ARG_TYPE_MASK: if (loop_vinfo && LOOP_VINFO_CAN_USE_PARTIAL_VECTORS_P (loop_vinfo)) - vect_record_loop_mask (loop_vinfo, - &LOOP_VINFO_MASKS (loop_vinfo), - ncopies_in, vectype, op); + { + if (masked_call_offset) + /* When there is an explicit mask we require the + number of elements to match up. */ + vect_record_loop_mask (loop_vinfo, + &LOOP_VINFO_MASKS (loop_vinfo), + ncopies_in, vectype, NULL_TREE); + else + { + /* When there is no explicit mask on the call we have + more relaxed requirements. */ + tree masktype; + poly_uint64 callee_nelements; + if (SCALAR_INT_MODE_P (bestn->simdclone->mask_mode)) + { + callee_nelements + = exact_div (bestn->simdclone->simdlen, + bestn->simdclone->args[i].linear_step); + masktype = get_related_vectype_for_scalar_type + (vinfo->vector_mode, TREE_TYPE (vectype), + callee_nelements); + } + else + { + masktype = bestn->simdclone->args[i].vector_type; + callee_nelements = TYPE_VECTOR_SUBPARTS (masktype); + } + auto o = vector_unroll_factor (nunits, callee_nelements); + vect_record_loop_mask (loop_vinfo, + &LOOP_VINFO_MASKS (loop_vinfo), + ncopies * o, masktype, NULL_TREE); + } + } break; } } @@ -4499,7 +4529,7 @@ vectorizable_simd_clone_call (vec_info *vinfo, stmt_vec_info stmt_info, { unsigned int k, l, m, o; tree atype; - op = gimple_call_arg (stmt, i + masked_call_offset); + tree op = gimple_call_arg (stmt, i + masked_call_offset); switch (bestn->simdclone->args[i].arg_type) { case SIMD_CLONE_ARG_TYPE_VECTOR: @@ -4818,12 +4848,20 @@ vectorizable_simd_clone_call (vec_info *vinfo, stmt_vec_info stmt_info, gcc_assert (bestn->simdclone->args[mask_i].arg_type == SIMD_CLONE_ARG_TYPE_MASK); - tree masktype = bestn->simdclone->args[mask_i].vector_type; + tree mask_argtype = bestn->simdclone->args[mask_i].vector_type; + tree mask_vectype; if (SCALAR_INT_MODE_P (bestn->simdclone->mask_mode)) - callee_nelements = exact_div (bestn->simdclone->simdlen, - bestn->simdclone->args[i].linear_step); + { + callee_nelements = exact_div (bestn->simdclone->simdlen, + bestn->simdclone->args[i].linear_step); + mask_vectype = get_related_vectype_for_scalar_type + (vinfo->vector_mode, TREE_TYPE (vectype), callee_nelements); + } else - callee_nelements = TYPE_VECTOR_SUBPARTS (masktype); + { + mask_vectype = mask_argtype; + callee_nelements = TYPE_VECTOR_SUBPARTS (mask_vectype); + } o = vector_unroll_factor (nunits, callee_nelements); for (m = j * o; m < (j + 1) * o; m++) { @@ -4831,10 +4869,11 @@ vectorizable_simd_clone_call (vec_info *vinfo, stmt_vec_info stmt_info, { vec_loop_masks *loop_masks = &LOOP_VINFO_MASKS (loop_vinfo); mask = vect_get_loop_mask (loop_vinfo, gsi, loop_masks, - ncopies_in, vectype, j); + ncopies * o, mask_vectype, m); } else - mask = vect_build_all_ones_mask (vinfo, stmt_info, masktype); + mask = vect_build_all_ones_mask (vinfo, stmt_info, + mask_argtype); gassign *new_stmt; if (SCALAR_INT_MODE_P (bestn->simdclone->mask_mode)) @@ -4852,23 +4891,18 @@ vectorizable_simd_clone_call (vec_info *vinfo, stmt_vec_info stmt_info, mask); gsi_insert_before (gsi, new_stmt, GSI_SAME_STMT); /* Then zero-extend to the mask mode. */ - mask = fold_build1 (NOP_EXPR, masktype, + mask = fold_build1 (NOP_EXPR, mask_argtype, gimple_get_lhs (new_stmt)); } else if (bestn->simdclone->mask_mode == VOIDmode) - { - tree one = fold_convert (TREE_TYPE (masktype), - integer_one_node); - tree zero = fold_convert (TREE_TYPE (masktype), - integer_zero_node); - mask = build3 (VEC_COND_EXPR, masktype, mask, - build_vector_from_val (masktype, one), - build_vector_from_val (masktype, zero)); - } + mask = build3 (VEC_COND_EXPR, mask_argtype, mask, + build_one_cst (mask_argtype), + build_zero_cst (mask_argtype)); else gcc_unreachable (); - new_stmt = gimple_build_assign (make_ssa_name (masktype), mask); + new_stmt = gimple_build_assign (make_ssa_name (mask_argtype), + mask); vect_finish_stmt_generation (vinfo, stmt_info, new_stmt, gsi); mask = gimple_assign_lhs (new_stmt); From 23e1be3c9517fd0a46ec6dca5af7eae2ea977179 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Thu, 27 Nov 2025 13:55:17 +0100 Subject: [PATCH 062/373] bitint: Fix up big-endian handling in limb_access [PR122714] The bitint_extended changes in limb_access broke bitint_big_endian. As we sometimes (for bitint_extended) access the MEM_REFs using atype rather than m_limb_type, for big-endian we need to adjust the MEM_REFs offset if atype has smaller TYPE_SIZE_UNIT than m_limb_size. 2025-11-27 Jakub Jelinek PR target/122714 * gimple-lower-bitint.cc (bitint_large_huge::limb_access): Adjust MEM_REFs offset for bitint_big_endian if ltype doesn't have the same byte size as m_limb_type. --- gcc/gimple-lower-bitint.cc | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/gcc/gimple-lower-bitint.cc b/gcc/gimple-lower-bitint.cc index 28802e3b4aaa..f699b8ec3af9 100644 --- a/gcc/gimple-lower-bitint.cc +++ b/gcc/gimple-lower-bitint.cc @@ -630,6 +630,8 @@ bitint_large_huge::limb_access (tree type, tree var, tree idx, bool write_p, | ENCODE_QUAL_ADDR_SPACE (as)); tree ptype = build_pointer_type (strip_array_types (TREE_TYPE (var))); unsigned HOST_WIDE_INT off = tree_to_uhwi (idx) * m_limb_size; + if (bitint_big_endian) + off += m_limb_size - tree_to_uhwi (TYPE_SIZE_UNIT (ltype)); ret = build2 (MEM_REF, ltype, build_fold_addr_expr (var), build_int_cst (ptype, off)); @@ -641,12 +643,14 @@ bitint_large_huge::limb_access (tree type, tree var, tree idx, bool write_p, if (as != TYPE_ADDR_SPACE (ltype)) ltype = build_qualified_type (ltype, TYPE_QUALS (ltype) | ENCODE_QUAL_ADDR_SPACE (as)); + unsigned HOST_WIDE_INT off = tree_to_uhwi (idx) * m_limb_size; + if (bitint_big_endian) + off += m_limb_size - tree_to_uhwi (TYPE_SIZE_UNIT (ltype)); ret = build2 (MEM_REF, ltype, unshare_expr (TREE_OPERAND (var, 0)), size_binop (PLUS_EXPR, TREE_OPERAND (var, 1), build_int_cst (TREE_TYPE (TREE_OPERAND (var, 1)), - tree_to_uhwi (idx) - * m_limb_size))); + off))); TREE_THIS_VOLATILE (ret) = TREE_THIS_VOLATILE (var); TREE_SIDE_EFFECTS (ret) = TREE_SIDE_EFFECTS (var); TREE_THIS_NOTRAP (ret) = TREE_THIS_NOTRAP (var); From 0aaff350c25659cba2c1bc86deada888aebbf0d3 Mon Sep 17 00:00:00 2001 From: Ronan Desplanques Date: Thu, 13 Nov 2025 08:16:18 +0100 Subject: [PATCH 063/373] ada: Fix actual parameters in call A recent patch made Multi_Module_Symbolic_Traceback have two consecutive formal parameters of type Boolean, which opens the door for mixing up actual parameters in calls. And that mistake was actually made in a call introduced by the same patch. This commit fixes the call and also introduces a new enumerated type to make this kind of mistake less likely in the future. gcc/ada/ChangeLog: * libgnat/s-dwalin.ads (Display_Mode_Type): New enumerated type. (Symbolic_Traceback): Use new type in profile. * libgnat/s-dwalin.adb (Symbolic_Traceback): Use new type in profile and adapt body. * libgnat/s-trasym__dwarf.adb (Multi_Module_Symbolic_Traceback): Fix wrong call in body of one overload. Use new type in profile. Adapt body. (Symbolic_Traceback, Symbolic_Traceback_No_Lock, Module_Symbolic_Traceback): Use new type in profile and adapt body. (Calling_Entity): Adapt body. --- gcc/ada/libgnat/s-dwalin.adb | 8 +- gcc/ada/libgnat/s-dwalin.ads | 18 ++-- gcc/ada/libgnat/s-trasym__dwarf.adb | 144 +++++++++++++--------------- 3 files changed, 85 insertions(+), 85 deletions(-) diff --git a/gcc/ada/libgnat/s-dwalin.adb b/gcc/ada/libgnat/s-dwalin.adb index 713aad4a304f..75c96619f994 100644 --- a/gcc/ada/libgnat/s-dwalin.adb +++ b/gcc/ada/libgnat/s-dwalin.adb @@ -1915,7 +1915,7 @@ package body System.Dwarf_Lines is (Cin : Dwarf_Context; Traceback : STE.Tracebacks_Array; Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; + Display_Mode : Display_Mode_Type; Symbol_Found : out Boolean; Res : in out System.Bounded_Strings.Bounded_String) is @@ -1954,7 +1954,7 @@ package body System.Dwarf_Lines is -- If we're not requested to suppress hex addresses, emit it now. - if not Suppress_Hex and then not Subprg_Name_Only then + if not Suppress_Hex and then Display_Mode = Full then Append_Address (Res, Addr_In_Traceback); Append (Res, ' '); end if; @@ -2007,7 +2007,7 @@ package body System.Dwarf_Lines is Append (Res, "???"); end if; - if not Subprg_Name_Only then + if Display_Mode = Full then Append (Res, " at "); Append (Res, String (File_Name (1 .. Last))); Append (Res, ':'); @@ -2023,7 +2023,7 @@ package body System.Dwarf_Lines is Append (Res, "???"); end if; - if not Subprg_Name_Only then + if Display_Mode = Full then Append (Res, " at ???"); end if; end if; diff --git a/gcc/ada/libgnat/s-dwalin.ads b/gcc/ada/libgnat/s-dwalin.ads index 641e515e62f8..17bf0937608f 100644 --- a/gcc/ada/libgnat/s-dwalin.ads +++ b/gcc/ada/libgnat/s-dwalin.ads @@ -79,13 +79,19 @@ package System.Dwarf_Lines is procedure Enable_Cache (C : in out Dwarf_Context); -- Read symbol information to speed up Symbolic_Traceback. + type Display_Mode_Type is (Full, Subprg_Name_Only); + -- This type is used to configure how frames are displayed. + -- In Subprg_Name_Only mode, only the name of the subprogram is displayed + -- for a frame. In Full mode, additional information is displayed on top of + -- that. + procedure Symbolic_Traceback - (Cin : Dwarf_Context; - Traceback : STE.Tracebacks_Array; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Symbol_Found : out Boolean; - Res : in out System.Bounded_Strings.Bounded_String); + (Cin : Dwarf_Context; + Traceback : STE.Tracebacks_Array; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Symbol_Found : out Boolean; + Res : in out System.Bounded_Strings.Bounded_String); -- Generate a string for a traceback suitable for displaying to the user. -- If one or more symbols are found, Symbol_Found is set to True. This -- allows the caller to fall back to hexadecimal addresses. diff --git a/gcc/ada/libgnat/s-trasym__dwarf.adb b/gcc/ada/libgnat/s-trasym__dwarf.adb index 09026c91efe8..0c4a036e1398 100644 --- a/gcc/ada/libgnat/s-trasym__dwarf.adb +++ b/gcc/ada/libgnat/s-trasym__dwarf.adb @@ -96,16 +96,15 @@ package body System.Traceback.Symbolic is -- Initialize Exec_Module if not already initialized function Symbolic_Traceback - (Traceback : System.Traceback_Entries.Tracebacks_Array; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean) return String; + (Traceback : System.Traceback_Entries.Tracebacks_Array; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type) return String; function Symbolic_Traceback (E : Ada.Exceptions.Exception_Occurrence; Suppress_Hex : Boolean) return String; -- Suppress_Hex means do not print any hexadecimal addresses, even if the - -- symbol is not available. Subprg_Name_Only means to only print the - -- subprogram name for each frame, as opposed to the complete description - -- of the frame. + -- symbol is not available. Display_Mode configures how frames for which + -- symbols are available are printed. function Lt (Left, Right : Module_Cache_Acc) return Boolean; -- Sort function for Module_Cache @@ -169,34 +168,34 @@ package body System.Traceback.Symbolic is -- Non-symbolic traceback (simply write addresses in hexa) procedure Symbolic_Traceback_No_Lock - (Traceback : Tracebacks_Array; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String); + (Traceback : Tracebacks_Array; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String); -- Like the public Symbolic_Traceback except there is no provision against -- concurrent accesses. procedure Module_Symbolic_Traceback - (Traceback : Tracebacks_Array; - Module : Module_Cache; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String); + (Traceback : Tracebacks_Array; + Module : Module_Cache; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String); -- Returns the Traceback for a given module procedure Multi_Module_Symbolic_Traceback - (Traceback : Tracebacks_Array; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String); + (Traceback : Tracebacks_Array; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String); -- Build string containing symbolic traceback for the given call chain procedure Multi_Module_Symbolic_Traceback - (Traceback : Tracebacks_Array; - Module : Module_Cache; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String); + (Traceback : Tracebacks_Array; + Module : Module_Cache; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String); -- Likewise but using Module Max_String_Length : constant := 4096; @@ -357,7 +356,9 @@ package body System.Traceback.Symbolic is declare With_Trailing_Newline : constant String := Symbolic_Traceback - (Traceback, Suppress_Hex => True, Subprg_Name_Only => True); + (Traceback, + Suppress_Hex => True, + Display_Mode => Subprg_Name_Only); begin return With_Trailing_Newline @@ -487,31 +488,28 @@ package body System.Traceback.Symbolic is ------------------------------- procedure Module_Symbolic_Traceback - (Traceback : Tracebacks_Array; - Module : Module_Cache; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String) + (Traceback : Tracebacks_Array; + Module : Module_Cache; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String) is Success : Boolean; begin - if Symbolic.Module_Name.Is_Supported and then not Subprg_Name_Only then + if Symbolic.Module_Name.Is_Supported and then Display_Mode = Full then Append (Res, '['); Append (Res, Module.Name.all); Append (Res, ']' & ASCII.LF); end if; Dwarf_Lines.Symbolic_Traceback - (Module.C, - Traceback, - Suppress_Hex, - Subprg_Name_Only, - Success, - Res); + (Module.C, Traceback, Suppress_Hex, Display_Mode, Success, Res); if not Success then Hexa_Traceback - (Traceback, Suppress_Hex or else Subprg_Name_Only, Res); + (Traceback, + Suppress_Hex or else Display_Mode = Subprg_Name_Only, + Res); end if; -- We must not allow an unhandled exception here, since this function @@ -527,10 +525,10 @@ package body System.Traceback.Symbolic is ------------------------------------- procedure Multi_Module_Symbolic_Traceback - (Traceback : Tracebacks_Array; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String) + (Traceback : Tracebacks_Array; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String) is F : constant Natural := Traceback'First; begin @@ -555,8 +553,8 @@ package body System.Traceback.Symbolic is Multi_Module_Symbolic_Traceback (Traceback, Modules_Cache (Mid).all, - Subprg_Name_Only, Suppress_Hex, + Display_Mode, Res); return; else @@ -569,7 +567,7 @@ package body System.Traceback.Symbolic is Multi_Module_Symbolic_Traceback (Traceback (F + 1 .. Traceback'Last), Suppress_Hex, - Subprg_Name_Only, + Display_Mode, Res); end; else @@ -577,7 +575,7 @@ package body System.Traceback.Symbolic is -- First try the executable if Is_Inside (Exec_Module.C, Traceback (F)) then Multi_Module_Symbolic_Traceback - (Traceback, Exec_Module, Suppress_Hex, Subprg_Name_Only, Res); + (Traceback, Exec_Module, Suppress_Hex, Display_Mode, Res); return; end if; @@ -593,7 +591,7 @@ package body System.Traceback.Symbolic is Init_Module (Module, Success, M_Name, Load_Addr); if Success then Multi_Module_Symbolic_Traceback - (Traceback, Module, Suppress_Hex, Subprg_Name_Only, Res); + (Traceback, Module, Suppress_Hex, Display_Mode, Res); Close_Module (Module); else -- Module not found @@ -601,7 +599,7 @@ package body System.Traceback.Symbolic is Multi_Module_Symbolic_Traceback (Traceback (F + 1 .. Traceback'Last), Suppress_Hex, - Subprg_Name_Only, + Display_Mode, Res); end if; end; @@ -609,11 +607,11 @@ package body System.Traceback.Symbolic is end Multi_Module_Symbolic_Traceback; procedure Multi_Module_Symbolic_Traceback - (Traceback : Tracebacks_Array; - Module : Module_Cache; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String) + (Traceback : Tracebacks_Array; + Module : Module_Cache; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String) is Pos : Positive; begin @@ -638,13 +636,10 @@ package body System.Traceback.Symbolic is (Traceback (Traceback'First .. Pos - 1), Module, Suppress_Hex, - Subprg_Name_Only, + Display_Mode, Res); Multi_Module_Symbolic_Traceback - (Traceback (Pos .. Traceback'Last), - Suppress_Hex, - Subprg_Name_Only, - Res); + (Traceback (Pos .. Traceback'Last), Suppress_Hex, Display_Mode, Res); end Multi_Module_Symbolic_Traceback; -------------------- @@ -674,22 +669,24 @@ package body System.Traceback.Symbolic is -------------------------------- procedure Symbolic_Traceback_No_Lock - (Traceback : Tracebacks_Array; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String) is + (Traceback : Tracebacks_Array; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String) is begin if Symbolic.Module_Name.Is_Supported then Multi_Module_Symbolic_Traceback - (Traceback, Suppress_Hex, Subprg_Name_Only, Res); + (Traceback, Suppress_Hex, Display_Mode, Res); else if Exec_Module_State = Failed then Append (Res, "Call stack traceback locations:" & ASCII.LF); Hexa_Traceback - (Traceback, Suppress_Hex or else Subprg_Name_Only, Res); + (Traceback, + Suppress_Hex or else Display_Mode = Subprg_Name_Only, + Res); else Module_Symbolic_Traceback - (Traceback, Exec_Module, Suppress_Hex, Subprg_Name_Only, Res); + (Traceback, Exec_Module, Suppress_Hex, Display_Mode, Res); end if; end if; end Symbolic_Traceback_No_Lock; @@ -702,9 +699,9 @@ package body System.Traceback.Symbolic is -- Copied from Ada.Exceptions.Exception_Data function Symbolic_Traceback - (Traceback : Tracebacks_Array; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean) return String + (Traceback : Tracebacks_Array; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type) return String is Load_Address : constant Address := Get_Executable_Load_Address; Res : Bounded_String (Max_Length => Max_String_Length); @@ -712,13 +709,12 @@ package body System.Traceback.Symbolic is begin System.Soft_Links.Lock_Task.all; Init_Exec_Module; - if not Subprg_Name_Only and then Load_Address /= Null_Address then + if Display_Mode = Full and then Load_Address /= Null_Address then Append (Res, LDAD_Header); Append_Address (Res, Load_Address); Append (Res, ASCII.LF); end if; - Symbolic_Traceback_No_Lock - (Traceback, Suppress_Hex, Subprg_Name_Only, Res); + Symbolic_Traceback_No_Lock (Traceback, Suppress_Hex, Display_Mode, Res); System.Soft_Links.Unlock_Task.all; return To_String (Res); @@ -734,7 +730,7 @@ package body System.Traceback.Symbolic is begin return Symbolic_Traceback - (Traceback, Suppress_Hex => False, Subprg_Name_Only => False); + (Traceback, Suppress_Hex => False, Display_Mode => Full); end Symbolic_Traceback; function Symbolic_Traceback_No_Hex @@ -742,7 +738,7 @@ package body System.Traceback.Symbolic is begin return Symbolic_Traceback - (Traceback, Suppress_Hex => True, Subprg_Name_Only => False); + (Traceback, Suppress_Hex => True, Display_Mode => Full); end Symbolic_Traceback_No_Hex; function Symbolic_Traceback @@ -752,9 +748,7 @@ package body System.Traceback.Symbolic is begin return Symbolic_Traceback - (Ada.Exceptions.Traceback.Tracebacks (E), - Suppress_Hex, - False); + (Ada.Exceptions.Traceback.Tracebacks (E), Suppress_Hex, Full); end Symbolic_Traceback; function Symbolic_Traceback From 86701d8912f7473aa35c8ee8487511e6622b6c7a Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 13 Nov 2025 09:16:52 +0100 Subject: [PATCH 064/373] ada: Fix missing activation of task returned through class-wide type This fixes an old issue whereby a task returned through the class-wide type of a limited record type is not activated by the caller, because it is not moved onto the activation chain that the caller passes to the function. gcc/ada/ChangeLog: * exp_ch6.ads (Needs_BIP_Task_Actuals): Adjust description. * exp_ch6.adb (Expand_N_Extended_Return_Statement): Move activation chain for every build-in-place function with task formal parameters when the type of the return object might have tasks. --- gcc/ada/exp_ch6.adb | 15 +++++++-------- gcc/ada/exp_ch6.ads | 3 ++- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index f41dca311d1d..6bf8d3ba145d 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -5908,8 +5908,6 @@ package body Exp_Ch6 is Loc : constant Source_Ptr := Sloc (N); Func_Id : constant Entity_Id := Return_Applies_To (Return_Statement_Entity (N)); - Is_BIP_Func : constant Boolean := - Is_Build_In_Place_Function (Func_Id); Ret_Obj_Id : constant Entity_Id := First_Entity (Return_Statement_Entity (N)); Ret_Obj_Decl : constant Node_Id := Parent (Ret_Obj_Id); @@ -6024,12 +6022,13 @@ package body Exp_Ch6 is -- master. But Move_Activation_Chain updates their master to be that -- of the caller, so they will not be terminated unless the return -- statement completes unsuccessfully due to exception, abort, goto, - -- or exit. As a formality, we test whether the function requires the - -- result to be built in place, though that's necessarily true for - -- the case of result types with task parts. - - if Is_BIP_Func and then Has_Task (Ret_Typ) then + -- or exit. Note that we test that the function is both BIP and has + -- implicit task formal parameters, because not all functions whose + -- result type contains tasks have them (see Needs_BIP_Task_Actuals). + if Is_Build_In_Place_Function (Func_Id) + and then Needs_BIP_Task_Actuals (Func_Id) + then -- The return expression is an aggregate for a complex type which -- contains tasks. This particular case is left unexpanded since -- the regular expansion would insert all temporaries and @@ -6042,7 +6041,7 @@ package body Exp_Ch6 is -- Do not move the activation chain if the return object does not -- contain tasks. - if Has_Task (Etype (Ret_Obj_Id)) then + if Might_Have_Tasks (Etype (Ret_Obj_Id)) then Append_To (Stmts, Move_Activation_Chain (Func_Id)); end if; end if; diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads index b32ac77e5b49..15804eaf0acc 100644 --- a/gcc/ada/exp_ch6.ads +++ b/gcc/ada/exp_ch6.ads @@ -305,7 +305,8 @@ package Exp_Ch6 is -- BIP_Collection parameter (see type BIP_Formal_Kind). function Needs_BIP_Task_Actuals (Func_Id : Entity_Id) return Boolean; - -- Return True if the function returns an object of a type that has tasks. + -- Ada 2005 (AI-318-02): Return True if the function needs implicit + -- BIP_Task_Master and BIP_Activation_Chain parameters. function Unqual_BIP_Iface_Function_Call (Expr : Node_Id) return Node_Id; -- Return the inner BIP function call removing any qualification from Expr From 57e5eec24cda138d97277467135201a351722548 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 13 Nov 2025 11:40:55 -0500 Subject: [PATCH 065/373] ada: VAST: Check basic tree properties Miscellaneous improvements to VAST. Mostly debugging improvements. Move the call to VAST from Frontend to Gnat1drv, because there is code AFTER the call to Frontend that notices certain errors, and disables the back end. We want VAST to be enabled only when the back end will be called. This is needed to enable Check_Error_Nodes, among other things. gcc/ada/ChangeLog: * frontend.adb: Move call to VAST from here... * gnat1drv.adb: ...to here. * vast.ads (VAST_If_Enabled): Rename main entry point of VAST from VAST to VAST_If_Enabled. * vast.adb: Miscellaneous improvements. Mostly debugging improvements. Also enable Check_Error_Nodes. Also add checks: Check_FE_Only, Check_Scope_Present, Check_Scope_Correct. * debug.ads: Minor comment tweaks. The comment, "In the checks off version of debug, the call to Set_Debug_Flag is always a null operation." appears to be false, so is removed. * debug.adb: Minor: Remove some code duplication. * sinfo-utils.adb (nnd): Add comment warning about C vs. Ada confusion. --- gcc/ada/debug.adb | 16 +- gcc/ada/debug.ads | 45 ++- gcc/ada/frontend.adb | 5 - gcc/ada/gnat1drv.adb | 5 + gcc/ada/sinfo-utils.adb | 3 + gcc/ada/vast.adb | 748 ++++++++++++++++++++++++++++++++++------ gcc/ada/vast.ads | 2 +- 7 files changed, 670 insertions(+), 154 deletions(-) diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb index ffe4adc790e1..7b36426ed3e9 100644 --- a/gcc/ada/debug.adb +++ b/gcc/ada/debug.adb @@ -1292,15 +1292,15 @@ package body Debug is -- display the source file name, the time stamp expected and -- the time stamp found. + subtype Dig is Character range '1' .. '9'; + subtype LLet is Character range 'a' .. 'z'; + subtype ULet is Character range 'A' .. 'Z'; + -------------------- -- Set_Debug_Flag -- -------------------- procedure Set_Debug_Flag (C : Character; Val : Boolean := True) is - subtype Dig is Character range '1' .. '9'; - subtype LLet is Character range 'a' .. 'z'; - subtype ULet is Character range 'A' .. 'Z'; - begin if C in Dig then case Dig (C) is @@ -1443,10 +1443,6 @@ package body Debug is --------------------------- procedure Set_Dotted_Debug_Flag (C : Character; Val : Boolean := True) is - subtype Dig is Character range '1' .. '9'; - subtype LLet is Character range 'a' .. 'z'; - subtype ULet is Character range 'A' .. 'Z'; - begin if C in Dig then case Dig (C) is @@ -1592,10 +1588,6 @@ package body Debug is (C : Character; Val : Boolean := True) is - subtype Dig is Character range '1' .. '9'; - subtype LLet is Character range 'a' .. 'z'; - subtype ULet is Character range 'A' .. 'Z'; - begin if C in Dig then case Dig (C) is diff --git a/gcc/ada/debug.ads b/gcc/ada/debug.ads index e8d78b11cf14..5cc408bc75c5 100644 --- a/gcc/ada/debug.ads +++ b/gcc/ada/debug.ads @@ -30,22 +30,22 @@ package Debug is pragma Preelaborate; - ------------------------- - -- Dynamic Debug Flags -- - ------------------------- - - -- Flags that can be used to activate various specialized debugging output - -- information. The flags are preset to False, which corresponds to the - -- given output being suppressed. The individual flags can be turned on - -- using the undocumented switch dxxx where xxx is a string of letters for - -- flags to be turned on. Documentation on the current usage of these flags - -- is contained in the body of Debug rather than the spec, so that we don't - -- have to recompile the world when a new debug flag is added. + ----------------- + -- Debug Flags -- + ----------------- + + -- Flags that can be used to activate various debugging actions. They are + -- False by default, which means any output is suppressed. The individual + -- flags can be turned on using the undocumented switches -dxxx, -d.xxx, or + -- -d_xxx where xxx is a string of letters or digits for flags to be turned + -- on. For the compiler itself, "gnat" is prepended, as in -gnatdxxx, + -- -gnatd.xxx, or -gnatd_xxx. Documentation of each flag is given in the + -- package body. -- WARNING: There is a matching C declaration of a few flags in fe.h - Debug_Flag_A : Boolean := False; - Debug_Flag_B : Boolean := False; + Debug_Flag_A : Boolean := False; -- -da or -gnatda + Debug_Flag_B : Boolean := False; -- ... etc. Debug_Flag_C : Boolean := False; Debug_Flag_D : Boolean := False; Debug_Flag_E : Boolean := False; @@ -71,7 +71,7 @@ package Debug is Debug_Flag_Y : Boolean := False; Debug_Flag_Z : Boolean := False; - Debug_Flag_AA : Boolean := False; + Debug_Flag_AA : Boolean := False; -- -dA or -gnatdA Debug_Flag_BB : Boolean := False; Debug_Flag_CC : Boolean := False; Debug_Flag_DD : Boolean := False; @@ -98,7 +98,7 @@ package Debug is Debug_Flag_YY : Boolean := False; Debug_Flag_ZZ : Boolean := False; - Debug_Flag_1 : Boolean := False; + Debug_Flag_1 : Boolean := False; -- -d1 or -gnatd1 Debug_Flag_2 : Boolean := False; Debug_Flag_3 : Boolean := False; Debug_Flag_4 : Boolean := False; @@ -108,7 +108,7 @@ package Debug is Debug_Flag_8 : Boolean := False; Debug_Flag_9 : Boolean := False; - Debug_Flag_Dot_A : Boolean := False; + Debug_Flag_Dot_A : Boolean := False; -- -d.a or -gnatd.a Debug_Flag_Dot_B : Boolean := False; Debug_Flag_Dot_C : Boolean := False; Debug_Flag_Dot_D : Boolean := False; @@ -135,7 +135,7 @@ package Debug is Debug_Flag_Dot_Y : Boolean := False; Debug_Flag_Dot_Z : Boolean := False; - Debug_Flag_Dot_AA : Boolean := False; + Debug_Flag_Dot_AA : Boolean := False; -- -d.A or -gnatd.A Debug_Flag_Dot_BB : Boolean := False; Debug_Flag_Dot_CC : Boolean := False; Debug_Flag_Dot_DD : Boolean := False; @@ -162,7 +162,7 @@ package Debug is Debug_Flag_Dot_YY : Boolean := False; Debug_Flag_Dot_ZZ : Boolean := False; - Debug_Flag_Dot_1 : Boolean := False; + Debug_Flag_Dot_1 : Boolean := False; -- -d.1 or -gnatd.1 Debug_Flag_Dot_2 : Boolean := False; Debug_Flag_Dot_3 : Boolean := False; Debug_Flag_Dot_4 : Boolean := False; @@ -172,7 +172,7 @@ package Debug is Debug_Flag_Dot_8 : Boolean := False; Debug_Flag_Dot_9 : Boolean := False; - Debug_Flag_Underscore_A : Boolean := False; + Debug_Flag_Underscore_A : Boolean := False; -- -d_a or -gnatd_a Debug_Flag_Underscore_B : Boolean := False; Debug_Flag_Underscore_C : Boolean := False; Debug_Flag_Underscore_D : Boolean := False; @@ -199,7 +199,7 @@ package Debug is Debug_Flag_Underscore_Y : Boolean := False; Debug_Flag_Underscore_Z : Boolean := False; - Debug_Flag_Underscore_AA : Boolean := False; + Debug_Flag_Underscore_AA : Boolean := False; -- -d_A or -gnatd_A Debug_Flag_Underscore_BB : Boolean := False; Debug_Flag_Underscore_CC : Boolean := False; Debug_Flag_Underscore_DD : Boolean := False; @@ -226,7 +226,7 @@ package Debug is Debug_Flag_Underscore_YY : Boolean := False; Debug_Flag_Underscore_ZZ : Boolean := False; - Debug_Flag_Underscore_1 : Boolean := False; + Debug_Flag_Underscore_1 : Boolean := False; -- -d_1 or -gnatd_1 Debug_Flag_Underscore_2 : Boolean := False; Debug_Flag_Underscore_3 : Boolean := False; Debug_Flag_Underscore_4 : Boolean := False; @@ -238,8 +238,7 @@ package Debug is procedure Set_Debug_Flag (C : Character; Val : Boolean := True); -- Where C is 0-9, A-Z, or a-z, sets the corresponding debug flag to - -- the given value. In the checks off version of debug, the call to - -- Set_Debug_Flag is always a null operation. + -- the given value. procedure Set_Dotted_Debug_Flag (C : Character; Val : Boolean := True); -- Where C is 0-9, A-Z, or a-z, sets the corresponding dotted debug diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb index bb700a9a422c..f9292d808b4f 100644 --- a/gcc/ada/frontend.adb +++ b/gcc/ada/frontend.adb @@ -69,7 +69,6 @@ with Sinput.L; use Sinput.L; with SCIL_LL; with Tbuild; use Tbuild; with Types; use Types; -with VAST; with Warnsw; use Warnsw; procedure Frontend is @@ -518,10 +517,6 @@ begin null; end if; - -- Verify the validity of the tree - - VAST.VAST; - -- Validate all the subprogram calls; this work will be done by VAST; in -- the meantime it is done to check extra formals and it can be disabled -- using -gnatd_X (which also disables all the other assertions on extra diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 176f2e2a4a23..4653741501a1 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -83,6 +83,7 @@ with Uname; use Uname; with Urealp; with Usage; with Validsw; use Validsw; +with VAST; with Warnsw; use Warnsw; with System.Assertions; @@ -1451,6 +1452,10 @@ begin end if; end if; + -- Verify the validity of the tree (if enabled) + + VAST.VAST_If_Enabled; + -- In -gnatc mode we only do annotation if -gnatR is also set, or if -- -gnatwz is enabled (default setting) and there is an unchecked -- conversion that involves a type whose size is not statically known, diff --git a/gcc/ada/sinfo-utils.adb b/gcc/ada/sinfo-utils.adb index d2e78a3b4b73..d63f457175b8 100644 --- a/gcc/ada/sinfo-utils.adb +++ b/gcc/ada/sinfo-utils.adb @@ -183,6 +183,9 @@ package body Sinfo.Utils is -- break nnd if n = 12345 -- and run gnat1 again from the beginning. + -- NOTE WELL: Make sure gdb is in Ada mode, because "n = 12345" is always + -- true in C mode. + -- The other way is to set a breakpoint near the beginning (e.g. on -- gnat1drv), and run. Then set Watch_Node (nickname "ww") to 12345 in gdb: -- ww := 12345 diff --git a/gcc/ada/vast.adb b/gcc/ada/vast.adb index 59470fdd0f15..e085e1251de8 100644 --- a/gcc/ada/vast.adb +++ b/gcc/ada/vast.adb @@ -36,11 +36,14 @@ with System.Case_Util; with Atree; use Atree; with Debug; with Einfo.Entities; use Einfo.Entities; +-- with Errout; +with Exp_Tss; with Lib; use Lib; with Namet; use Namet; with Nlists; use Nlists; with Opt; use Opt; with Output; +with Sem_Util; with Sinfo.Nodes; use Sinfo.Nodes; with Sinput; with Table; @@ -64,9 +67,12 @@ package body VAST is Check_Sloc, Check_Analyzed, Check_Error_Nodes, + Check_FE_Only, Check_Sharing, Check_Parent_Present, - Check_Parent_Correct); + Check_Parent_Correct, + Check_Scope_Present, + Check_Scope_Correct); type Check_Status is -- Action in case of check failure: @@ -79,10 +85,13 @@ package body VAST is (Check_Other => Enabled, Check_Sloc => Disabled, Check_Analyzed => Disabled, - Check_Error_Nodes => Print_And_Continue, + Check_Error_Nodes => Enabled, + Check_FE_Only => Disabled, Check_Sharing => Disabled, - Check_Parent_Present => Print_And_Continue, - Check_Parent_Correct => Disabled); + Check_Parent_Present => Disabled, + Check_Parent_Correct => Disabled, + Check_Scope_Present => Print_And_Continue, + Check_Scope_Correct => Print_And_Continue); -- others => Print_And_Continue); -- others => Enabled); -- others => Disabled); @@ -109,6 +118,21 @@ package body VAST is Table_Increment => 100, Table_Name => "Node_Stack"); + type Pass_Number is range 1 .. 2; + Pass : Pass_Number; + + procedure VAST; + -- Called by VAST_If_Enabled to do all the checking + + procedure Fail + (Check : Check_Enum := Check_Other; + Detail : String := ""); + -- Print failure information if Check is not disabled. Called by Assert + -- when Condition is False and for other failures. + + procedure Fail_Breakpoint (N : Node_Id) with Export; + -- Does nothing. Called by Fail; useful to set a breakpoint in gdb on this. + procedure Assert (Condition : Boolean; Check : Check_Enum := Check_Other; @@ -121,6 +145,11 @@ package body VAST is function Image (Kind : Node_Kind) return String is (To_Mixed (Kind'Img)); function Image (Kind : Entity_Kind) return String is (To_Mixed (Kind'Img)); + function Kind_Image (N : Node_Or_Entity_Id) return String is + (if Nkind (N) in N_Entity then Image (Ekind (N)) + else Image (Nkind (N))); + function Node_Image (N : Node_Or_Entity_Id) return String is + (Kind_Image (N) & N'Img); procedure Put (S : String); procedure Put_Line (S : String); @@ -147,6 +176,11 @@ package body VAST is procedure Do_Tree (N : Node_Id); -- Do VAST checking on a tree of nodes + function Is_FE_Only (Kind : Node_Kind) return Boolean; + -- True if nodes of this Kind can appear only in the front end. They should + -- be transformed into something else before calling the back end, or else + -- they can only appear in illegal code. + function Has_Subtrees (N : Node_Id) return Boolean; -- True if N has one or more syntactic fields @@ -156,9 +190,15 @@ package body VAST is procedure Do_List (L : List_Id); -- Call Do_Tree on the list elements + procedure Do_Node_Pass_2 (N : Node_Id); + -- Called by Do_Tree in the second pass + procedure Do_Unit (U : Unit_Number_Type); -- Call Do_Tree on the root node of a compilation unit + function Is_On_Stack (Kind : Node_Kind) return Boolean; + -- True if there is at least one node on the stack with the specified Kind + function Ancestor_Node (Count : Node_Stack_Count) return Node_Id; -- Nth ancestor on the Node_Stack. Ancestor_Node(0) is the current node, -- Ancestor_Node(1) is its parent, Ancestor_Node(2) is its grandparent, @@ -166,20 +206,45 @@ package body VAST is function Top_Node return Node_Id is (Ancestor_Node (0)); - type Node_Set is array (Node_Id range <>) of Boolean; - pragma Pack (Node_Set); - type Node_Set_Ptr is access all Node_Set; - procedure Free is new Ada.Unchecked_Deallocation (Node_Set, Node_Set_Ptr); - - Visited : Node_Set_Ptr; - -- Giant array of Booleans; Visited (N) is True if and only if we have - -- visited N in the tree walk. Used to detect incorrect sharing of subtrees - -- or (worse) cycles. We don't allocate the set on the stack, for fear of - -- Storage_Error. + type Node_Info is record + Count : Nat := 0; + Prev_Parent : Node_Id := Empty; + In_Aspect : Boolean := False; + end record; + type Node_Info_Array is array (Node_Id range <>) of Node_Info; + type Node_Info_Array_Ptr is access all Node_Info_Array; + procedure Free is new Ada.Unchecked_Deallocation + (Node_Info_Array, Node_Info_Array_Ptr); + + Nodes_Info : Node_Info_Array_Ptr; + -- Nodes_Info (N).Prev_Parent is non-Empty if and only if the tree walk has + -- visited N. If non-Empty, it points to the most recent parent of N in the + -- tree walk; that is, the node that allowed us to get to N. Normally, each + -- reachable node is visited exactly once, and if the Parent pointers + -- aren't messed up, then Nodes_Info (N).Prev_Parent will be Parent (N). + -- (See below for the special case of the root compilation unit node.) + -- + -- Used to detect incorrect sharing of subtrees or (worse) cycles. We don't + -- allocate this on the stack, for fear of Storage_Error. + -- + -- Nodes_Info (N).Count is the number of ways N is reachable in the walk. + -- It should be 1 for all nodes except the root. function Get_Node_Field_Union is new Atree.Atree_Private_Part.Get_32_Bit_Field (Union_Id) with Inline; + function Has_Field (Kind : Node_Kind; F : Node_Field) return Boolean; + -- True if nodes of type Kind have field F + + function Related_Chars (N : Node_Id) return Name_Id; + -- Return a Name_Id related to N that is worth printing when we print + -- information about N. Returns No_Name if there is no interesting Name_Id. + -- This is typically "Chars (N)" or "Chars (Defining_Identifier (N))" or + -- similar. + + procedure Check_Scope (N : Node_Id); + -- Check that the Scope of N makes sense + -------------- -- To_Mixed -- -------------- @@ -213,6 +278,41 @@ package body VAST is end if; end Put_Line; + --------------- + -- Has_Field -- + --------------- + + function Has_Field (Kind : Node_Kind; F : Node_Field) return Boolean is + Fields : Node_Field_Array renames Node_Field_Table (Kind).all; + begin + for Index in Fields'Range loop + if Fields (Index) = F then + return True; + end if; + end loop; + + return False; + end Has_Field; + + ------------------- + -- Related_Chars -- + ------------------- + + function Related_Chars (N : Node_Id) return Name_Id is + begin + return Result : Name_Id := No_Name do + if Has_Field (Nkind (N), F_Chars) then + Result := Chars (N); + elsif Has_Field (Nkind (N), F_Defining_Identifier) then + Result := Related_Chars (Defining_Identifier (N)); + elsif Has_Field (Nkind (N), F_Defining_Unit_Name) then + Result := Related_Chars (Defining_Unit_Name (N)); + elsif Has_Field (Nkind (N), F_Specification) then + Result := Related_Chars (Specification (N)); + end if; + end return; + end Related_Chars; + -------------- -- Put_Node -- -------------- @@ -220,26 +320,21 @@ package body VAST is procedure Put_Node (N : Node_Id) is begin if Debug.Debug_Flag_Underscore_WW then - if Nkind (N) in N_Entity then - Put (Image (Ekind (N))); - else - Put (Image (Nkind (N))); - end if; - - Put (N'Img & " "); + Put (Node_Image (N) & " "); Sinput.Write_Location (Sloc (N)); if Comes_From_Source (N) then Put (" (s)"); end if; - case Nkind (N) is - when N_Has_Chars => + declare + Chars_To_Print : constant Name_Id := Related_Chars (N); + begin + if Present (Chars_To_Print) then Put (" "); - Write_Name_For_Debug (Chars (N), Quote => """"); - when others => null; - end case; - + Write_Name_For_Debug (Chars_To_Print, Quote => """"); + end if; + end; end if; end Put_Node; @@ -300,6 +395,21 @@ package body VAST is end loop; end Put_Node_Stack; + ----------------- + -- Is_On_Stack -- + ----------------- + + function Is_On_Stack (Kind : Node_Kind) return Boolean is + begin + for J in reverse Node_Stack.First .. Node_Stack.Last loop + if Nkind (Node_Stack.Table (J)) = Kind then + return True; + end if; + end loop; + + return False; + end Is_On_Stack; + ------------------- -- Ancestor_Node -- ------------------- @@ -309,12 +419,63 @@ package body VAST is return Node_Stack.Table (Node_Stack.Last - Count); end Ancestor_Node; + --------------------- + -- Fail_Breakpoint -- + --------------------- + + procedure Fail_Breakpoint (N : Node_Id) is + begin + null; + end Fail_Breakpoint; + + ---------- + -- Fail -- + ---------- + + VAST_Failure : exception; + + procedure Fail + (Check : Check_Enum := Check_Other; + Detail : String := "") + is + Part1 : constant String := "VAST fail"; + Part2 : constant String := + (if Check = Check_Other then "" + else ": " & To_Mixed (Check'Img)); + Part3 : constant String := + (if Detail = "" then "" else " -- " & Detail); + Message : constant String := Part1 & Part2 & Part3; + Save : constant Boolean := Debug.Debug_Flag_Underscore_WW; + begin + case Status (Check) is + when Disabled => null; + when Enabled | Print_And_Continue => + Debug.Debug_Flag_Underscore_WW := True; + -- ????We should probably avoid changing the debug flag here + Put (Message & ": "); + Put_Node (Top_Node); + Put_Line (""); + + Put ("VAST file: "); + Sinput.Write_Location (Sloc (Top_Node)); + Put_Line (""); + Put_Node_Stack; + + if Status (Check) = Enabled then + Put_Node_Stack; + raise VAST_Failure with Message; + end if; + + Debug.Debug_Flag_Underscore_WW := Save; + + Fail_Breakpoint (Ancestor_Node (0)); + end case; + end Fail; + ------------ -- Assert -- ------------ - VAST_Failure : exception; - procedure Assert (Condition : Boolean; Check : Check_Enum := Check_Other; @@ -322,57 +483,53 @@ package body VAST is is begin if not Condition then - declare - Part1 : constant String := "VAST fail"; - Part2 : constant String := - (if Check = Check_Other then "" - else ": " & To_Mixed (Check'Img)); - Part3 : constant String := - (if Detail = "" then "" else " -- " & Detail); - Message : constant String := Part1 & Part2 & Part3; - Save : constant Boolean := Debug.Debug_Flag_Underscore_WW; - begin - case Status (Check) is - when Disabled => null; - when Enabled | Print_And_Continue => - Debug.Debug_Flag_Underscore_WW := True; - -- ???We should probably avoid changing the debug flag here - Put (Message & ": "); - Put_Node (Top_Node); - Put_Line (""); - - if Status (Check) = Enabled then - Put_Node_Stack; - raise VAST_Failure with Message; - end if; - - Debug.Debug_Flag_Underscore_WW := Save; - end case; - end; + Fail (Check, Detail); end if; end Assert; - ------------- - -- Do_Tree -- - ------------- + ----------------- + -- Check_Scope -- + ----------------- - procedure Do_Tree (N : Node_Id) is + procedure Check_Scope (N : Node_Id) is + use Exp_Tss, Sem_Util; begin - Enter_Node (N); + if Present (Scope (N)) then + if False then -- ???? + Assert (Enclosing_Declaration (Scope (N)) = + Enclosing_Declaration (Enclosing_Declaration (N)), + Check_Scope_Correct); + end if; + else + if Ekind (N) = E_Void then + -- ????These seem to be SW, PI, &c, and their params. + null; + elsif Ekind (N) = E_Procedure and then Is_TSS (N, TSS_Put_Image) + then + null; -- also PI + elsif Ekind (N) = E_Protected_Body then + null; + else + Fail (Check_Scope_Present); + end if; + end if; + end Check_Scope; - -- Skip the rest if empty. Check Sloc: + -------------------- + -- Do_Node_Pass_2 -- + -------------------- - case Nkind (N) is - when N_Empty => - Assert (No (Sloc (N))); - goto Done; -- --------------> - -- Don't do any further checks on Empty + procedure Do_Node_Pass_2 (N : Node_Id) is + begin + -- Check Sloc: + case Nkind (N) is -- ???Some nodes, including exception handlers, have no Sloc; -- it's unclear why. when N_Exception_Handler => - Assert (if Comes_From_Source (N) then Present (Sloc (N))); + Assert + ((if Comes_From_Source (N) then Present (Sloc (N))), Check_Sloc); when others => Assert (Present (Sloc (N)), Check_Sloc); end case; @@ -382,24 +539,21 @@ package body VAST is Assert (Analyzed (N), Check_Analyzed); - -- If we visit the same node more than once, then there are shared - -- nodes; the "tree" is not a tree: - - Assert (not Visited (N), Check_Sharing); - Visited (N) := True; - -- Misc checks based on node/entity kind: case Nkind (N) is when N_Unused_At_Start | N_Unused_At_End => - Assert (False); + -- ????Can't get here, because Is_FE_Only. Also 'case' below. + Fail; when N_Error => -- VAST doesn't do anything when Serious_Errors_Detected > 0 (at -- least for now), so we shouldn't encounter any N_Error nodes. - Assert (False, Check_Error_Nodes); + Fail (Check_Error_Nodes); when N_Entity => + Check_Scope (N); + case Ekind (N) is when others => null; -- more to be done here @@ -416,7 +570,7 @@ package body VAST is raise Program_Error; -- can't get here when N_Error => - Assert (False, Check_Error_Nodes); + Fail (Check_Error_Nodes); -- The error node has no parent, but we shouldn't even be seeing -- error nodes in VAST at all. See earlier "when N_Error". @@ -440,10 +594,95 @@ package body VAST is Assert (Parent (N) = Ancestor_Node (1), Check_Parent_Correct); end if; end case; + end Do_Node_Pass_2; + + ------------- + -- Do_Tree -- + ------------- + + procedure Do_Tree (N : Node_Id) is + Visited : constant Boolean := Present (Nodes_Info (N).Prev_Parent); + begin + if False and Nkind (N) = N_Aspect_Specification then + -- ????This cuts failures 453490/235214 = 1.9. + return; + end if; + + if Pass = 1 then + Nodes_Info (N).Count := Nodes_Info (N).Count + 1; + -- ????Get rid of asserts: + pragma Assert + (if Nkind (N) not in N_Empty | N_Compilation_Unit then + Visited = (Nodes_Info (N).Count > 1)); + + if Is_On_Stack (N_Aspect_Specification) then + Nodes_Info (N).In_Aspect := True; + end if; + elsif Pass = 2 then + pragma Assert (Nodes_Info (N).Count > 0); + end if; + + Enter_Node (N); + + Assert (not Is_FE_Only (Nkind (N)), Check_FE_Only); + -- ????Also check for particular pragmas, etc. + -- And Ekind. + + if Nkind (N) = N_Empty then + Assert (N = Empty); + Assert (No (Sloc (N))); + goto Done; -- --------------> + -- Don't do any further checks on Empty + end if; + + -- If we visit the same node more than once, then there are shared + -- nodes; the "tree" is not a tree: + -- We know that the "extra formals" involve shared subtrees, + -- and that's probably unavoidable. See Expand_Call_Helper. + -- A lot of shared subtrees come from aspect specifications, + -- probably because they get turned into pragmas, and the + -- subtrees get placed inside the pragmas without removing + -- them from the original aspect specifications. + + if Pass = 2 and then Nodes_Info (N).Count > 1 and then + not Nodes_Info (N).In_Aspect -- ????cuts failures by 1.9 + then + declare + Count : constant String := + (if Nodes_Info (N).Count = 2 then "" + else Nodes_Info (N).Count'Img & "par"); + Aspect : constant String := + (if Nodes_Info (N).In_Aspect then "{asp}" else ""); + begin + Fail (Check_Sharing, + "(prev-par=" & + Node_Image (Nodes_Info (N).Prev_Parent) & ")" & + Count & Aspect); + if Status (Check_Sharing) /= Disabled then + Output.Write_Line + (Kind_Image (Ancestor_Node (1)) & "```" & Kind_Image (N)); + Output.Write_Line (""); + end if; + end; + end if; - Do_Subtrees (N); + if Node_Stack.Last = 1 then + Nodes_Info (N).Prev_Parent := Ancestor_Node (0); + Assert (Nkind (N) = N_Compilation_Unit); + -- This is the root node. Set the parent to itself, + -- for no particular reason except to make it not Empty. + else + Nodes_Info (N).Prev_Parent := Ancestor_Node (1); + end if; + if not Visited then -- Don't walk it more than once + if Pass = 2 then + Do_Node_Pass_2 (N); + end if; + Do_Subtrees (N); + end if; <> + Leave_Node (N); end Do_Tree; @@ -455,7 +694,7 @@ package body VAST is Offsets : Traversed_Offset_Array renames Traversed_Fields (Nkind (N)); begin - -- True if sentinel comes first + -- True if the first Offset is not the sentinel return Offsets (Offsets'First) /= No_Field_Offset; end Has_Subtrees; @@ -559,14 +798,67 @@ package body VAST is ---------- procedure VAST is + begin + Put_Line ("VAST"); + + -- Operating_Mode = Generate_Code implies there are no legality errors: + + pragma Assert (Serious_Errors_Detected = 0); + -- ????pragma Assert (not Errout.Compilation_Errors); + + Put_Line ("VAST checking" & Last_Unit'Img & " units"); + + declare + use Atree_Private_Part; + Last_Node : constant Node_Id := Node_Offsets.Last; + begin + pragma Assert (Nodes_Info = null); + Nodes_Info := new Node_Info_Array (Node_Id'First .. Last_Node); + + -- Walk all nodes in all units doing Pass 1, and so on + -- for each Pass. + + for P in Pass_Number loop + Pass := P; + + Put_Line ("VAST Pass" & Pass'Img); + if Pass = 2 then -- ????Is this needed? + for Index in Nodes_Info'Range loop + Nodes_Info (Index).Prev_Parent := Empty; + end loop; + end if; + + for U in Main_Unit .. Last_Unit loop + -- Main_Unit is the one passed to the back end, but here we are + -- walking all the units. + Do_Unit (U); + end loop; + end loop; + + -- We shouldn't have allocated any new nodes during VAST: + + pragma Assert (Node_Offsets.Last = Last_Node); + Free (Nodes_Info); + end; + + Put_Line ("VAST done."); + end VAST; + + --------------------- + -- VAST_If_Enabled -- + --------------------- + + procedure VAST_If_Enabled is + -- This is the public entry point + pragma Assert (Expander_Active = (Operating_Mode = Generate_Code)); -- ???So why do we need both Operating_Mode and Expander_Active? use Debug; begin -- Do nothing if we're not calling the back end; the main point of VAST - -- is to protect against code-generation bugs. This includes the - -- case where legality errors were detected; the tree is known to be - -- malformed in some error cases. + -- is to protect against code-generation bugs. VAST is disabled if + -- legality errors were detected; the tree is known to be malformed + -- in some error cases. The -gnatc switch also disables VAST. if Operating_Mode /= Generate_Code then return; @@ -575,46 +867,276 @@ package body VAST is -- If -gnatd_W (VAST in verbose mode) is enabled, then that should imply -- -gnatd_V (enable VAST). - if Debug_Flag_Underscore_WW then + if Debug_Flag_Underscore_WW or Force_Enable_VAST then Debug_Flag_Underscore_VV := True; end if; -- Do nothing if VAST is disabled - if not (Debug_Flag_Underscore_VV or Force_Enable_VAST) then + if not Debug_Flag_Underscore_VV then return; end if; - -- Turn off output unless verbose mode is enabled - - Put_Line ("VAST"); - - -- Operating_Mode = Generate_Code implies there are no legality errors: - - Assert (Serious_Errors_Detected = 0); - - Put_Line ("VAST checking" & Last_Unit'Img & " units"); - - declare - use Atree_Private_Part; - Last_Node : constant Node_Id := Node_Offsets.Last; - begin - pragma Assert (Visited = null); - Visited := new Node_Set'(Node_Id'First .. Last_Node => False); - - for U in Main_Unit .. Last_Unit loop - -- Main_Unit is the one passed to the back end, but here we are - -- walking all the units. - Do_Unit (U); - end loop; - - -- We shouldn't have allocated any new nodes during VAST: + VAST; + end VAST_If_Enabled; - pragma Assert (Node_Offsets.Last = Last_Node); - Free (Visited); - end; + ---------------- + -- Is_FE_Only -- + ---------------- - Put_Line ("VAST done."); - end VAST; + function Is_FE_Only (Kind : Node_Kind) return Boolean is + -- ????This is work in progress; see "?" marks below + begin + case Kind is + when N_Abortable_Part + | N_Abort_Statement + | N_Asynchronous_Select + | N_Compound_Statement + | N_Conditional_Entry_Call + | N_Continue_Statement + | N_Contract + | N_Delay_Alternative + | N_Delay_Until_Statement + | N_Delta_Constraint + | N_Entry_Call_Alternative + | N_Entry_Index_Specification + | N_Error + | N_Formal_Derived_Type_Definition + | N_Formal_Package_Declaration + | N_Goto_When_Statement + | N_Interpolated_String_Literal + | N_Iterated_Element_Association + | N_Mod_Clause + | N_Raise_When_Statement + | N_Return_When_Statement + | N_SCIL_Dispatching_Call + | N_SCIL_Dispatch_Table_Tag_Init + | N_SCIL_Membership_Test + | N_Timed_Entry_Call + | N_Triggering_Alternative + | N_Unused_At_End + | N_Unused_At_Start + => return True; + + when N_Empty + | N_Delay_Relative_Statement -- ????not turned into rt call? + | N_Expression_Function + | N_Iterated_Component_Association -- ???? + | N_Single_Protected_Declaration + | N_Accept_Alternative -- ????not turned into rt call? + | N_Accept_Statement -- ????not turned into rt call? + | N_Decimal_Fixed_Point_Definition + | N_Digits_Constraint + | N_Entry_Call_Statement -- ????not turned into rt call? + | N_Requeue_Statement -- ????not turned into rt call? + | N_Selective_Accept -- ????not turned into rt call? + | N_Terminate_Alternative -- ????not turned into rt call? + | N_Defining_Character_Literal + | N_Access_Function_Definition + | N_Formal_Discrete_Type_Definition + | N_Formal_Modular_Type_Definition + | N_Iterator_Specification + | N_Op_Expon + | N_Variant + | N_Variant_Part + | N_Access_Definition + | N_Access_Procedure_Definition + | N_Access_To_Object_Definition + | N_Aspect_Specification + | N_Case_Statement_Alternative + | N_Compilation_Unit_Aux + | N_Component_Clause + | N_Component_Declaration + | N_Component_Definition + | N_Component_List + | N_Constrained_Array_Definition + | N_Derived_Type_Definition + | N_Designator + | N_Discriminant_Association + | N_Discriminant_Specification + | N_Elsif_Part + | N_Enumeration_Type_Definition + | N_Floating_Point_Definition + | N_Formal_Concrete_Subprogram_Declaration + | N_Formal_Floating_Point_Definition + | N_Formal_Object_Declaration + | N_Formal_Private_Type_Definition + | N_Formal_Signed_Integer_Type_Definition + | N_Formal_Type_Declaration + | N_Generic_Association + | N_Index_Or_Discriminant_Constraint + | N_Iteration_Scheme + | N_Loop_Parameter_Specification + | N_Modular_Type_Definition + | N_Others_Choice + | N_Parameter_Association + | N_Parameter_Specification + | N_Quantified_Expression -- ???? + | N_Range + | N_Range_Constraint + | N_Record_Definition + | N_Signed_Integer_Type_Definition + | N_Subtype_Indication + | N_Unconstrained_Array_Definition + | N_Pragma_Argument_Association + | N_Case_Expression + | N_Case_Expression_Alternative + | N_Delta_Aggregate -- ???? + | N_Entry_Body_Formal_Part + | N_Entry_Declaration + | N_Extended_Return_Statement -- ???? + | N_Formal_Abstract_Subprogram_Declaration + | N_Formal_Decimal_Fixed_Point_Definition + | N_Formal_Incomplete_Type_Definition + | N_Formal_Ordinary_Fixed_Point_Definition + | N_Ordinary_Fixed_Point_Definition + | N_Protected_Definition + | N_Raise_Expression + | N_Real_Range_Specification + | N_Target_Name -- ???? + | N_Task_Definition + => return False; + -- ???? + + when N_Abstract_Subprogram_Declaration + | N_Aggregate + | N_Allocator + | N_And_Then + | N_Assignment_Statement + | N_At_Clause + | N_Attribute_Definition_Clause + | N_Attribute_Reference + | N_Block_Statement + | N_Call_Marker + | N_Case_Statement + | N_Character_Literal + | N_Code_Statement + | N_Compilation_Unit + | N_Component_Association + | N_Defining_Identifier + | N_Defining_Operator_Symbol + | N_Defining_Program_Unit_Name + | N_Entry_Body + | N_Enumeration_Representation_Clause + | N_Exception_Declaration + | N_Exception_Handler + | N_Exception_Renaming_Declaration + | N_Exit_Statement + | N_Expanded_Name + | N_Explicit_Dereference + | N_Expression_With_Actions + | N_Extension_Aggregate + | N_External_Initializer + | N_Free_Statement + | N_Freeze_Entity + | N_Freeze_Generic_Entity + | N_Full_Type_Declaration + | N_Function_Call + | N_Function_Instantiation + | N_Function_Specification + | N_Generic_Function_Renaming_Declaration + | N_Generic_Package_Declaration + | N_Generic_Package_Renaming_Declaration + | N_Generic_Procedure_Renaming_Declaration + | N_Generic_Subprogram_Declaration + | N_Goto_Statement + | N_Handled_Sequence_Of_Statements + | N_Identifier + | N_If_Expression + | N_If_Statement + | N_Implicit_Label_Declaration + | N_In + | N_Incomplete_Type_Declaration + | N_Indexed_Component + | N_Integer_Literal + | N_Itype_Reference + | N_Label + | N_Loop_Statement + | N_Not_In + | N_Null + | N_Null_Statement + | N_Number_Declaration + | N_Object_Declaration + | N_Object_Renaming_Declaration + | N_Op_Abs + | N_Op_Add + | N_Op_And + | N_Op_Concat + | N_Op_Divide + | N_Op_Eq + | N_Operator_Symbol + | N_Op_Ge + | N_Op_Gt + | N_Op_Le + | N_Op_Lt + | N_Op_Minus + | N_Op_Mod + | N_Op_Multiply + | N_Op_Ne + | N_Op_Not + | N_Op_Or + | N_Op_Plus + | N_Op_Rem + | N_Op_Rotate_Left + | N_Op_Rotate_Right + | N_Op_Shift_Left + | N_Op_Shift_Right + | N_Op_Shift_Right_Arithmetic + | N_Op_Subtract + | N_Op_Xor + | N_Or_Else + | N_Package_Body + | N_Package_Body_Stub + | N_Package_Declaration + | N_Package_Instantiation + | N_Package_Renaming_Declaration + | N_Package_Specification + | N_Pop_Constraint_Error_Label + | N_Pop_Program_Error_Label + | N_Pop_Storage_Error_Label + | N_Pragma + | N_Private_Extension_Declaration + | N_Private_Type_Declaration + | N_Procedure_Call_Statement + | N_Procedure_Instantiation + | N_Procedure_Specification + | N_Protected_Body + | N_Protected_Body_Stub + | N_Protected_Type_Declaration + | N_Push_Constraint_Error_Label + | N_Push_Program_Error_Label + | N_Push_Storage_Error_Label + | N_Qualified_Expression + | N_Raise_Constraint_Error + | N_Raise_Program_Error + | N_Raise_Statement + | N_Raise_Storage_Error + | N_Real_Literal + | N_Record_Representation_Clause + | N_Reference + | N_Selected_Component + | N_Simple_Return_Statement + | N_Single_Task_Declaration + | N_Slice + | N_String_Literal + | N_Subprogram_Body + | N_Subprogram_Body_Stub + | N_Subprogram_Declaration + | N_Subprogram_Renaming_Declaration + | N_Subtype_Declaration + | N_Subunit + | N_Task_Body + | N_Task_Body_Stub + | N_Task_Type_Declaration + | N_Type_Conversion + | N_Unchecked_Type_Conversion + | N_Use_Package_Clause + | N_Use_Type_Clause + | N_Validate_Unchecked_Conversion + | N_Variable_Reference_Marker + | N_With_Clause + => return False; + end case; + end Is_FE_Only; end VAST; diff --git a/gcc/ada/vast.ads b/gcc/ada/vast.ads index faecd9a33f3c..7888121817c9 100644 --- a/gcc/ada/vast.ads +++ b/gcc/ada/vast.ads @@ -28,6 +28,6 @@ package VAST is - procedure VAST; + procedure VAST_If_Enabled; end VAST; From c00ed72920735a228b0380b59c1ae13ce86d881b Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 13 Nov 2025 21:12:54 +0100 Subject: [PATCH 066/373] ada: Fix fallout of recent finalization fix for limited types The recent finalization fix made for limited types has uncovered cases where the object returned by calls to build-in-place functions was not finalized in selected anonymous contexts, most notably the dependent expressions of conditional expressions. The specific finalization machinery that handles conditional expressions requires the temporaries built for their dependent expressions to be visible as early as possible, and this was not the case. gcc/ada/ChangeLog: * exp_ch4.adb (Expand_N_Case_Expression): When not optimizing for a specific context, call Make_Build_In_Place_Call_In_Anonymous_Context on expressions of alternatives when they are calls to BIP functions. (Expand_N_If_Expression): Likewise for the Then & Else expressions. --- gcc/ada/exp_ch4.adb | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 7c90aa0d1b8e..520ab683a6e2 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -5368,7 +5368,17 @@ package body Exp_Ch4 is -- When the alternative's expression involves controlled function -- calls, generated temporaries are chained on the corresponding -- list of actions. These temporaries need to be finalized after - -- the case expression is evaluated. + -- the case expression is evaluated. We first need to make them + -- explicit for build-in-place functions in anonymous contexts, + -- because calls to these do not go through Expand_Ctrl_Actions. + + if Is_Build_In_Place_Function_Call (Expression (Alt)) + and then not Optimize_Assignment_Stmt + and then not Optimize_Return_Stmt + and then not Optimize_Object_Decl + then + Make_Build_In_Place_Call_In_Anonymous_Context (Expression (Alt)); + end if; Process_Transients_In_Expression (N, Actions (Alt)); @@ -6345,7 +6355,17 @@ package body Exp_Ch4 is -- When the "then" or "else" expressions involve controlled function -- calls, generated temporaries are chained on the corresponding list -- of actions. These temporaries need to be finalized after the if - -- expression is evaluated. + -- expression is evaluated. We first need to make them explicit for + -- build-in-place functions in anonymous contexts, because calls to + -- these do not go through Expand_Ctrl_Actions. + + if Is_Build_In_Place_Function_Call (Thenx) then + Make_Build_In_Place_Call_In_Anonymous_Context (Thenx); + end if; + + if Is_Build_In_Place_Function_Call (Elsex) then + Make_Build_In_Place_Call_In_Anonymous_Context (Elsex); + end if; Process_Transients_In_Expression (N, Then_Actions (N)); Process_Transients_In_Expression (N, Else_Actions (N)); From adb8151b26c1b3b9689a81f29a42fcca56fb38d9 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Fri, 14 Nov 2025 16:29:45 -0500 Subject: [PATCH 067/373] ada: VAST found bug: Missing Parent in annotate aspect In case of an Annotate aspect of the form "Annotate => Expr", where Expr is an identifier (as opposed to an aggregate), the Parent field of the N_Identifier node for Expr was destroyed. This patch changes the code that turns the aspect into a pragma, so that it no longer has that bug. The problem was in "New_List (Expr)"; which sets the Parent of Expr to Empty. But Expr is still part of the tree of the aspect, so it should have a proper Parent; we can't just stick it in a temporary list. The new algorithm constructs the pragma arguments without disturbing the tree of the aspect. This is the last known case of missing Parent fields, so we can now enable the VAST check that detected this bug. gcc/ada/ChangeLog: * sem_ch13.adb (Aspect_Annotate): Avoid disturbing the tree of the aspect. * vast.adb: Enable Check_Parent_Present. * exp_ch6.adb (Validate_Subprogram_Calls): Minor reformatting. --- gcc/ada/exp_ch6.adb | 5 +++-- gcc/ada/sem_ch13.adb | 51 +++++++++++++++++++------------------------- gcc/ada/vast.adb | 2 +- 3 files changed, 26 insertions(+), 32 deletions(-) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 6bf8d3ba145d..42111a416de2 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -10558,8 +10558,9 @@ package body Exp_Ch6 is begin pragma Assert (Check_BIP_Actuals (Call_Node, Subp)); - -- Build-in-place function calls return their result by - -- reference. + + -- Build-in-place function calls return their result by + -- reference. pragma Assert (not Is_Build_In_Place_Function (Subp) or else Returns_By_Ref (Subp)); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 46eb08e38f13..98c3335e593c 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2167,12 +2167,10 @@ package body Sem_Ch13 is Pragma_Name : Name_Id) return Node_Id; -- This is a wrapper for Make_Pragma used for converting aspects -- to pragmas. It takes care of Sloc (set from Loc) and building - -- the pragma identifier from the given name. In addition the flag - -- Class_Present is set from the aspect node, as well as - -- Is_Ignored. This routine also sets the - -- From_Aspect_Specification in the resulting pragma node to True, - -- and sets Corresponding_Aspect to point to the aspect. The - -- resulting pragma is assigned to Aitem. + -- the pragma identifier from the given name. In addition + -- Class_Present and Is_Ignored are set from the aspect node. + -- This routine also sets From_Aspect_Specification to True, + -- and sets Corresponding_Aspect to point to the aspect. ------------------------------- -- Analyze_Aspect_Convention -- @@ -4814,12 +4812,10 @@ package body Sem_Ch13 is when Aspect_Annotate | Aspect_GNAT_Annotate => declare - Args : List_Id; - Pargs : List_Id; - Arg : Node_Id; - + Pargs : constant List_Id := New_List; -- pragma args begin - -- The argument can be a single identifier + -- The argument can be a single identifier; add it to + -- Pargs. if Nkind (Expr) = N_Identifier then @@ -4831,11 +4827,12 @@ package body Sem_Ch13 is Set_Paren_Count (Expr, 0); - -- Add the single item to the list - - Args := New_List (Expr); + Append_To (Pargs, + Make_Pragma_Argument_Association (Sloc (Expr), + Expression => Relocate_Node (Expr))); - -- Otherwise we must have an aggregate + -- Otherwise we must have an aggregate; add all + -- expressions to Pargs. elsif Nkind (Expr) = N_Aggregate then @@ -4854,9 +4851,16 @@ package body Sem_Ch13 is ("redundant parentheses", Expr); end if; - -- List of arguments is list of aggregate expressions - - Args := Expressions (Expr); + declare + Arg : Node_Id := First (Expressions (Expr)); + begin + while Present (Arg) loop + Append_To (Pargs, + Make_Pragma_Argument_Association (Sloc (Arg), + Expression => Relocate_Node (Arg))); + Next (Arg); + end loop; + end; -- Anything else is illegal @@ -4865,17 +4869,6 @@ package body Sem_Ch13 is goto Continue; end if; - -- Prepare pragma arguments - - Pargs := New_List; - Arg := First (Args); - while Present (Arg) loop - Append_To (Pargs, - Make_Pragma_Argument_Association (Sloc (Arg), - Expression => Relocate_Node (Arg))); - Next (Arg); - end loop; - Append_To (Pargs, Make_Pragma_Argument_Association (Sloc (Ent), Chars => Name_Entity, diff --git a/gcc/ada/vast.adb b/gcc/ada/vast.adb index e085e1251de8..429eeaf8c294 100644 --- a/gcc/ada/vast.adb +++ b/gcc/ada/vast.adb @@ -88,7 +88,7 @@ package body VAST is Check_Error_Nodes => Enabled, Check_FE_Only => Disabled, Check_Sharing => Disabled, - Check_Parent_Present => Disabled, + Check_Parent_Present => Enabled, Check_Parent_Correct => Disabled, Check_Scope_Present => Print_And_Continue, Check_Scope_Correct => Print_And_Continue); From fc5301ce89bf69ed25bbe72205ee50d1fccfd1f1 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 17 Nov 2025 08:45:21 +0100 Subject: [PATCH 068/373] ada: Streamline implementation of masters in Exp_Ch9 The incidental discovery of an old issue and its resolution has exposed the convoluted handling of masters in Exp_Ch9, which uses two totally different approaches to achieve the same goal, respectively in Build_Master_Entity and Build_Class_Wide_Master, the latter being quite hard to follow. The handling of activation chains for extended return statements is also a bit complex. This gets rid of the second approach entirely for masters, as well as makes the handling of activation chains uniform for all nodes. No functional changes. gcc/ada/ChangeLog: * gen_il-gen-gen_nodes.adb (N_Extended_Return_Statement): Add Activation_Chain_Entity semantic field. * exp_ch3.adb (Build_Master): Use Build_Master_{Entity,Renaming} in all cases. (Expand_N_Object_Declaration): Small tweak. * exp_ch6.adb (Make_Build_In_Place_Iface_Call_In_Allocator): Use Build_Master_{Entity,Renaming} to build the master. * exp_ch7.adb (Expand_N_Package_Declaration): Do not guard the call to Build_Task_Activation_Call for the sake of consistency. * exp_ch9.ads (Build_Class_Wide_Master): Delete. (Find_Master_Scope): Likewise. (Build_Protected_Subprogram_Call_Cleanup): Move to... (First_Protected_Operation): Move to... (Mark_Construct_As_Task_Master): New procedure. * exp_ch9.adb (Build_Protected_Subprogram_Call_Cleanup): ...here. (First_Protected_Operation): ...here. (Build_Activation_Chain_Entity): Streamline handling of extended return statements. (Build_Class_Wide_Master): Delete. (Build_Master_Entity): Streamline handling of extended return statements and call Mark_Construct_As_Task_Master on the context. (Build_Task_Activation_Call): Assert that the owner is not an extended return statement. (Find_Master_Scope): Delete. (Mark_Construct_As_Task_Master): New procedure. * sem_ch3.adb (Access_Definition): Use Build_Master_{Entity,Renaming} in all cases to build a master. * sem_ch6.adb (Check_Anonymous_Return): Rename to... (Check_Anonymous_Access_Return_With_Tasks): ...this. At the end, call Mark_Construct_As_Task_Master on the parent node. (Analyze_Subprogram_Body_Helper): Adjust to above renaming. (Create_Extra_Formals): Do not set Has_Master_Entity here. * sinfo.ads (Activation_Chain_Entity): Adjust description. --- gcc/ada/exp_ch3.adb | 14 +- gcc/ada/exp_ch6.adb | 4 +- gcc/ada/exp_ch7.adb | 4 +- gcc/ada/exp_ch9.adb | 351 +++++-------------------------- gcc/ada/exp_ch9.ads | 35 +-- gcc/ada/gen_il-gen-gen_nodes.adb | 1 + gcc/ada/sem_ch3.adb | 3 +- gcc/ada/sem_ch6.adb | 53 ++--- gcc/ada/sinfo.ads | 4 +- 9 files changed, 97 insertions(+), 372 deletions(-) diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index fbc7060a7442..57d2ec399745 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -6684,7 +6684,8 @@ package body Exp_Ch3 is elsif not Is_Param_Block_Component_Type (Ptr_Typ) and then Is_Limited_Class_Wide_Type (Desig_Typ) then - Build_Class_Wide_Master (Ptr_Typ); + Build_Master_Entity (Ptr_Typ); + Build_Master_Renaming (Ptr_Typ); end if; end Build_Master; @@ -7651,7 +7652,9 @@ package body Exp_Ch3 is -- If tasks are being declared, make sure we have an activation chain -- defined for the tasks (has no effect if we already have one), and -- also that a Master variable is established (and that the appropriate - -- enclosing construct is established as a task master). + -- enclosing construct is established as a task master). And also deal + -- with objects initialized with a call to a BIP function that has task + -- formal parameters. if Has_Task (Typ) or else Might_Have_Tasks (Typ) @@ -7660,12 +7663,7 @@ package body Exp_Ch3 is then Build_Activation_Chain_Entity (N); - if Has_Task (Typ) then - Build_Master_Entity (Def_Id); - - -- Handle objects initialized with BIP function calls - - elsif Has_BIP_Init_Expr then + if Has_Task (Typ) or else Has_BIP_Init_Expr then Build_Master_Entity (Def_Id); end if; end if; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 42111a416de2..b388044fb3c3 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -9954,7 +9954,6 @@ package body Exp_Ch6 is Anon_Type := Create_Itype (E_Anonymous_Access_Type, Function_Call); Set_Directly_Designated_Type (Anon_Type, Etype (BIP_Func_Call)); Set_Etype (Anon_Type, Anon_Type); - Build_Class_Wide_Master (Anon_Type); Tmp_Decl := Make_Object_Declaration (Loc, @@ -9978,6 +9977,9 @@ package body Exp_Ch6 is Insert_Action (Allocator, Tmp_Decl); Expander_Mode_Restore; + Build_Master_Entity (Anon_Type); + Build_Master_Renaming (Anon_Type); + Make_Build_In_Place_Call_In_Allocator (Allocator => Expression (Tmp_Decl), Function_Call => Expression (Expression (Tmp_Decl))); diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index c170c23451d8..e3cde2e3f30f 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -5067,9 +5067,7 @@ package body Exp_Ch7 is -- Generate task activation call as last step of elaboration - if Present (Activation_Chain_Entity (N)) then - Build_Task_Activation_Call (N); - end if; + Build_Task_Activation_Call (N); -- Verify the run-time semantics of pragma Initial_Condition at the -- end of the private declarations when the package lacks a body. diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 4c63ec978ff0..f23df88a5b81 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -243,6 +243,16 @@ package body Exp_Ch9 is -- cleanup handler that unlocks the object in all cases. For details, -- see Exp_Ch7.Expand_Cleanup_Actions. + procedure Build_Protected_Subprogram_Call_Cleanup + (Op_Spec : Node_Id; + Conc_Typ : Node_Id; + Loc : Source_Ptr; + Stmts : List_Id); + -- Append to Stmts the cleanups after a call to a protected subprogram + -- whose specification is Op_Spec. Conc_Typ is the concurrent type and Loc + -- the sloc for appended statements. The cleanup will either unlock the + -- protected object or serve pending entries. + function Build_Renamed_Formal_Declaration (New_F : Entity_Id; Formal : Entity_Id; @@ -424,6 +434,10 @@ package body Exp_Ch9 is -- the scope of Context_Id and Context_Decls is the declarative list of -- Context. + function First_Protected_Operation (D : List_Id) return Node_Id; + -- Given the declarations list for a protected body, find the + -- first protected operation body. + function Index_Object (Spec_Id : Entity_Id) return Entity_Id; -- Given a subprogram identifier, return the entity which is associated -- with the protection entry index in the Protected_Body_Subprogram or @@ -959,33 +973,6 @@ package body Exp_Ch9 is ----------------------------------- procedure Build_Activation_Chain_Entity (N : Node_Id) is - function Has_Activation_Chain (Stmt : Node_Id) return Boolean; - -- Determine whether an extended return statement has activation chain - - -------------------------- - -- Has_Activation_Chain -- - -------------------------- - - function Has_Activation_Chain (Stmt : Node_Id) return Boolean is - Decl : Node_Id; - - begin - Decl := First (Return_Object_Declarations (Stmt)); - while Present (Decl) loop - if Nkind (Decl) = N_Object_Declaration - and then Chars (Defining_Identifier (Decl)) = Name_uChain - then - return True; - end if; - - Next (Decl); - end loop; - - return False; - end Has_Activation_Chain; - - -- Local variables - Context : Node_Id; Context_Id : Entity_Id; Decls : List_Id; @@ -1010,19 +997,7 @@ package body Exp_Ch9 is -- If activation chain entity has not been declared already, create one - if Nkind (Context) = N_Extended_Return_Statement - or else No (Activation_Chain_Entity (Context)) - then - -- Since extended return statements do not store the entity of the - -- chain, examine the return object declarations to avoid creating - -- a duplicate. - - if Nkind (Context) = N_Extended_Return_Statement - and then Has_Activation_Chain (Context) - then - return; - end if; - + if No (Activation_Chain_Entity (Context)) then declare Loc : constant Source_Ptr := Sloc (Context); Chain : Entity_Id; @@ -1031,18 +1006,7 @@ package body Exp_Ch9 is begin Chain := Make_Defining_Identifier (Sloc (N), Name_uChain); - -- Note: An extended return statement is not really a task - -- activator, but it does have an activation chain on which to - -- store the tasks temporarily. On successful return, the tasks - -- on this chain are moved to the chain passed in by the caller. - -- We do not build an Activation_Chain_Entity for an extended - -- return statement, because we do not want to build a call to - -- Activate_Tasks. Task activation is the responsibility of the - -- caller. - - if Nkind (Context) /= N_Extended_Return_Statement then - Set_Activation_Chain_Entity (Context, Chain); - end if; + Set_Activation_Chain_Entity (Context, Chain); Decl := Make_Object_Declaration (Loc, @@ -1184,155 +1148,6 @@ package body Exp_Ch9 is Parameter_Associations => New_List (Concurrent_Ref (N))); end Build_Call_With_Task; - ----------------------------- - -- Build_Class_Wide_Master -- - ----------------------------- - - procedure Build_Class_Wide_Master (Typ : Entity_Id) is - Loc : constant Source_Ptr := Sloc (Typ); - Master_Decl : Node_Id; - Master_Id : Entity_Id; - Master_Scope : Entity_Id; - Name_Id : Node_Id; - Related_Node : Node_Id; - Ren_Decl : Node_Id; - - begin - -- No action needed if the run-time has no tasking support - - if Global_No_Tasking then - return; - end if; - - -- Find the declaration that created the access type, which is either a - -- type declaration, or an object declaration with an access definition, - -- in which case the type is anonymous. - - if Is_Itype (Typ) then - Related_Node := Associated_Node_For_Itype (Typ); - else - Related_Node := Parent (Typ); - end if; - - Master_Scope := Find_Master_Scope (Typ); - - -- Nothing to do if the master scope already contains a _master entity. - -- The only exception to this is the following scenario: - - -- Source_Scope - -- Transient_Scope_1 - -- _master - - -- Transient_Scope_2 - -- use of master - - -- In this case the source scope is marked as having the master entity - -- even though the actual declaration appears inside an inner scope. If - -- the second transient scope requires a _master, it cannot use the one - -- already declared because the entity is not visible. - - Name_Id := Make_Identifier (Loc, Name_uMaster); - Master_Decl := Empty; - - if not Has_Master_Entity (Master_Scope) - or else No (Current_Entity_In_Scope (Name_Id)) - then - declare - Ins_Nod : Node_Id; - Par_Nod : Node_Id; - - begin - Master_Decl := Build_Master_Declaration (Loc); - - -- Ensure that the master declaration is placed before its use - - Ins_Nod := Find_Hook_Context (Related_Node); - while not Is_List_Member (Ins_Nod) loop - Ins_Nod := Parent (Ins_Nod); - end loop; - - Par_Nod := Parent (List_Containing (Ins_Nod)); - - -- For internal blocks created by Wrap_Loop_Statement, Wrap_ - -- Statements_In_Block, and Build_Abort_Undefer_Block, remember - -- that they have a task master entity declaration; required by - -- Build_Master_Entity to avoid creating another master entity, - -- and also ensures that subsequent calls to Find_Master_Scope - -- return this scope as the master scope of Typ. - - if Is_Internal_Block (Par_Nod) then - Set_Has_Master_Entity (Entity (Identifier (Par_Nod))); - - elsif Nkind (Par_Nod) = N_Handled_Sequence_Of_Statements - and then Is_Internal_Block (Parent (Par_Nod)) - then - Set_Has_Master_Entity (Entity (Identifier (Parent (Par_Nod)))); - - -- Otherwise remember that this scope has an associated task - -- master entity declaration. - - else - Set_Has_Master_Entity (Master_Scope); - end if; - - Insert_Before (First (List_Containing (Ins_Nod)), Master_Decl); - Analyze (Master_Decl); - - -- Mark the containing scope as a task master. Masters associated - -- with return statements are already marked at this stage (see - -- Analyze_Subprogram_Body). - - if Ekind (Current_Scope) /= E_Return_Statement then - declare - Par : Node_Id := Related_Node; - - begin - while Nkind (Par) /= N_Compilation_Unit loop - Par := Parent (Par); - - -- If we fall off the top, we are at the outer level, - -- and the environment task is our effective master, - -- so nothing to mark. - - if Nkind (Par) in - N_Block_Statement | N_Subprogram_Body | N_Task_Body - then - Set_Is_Task_Master (Par); - exit; - end if; - end loop; - end; - end if; - end; - end if; - - Master_Id := - Make_Defining_Identifier (Loc, New_External_Name (Chars (Typ), 'M')); - - -- Generate: - -- typeMnn renames _master; - - Ren_Decl := - Make_Object_Renaming_Declaration (Loc, - Defining_Identifier => Master_Id, - Subtype_Mark => New_Occurrence_Of (Standard_Integer, Loc), - Name => Name_Id); - - -- If the master is declared locally, add the renaming declaration - -- immediately after it, to prevent access-before-elaboration in the - -- back-end. - - if Present (Master_Decl) then - Insert_After (Master_Decl, Ren_Decl); - Analyze (Ren_Decl); - - else - Insert_Action (Related_Node, Ren_Decl); - end if; - - Set_Master_Id (Typ, Master_Id); - end Build_Class_Wide_Master; - -------------------------------- -- Build_Corresponding_Record -- -------------------------------- @@ -3256,47 +3071,11 @@ package body Exp_Ch9 is Find_Enclosing_Context (Par, Context, Context_Id, Decls); end if; - -- When the enclosing context is a BIP function whose result type has - -- tasks, the function has an extra formal that is the master of the - -- tasks to be created by its returned object (that is, when its - -- enclosing context is a return statement). However, if the body of - -- the function creates tasks before its return statements, such tasks - -- need their own master. + pragma Assert (not Is_Finalizer (Context_Id)); - if Has_Master_Entity (Context_Id) - and then Ekind (Context_Id) = E_Function - and then Is_Build_In_Place_Function (Context_Id) - and then Needs_BIP_Task_Actuals (Context_Id) - then - -- No need to add it again if previously added - - declare - Master_Present : Boolean; + -- Nothing to do if the context already has a master - begin - -- Handle transient scopes - - if Context_Id /= Current_Scope then - Push_Scope (Context_Id); - Master_Present := - Present (Current_Entity_In_Scope (Name_uMaster)); - Pop_Scope; - else - Master_Present := - Present (Current_Entity_In_Scope (Name_uMaster)); - end if; - - if Master_Present then - return; - end if; - end; - - -- Nothing to do if the context already has a master; internally built - -- finalizers don't need a master. - - elsif Has_Master_Entity (Context_Id) - or else Is_Finalizer (Context_Id) - then + if Has_Master_Entity (Context_Id) then return; end if; @@ -3319,26 +3098,15 @@ package body Exp_Ch9 is Analyze (Decl); end if; - -- Mark the enclosing scope and its associated construct as being task - -- masters. - Set_Has_Master_Entity (Context_Id); - while Present (Context) - and then Nkind (Context) /= N_Compilation_Unit - loop - if Nkind (Context) in - N_Block_Statement | N_Subprogram_Body | N_Task_Body - then - Set_Is_Task_Master (Context); - exit; - - elsif Nkind (Parent (Context)) = N_Subunit then - Context := Corresponding_Stub (Parent (Context)); - end if; + -- Mark its associated construct as being a task master, but masters + -- associated with return statements are already marked at this stage + -- (see Analyze_Subprogram_Body_Helper). - Context := Parent (Context); - end loop; + if Nkind (Context) /= N_Extended_Return_Statement then + Mark_Construct_As_Task_Master (Context); + end if; end Build_Master_Entity; --------------------------- @@ -4680,6 +4448,13 @@ package body Exp_Ch9 is Owner := Unit_Declaration_Node (Corresponding_Spec (Owner)); end if; + -- An extended return statement is not really a task activator, but it + -- does have an activation chain on which to store tasks temporarily. + -- On successful return, the tasks on this chain are moved to the chain + -- passed in by the caller. + + pragma Assert (Nkind (Owner) /= N_Extended_Return_Statement); + Chain := Activation_Chain_Entity (Owner); -- Nothing to do when there are no tasks to activate. This is indicated @@ -13298,42 +13073,6 @@ package body Exp_Ch9 is pragma Assert (Present (Context_Decls)); end Find_Enclosing_Context; - ----------------------- - -- Find_Master_Scope -- - ----------------------- - - function Find_Master_Scope (E : Entity_Id) return Entity_Id is - S : Entity_Id; - - begin - -- In Ada 2005, the master is the innermost enclosing scope that is not - -- transient. If the enclosing block is the rewriting of a call or the - -- scope is an extended return statement this is valid master. The - -- master in an extended return is only used within the return, and is - -- subsequently overwritten in Move_Activation_Chain, but it must exist - -- now before that overwriting occurs. - - S := Scope (E); - - if Ada_Version >= Ada_2005 then - while Is_Internal (S) loop - if Nkind (Parent (S)) = N_Block_Statement - and then Has_Master_Entity (S) - then - exit; - - elsif Ekind (S) = E_Return_Statement then - exit; - - else - S := Scope (S); - end if; - end loop; - end if; - - return S; - end Find_Master_Scope; - ------------------------------- -- First_Protected_Operation -- ------------------------------- @@ -14650,6 +14389,32 @@ package body Exp_Ch9 is Attribute_Name => Name_Unchecked_Access))); end Make_Unlock_Statement; + ----------------------------------- + -- Mark_Construct_As_Task_Master -- + ----------------------------------- + + procedure Mark_Construct_As_Task_Master (N : Node_Id) is + Nod : Node_Id := N; + + begin + -- If we fall off the top, we are at the outer level, and the + -- environment task is our effective master, so nothing to mark. + + while Nkind (Nod) /= N_Compilation_Unit loop + if Nkind (Nod) in N_Block_Statement | N_Subprogram_Body | N_Task_Body + then + Set_Is_Task_Master (Nod); + exit; + + elsif Nkind (Parent (Nod)) = N_Subunit then + Nod := Corresponding_Stub (Parent (Nod)); + + else + Nod := Parent (Nod); + end if; + end loop; + end Mark_Construct_As_Task_Master; + ------------------------------ -- Next_Protected_Operation -- ------------------------------ diff --git a/gcc/ada/exp_ch9.ads b/gcc/ada/exp_ch9.ads index 681114133fe1..4e5bdcc64347 100644 --- a/gcc/ada/exp_ch9.ads +++ b/gcc/ada/exp_ch9.ads @@ -50,11 +50,6 @@ package Exp_Ch9 is -- Task_Id of the associated task as the parameter. The caller is -- responsible for analyzing and resolving the resulting tree. - procedure Build_Class_Wide_Master (Typ : Entity_Id); - -- Given an access-to-limited class-wide type or an access-to-limited - -- interface, ensure that the designated type has a _master and generate - -- a renaming of the said master to service the access type. - function Build_Master_Declaration (Loc : Source_Ptr) return Node_Id; -- For targets supporting tasks, generate: -- _Master : constant Integer := Current_Master.all; @@ -99,16 +94,6 @@ package Exp_Ch9 is -- External is False if the call is to another protected subprogram within -- the same object. - procedure Build_Protected_Subprogram_Call_Cleanup - (Op_Spec : Node_Id; - Conc_Typ : Node_Id; - Loc : Source_Ptr; - Stmts : List_Id); - -- Append to Stmts the cleanups after a call to a protected subprogram - -- whose specification is Op_Spec. Conc_Typ is the concurrent type and Loc - -- the sloc for appended statements. The cleanup will either unlock the - -- protected object or serve pending entries. - procedure Build_Task_Activation_Call (N : Node_Id); -- This procedure is called for constructs that can be task activators, -- i.e. task bodies, subprogram bodies, package bodies and blocks. If the @@ -185,8 +170,7 @@ package Exp_Ch9 is (Sloc : Source_Ptr; Ent : Entity_Id; Index : Node_Id; - Ttyp : Entity_Id) - return Node_Id; + Ttyp : Entity_Id) return Node_Id; -- Returns an expression to compute a task entry index given the name of -- the entry or entry family. For the case of a task entry family, the -- Index parameter contains the expression for the subscript. Ttyp is the @@ -267,19 +251,6 @@ package Exp_Ch9 is -- Return the external version of a protected operation, which locks -- the object before invoking the internal protected subprogram body. - function Find_Master_Scope (E : Entity_Id) return Entity_Id; - -- When a type includes tasks, a master entity is created in the scope, to - -- be used by the runtime during activation. In general the master is the - -- immediate scope in which the type is declared, but in Ada 2005, in the - -- presence of synchronized classwide interfaces, the immediate scope of - -- an anonymous access type may be a transient scope, which has no run-time - -- presence. In this case, the scope of the master is the innermost scope - -- that comes from source. - - function First_Protected_Operation (D : List_Id) return Node_Id; - -- Given the declarations list for a protected body, find the - -- first protected operation body. - procedure Install_Private_Data_Declarations (Loc : Source_Ptr; Spec_Id : Entity_Id; @@ -345,6 +316,10 @@ package Exp_Ch9 is -- Given the entity of the record type created for a protected type, build -- a list of statements needed for proper initialization of the object. + procedure Mark_Construct_As_Task_Master (N : Node_Id); + -- Mark the innermost N_Block_Statement, N_Subprogram_Body or N_Task_Body + -- that is either N or enclosing N as being a task master. + function Next_Protected_Operation (N : Node_Id) return Node_Id; -- Given a protected operation node (a subprogram or entry body), find the -- following node in the declarations list. diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb index 9334c98e3945..750287f771bf 100644 --- a/gcc/ada/gen_il-gen-gen_nodes.adb +++ b/gcc/ada/gen_il-gen-gen_nodes.adb @@ -1015,6 +1015,7 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_Extended_Return_Statement, N_Statement_Other_Than_Procedure_Call, (Sy (Return_Object_Declarations, List_Id), Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), + Sm (Activation_Chain_Entity, Node_Id), Sm (Procedure_To_Call, Node_Id), Sm (Return_Statement_Entity, Node_Id), Sm (Storage_Pool, Node_Id))); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index cc26ecab6ae1..e302908e9db7 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -958,7 +958,8 @@ package body Sem_Ch3 is if Is_Limited_Record (Desig_Type) and then Is_Class_Wide_Type (Desig_Type) then - Build_Class_Wide_Master (Anon_Type); + Build_Master_Entity (Defining_Identifier (Related_Nod)); + Build_Master_Renaming (Anon_Type); -- Similarly, if the type is an anonymous access that designates -- tasks, create a master entity for it in the current context. diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 1235ea453b6a..3b7e61ed11eb 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2434,11 +2434,11 @@ package body Sem_Ch6 is procedure Build_Subprogram_Declaration; -- Create a matching subprogram declaration for subprogram body N - procedure Check_Anonymous_Return; - -- Ada 2005: if a function returns an access type that denotes a task, - -- or a type that contains tasks, we must create a master entity for - -- the anonymous type, which typically will be used in an allocator - -- in the body of the function. + procedure Check_Anonymous_Access_Return_With_Tasks; + -- If a function returns an anonymous access type that designates a task + -- or a type that contains tasks, create a master entity in the function + -- for the anonymous access type, and also mark the construct enclosing + -- the function as a task master. procedure Check_Inline_Pragma (Spec : in out Node_Id); -- Look ahead to recognize a pragma that may appear after the body. @@ -2795,13 +2795,12 @@ package body Sem_Ch6 is Body_Id := Analyze_Subprogram_Specification (Body_Spec); end Build_Subprogram_Declaration; - ---------------------------- - -- Check_Anonymous_Return -- - ---------------------------- + ---------------------------------------------- + -- Check_Anonymous_Access_Return_With_Tasks -- + ---------------------------------------------- - procedure Check_Anonymous_Return is + procedure Check_Anonymous_Access_Return_With_Tasks is Decl : Node_Id; - Par : Node_Id; Scop : Entity_Id; begin @@ -2837,29 +2836,14 @@ package body Sem_Ch6 is Set_Declarations (N, New_List (Decl)); end if; - Set_Master_Id (Etype (Scop), Defining_Identifier (Decl)); Set_Has_Master_Entity (Scop); + Set_Master_Id (Etype (Scop), Defining_Identifier (Decl)); - -- Now mark the containing scope as a task master - - Par := N; - while Nkind (Par) /= N_Compilation_Unit loop - Par := Parent (Par); - pragma Assert (Present (Par)); - - -- If we fall off the top, we are at the outer level, and - -- the environment task is our effective master, so nothing - -- to mark. + -- Now mark the enclosing construct as a task master - if Nkind (Par) - in N_Task_Body | N_Block_Statement | N_Subprogram_Body - then - Set_Is_Task_Master (Par, True); - exit; - end if; - end loop; + Mark_Construct_As_Task_Master (Parent (N)); end if; - end Check_Anonymous_Return; + end Check_Anonymous_Access_Return_With_Tasks; ------------------------- -- Check_Inline_Pragma -- @@ -4476,7 +4460,12 @@ package body Sem_Ch6 is Install_Private_With_Clauses (Body_Id); end if; - Check_Anonymous_Return; + -- If a function returns an anonymous access type that designates a task + -- or a type that contains tasks, we must create a master entity for the + -- anonymous access type, which typically will be used for an allocator + -- in the body of the function. + + Check_Anonymous_Access_Return_With_Tasks; -- Set the Protected_Formal field of each extra formal of the protected -- subprogram to reference the corresponding extra formal of the @@ -9420,10 +9409,6 @@ package body Sem_Ch6 is (E, Standard_Integer, E, BIP_Formal_Suffix (BIP_Task_Master)); - if Needs_BIP_Task_Actuals (Ref_E) then - Set_Has_Master_Entity (E); - end if; - Discard := Add_Extra_Formal (E, RTE (RE_Activation_Chain_Access), diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index c5d981d53023..34777c01cfb6 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -757,8 +757,8 @@ package Sinfo is -- When tasks are declared in the corresponding declarative region this -- entity is located by name (its name is always _Chain) and the declared -- tasks are added to the chain. Note that N_Extended_Return_Statement - -- does not have this attribute, although it does have an activation - -- chain. This chain is used to store the tasks temporarily, and is not + -- also has this attribute, although it is not really a task activator: + -- this chain is only used to store the tasks temporarily, and is not -- used for activating them. On successful completion of the return -- statement, the tasks are moved to the caller's chain, and the caller -- activates them. From 55d87cd891920ea2d3f779fdc154e64ee4ce1a44 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sun, 16 Nov 2025 14:29:39 +0100 Subject: [PATCH 069/373] ada: Couple of small and unrelated cleanups No functional changes. gcc/ada/ChangeLog: * exp_ch11.adb (Expand_N_Handled_Sequence_Of_Statement): Merge the eslif condition with the if condition for cleanup actions. * sem_ch6.adb (Analyze_Procedure_Call.Analyze_Call_And_Resolve): Get rid of if statement whose condition is always true. * sinfo.ads (Finally_Statements): Document their purpose. --- gcc/ada/exp_ch11.adb | 20 +++++--------------- gcc/ada/sem_ch6.adb | 12 +++--------- gcc/ada/sinfo.ads | 10 ++++++---- 3 files changed, 14 insertions(+), 28 deletions(-) diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index a6b17184cb16..719217879551 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -1279,27 +1279,17 @@ package body Exp_Ch11 is -- Add cleanup actions if required. No cleanup actions are needed in -- thunks associated with interfaces, because they only displace the - -- pointer to the object. For extended return statements, we need - -- cleanup actions if the Handled_Statement_Sequence contains generated - -- objects of controlled types, for example. We do not want to clean up - -- the return object. - - if Nkind (Parent (N)) not in N_Accept_Statement - | N_Extended_Return_Statement - | N_Package_Body - and then not Delay_Cleanups (Current_Scope) - and then not Is_Thunk (Current_Scope) - then - Expand_Cleanup_Actions (Parent (N)); + -- pointer to the object. - elsif Nkind (Parent (N)) = N_Extended_Return_Statement - and then Handled_Statement_Sequence (Parent (N)) = N + if Nkind (Parent (N)) not in N_Accept_Statement | N_Package_Body and then not Delay_Cleanups (Current_Scope) + and then not Is_Thunk (Current_Scope) then - pragma Assert (not Is_Thunk (Current_Scope)); Expand_Cleanup_Actions (Parent (N)); end if; + -- Protect the Finally_Statements with abort defer/undefer + if Present (Finally_Statements (N)) and then Abort_Allowed then if Exceptions_OK then Set_Finally_Statements diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 3b7e61ed11eb..2e0df1df29eb 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1611,9 +1611,7 @@ package body Sem_Ch6 is procedure Analyze_Procedure_Call (N : Node_Id) is procedure Analyze_Call_And_Resolve; - -- Do Analyze and Resolve calls for procedure call. At the end, check - -- for illegal order dependence. - -- ??? where is the check for illegal order dependencies? + -- Do Analyze and Resolve for procedure call ------------------------------ -- Analyze_Call_And_Resolve -- @@ -1621,12 +1619,8 @@ package body Sem_Ch6 is procedure Analyze_Call_And_Resolve is begin - if Nkind (N) = N_Procedure_Call_Statement then - Analyze_Call (N); - Resolve (N, Standard_Void_Type); - else - Analyze (N); - end if; + Analyze_Call (N); + Resolve (N, Standard_Void_Type); end Analyze_Call_And_Resolve; -- Local variables diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 34777c01cfb6..bd0ef87e9e81 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1274,8 +1274,9 @@ package Sinfo is -- that references the file the external initializer points to. -- Finally_Statements - -- Present in N_Handled_Statement_Sequences nodes. Points to a list - -- containing statements. + -- Present in N_Handled_Sequence_Of_Statements nodes. Points to a list + -- of statements to be executed on all possible execution paths on exit + -- to the sequence of statements. -- First_Inlined_Subprogram -- Present in the N_Compilation_Unit node for the main program. Points @@ -6920,10 +6921,11 @@ package Sinfo is -- Statements -- End_Label (set to Empty if expander generated) -- Exception_Handlers (set to No_List if none present) + -- Finally_Statements (set to No_List if no finally statements) -- At_End_Proc (set to Empty if no clean up procedure) - -- Note: A Handled_Sequence_Of_Statements can contain both - -- Exception_Handlers and an At_End_Proc. + -- Note: An N_Handled_Sequence_Of_Statements node can simultaneously + -- contain Exception_Handlers, Finally_Statements and an At_End_Proc. -- Note: the parent always contains a Declarations field which contains -- declarations associated with the handled sequence of statements. This From 82193bed681a32919e833e931346ea5eed27e511 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 14 Nov 2025 22:39:51 +0100 Subject: [PATCH 070/373] ada: Streamline processing for shared passive and protected objects The Add_Shared_Var_Lock_Procs procedure in Exp_Smem contains a very ad-hoc management of transient scopes, which is probably unavoidable but can be streamlined by changing the insertion point of the finalizer to be the one used in the presence of controlled objects. However, the latter change badly interacts with the special processing of protected subprogram bodies implemented in Build_Finalizer_Call. Now this processing is obsolete after the recent overhaul of the expansion of these protected subprogram bodies and can be entirely removed. No functional changes. gcc/ada/ChangeLog: * exp_ch7.adb (Build_Finalizer_Call): Delete. (Build_Finalizer): Always insert the finalizer at the end of the statement list in the non-package case. (Expand_Cleanup_Actions): Attach the finalizer manually, if any. * exp_smem.adb (Add_Shared_Var_Lock_Procs): Insert all the actions directly in the transient scope. --- gcc/ada/exp_ch7.adb | 137 +++++++++---------------------------------- gcc/ada/exp_smem.adb | 81 ++++++++++--------------- 2 files changed, 59 insertions(+), 159 deletions(-) diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index e3cde2e3f30f..030134394cb3 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -428,13 +428,6 @@ package body Exp_Ch7 is -- does not contain the above constructs, the routine returns an empty -- list. - procedure Build_Finalizer_Call (N : Node_Id; Fin_Id : Entity_Id); - -- N is a construct that contains a handled sequence of statements, Fin_Id - -- is the entity of a finalizer. Create an At_End handler that covers the - -- statements of N and calls Fin_Id. If the handled statement sequence has - -- an exception handler, the statements will be wrapped in a block to avoid - -- unwanted interaction with the new At_End handler. - procedure Build_Record_Deep_Procs (Typ : Entity_Id); -- Build the deep Initialize/Adjust/Finalize for a record Typ with -- Has_Controlled_Component set and store them using the TSS mechanism. @@ -2306,38 +2299,30 @@ package body Exp_Ch7 is Append_To (Decls, Fin_Spec); - -- When the finalizer acts solely as a cleanup routine, the body - -- is inserted right after the spec. + -- Manually freeze the spec. This is somewhat of a hack because a + -- subprogram is frozen when its body is seen and the freeze node + -- appears right before the body. However, in this case, the spec + -- must be frozen earlier since the At_End handler must be able to + -- call it. + -- + -- declare + -- procedure Fin_Id; -- Spec + -- [Fin_Id] -- Freeze node + -- begin + -- ... + -- at end + -- Fin_Id; -- At_End handler + -- end; - if Acts_As_Clean and not Has_Ctrl_Objs then - Insert_After (Fin_Spec, Fin_Body); + Ensure_Freeze_Node (Fin_Id); + Insert_After (Fin_Spec, Freeze_Node (Fin_Id)); + Mutate_Ekind (Fin_Id, E_Procedure); + Freeze_Extra_Formals (Fin_Id); + Set_Is_Frozen (Fin_Id); - -- In other cases the body is inserted after the last statement + pragma Assert (Present (Stmts)); - else - -- Manually freeze the spec. This is somewhat of a hack because - -- a subprogram is frozen when its body is seen and the freeze - -- node appears right before the body. However, in this case, - -- the spec must be frozen earlier since the At_End handler - -- must be able to call it. - -- - -- declare - -- procedure Fin_Id; -- Spec - -- [Fin_Id] -- Freeze node - -- begin - -- ... - -- at end - -- Fin_Id; -- At_End handler - -- end; - - Ensure_Freeze_Node (Fin_Id); - Insert_After (Fin_Spec, Freeze_Node (Fin_Id)); - Mutate_Ekind (Fin_Id, E_Procedure); - Freeze_Extra_Formals (Fin_Id); - Set_Is_Frozen (Fin_Id); - - Append_To (Stmts, Fin_Body); - end if; + Append_To (Stmts, Fin_Body); end if; Analyze (Fin_Spec, Suppress => All_Checks); @@ -3183,8 +3168,7 @@ package body Exp_Ch7 is Spec_Id := Defining_Identifier (Spec_Id); end if; - -- Accept statement, block, entry body, package body, protected body, - -- subprogram body or task body. + -- Block, entry body, package body, subprogram body or task body else Decls := Declarations (N); @@ -3310,76 +3294,6 @@ package body Exp_Ch7 is end if; end Build_Finalizer; - -------------------------- - -- Build_Finalizer_Call -- - -------------------------- - - procedure Build_Finalizer_Call (N : Node_Id; Fin_Id : Entity_Id) is - begin - -- Do not perform this expansion in SPARK mode because we do not create - -- finalizers in the first place. - - if GNATprove_Mode then - return; - end if; - - -- If the construct to be cleaned up is a protected subprogram body, the - -- finalizer call needs to be associated with the block that wraps the - -- unprotected version of the subprogram. The following illustrates this - -- scenario: - - -- procedure Prot_SubpP is - -- procedure finalizer is - -- begin - -- Service_Entries (Prot_Obj); - -- Abort_Undefer; - -- end finalizer; - - -- begin - -- . . . - -- begin - -- Prot_SubpN (Prot_Obj); - -- at end - -- finalizer; - -- end; - -- end Prot_SubpP; - - declare - Loc : constant Source_Ptr := Sloc (N); - - Is_Protected_Subp_Body : constant Boolean := - Nkind (N) = N_Subprogram_Body - and then Is_Protected_Subprogram_Body (N); - -- True if N is the protected version of a subprogram that belongs to - -- a protected type. - - HSS : constant Node_Id := - (if Is_Protected_Subp_Body - then Handled_Statement_Sequence - (Last (Statements (Handled_Statement_Sequence (N)))) - else Handled_Statement_Sequence (N)); - - -- We attach the At_End_Proc to the HSS if this is an accept - -- statement or extended return statement. Also in the case of - -- a protected subprogram, because if Service_Entries raises an - -- exception, we do not lock the PO, so we also do not want to - -- unlock it. - - Use_HSS : constant Boolean := - Nkind (N) in N_Accept_Statement | N_Extended_Return_Statement - or else Is_Protected_Subp_Body; - - At_End_Proc_Bearer : constant Node_Id := (if Use_HSS then HSS else N); - begin - pragma Assert (No (At_End_Proc (At_End_Proc_Bearer))); - Set_At_End_Proc (At_End_Proc_Bearer, New_Occurrence_Of (Fin_Id, Loc)); - -- Attach reference to finalizer to tree, for LLVM use - Set_Parent (At_End_Proc (At_End_Proc_Bearer), At_End_Proc_Bearer); - Analyze (At_End_Proc (At_End_Proc_Bearer)); - Expand_At_End_Handler (At_End_Proc_Bearer, Empty); - end; - end Build_Finalizer_Call; - --------------------- -- Build_Late_Proc -- --------------------- @@ -4898,7 +4812,12 @@ package body Exp_Ch7 is Fin_Id => Fin_Id); if Present (Fin_Id) then - Build_Finalizer_Call (N, Fin_Id); + pragma Assert (No (At_End_Proc (N))); + Set_At_End_Proc (N, New_Occurrence_Of (Fin_Id, Sloc (N))); + -- Attach reference to finalizer to tree for LLVM + Set_Parent (At_End_Proc (N), N); + Analyze (At_End_Proc (N)); + Expand_At_End_Handler (N, Empty); end if; end; end Expand_Cleanup_Actions; diff --git a/gcc/ada/exp_smem.adb b/gcc/ada/exp_smem.adb index f9a35e892116..831b7c09f9e8 100644 --- a/gcc/ada/exp_smem.adb +++ b/gcc/ada/exp_smem.adb @@ -134,31 +134,18 @@ package body Exp_Smem is ------------------------------- procedure Add_Shared_Var_Lock_Procs (N : Node_Id) is + Aft : constant List_Id := New_List; Loc : constant Source_Ptr := Sloc (N); Obj : constant Entity_Id := Entity (Expression (First_Actual (N))); - Vnm : String_Id; - Vid : Entity_Id; - Vde : Node_Id; - Aft : constant List_Id := New_List; In_Transient : constant Boolean := Scope_Is_Transient; + -- Whether we are already in a transient scope - function Build_Shared_Var_Lock_Call (RE : RE_Id) return Node_Id; - -- Return a procedure call statement for lock proc RTE - - -------------------------------- - -- Build_Shared_Var_Lock_Call -- - -------------------------------- + function Current_Scope return Int renames Scope_Stack.Last; + -- Return the index of the current scope - function Build_Shared_Var_Lock_Call (RE : RE_Id) return Node_Id is - begin - return - Make_Procedure_Call_Statement (Loc, - Name => - New_Occurrence_Of (RTE (RE), Loc), - Parameter_Associations => - New_List (New_Occurrence_Of (Vid, Loc))); - end Build_Shared_Var_Lock_Call; + Vid : Entity_Id; + Vnm : String_Id; -- Start of processing for Add_Shared_Var_Lock_Procs @@ -176,53 +163,42 @@ package body Exp_Smem is -- If the lock/read/write/unlock actions for this object have already -- been emitted in the current scope, no need to perform them anew. - if In_Transient - and then Contains (Scope_Stack.Table (Scope_Stack.Last) - .Locked_Shared_Objects, - Obj) - then - return; + if In_Transient then + if Contains (Scope_Stack.Table (Current_Scope).Locked_Shared_Objects, + Obj) + then + return; + end if; + + else + Establish_Transient_Scope (N, Manage_Sec_Stack => False); end if; Build_Full_Name (Obj, Vnm); - -- Declare a constant string to hold the name of the shared object. - -- Note that this must occur outside of the transient scope, as the - -- scope's finalizer needs to have access to this object. Also, it - -- appears that GIGI does not support elaborating string literal - -- subtypes in transient scopes. + -- Declare a constant string to hold the name of the shared object Vid := Make_Temporary (Loc, 'N', Obj); - Vde := + Insert_Action (N, Make_Object_Declaration (Loc, Defining_Identifier => Vid, Constant_Present => True, Object_Definition => New_Occurrence_Of (Standard_String, Loc), - Expression => Make_String_Literal (Loc, Vnm)); - - -- Already in a transient scope. Make sure that we insert Vde outside - -- that scope. - - if In_Transient then - Insert_Before_And_Analyze (Node_To_Be_Wrapped, Vde); - - -- Not in a transient scope yet: insert Vde as an action on N prior to - -- establishing one. - - else - Insert_Action (N, Vde); - Establish_Transient_Scope (N, Manage_Sec_Stack => False); - end if; + Expression => Make_String_Literal (Loc, Vnm))); -- Mark object as locked in the current (transient) scope Append_New_Elmt - (Obj, - To => Scope_Stack.Table (Scope_Stack.Last).Locked_Shared_Objects); + (Obj, Scope_Stack.Table (Current_Scope).Locked_Shared_Objects); -- First insert the Lock call before - Insert_Action (N, Build_Shared_Var_Lock_Call (RE_Shared_Var_Lock)); + Insert_Action (N, + Make_Procedure_Call_Statement (Loc, + Name => + New_Occurrence_Of (RTE (RE_Shared_Var_Lock), Loc), + Parameter_Associations => + New_List (New_Occurrence_Of (Vid, Loc)))); -- Now, right after the Lock, insert a call to read the object @@ -237,7 +213,12 @@ package body Exp_Smem is -- Finally insert the Unlock call - Append_To (Aft, Build_Shared_Var_Lock_Call (RE_Shared_Var_Unlock)); + Append_To (Aft, + Make_Procedure_Call_Statement (Loc, + Name => + New_Occurrence_Of (RTE (RE_Shared_Var_Unlock), Loc), + Parameter_Associations => + New_List (New_Occurrence_Of (Vid, Loc)))); -- Store cleanup actions in transient scope From 52d71516634642bf99108fe7cfbfcbc46639518e Mon Sep 17 00:00:00 2001 From: Ghjuvan Lacambre Date: Mon, 17 Nov 2025 16:23:50 +0100 Subject: [PATCH 071/373] ada: sem_ch13.adb: accept VADS inline asm in Relaxed RM Semantics mode VADS inline assembly works by using a qualified expression for one of the types defined in the Machine_Code package, e.g. procedure P is begin code_2'(INSTR, OPERAND1, OPERAND2); end y; This is different from GNAT's own inline assembly machinery, which instead expects a call to Machine_Code.ASM with a set of differently-typed arguments. This incompatibility is preventing GNATSAS' GNAT-Warnings engine from analyzing VADS code, hence we adapt sem_ch13.adb to not fail on such constructs when GNAT is running under both Check_Semantics_Only_Mode and Relaxed_RM_Semantics mode. gcc/ada/ChangeLog: * sem_ch13.adb (Analyze_Code_Statement): Do not emit error message when only checking relaxed semantics. --- gcc/ada/sem_ch13.adb | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 98c3335e593c..b90c73018953 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -8482,7 +8482,15 @@ package body Sem_Ch13 is if Etype (Expression (N)) = Any_Type then return; elsif not Is_RTE (Etype (Expression (N)), RE_Asm_Insn) then - Error_Msg_N ("incorrect type for code statement", N); + + -- Only emit an error message when not running in Relaxed RM + -- Semantics. This enables GNATSAS' GNAT Warnings engine to work on + -- VADS codebases. + + if not (Check_Semantics_Only_Mode and then Relaxed_RM_Semantics) then + Error_Msg_N ("incorrect type for code statement", N); + end if; + return; end if; From 8039d2fea973a8882b6554768dc24c901bcfa41f Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Tue, 23 Sep 2025 09:36:47 -0600 Subject: [PATCH 072/373] ada: Add Visitor generic to Repinfo For a gnat-llvm debuginfo patch, it was convenient to be able to inspect the expressions created during back-annotation. This patch adds a new generic Visit procedure that can be implemented to allow such inspection. List_GCC_Expression is reimplemented in terms of this procedure as a proof of concept. gcc/ada/ChangeLog: * repinfo.adb (Visit): New procedure. (List_GCC_Expression): Rewrite. * repinfo.ads (Visit): New generic procedure. --- gcc/ada/repinfo.adb | 386 +++++++++++++++++++++++++------------------- gcc/ada/repinfo.ads | 32 ++++ 2 files changed, 248 insertions(+), 170 deletions(-) diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index a8cb126d1929..14c293056900 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -283,6 +283,64 @@ package body Repinfo is return U >= Uint_0; end Is_Static_SO_Ref; + ----------- + -- Visit -- + ----------- + + procedure Visit (Expr : Node_Ref_Or_Val) is + begin + pragma Assert (Present (Expr)); + if Expr >= 0 then + Visit_Constant (Expr); + return; + end if; + + declare + Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Expr)); + begin + case Node.Expr is + when Cond_Expr => + Visit_Cond_Expr (Node.Op1, Node.Op2, Node.Op3); + + when Plus_Expr + | Minus_Expr + | Mult_Expr + | Trunc_Div_Expr + | Ceil_Div_Expr + | Floor_Div_Expr + | Trunc_Mod_Expr + | Ceil_Mod_Expr + | Floor_Mod_Expr + | Exact_Div_Expr + | Min_Expr + | Max_Expr + | Truth_And_Expr + | Truth_Or_Expr + | Truth_Xor_Expr + | Lt_Expr + | Le_Expr + | Gt_Expr + | Ge_Expr + | Eq_Expr + | Ne_Expr + | Bit_And_Expr + => + Visit_Binop (Node.Expr, Node.Op1, Node.Op2); + + when Negate_Expr + | Abs_Expr + | Truth_Not_Expr => + Visit_Unop (Node.Expr, Node.Op1); + + when Discrim_Val => + Visit_Discriminant (Node.Op1); + + when Dynamic_Val => + Visit_Variable (Node.Op1); + end case; + end; + end Visit; + --------- -- lgx -- --------- @@ -581,189 +639,177 @@ package body Repinfo is procedure List_GCC_Expression (U : Node_Ref_Or_Val) is - procedure Print_Expr (Val : Node_Ref_Or_Val); - -- Internal recursive procedure to print expression + procedure Unop (Code : TCode; Op : Node_Ref_Or_Val); + procedure Binop (Code : TCode; Lhs : Node_Ref_Or_Val; + Rhs : Node_Ref_Or_Val); + procedure Cond_Expr (Test : Node_Ref_Or_Val; + Lhs : Node_Ref_Or_Val; + Rhs : Node_Ref_Or_Val); + procedure Const (Val : Node_Ref_Or_Val); + procedure Discriminant (Val : Node_Ref_Or_Val); + procedure Variable (Val : Node_Ref_Or_Val); + + procedure Print_It is new Visit (Visit_Unop => Unop, + Visit_Binop => Binop, + Visit_Cond_Expr => Cond_Expr, + Visit_Constant => Const, + Visit_Discriminant => Discriminant, + Visit_Variable => Variable); + + procedure Unop (Code : TCode; Op : Node_Ref_Or_Val) is + procedure Emit (S : String); + procedure Emit (S : String) is + begin + if List_Representation_Info_To_JSON then + Write_Str ("{ ""code"": """); + if S (S'Last) = ' ' then + Write_Str (S (S'First .. S'Last - 1)); + else + Write_Str (S); + end if; + Write_Str (""", ""operands"": [ "); + Print_It (Op); + Write_Str (" ] }"); + else + Write_Str (S); + Print_It (Op); + end if; + end Emit; + begin + case Code is + when Negate_Expr => + Emit ("-"); + when Abs_Expr => + Emit ("abs "); + when Truth_Not_Expr => + Emit ("not "); + when Discrim_Val => + Emit ("#"); + when Dynamic_Val => + Emit ("var"); + when others => + Emit ("ERROR"); + end case; + end Unop; - ---------------- - -- Print_Expr -- - ---------------- + procedure Binop (Code : TCode; Lhs : Node_Ref_Or_Val; + Rhs : Node_Ref_Or_Val) + is + procedure Emit (S : String); + procedure Emit (S : String) is + begin + if List_Representation_Info_To_JSON then + Write_Str ("{ ""code"": """); + Write_Str (S (S'First + 1 .. S'Last - 1)); + Write_Str (""", ""operands"": [ "); + Print_It (Lhs); + Write_Str (", "); + Print_It (Rhs); + Write_Str (" ] }"); + else + Write_Char ('('); + Print_It (Lhs); + Write_Str (S); + Print_It (Rhs); + Write_Char (')'); + end if; + end Emit; - procedure Print_Expr (Val : Node_Ref_Or_Val) is begin - if Val >= 0 then - UI_Write (Val, Decimal); + case Code is + when Plus_Expr => + Emit (" + "); + when Minus_Expr => + Emit (" - "); + when Mult_Expr => + Emit (" * "); + when Trunc_Div_Expr => + Emit (" /t "); + when Ceil_Div_Expr => + Emit (" /c "); + when Floor_Div_Expr => + Emit (" /f "); + when Trunc_Mod_Expr => + Emit (" modt "); + when Ceil_Mod_Expr => + Emit (" modc "); + when Floor_Mod_Expr => + Emit (" modf "); + when Exact_Div_Expr => + Emit (" /e "); + when Min_Expr => + Emit (" min "); + when Max_Expr => + Emit (" max "); + when Truth_And_Expr => + Emit (" and "); + when Truth_Or_Expr => + Emit (" or "); + when Truth_Xor_Expr => + Emit (" xor "); + when Lt_Expr => + Emit (" < "); + when Le_Expr => + Emit (" <= "); + when Gt_Expr => + Emit (" > "); + when Ge_Expr => + Emit (" >= "); + when Eq_Expr => + Emit (" == "); + when Ne_Expr => + Emit (" != "); + when Bit_And_Expr => + Emit (" & "); + when others => + Emit ("ERROR"); + end case; + end Binop; + procedure Cond_Expr (Test : Node_Ref_Or_Val; + Lhs : Node_Ref_Or_Val; + Rhs : Node_Ref_Or_Val) is + begin + if List_Representation_Info_To_JSON then + Write_Str ("{ ""code"": ""?<>"""); + Write_Str (", ""operands"": [ "); + Print_It (Test); + Write_Str (", "); + Print_It (Lhs); + Write_Str (", "); + Print_It (Rhs); + Write_Str (" ] }"); else - declare - Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val)); - - procedure Unop (S : String); - -- Output text for unary operator with S being operator name - - procedure Binop (S : String); - -- Output text for binary operator with S being operator name - - ---------- - -- Unop -- - ---------- - - procedure Unop (S : String) is - begin - if List_Representation_Info_To_JSON then - Write_Str ("{ ""code"": """); - if S (S'Last) = ' ' then - Write_Str (S (S'First .. S'Last - 1)); - else - Write_Str (S); - end if; - Write_Str (""", ""operands"": [ "); - Print_Expr (Node.Op1); - Write_Str (" ] }"); - else - Write_Str (S); - Print_Expr (Node.Op1); - end if; - end Unop; - - ----------- - -- Binop -- - ----------- - - procedure Binop (S : String) is - begin - if List_Representation_Info_To_JSON then - Write_Str ("{ ""code"": """); - Write_Str (S (S'First + 1 .. S'Last - 1)); - Write_Str (""", ""operands"": [ "); - Print_Expr (Node.Op1); - Write_Str (", "); - Print_Expr (Node.Op2); - Write_Str (" ] }"); - else - Write_Char ('('); - Print_Expr (Node.Op1); - Write_Str (S); - Print_Expr (Node.Op2); - Write_Char (')'); - end if; - end Binop; - - -- Start of processing for Print_Expr - - begin - case Node.Expr is - when Cond_Expr => - if List_Representation_Info_To_JSON then - Write_Str ("{ ""code"": ""?<>"""); - Write_Str (", ""operands"": [ "); - Print_Expr (Node.Op1); - Write_Str (", "); - Print_Expr (Node.Op2); - Write_Str (", "); - Print_Expr (Node.Op3); - Write_Str (" ] }"); - else - Write_Str ("(if "); - Print_Expr (Node.Op1); - Write_Str (" then "); - Print_Expr (Node.Op2); - Write_Str (" else "); - Print_Expr (Node.Op3); - Write_Str (")"); - end if; - - when Plus_Expr => - Binop (" + "); - - when Minus_Expr => - Binop (" - "); - - when Mult_Expr => - Binop (" * "); - - when Trunc_Div_Expr => - Binop (" /t "); - - when Ceil_Div_Expr => - Binop (" /c "); - - when Floor_Div_Expr => - Binop (" /f "); - - when Trunc_Mod_Expr => - Binop (" modt "); - - when Ceil_Mod_Expr => - Binop (" modc "); - - when Floor_Mod_Expr => - Binop (" modf "); - - when Exact_Div_Expr => - Binop (" /e "); - - when Negate_Expr => - Unop ("-"); - - when Min_Expr => - Binop (" min "); - - when Max_Expr => - Binop (" max "); - - when Abs_Expr => - Unop ("abs "); - - when Truth_And_Expr => - Binop (" and "); - - when Truth_Or_Expr => - Binop (" or "); - - when Truth_Xor_Expr => - Binop (" xor "); - - when Truth_Not_Expr => - Unop ("not "); - - when Lt_Expr => - Binop (" < "); - - when Le_Expr => - Binop (" <= "); - - when Gt_Expr => - Binop (" > "); - - when Ge_Expr => - Binop (" >= "); - - when Eq_Expr => - Binop (" == "); - - when Ne_Expr => - Binop (" != "); - - when Bit_And_Expr => - Binop (" & "); + Write_Str ("(if "); + Print_It (Test); + Write_Str (" then "); + Print_It (Lhs); + Write_Str (" else "); + Print_It (Rhs); + Write_Str (")"); + end if; + end Cond_Expr; - when Discrim_Val => - Unop ("#"); + procedure Const (Val : Node_Ref_Or_Val) is + begin + UI_Write (Val, Decimal); + end Const; - when Dynamic_Val => - Unop ("var"); - end case; - end; - end if; - end Print_Expr; + procedure Discriminant (Val : Node_Ref_Or_Val) is + begin + Unop (Discrim_Val, Val); + end Discriminant; - -- Start of processing for List_GCC_Expression + procedure Variable (Val : Node_Ref_Or_Val) is + begin + Unop (Dynamic_Val, Val); + end Variable; begin if No (U) then Write_Unknown_Val; else - Print_Expr (U); + Print_It (U); end if; end List_GCC_Expression; diff --git a/gcc/ada/repinfo.ads b/gcc/ada/repinfo.ads index 98ba98375f38..597e8b987629 100644 --- a/gcc/ada/repinfo.ads +++ b/gcc/ada/repinfo.ads @@ -345,6 +345,38 @@ package Repinfo is -- and entity id values and the back end makes Get_Dynamic_SO_Ref -- calls to retrieve them. + generic + with procedure Visit_Unop (Code : TCode; Op : Node_Ref_Or_Val); + -- Visit a unary operation. The opcode and argument are passed + -- in. + + with procedure Visit_Binop (Code : TCode; Lhs : Node_Ref_Or_Val; + Rhs : Node_Ref_Or_Val); + -- Visit a binary operation. The opcode and the arguments are + -- passed in. + + with procedure Visit_Cond_Expr (Test : Node_Ref_Or_Val; + Lhs : Node_Ref_Or_Val; + Rhs : Node_Ref_Or_Val); + -- Visit a conditional operation. The arguments are passed in + -- (the opcode is always Cond_Expr). + + with procedure Visit_Constant (Val : Node_Ref_Or_Val); + -- Visit a constant operand. The constant is passed in. + + with procedure Visit_Discriminant (Val : Node_Ref_Or_Val); + -- Visit a discriminant. The discriminant number is passed in. + + with procedure Visit_Variable (Val : Node_Ref_Or_Val); + -- Visit a variable reference. The variable's index (see + -- Dynamic_Val) is passed in. + + procedure Visit (Expr : Node_Ref_Or_Val); + -- A way to walk over a back annotation expression. The user + -- provides callbacks which are called with the operands and (when + -- needed) the code. Users can recurse on the operands by calling + -- Visit again. + ------------------------------ -- External tools Interface -- ------------------------------ From 1f7820c7663dbc215a35991498d7277ef47df028 Mon Sep 17 00:00:00 2001 From: Ronan Desplanques Date: Wed, 19 Nov 2025 09:23:54 +0100 Subject: [PATCH 073/373] ada: Fix spurious exceptions with iterated aggregates When an array aggregate has an iterated component association over a range that we know is empty, we don't create a loop during expansion but we still analyze the expression of the component association in a unusual context. Before this patch, this analysis could incorrectly insert actions in an enclosing scope. This patch fixes it by only doing preanalysis of the expression in that case. gcc/ada/ChangeLog: * exp_aggr.adb (Gen_Loop): Only preanalyze expressions we know won't evaluated. --- gcc/ada/exp_aggr.adb | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 51fbdb8e1e92..d195fb044d55 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -32,7 +32,6 @@ with Einfo.Entities; use Einfo.Entities; with Einfo.Utils; use Einfo.Utils; with Elists; use Elists; with Errout; use Errout; -with Expander; use Expander; with Exp_Util; use Exp_Util; with Exp_Ch3; use Exp_Ch3; with Exp_Ch6; use Exp_Ch6; @@ -1604,7 +1603,6 @@ package body Exp_Aggr is and then Is_Array_Type (Etype (N)) and then No (Next_Index (Index)) then - Expander_Mode_Save_And_Set (False); Tcopy := New_Copy_Tree (Expr); Set_Parent (Tcopy, N); @@ -1614,9 +1612,10 @@ package body Exp_Aggr is Comp_Typ := Corresponding_Mutably_Tagged_Type (Comp_Typ); end if; - -- For iterated_component_association analyze and resolve - -- the expression with name of the index parameter visible. - -- To manipulate scopes, we use entity of the implicit loop. + -- For iterated_component_association (pre)analyze and + -- resolve the expression with name of the index parameter + -- visible. To manipulate scopes, we use entity of the + -- implicit loop. if Is_Iterated_Component then declare @@ -1625,18 +1624,16 @@ package body Exp_Aggr is begin Push_Scope (Scope (Index_Parameter)); Enter_Name (Index_Parameter); - Analyze_And_Resolve (Tcopy, Comp_Typ); + Preanalyze_And_Resolve (Tcopy, Comp_Typ); End_Scope; end; - -- For ordinary component association, just analyze and + -- For ordinary component association, just (pre)analyze and -- resolve the expression. else - Analyze_And_Resolve (Tcopy, Comp_Typ); + Preanalyze_And_Resolve (Tcopy, Comp_Typ); end if; - - Expander_Mode_Restore; end if; end if; From d05f050e4b26df2de315d5462072c3f9a1337e2b Mon Sep 17 00:00:00 2001 From: Denis Mazzucato Date: Mon, 17 Nov 2025 11:54:10 +0100 Subject: [PATCH 074/373] ada: Fix spurious error during record initialization of limited types This patch fixes the spurious error regarding assignment to limited types. Inside record initialization, the assignment calling a constructor is actually its initialization, and is considered legal. gcc/ada/ChangeLog: * sem_ch5.adb: Skip check for assignment that doesn't come from source. --- gcc/ada/sem_ch5.adb | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 87e1b30369ea..e6bba80c5f19 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -668,12 +668,13 @@ package body Sem_Ch5 is -- Error of assigning to limited type. We do however allow this in -- certain cases where the front end generates the assignments. -- Comes_From_Source test is needed to allow compiler-generated - -- streaming/put_image subprograms, which may ignore privacy. + -- constructor calls or streaming/put_image subprograms, which may + -- ignore privacy. elsif Is_Limited_Type (T1) and then not Assignment_OK (Lhs) and then not Assignment_OK (Original_Node (Lhs)) - and then (Comes_From_Source (N) or Is_Immutably_Limited_Type (T1)) + and then Comes_From_Source (N) then -- CPP constructors can only be called in declarations From 2036765303869f5bdd72807ebde875e16e737935 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 19 Nov 2025 08:39:20 +0100 Subject: [PATCH 075/373] ada: Fix undefined reference with inline subprogram containing generic instance The problem is that, for an inline subprogram declared in an instance, the cross-unit inlining machinery does not have the body by the time it decides to inline calls to the subprogram, because the instantiation of bodies is deferred until the end of the compilation. So it cannot see whether this body contains excluded declarations or statements by that time, typically nested packages or instances thereof. The fix is to check that Is_Inlined is still set on the subprogram before passing it on to the back-end for cross-unit inlining. It also removes an obsolete check that was done precisely there. This also adjusts the description of the -gnatwp switch, which can be used to get the reason why cross-inlining has failed, for example here: g.ads:4:01: warning: in instantiation at generic_si.adb:60 [-gnatwp] g.ads:4:01: warning: cannot inline "*" (nested package instantiation) gcc/ada/ChangeLog: PR ada/122574 * doc/gnat_ugn/building_executable_programs_with_gnat.rst (-gnatwp): Replace reference to -gnatN with -gnatn and adjust accordingly. * inline.adb: Remove clauses for Exp_Tss. (Has_Initialized_Type): Delete. (Add_Inlined_Subprogram): Test that the Is_Inlined flag is still set on the subprogram. * usage.adb (Usage): Adjust description of -gnatwp. * gnat_ugn.texi: Regenerate. --- ...building_executable_programs_with_gnat.rst | 14 +++---- gcc/ada/gnat_ugn.texi | 16 ++++---- gcc/ada/inline.adb | 41 ++----------------- gcc/ada/usage.adb | 4 +- 4 files changed, 21 insertions(+), 54 deletions(-) diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst index 703607d28493..13654e185e0a 100644 --- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst @@ -3587,13 +3587,13 @@ of the pragma in the :title:`GNAT_Reference_manual`). :switch:`-gnatwp` *Activate warnings on ineffective pragma Inlines.* - This switch activates warnings for failure of front end inlining - (activated by :switch:`-gnatN`) to inline a particular call. There are - many reasons for not being able to inline a call, including most - commonly that the call is too complex to inline. The default is - that such warnings are not given. - Warnings on ineffective inlining by the gcc back end can be activated - separately, using the gcc switch -Winline. + This switch activates warnings for failure of cross-unit inlining + (activated by :switch:`-gnatn`) to inline calls to a subprogram. + There are many reasons for not being able to inline these calls, + including most commonly that the subprogram body is too complex + to inline. The default is that such warnings are not given. + Warnings on ineffective inlining (within units) by the back end + can be activated separately, using the -Winline switch. .. index:: -gnatwP (gcc) diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 77db8789ca82..241ded65e8ec 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -19,7 +19,7 @@ @copying @quotation -GNAT User's Guide for Native Platforms , Nov 18, 2025 +GNAT User's Guide for Native Platforms , Nov 27, 2025 AdaCore @@ -11942,13 +11942,13 @@ the resulting assigned value is never read. `Activate warnings on ineffective pragma Inlines.' -This switch activates warnings for failure of front end inlining -(activated by @code{-gnatN}) to inline a particular call. There are -many reasons for not being able to inline a call, including most -commonly that the call is too complex to inline. The default is -that such warnings are not given. -Warnings on ineffective inlining by the gcc back end can be activated -separately, using the gcc switch -Winline. +This switch activates warnings for failure of cross-unit inlining +(activated by @code{-gnatn}) to inline calls to a subprogram. +There are many reasons for not being able to inline these calls, +including most commonly that the subprogram body is too complex +to inline. The default is that such warnings are not given. +Warnings on ineffective inlining (within units) by the back end +can be activated separately, using the -Winline switch. @end table @geindex -gnatwP (gcc) diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index a966c28351f3..0cb879a7133a 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -34,7 +34,6 @@ with Elists; use Elists; with Errout; use Errout; with Exp_Ch6; use Exp_Ch6; with Exp_Ch7; use Exp_Ch7; -with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; with Fname; use Fname; with Fname.UF; use Fname.UF; @@ -287,10 +286,6 @@ package body Inline is -- Return the entity node for the unit containing E. Always return the spec -- for a package. - function Has_Initialized_Type (E : Entity_Id) return Boolean; - -- If a candidate for inlining contains type declarations for types with - -- nontrivial initialization procedures, they are not worth inlining. - function Has_Single_Return (N : Node_Id) return Boolean; -- In general we cannot inline functions that return unconstrained type. -- However, we can handle such functions if all return statements return @@ -758,14 +753,15 @@ package body Inline is -- an instance whose body will be analyzed anyway or the subprogram was -- generated as a body by the compiler (for example an initialization -- procedure) or its declaration was provided along with the body (for - -- example an expression function) and it does not declare types with - -- nontrivial initialization procedures. + -- example an expression function). Note that we need to test again the + -- Is_Inlined flag because Analyze_Subprogram_Body_Helper may have reset + -- it if the body contains excluded declarations or statements. if (Is_Inlined (Pack) or else Is_Generic_Instance (Pack) or else Nkind (Decl) = N_Subprogram_Body or else Present (Corresponding_Body (Decl))) - and then not Has_Initialized_Type (E) + and then Is_Inlined (E) then Register_Backend_Inlined_Subprogram (E); @@ -4528,35 +4524,6 @@ package body Inline is return False; end Has_Excluded_Statement; - -------------------------- - -- Has_Initialized_Type -- - -------------------------- - - function Has_Initialized_Type (E : Entity_Id) return Boolean is - E_Body : constant Node_Id := Subprogram_Body (E); - Decl : Node_Id; - - begin - if No (E_Body) then -- imported subprogram - return False; - - else - Decl := First (Declarations (E_Body)); - while Present (Decl) loop - if Nkind (Decl) = N_Full_Type_Declaration - and then Comes_From_Source (Decl) - and then Present (Init_Proc (Defining_Identifier (Decl))) - then - return True; - end if; - - Next (Decl); - end loop; - end if; - - return False; - end Has_Initialized_Type; - ----------------------- -- Has_Single_Return -- ----------------------- diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index bf8417a92c85..868ecd850001 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -562,9 +562,9 @@ begin Write_Line (" .O* turn off warnings for out parameters assigned " & "but not read"); Write_Line (" p+ turn on warnings for ineffective pragma " & - "Inline in frontend"); + "Inline"); Write_Line (" P* turn off warnings for ineffective pragma " & - "Inline in frontend"); + "Inline"); Write_Line (" .p+ turn on warnings for suspicious parameter " & "order"); Write_Line (" .P* turn off warnings for suspicious parameter " & From 7a7eadc2dfa1c463958f5f7218d76231ffe79d84 Mon Sep 17 00:00:00 2001 From: Ronan Desplanques Date: Wed, 19 Nov 2025 14:04:12 +0100 Subject: [PATCH 076/373] ada: Minor fixes to native user's guide About the removal of the mention of Emacs, note that the same change has been made to the cross user's guide a while ago. gcc/ada/ChangeLog: * doc/gnat_ugn/about_this_guide.rst: Minor fixes * gnat_ugn.texi: Regenerate. --- gcc/ada/doc/gnat_ugn/about_this_guide.rst | 20 ++++++++------------ gcc/ada/gnat_ugn.texi | 16 ++++++---------- 2 files changed, 14 insertions(+), 22 deletions(-) diff --git a/gcc/ada/doc/gnat_ugn/about_this_guide.rst b/gcc/ada/doc/gnat_ugn/about_this_guide.rst index d614fe1857bf..fc7bd8c96fe4 100644 --- a/gcc/ada/doc/gnat_ugn/about_this_guide.rst +++ b/gcc/ada/doc/gnat_ugn/about_this_guide.rst @@ -78,7 +78,7 @@ What You Should Know before Reading This Guide This guide assumes a basic familiarity with the Ada 95 language, as described in the International Standard ANSI/ISO/IEC-8652:1995, January 1995. -Reference manuals for Ada 95, Ada 2005, and Ada 2012 are included in +Reference manuals for Ada 95, Ada 2005, Ada 2012 and Ada 2022 are included in the GNAT documentation package. @@ -88,11 +88,12 @@ Related Information For further information about Ada and related tools, please refer to the following documents: -* :title:`Ada 95 Reference Manual`, :title:`Ada 2005 Reference Manual`, and - :title:`Ada 2012 Reference Manual`, which contain reference - material for the several revisions of the Ada language standard. +* :title:`Ada 95 Reference Manual`, :title:`Ada 2005 Reference Manual`, + :title:`Ada 2012 Reference Manual`, and :title:`Ada 2022 Reference Manual`, + which contain reference material for the several revisions of the Ada language + standard. -* :title:`GNAT Reference_Manual`, which contains all reference material for the GNAT +* :title:`GNAT Reference Manual`, which contains all reference material for the GNAT implementation of Ada. * :title:`Using GNAT Studio`, which describes the GNAT Studio @@ -104,11 +105,6 @@ following documents: * :title:`Debugging with GDB`, for all details on the use of the GNU source-level debugger. -* :title:`GNU Emacs Manual`, - for full information on the extensible editor and programming - environment Emacs. - - Conventions =========== .. index:: Conventions, typographical @@ -133,9 +129,9 @@ in this guide: * Examples are described by text - :: + .. code-block:: text - and then shown this way. + and then shown this way. * Commands that you enter are shown as preceded by a prompt string comprising the ``$`` character followed by a space. diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 241ded65e8ec..2b6ab38dd534 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -648,7 +648,7 @@ in an Ada program. This guide assumes a basic familiarity with the Ada 95 language, as described in the International Standard ANSI/ISO/IEC-8652:1995, January 1995. -Reference manuals for Ada 95, Ada 2005, and Ada 2012 are included in +Reference manuals for Ada 95, Ada 2005, Ada 2012 and Ada 2022 are included in the GNAT documentation package. @node Related Information,Conventions,What You Should Know before Reading This Guide,About This Guide @@ -663,12 +663,13 @@ following documents: @itemize * @item -@cite{Ada 95 Reference Manual}, @cite{Ada 2005 Reference Manual}, and -@cite{Ada 2012 Reference Manual}, which contain reference -material for the several revisions of the Ada language standard. +@cite{Ada 95 Reference Manual}, @cite{Ada 2005 Reference Manual}, +@cite{Ada 2012 Reference Manual}, and @cite{Ada 2022 Reference Manual}, +which contain reference material for the several revisions of the Ada language +standard. @item -@cite{GNAT Reference_Manual}, which contains all reference material for the GNAT +@cite{GNAT Reference Manual}, which contains all reference material for the GNAT implementation of Ada. @item @@ -682,11 +683,6 @@ main GNAT Studio features through examples. @item @cite{Debugging with GDB}, for all details on the use of the GNU source-level debugger. - -@item -@cite{GNU Emacs Manual}, -for full information on the extensible editor and programming -environment Emacs. @end itemize @node Conventions,,Related Information,About This Guide From 12db40e076ae780edb1a022c22f5259f9a7dfa42 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 19 Nov 2025 09:45:05 +0100 Subject: [PATCH 077/373] ada: Couple of minor fixes for build-in-place calls in anonymous contexts The current code does not deal with all the anonymous contexts uniformly, since it potentially creates an activation chain and a master only in the case of an actual in a call; moreover, the master is created in the scope of the actual's type, instead of in the context of the call like the chain. The change also aligns Make_Build_In_Place_Call_In_Anonymous_Context with sibling routines by calling Make_Build_In_Place_Call_In_Object_Declaration directly instead of letting the expander recursively do it. It also adds a missing rewriting in Make_Build_In_Place_Iface_Call_In_Anonymous_Context. gcc/ada/ChangeLog: * exp_ch6.adb (Expand_Actuals): Do not create activation chain and master for build-in-place calls here but... (Make_Build_In_Place_Call_In_Allocator): Use Unqual_Conv. (Make_Build_In_Place_Call_In_Anonymous_Context): ...here instead. Call Make_Build_In_Place_Call_In_Object_Declaration directly. (Make_Build_In_Place_Iface_Call_In_Anonymous_Context): ...and here instead. Add missing rewriting of the call. --- gcc/ada/exp_ch6.adb | 57 +++++++++++++++++++++------------------------ 1 file changed, 26 insertions(+), 31 deletions(-) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index b388044fb3c3..23150c73b917 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2729,9 +2729,7 @@ package body Exp_Ch6 is -- Ada 2005 (AI-318-02): If the actual parameter is a call to a -- build-in-place function, then a temporary return object needs - -- to be created and access to it must be passed to the function - -- (and ensure that we have an activation chain defined for tasks - -- and a Master variable). + -- to be created and access to it must be passed to the function. -- But do not do it here for intrinsic subprograms since this will -- be done properly after the subprogram is expanded. @@ -2740,11 +2738,6 @@ package body Exp_Ch6 is null; elsif Is_Build_In_Place_Function_Call (Actual) then - if Might_Have_Tasks (Etype (Actual)) then - Build_Activation_Chain_Entity (N); - Build_Master_Entity (Etype (Actual)); - end if; - Make_Build_In_Place_Call_In_Anonymous_Context (Actual); -- Ada 2005 (AI-318-02): Specialization of the previous case for @@ -2752,8 +2745,6 @@ package body Exp_Ch6 is -- object covers interface types. elsif Present (Unqual_BIP_Iface_Function_Call (Actual)) then - Build_Activation_Chain_Entity (N); - Build_Master_Entity (Etype (Actual)); Make_Build_In_Place_Iface_Call_In_Anonymous_Context (Actual); end if; @@ -9009,9 +9000,9 @@ package body Exp_Ch6 is (Allocator : Node_Id; Function_Call : Node_Id) is - Acc_Type : constant Entity_Id := Etype (Allocator); + Acc_Type : constant Entity_Id := Etype (Allocator); Loc : constant Source_Ptr := Sloc (Function_Call); - Func_Call : Node_Id := Function_Call; + Func_Call : constant Node_Id := Unqual_Conv (Function_Call); Ref_Func_Call : Node_Id; Function_Id : Entity_Id; Result_Subt : Entity_Id; @@ -9024,16 +9015,6 @@ package body Exp_Ch6 is Chain : Entity_Id; -- activation chain, in case of tasks begin - -- Step past qualification or unchecked conversion (the latter can occur - -- in cases of calls to 'Input). - - if Nkind (Func_Call) in N_Qualified_Expression - | N_Type_Conversion - | N_Unchecked_Type_Conversion - then - Func_Call := Expression (Func_Call); - end if; - -- Mark the call as processed as a build-in-place call pragma Assert (not Is_Expanded_Build_In_Place_Call (Func_Call)); @@ -9287,6 +9268,7 @@ package body Exp_Ch6 is Loc : constant Source_Ptr := Sloc (Function_Call); Func_Call : constant Node_Id := Unqual_Conv (Function_Call); Function_Id : Entity_Id; + Has_Tasks : Boolean; Known_Size : Boolean; Needs_Fin : Boolean; Result_Subt : Entity_Id; @@ -9315,6 +9297,7 @@ package body Exp_Ch6 is Warn_BIP (Func_Call); Result_Subt := Etype (Function_Id); + Has_Tasks := Might_Have_Tasks (Result_Subt); Known_Size := Caller_Known_Size (Func_Call, Result_Subt); Needs_Fin := Needs_Finalization (Result_Subt); @@ -9326,15 +9309,11 @@ package body Exp_Ch6 is -- object also needs to be created and an access value designating it -- passed as an actual. - -- Create a temporary which is initialized with the function call: - -- - -- Temp_Id : Func_Type := BIP_Func_Call; - -- - -- The initialization expression of the temporary will be rewritten by - -- the expander using the appropriate mechanism in Make_Build_In_Place_ - -- Call_In_Object_Declaration. + -- Insert a temporary before the call initialized with function call to + -- reuse the BIP machinery which takes care of adding the extra build-in + -- place actuals. - if Needs_Fin or else Known_Size then + if Needs_Fin or else Known_Size or else Has_Tasks then if Needs_Fin then Establish_Transient_Scope (Func_Call, Manage_Sec_Stack => not Known_Size); @@ -9351,9 +9330,20 @@ package body Exp_Ch6 is begin Set_Assignment_OK (Temp_Decl); + Expander_Mode_Save_And_Set (False); Insert_Action (Function_Call, Temp_Decl); + Expander_Mode_Restore; + + if Has_Tasks then + Build_Activation_Chain_Entity (Temp_Decl); + Build_Master_Entity (Temp_Id); + end if; + + Make_Build_In_Place_Call_In_Object_Declaration + (Obj_Decl => Temp_Decl, + Function_Call => Expression (Temp_Decl)); + Rewrite (Function_Call, New_Occurrence_Of (Temp_Id, Loc)); - Analyze (Function_Call); end; -- When the result subtype is unconstrained, the function must allocate @@ -10034,9 +10024,14 @@ package body Exp_Ch6 is Insert_Action (Function_Call, Tmp_Decl); Expander_Mode_Restore; + Build_Activation_Chain_Entity (Tmp_Decl); + Build_Master_Entity (Tmp_Id); + Make_Build_In_Place_Iface_Call_In_Object_Declaration (Obj_Decl => Tmp_Decl, Function_Call => Expression (Tmp_Decl)); + + Rewrite (Function_Call, New_Occurrence_Of (Tmp_Id, Loc)); end Make_Build_In_Place_Iface_Call_In_Anonymous_Context; ---------------------------------------------------------- From 2c1e896ac970654a092e565f82ba12241c8286df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tomasz=20Kami=C5=84ski?= Date: Thu, 27 Nov 2025 14:31:51 +0100 Subject: [PATCH 078/373] libstdc++: Fix exposure of TU-local lambda in __detail::__func_handle_t. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The lambda is considered to be TU-local entity, use a named function instead. As drive-by, a functor stored inside __func_handle::_Inplace is renamed to _M_fn, as we no longer limit the functor type to function pointers. libstdc++-v3/ChangeLog: * include/std/ranges (__func_handle::__select): Named function extracted from local lambda. (__detail::__func_handle_t): Define using __func_handle::__select. (__func_handle::_Inplace): Raname _M_ptr to _M_fn. Reviewed-by: Jonathan Wakely Signed-off-by: Tomasz Kamiński --- libstdc++-v3/include/std/ranges | 45 ++++++++++++++++++--------------- 1 file changed, 25 insertions(+), 20 deletions(-) diff --git a/libstdc++-v3/include/std/ranges b/libstdc++-v3/include/std/ranges index 7c5ac931e313..b3105c553839 100644 --- a/libstdc++-v3/include/std/ranges +++ b/libstdc++-v3/include/std/ranges @@ -346,23 +346,23 @@ namespace ranges constexpr explicit _Inplace(_Fn __func) noexcept - : _M_ptr(__func) + : _M_fn(__func) { } template constexpr decltype(auto) _M_call_deref(const _Iters&... __iters) const - noexcept(noexcept(_M_ptr(*__iters...))) - { return _M_ptr(*__iters...); } + noexcept(noexcept(_M_fn(*__iters...))) + { return _M_fn(*__iters...); } template constexpr decltype(auto) _M_call_subscript(const _DistType __n, const _Iters&... __iters) const - noexcept(noexcept(_M_ptr(__iters[iter_difference_t<_Iters>(__n)]...))) - { return _M_ptr(__iters[iter_difference_t<_Iters>(__n)]...); } + noexcept(noexcept(_M_fn(__iters[iter_difference_t<_Iters>(__n)]...))) + { return _M_fn(__iters[iter_difference_t<_Iters>(__n)]...); } private: - [[no_unique_address]] _Fn _M_ptr = _Fn(); + [[no_unique_address]] _Fn _M_fn = _Fn(); }; template @@ -448,23 +448,28 @@ namespace ranges noexcept(noexcept(_Fn::operator()(__iters[iter_difference_t<_Iters>(__n)]...))) { return _Fn::operator()(__iters[iter_difference_t<_Iters>(__n)]...); } }; + + template + consteval auto + __select() + { + using _Fd = remove_cv_t<_Fn>; + if constexpr (is_member_pointer_v<_Fd>) + return __func_handle::_InplaceMemPtr<_Fd>(); + else if constexpr (is_function_v>) + return __func_handle::_Inplace<_Fd>(); + else if constexpr (__is_std_op_wrapper<_Fd>) + return __func_handle::_Inplace<_Fd>(); + else if constexpr (requires (const _Iters&... __iters) + { _Fd::operator()(*__iters...); }) + return __func_handle::_StaticCall<_Fd>(); + else + return __func_handle::_ViaPointer<_Fn>(); + }; } // __func_handle template - using __func_handle_t = decltype([] { - using _Fd = remove_cv_t<_Fn>; - if constexpr (is_member_pointer_v<_Fd>) - return __func_handle::_InplaceMemPtr<_Fd>(); - else if constexpr (is_function_v>) - return __func_handle::_Inplace<_Fd>(); - else if constexpr (__is_std_op_wrapper<_Fd>) - return __func_handle::_Inplace<_Fd>(); - else if constexpr (requires (const _Iters&... __iters) - { _Fd::operator()(*__iters...); }) - return __func_handle::_StaticCall<_Fd>(); - else - return __func_handle::_ViaPointer<_Fn>(); - }()); + using __func_handle_t = decltype(__func_handle::__select<_Fn, _Iters...>()); } // namespace __detail /// A view that contains exactly one element. From a44c14e0991594652aae00c1ee18fbd824d57b43 Mon Sep 17 00:00:00 2001 From: Pan Li Date: Thu, 27 Nov 2025 21:43:37 +0800 Subject: [PATCH 079/373] RISC-V: Fix one typo result in pr121959-run-1 run failure The reference value of run test data array[0] is not updated. Thus, update it to make the run test happy. gcc/testsuite/ChangeLog: * gcc.target/riscv/rvv/autovec/pr121959-run-1.c: Update the reference for run test. Signed-off-by: Pan Li --- gcc/testsuite/gcc.target/riscv/rvv/autovec/pr121959-run-1.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/testsuite/gcc.target/riscv/rvv/autovec/pr121959-run-1.c b/gcc/testsuite/gcc.target/riscv/rvv/autovec/pr121959-run-1.c index 77fd95b8ebb1..af6141d1a875 100644 --- a/gcc/testsuite/gcc.target/riscv/rvv/autovec/pr121959-run-1.c +++ b/gcc/testsuite/gcc.target/riscv/rvv/autovec/pr121959-run-1.c @@ -17,7 +17,7 @@ NT g_data[][2][N] = { { /* a */ { - 2, 2, 2, 1, + 2, 2, 2, 2, 255, 255, 255, 255, 128, 128, 128, 128, 127, 127, 127, 127, From 86cf7857bb2599e3d7d35199afbd9c37d36e1099 Mon Sep 17 00:00:00 2001 From: Andrew Stubbs Date: Tue, 11 Nov 2025 15:41:04 +0000 Subject: [PATCH 080/373] amdgcn: Auto-detect USM mode and set HSA_XNACK The AMD GCN runtime must be set to the correct "XNACK" mode for Unified Shared Memory and/or self-mapping to work, but this is not always clear at compile and link time due to the split nature of the offload compilation pipeline. When XNACK mode is enabled, the runtime will restart GPU load/store instructions that fail due to memory exceptions caused by page-misses. While this is important for shared-memory systems that might experience swapping, we are mostly interested in it because it is also used to implement page migration between host and GPU memory, which is the basis of USM. This patch checks that the XNACK mode is configured appropriately in the compiler, and mkoffload then adds a runtime check into the final program to ensure that the HSA_XNACK environment variable passes the correct mode to the GPU. The HSA_XNACK variable must be set before the HSA runtime is even loaded, so it makes more sense to have this set within the constructor than at some point later within libgomp or the GCN plugin. Other toolchains require the end-user to set HSA_XNACK manually (or else wonder why it's not working), so the constructor also checks that any existing manual setting is compatible with the binary's requirements. gcc/ChangeLog: * config/gcn/gcn.cc (gcn_init_cumulative_args): Emit a warning if the -mxnack setting looks wrong. * config/gcn/mkoffload.cc: Include tree.h and omp-general.h. (process_asm): Add omp_requires parameter. Emit HSA_XNACK code into mkoffload_setup, as required. (main): Modify HSACO_ATTR_OFF to preserve user-set -mxnack. Pass omp_requires to process_asm. --- gcc/config/gcn/gcn.cc | 10 +++++++ gcc/config/gcn/mkoffload.cc | 54 +++++++++++++++++++++++++++++++------ 2 files changed, 56 insertions(+), 8 deletions(-) diff --git a/gcc/config/gcn/gcn.cc b/gcc/config/gcn/gcn.cc index 1e04074d78b7..a729ea4de36b 100644 --- a/gcc/config/gcn/gcn.cc +++ b/gcc/config/gcn/gcn.cc @@ -2940,6 +2940,16 @@ gcn_init_cumulative_args (CUMULATIVE_ARGS *cum /* Argument info to init */ , if (!caller && cfun->machine->normal_function) gcn_detect_incoming_pointer_arg (fndecl); + if ((omp_requires_mask & (OMP_REQUIRES_UNIFIED_SHARED_MEMORY + | OMP_REQUIRES_SELF_MAPS)) + && gcn_devices[gcn_arch].xnack_default != HSACO_ATTR_UNSUPPORTED + && flag_xnack == HSACO_ATTR_OFF) + { + warning_at (UNKNOWN_LOCATION, 0, + "Unified Shared Memory is enabled, but XNACK is disabled"); + inform (UNKNOWN_LOCATION, "Try -foffload-options=-mxnack=any"); + } + reinit_regs (); } diff --git a/gcc/config/gcn/mkoffload.cc b/gcc/config/gcn/mkoffload.cc index 222adb2cd41d..d9d89c64f950 100644 --- a/gcc/config/gcn/mkoffload.cc +++ b/gcc/config/gcn/mkoffload.cc @@ -38,6 +38,9 @@ #include "configargs.h" /* For configure_default_options. */ #include "multilib.h" /* For multilib_options. */ +#include "tree.h" /* Dependency of omp-general.h. */ +#include "omp-general.h" /* For enum omp_requires. */ + /* These probably won't (all) be in elf.h for a while. */ #undef EM_AMDGPU #define EM_AMDGPU 0xe0; @@ -441,10 +444,12 @@ copy_early_debug_info (const char *infile, const char *outfile) encoded as structured data. */ static void -process_asm (FILE *in, FILE *out, FILE *cfile) +process_asm (FILE *in, FILE *out, FILE *cfile, uint32_t omp_requires) { int fn_count = 0, var_count = 0, ind_fn_count = 0; int dims_count = 0, regcount_count = 0; + bool xnack_required = (omp_requires & (OMP_REQUIRES_UNIFIED_SHARED_MEMORY + | OMP_REQUIRES_SELF_MAPS)); struct obstack fns_os, dims_os, regcounts_os; obstack_init (&fns_os); obstack_init (&dims_os); @@ -469,6 +474,7 @@ process_asm (FILE *in, FILE *out, FILE *cfile) fn_count += 2; char buf[1000]; + char dummy; enum { IN_CODE, IN_METADATA, @@ -549,7 +555,6 @@ process_asm (FILE *in, FILE *out, FILE *cfile) } } - char dummy; if (sscanf (buf, " .section .gnu.offload_vars%c", &dummy) > 0) { state = IN_VARS; @@ -615,11 +620,24 @@ process_asm (FILE *in, FILE *out, FILE *cfile) struct oaccdims *dims = XOBFINISH (&dims_os, struct oaccdims *); struct regcount *regcounts = XOBFINISH (®counts_os, struct regcount *); + /* If the -mxnack setting has a definite value (not "any" or undefined), or + the program "requires unified_shared_memory" (in which case -mxnack might + be "any"), then we emit code to check the mode at runtime. */ + bool check_xnack = (TEST_XNACK_OFF (elf_flags) + || TEST_XNACK_ON (elf_flags) + || xnack_required); + if (TEST_XNACK_OFF (elf_flags) && xnack_required) + fatal_error (input_location, + "conflicting settings; XNACK is forced off but Unified " + "Shared Memory is on"); + + /* Start generating the C code. */ if (gcn_stack_size) - { - fprintf (cfile, "#include \n"); - fprintf (cfile, "#include \n\n"); - } + fprintf (cfile, "#include \n"); + if (check_xnack) + fprintf (cfile, "#include \n"); + if (gcn_stack_size || check_xnack) + fprintf (cfile, "#include \n\n"); fprintf (cfile, "static const int gcn_num_vars = %d;\n\n", var_count); fprintf (cfile, "static const int gcn_num_ind_funcs = %d;\n\n", ind_fn_count); @@ -677,6 +695,25 @@ process_asm (FILE *in, FILE *out, FILE *cfile) " setenv (\"GCN_STACK_SIZE\", \"%d\", true);\n", gcn_stack_size); + /* Emit a constructor function to set the HSA_XNACK environment variable. + This must be done before the ROCr runtime library is loaded. + We never override a user value (except empty string), but we do emit a + useful diagnostic in the wrong mode (the ROCr message is not good. */ + if (check_xnack) + fprintf (cfile, + "\n" + " const char *xn_var = getenv (\"HSA_XNACK\");\n" + " if (!xn_var || xn_var[0] == '\\0')\n" + " setenv (\"HSA_XNACK\", \"%d\", true);\n" + " else if (%s)\n" + " fprintf (stderr, \"warning: HSA_XNACK=%%s is incompatible; " + "the GPU kernel may revert to host fallback\\n\", " + "xn_var);\n", + xnack_required || TEST_XNACK_ON (elf_flags), + (xnack_required || TEST_XNACK_ON (elf_flags) + ? "xn_var[0] != '1' || xn_var[1] != '\\0'" + : "xn_var[0] != '0' || xn_var[1] != '\\0'")); + /* End of mkoffload_setup function. */ fprintf (cfile, "}\n\n"); @@ -1116,7 +1153,8 @@ main (int argc, char **argv) #define GCN_DEVICE(name, NAME, ELF, ISA, XNACK, SRAM, ...) \ case ELF: XNACK; break; #define HSACO_ATTR_UNSUPPORTED SET_XNACK_UNSET (elf_flags) -#define HSACO_ATTR_OFF SET_XNACK_OFF (elf_flags) +#define HSACO_ATTR_OFF \ + if (TEST_XNACK_UNSET (elf_flags)) SET_XNACK_OFF (elf_flags) #define HSACO_ATTR_ANY \ if (TEST_XNACK_UNSET (elf_flags)) SET_XNACK_ANY (elf_flags) #include "gcn-devices.def" @@ -1348,7 +1386,7 @@ main (int argc, char **argv) if (!out) fatal_error (input_location, "cannot open %qs", gcn_s2_name); - process_asm (in, out, cfile); + process_asm (in, out, cfile, omp_requires); fclose (in); fclose (out); From fefc96d7b285fd541696d1a43223612d282bc197 Mon Sep 17 00:00:00 2001 From: Robin Dapp Date: Wed, 26 Nov 2025 10:27:24 +0100 Subject: [PATCH 081/373] forwprop: Nop-convert operands if necessary [PR122855]. This fixes up r16-5561-g283eb27d5f674b where I allowed nop conversions for the input operands. There are several paths through the function that still require an explicit nop conversion for them. This patch adds them. PR tree-optimization/122855 PR tree-optimization/122850 gcc/ChangeLog: * tree-ssa-forwprop.cc (simplify_vector_constructor): Nop convert input if necessary. gcc/testsuite/ChangeLog: * gcc.dg/vect/pr122850.c: New test. * gcc.dg/vect/pr122855.c: New test. --- gcc/testsuite/gcc.dg/vect/pr122850.c | 13 ++++++++ gcc/testsuite/gcc.dg/vect/pr122855.c | 15 +++++++++ gcc/tree-ssa-forwprop.cc | 47 +++++++++++++++++++++++----- 3 files changed, 67 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gcc.dg/vect/pr122850.c create mode 100644 gcc/testsuite/gcc.dg/vect/pr122855.c diff --git a/gcc/testsuite/gcc.dg/vect/pr122850.c b/gcc/testsuite/gcc.dg/vect/pr122850.c new file mode 100644 index 000000000000..4f50aa9660dc --- /dev/null +++ b/gcc/testsuite/gcc.dg/vect/pr122850.c @@ -0,0 +1,13 @@ +/* { dg-do compile { target { x86_64-*-* i?86-*-* } } } */ +/* { dg-additional-options "-O3 -march=haswell -m32" } */ + +typedef int v2ll __attribute__ ((__vector_size__ (2 * sizeof (int)))); +typedef unsigned int v2ull __attribute__ ((__vector_size__ (2 * sizeof (int)))); +typedef __attribute__ ((__vector_size__ (2 * sizeof (short)))) short v2s; + +v2ll +f (v2ull e) +{ + v2s c = (v2s) e[0]; + return (v2ll) {(int) c, 0}; +} diff --git a/gcc/testsuite/gcc.dg/vect/pr122855.c b/gcc/testsuite/gcc.dg/vect/pr122855.c new file mode 100644 index 000000000000..3084d2062a17 --- /dev/null +++ b/gcc/testsuite/gcc.dg/vect/pr122855.c @@ -0,0 +1,15 @@ +/* { dg-do compile { target { x86_64-*-* i?86-*-* } } } */ +/* { dg-additional-options "-O3 -march=haswell" } */ + +int zoom_x3_weights_0, zoom_x3_j, zoom_x3_pixel2; + +void zoom_x3(char *__restrict s, char *__restrict zoom_x3_tmp) { + int pixel0 = 0, pixel1 = 0; + for (; zoom_x3_j; zoom_x3_j--) { + pixel0 += *s++ * zoom_x3_weights_0; + pixel1 += *s++ * zoom_x3_weights_0; + zoom_x3_pixel2 += *s++ * zoom_x3_weights_0; + } + *zoom_x3_tmp++ = pixel0 < 0 ? 0 : pixel0 > 255 ? 255 : pixel0; + *zoom_x3_tmp = pixel1 < 0 ? 0 : pixel1 > 255 ? 255 : pixel1; +} diff --git a/gcc/tree-ssa-forwprop.cc b/gcc/tree-ssa-forwprop.cc index 00140ce950c3..2200fc04918d 100644 --- a/gcc/tree-ssa-forwprop.cc +++ b/gcc/tree-ssa-forwprop.cc @@ -4183,24 +4183,45 @@ simplify_vector_constructor (gimple_stmt_iterator *gsi) /* ??? We can see if we can safely convert to the original element type. */ converted_orig1 = conv_code != ERROR_MARK; + tree target_type = converted_orig1 ? type : perm_type; + tree nonconstant_for_splat = one_nonconstant; + /* If there's a nop conversion between the target element type and + the nonconstant's type, convert it. */ + if (!useless_type_conversion_p (TREE_TYPE (target_type), + TREE_TYPE (one_nonconstant))) + nonconstant_for_splat + = gimple_build (&stmts, NOP_EXPR, TREE_TYPE (target_type), + one_nonconstant); orig[1] = gimple_build_vector_from_val (&stmts, UNKNOWN_LOCATION, - converted_orig1 - ? type : perm_type, - one_nonconstant); + target_type, + nonconstant_for_splat); } else if (orig[1] == error_mark_node) { /* ??? See if we can convert the vector to the original type. */ converted_orig1 = conv_code != ERROR_MARK; unsigned n = converted_orig1 ? nelts : refnelts; - tree_vector_builder vec (converted_orig1 - ? type : perm_type, n, 1); + tree target_type = converted_orig1 ? type : perm_type; + tree_vector_builder vec (target_type, n, 1); for (unsigned i = 0; i < n; ++i) if (i < nelts && constants[i]) - vec.quick_push (constants[i]); + { + tree constant = constants[i]; + /* If there's a nop conversion, convert the constant. */ + if (!useless_type_conversion_p (TREE_TYPE (target_type), + TREE_TYPE (constant))) + constant = fold_convert (TREE_TYPE (target_type), constant); + vec.quick_push (constant); + } else - /* ??? Push a don't-care value. */ - vec.quick_push (one_constant); + { + /* ??? Push a don't-care value. */ + tree constant = one_constant; + if (!useless_type_conversion_p (TREE_TYPE (target_type), + TREE_TYPE (constant))) + constant = fold_convert (TREE_TYPE (target_type), constant); + vec.quick_push (constant); + } orig[1] = vec.build (); } tree blend_op2 = NULL_TREE; @@ -4224,6 +4245,16 @@ simplify_vector_constructor (gimple_stmt_iterator *gsi) return false; blend_op2 = vec_perm_indices_to_tree (mask_type, indices); } + + /* For a real orig[1] (no splat, constant etc.) we might need to + nop-convert it. Do so here. */ + if (orig[1] && orig[1] != error_mark_node + && !useless_type_conversion_p (perm_type, TREE_TYPE (orig[1])) + && tree_nop_conversion_p (TREE_TYPE (perm_type), + TREE_TYPE (TREE_TYPE (orig[1])))) + orig[1] = gimple_build (&stmts, VIEW_CONVERT_EXPR, perm_type, + orig[1]); + tree orig1_for_perm = converted_orig1 ? build_zero_cst (perm_type) : orig[1]; tree res = gimple_build (&stmts, VEC_PERM_EXPR, perm_type, From ae65633676fba0eadf3516fd8d7b9bb21788f9f5 Mon Sep 17 00:00:00 2001 From: Georg-Johann Lay Date: Thu, 27 Nov 2025 15:25:05 +0100 Subject: [PATCH 082/373] AVR: Add new devices AVR16LA14/20/28/32 and AVR32LA14/20/28/32. gcc/ * config/avr/avr-mcus.def (AVR_MCUS): Add avr16la14, avr16la20, avr16la28, avr16la32, avr32la14, avr32la20, avr32la28, avr32la32. * doc/avr-mmcu.texi: Rebuild. --- gcc/config/avr/avr-mcus.def | 8 ++++++++ gcc/doc/avr-mmcu.texi | 2 +- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/gcc/config/avr/avr-mcus.def b/gcc/config/avr/avr-mcus.def index 896623d039e3..8b05af545070 100644 --- a/gcc/config/avr/avr-mcus.def +++ b/gcc/config/avr/avr-mcus.def @@ -421,6 +421,14 @@ AVR_MCU ("avr16ea48", ARCH_AVRXMEGA3, AVR_CVT, "__AVR_AVR AVR_MCU ("avr32ea28", ARCH_AVRXMEGA3, AVR_CVT, "__AVR_AVR32EA28__", 0x7000, 0x0, 0x8000, 0x8000) AVR_MCU ("avr32ea32", ARCH_AVRXMEGA3, AVR_CVT, "__AVR_AVR32EA32__", 0x7000, 0x0, 0x8000, 0x8000) AVR_MCU ("avr32ea48", ARCH_AVRXMEGA3, AVR_CVT, "__AVR_AVR32EA48__", 0x7000, 0x0, 0x8000, 0x8000) +AVR_MCU ("avr16la14", ARCH_AVRXMEGA3, AVR_CVT, "__AVR_AVR16LA14__", 0x7800, 0x0, 0x4000, 0x8000) +AVR_MCU ("avr16la20", ARCH_AVRXMEGA3, AVR_CVT, "__AVR_AVR16LA20__", 0x7800, 0x0, 0x4000, 0x8000) +AVR_MCU ("avr16la28", ARCH_AVRXMEGA3, AVR_CVT, "__AVR_AVR16LA28__", 0x7800, 0x0, 0x4000, 0x8000) +AVR_MCU ("avr16la32", ARCH_AVRXMEGA3, AVR_CVT, "__AVR_AVR16LA32__", 0x7800, 0x0, 0x4000, 0x8000) +AVR_MCU ("avr32la14", ARCH_AVRXMEGA3, AVR_CVT, "__AVR_AVR32LA14__", 0x7800, 0x0, 0x8000, 0x8000) +AVR_MCU ("avr32la20", ARCH_AVRXMEGA3, AVR_CVT, "__AVR_AVR32LA20__", 0x7800, 0x0, 0x8000, 0x8000) +AVR_MCU ("avr32la28", ARCH_AVRXMEGA3, AVR_CVT, "__AVR_AVR32LA28__", 0x7800, 0x0, 0x8000, 0x8000) +AVR_MCU ("avr32la32", ARCH_AVRXMEGA3, AVR_CVT, "__AVR_AVR32LA32__", 0x7800, 0x0, 0x8000, 0x8000) AVR_MCU ("avr32sd20", ARCH_AVRXMEGA3, AVR_CVT, "__AVR_AVR32SD20__", 0x7000, 0x0, 0x8000, 0x8000) AVR_MCU ("avr32sd28", ARCH_AVRXMEGA3, AVR_CVT, "__AVR_AVR32SD28__", 0x7000, 0x0, 0x8000, 0x8000) AVR_MCU ("avr32sd32", ARCH_AVRXMEGA3, AVR_CVT, "__AVR_AVR32SD32__", 0x7000, 0x0, 0x8000, 0x8000) diff --git a/gcc/doc/avr-mmcu.texi b/gcc/doc/avr-mmcu.texi index 1938994d74f9..427357979705 100644 --- a/gcc/doc/avr-mmcu.texi +++ b/gcc/doc/avr-mmcu.texi @@ -54,7 +54,7 @@ @item @anchor{avrxmega3}avrxmega3 ``XMEGA'' devices with up to 64@tie{}KiB of combined program memory and RAM, and with program memory visible in the RAM address space. -@*@var{mcu}@tie{}= @code{attiny202}, @code{attiny204}, @code{attiny212}, @code{attiny214}, @code{attiny402}, @code{attiny404}, @code{attiny406}, @code{attiny412}, @code{attiny414}, @code{attiny416}, @code{attiny416auto}, @code{attiny417}, @code{attiny424}, @code{attiny426}, @code{attiny427}, @code{attiny804}, @code{attiny806}, @code{attiny807}, @code{attiny814}, @code{attiny816}, @code{attiny817}, @code{attiny824}, @code{attiny826}, @code{attiny827}, @code{attiny1604}, @code{attiny1606}, @code{attiny1607}, @code{attiny1614}, @code{attiny1616}, @code{attiny1617}, @code{attiny1624}, @code{attiny1626}, @code{attiny1627}, @code{attiny3214}, @code{attiny3216}, @code{attiny3217}, @code{attiny3224}, @code{attiny3226}, @code{attiny3227}, @code{atmega808}, @code{atmega809}, @code{atmega1608}, @code{atmega1609}, @code{atmega3208}, @code{atmega3209}, @code{atmega4808}, @code{atmega4809}, @code{avr16dd14}, @code{avr16dd20}, @code{avr16dd28}, @code{avr16dd32}, @code{avr16du14}, @code{avr16du20}, @code{avr16du28}, @code{avr16du32}, @code{avr16ea28}, @code{avr16ea32}, @code{avr16ea48}, @code{avr16eb14}, @code{avr16eb20}, @code{avr16eb28}, @code{avr16eb32}, @code{avr32da28}, @code{avr32da28s}, @code{avr32da32}, @code{avr32da32s}, @code{avr32da48}, @code{avr32da48s}, @code{avr32db28}, @code{avr32db32}, @code{avr32db48}, @code{avr32dd14}, @code{avr32dd20}, @code{avr32dd28}, @code{avr32dd32}, @code{avr32du14}, @code{avr32du20}, @code{avr32du28}, @code{avr32du32}, @code{avr32ea28}, @code{avr32ea32}, @code{avr32ea48}, @code{avr32eb14}, @code{avr32eb20}, @code{avr32eb28}, @code{avr32eb32}, @code{avr32sd20}, @code{avr32sd28}, @code{avr32sd32}. +@*@var{mcu}@tie{}= @code{attiny202}, @code{attiny204}, @code{attiny212}, @code{attiny214}, @code{attiny402}, @code{attiny404}, @code{attiny406}, @code{attiny412}, @code{attiny414}, @code{attiny416}, @code{attiny416auto}, @code{attiny417}, @code{attiny424}, @code{attiny426}, @code{attiny427}, @code{attiny804}, @code{attiny806}, @code{attiny807}, @code{attiny814}, @code{attiny816}, @code{attiny817}, @code{attiny824}, @code{attiny826}, @code{attiny827}, @code{attiny1604}, @code{attiny1606}, @code{attiny1607}, @code{attiny1614}, @code{attiny1616}, @code{attiny1617}, @code{attiny1624}, @code{attiny1626}, @code{attiny1627}, @code{attiny3214}, @code{attiny3216}, @code{attiny3217}, @code{attiny3224}, @code{attiny3226}, @code{attiny3227}, @code{atmega808}, @code{atmega809}, @code{atmega1608}, @code{atmega1609}, @code{atmega3208}, @code{atmega3209}, @code{atmega4808}, @code{atmega4809}, @code{avr16dd14}, @code{avr16dd20}, @code{avr16dd28}, @code{avr16dd32}, @code{avr16du14}, @code{avr16du20}, @code{avr16du28}, @code{avr16du32}, @code{avr16ea28}, @code{avr16ea32}, @code{avr16ea48}, @code{avr16eb14}, @code{avr16eb20}, @code{avr16eb28}, @code{avr16eb32}, @code{avr16la14}, @code{avr16la20}, @code{avr16la28}, @code{avr16la32}, @code{avr32da28}, @code{avr32da28s}, @code{avr32da32}, @code{avr32da32s}, @code{avr32da48}, @code{avr32da48s}, @code{avr32db28}, @code{avr32db32}, @code{avr32db48}, @code{avr32dd14}, @code{avr32dd20}, @code{avr32dd28}, @code{avr32dd32}, @code{avr32du14}, @code{avr32du20}, @code{avr32du28}, @code{avr32du32}, @code{avr32ea28}, @code{avr32ea32}, @code{avr32ea48}, @code{avr32eb14}, @code{avr32eb20}, @code{avr32eb28}, @code{avr32eb32}, @code{avr32la14}, @code{avr32la20}, @code{avr32la28}, @code{avr32la32}, @code{avr32sd20}, @code{avr32sd28}, @code{avr32sd32}. @item @anchor{avrxmega4}avrxmega4 ``XMEGA'' devices with more than 64@tie{}KiB and up to 128@tie{}KiB of program memory. From 37e881b316cdd48cf4b6f50127a1059ee6c017b7 Mon Sep 17 00:00:00 2001 From: Jonathan Wakely Date: Thu, 27 Nov 2025 14:56:20 +0000 Subject: [PATCH 083/373] libstdc++: Fix comment typo in testsuite/Makefile libstdc++-v3/ChangeLog: * testsuite/Makefile.am: Fix typo in comment. * testsuite/Makefile.in: Regenerate. --- libstdc++-v3/testsuite/Makefile.am | 2 +- libstdc++-v3/testsuite/Makefile.in | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libstdc++-v3/testsuite/Makefile.am b/libstdc++-v3/testsuite/Makefile.am index bbdb72e9cf56..7754ab60003d 100644 --- a/libstdc++-v3/testsuite/Makefile.am +++ b/libstdc++-v3/testsuite/Makefile.am @@ -178,7 +178,7 @@ check-compile: testsuite_files ${compile_script} # Runs the testsuite/performance tests. # Some of these tests create large (~75MB) files, allocate huge -# ammounts of memory, or otherwise tie up machine resources. Thus, +# amounts of memory, or otherwise tie up machine resources. Thus, # running this is off by default. # XXX Need to add dependency on libtestc++.a check_performance_script=${glibcxx_srcdir}/scripts/check_performance diff --git a/libstdc++-v3/testsuite/Makefile.in b/libstdc++-v3/testsuite/Makefile.in index aeb3f716216f..c3693b6a56c9 100644 --- a/libstdc++-v3/testsuite/Makefile.in +++ b/libstdc++-v3/testsuite/Makefile.in @@ -415,7 +415,7 @@ compile_script = ${glibcxx_srcdir}/scripts/check_compile # Runs the testsuite/performance tests. # Some of these tests create large (~75MB) files, allocate huge -# ammounts of memory, or otherwise tie up machine resources. Thus, +# amounts of memory, or otherwise tie up machine resources. Thus, # running this is off by default. # XXX Need to add dependency on libtestc++.a check_performance_script = ${glibcxx_srcdir}/scripts/check_performance From 7f355b11db1c83158a8f7d8c323c4920bee21ce8 Mon Sep 17 00:00:00 2001 From: Jonathan Wakely Date: Thu, 27 Nov 2025 15:54:44 +0000 Subject: [PATCH 084/373] libstdc++: Fix nodiscard warnings in performance tests libstdc++-v3/ChangeLog: * testsuite/performance/23_containers/sort_search/list.cc: Cast results to void to suppress -Wunused-result warnings from nodiscard functions. * testsuite/performance/25_algorithms/equal_deque_iterators.cc: Likewise. * testsuite/performance/25_algorithms/search_n.cc: Likewise. --- .../performance/23_containers/sort_search/list.cc | 2 +- .../performance/25_algorithms/equal_deque_iterators.cc | 10 +++++----- .../testsuite/performance/25_algorithms/search_n.cc | 4 ++-- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/libstdc++-v3/testsuite/performance/23_containers/sort_search/list.cc b/libstdc++-v3/testsuite/performance/23_containers/sort_search/list.cc index 525d37aad234..efb6e6a572e6 100644 --- a/libstdc++-v3/testsuite/performance/23_containers/sort_search/list.cc +++ b/libstdc++-v3/testsuite/performance/23_containers/sort_search/list.cc @@ -34,7 +34,7 @@ template //Search for random values that may or may not belong to the list. for (int i = 0; i < 50; ++i) - std::find(obj.begin(), obj.end(), rand() % 100001); + (void) std::find(obj.begin(), obj.end(), rand() % 100001); obj.sort(); diff --git a/libstdc++-v3/testsuite/performance/25_algorithms/equal_deque_iterators.cc b/libstdc++-v3/testsuite/performance/25_algorithms/equal_deque_iterators.cc index 1f97adb06deb..58166676110e 100644 --- a/libstdc++-v3/testsuite/performance/25_algorithms/equal_deque_iterators.cc +++ b/libstdc++-v3/testsuite/performance/25_algorithms/equal_deque_iterators.cc @@ -34,7 +34,7 @@ int main() start_counters(time, resource); for (int i = 0; i < 1000; ++i) for (int j = 0; j < 3000; ++j) - std::equal(data.begin(), data.begin() + j, d.begin()); + (void) std::equal(data.begin(), data.begin() + j, d.begin()); stop_counters(time, resource); report_performance(__FILE__, "deque vs deque", time, resource); clear_counters(time, resource); @@ -44,7 +44,7 @@ int main() start_counters(time, resource); for (int i = 0; i < 1000; ++i) for (int j = 0; j < 3000; ++j) - std::equal(data.begin(), data.begin() + j, v.begin()); + (void) std::equal(data.begin(), data.begin() + j, v.begin()); stop_counters(time, resource); report_performance(__FILE__, "deque vs vector", time, resource); clear_counters(time, resource); @@ -54,7 +54,7 @@ int main() start_counters(time, resource); for (int i = 0; i < 1000; ++i) for (int j = 0; j < 3000; ++j) - std::equal(v.begin(), v.begin() + j, d.begin()); + (void) std::equal(v.begin(), v.begin() + j, d.begin()); stop_counters(time, resource); report_performance(__FILE__, "vector vs deque", time, resource); clear_counters(time, resource); @@ -64,7 +64,7 @@ int main() start_counters(time, resource); for (int i = 0; i < 1000; ++i) for (int j = 0; j < 3000; ++j) - std::equal(data.begin(), data.begin() + j, cv.begin()); + (void) std::equal(data.begin(), data.begin() + j, cv.begin()); stop_counters(time, resource); report_performance(__FILE__, "int deque vs char vector", time, resource); clear_counters(time, resource); @@ -74,7 +74,7 @@ int main() start_counters(time, resource); for (int i = 0; i < 1000; ++i) for (int j = 0; j < 3000; ++j) - std::equal(cv.begin(), cv.begin() + j, d.begin()); + (void) std::equal(cv.begin(), cv.begin() + j, d.begin()); stop_counters(time, resource); report_performance(__FILE__, "char vector vs int deque", time, resource); diff --git a/libstdc++-v3/testsuite/performance/25_algorithms/search_n.cc b/libstdc++-v3/testsuite/performance/25_algorithms/search_n.cc index 3f3585a65104..6218c1ed59ca 100644 --- a/libstdc++-v3/testsuite/performance/25_algorithms/search_n.cc +++ b/libstdc++-v3/testsuite/performance/25_algorithms/search_n.cc @@ -47,7 +47,7 @@ main(void) __gnu_test::test_container fcon(ary, ary + length); start_counters(time, resource); for(int i = 0; i < 100; i++) - search_n(fcon.begin(), fcon.end(), 10, 1); + (void) search_n(fcon.begin(), fcon.end(), 10, 1); stop_counters(time, resource); report_performance(__FILE__, "forward iterator", time, resource); clear_counters(time, resource); @@ -55,7 +55,7 @@ main(void) __gnu_test::test_container rcon(ary, ary + length); start_counters(time, resource); for(int i = 0; i < 100; i++) - search_n(rcon.begin(), rcon.end(), 10, 1); + (void) search_n(rcon.begin(), rcon.end(), 10, 1); stop_counters(time, resource); report_performance(__FILE__, "random access iterator", time, resource); clear_counters(time, resource); From dfd17e05f9e983660b87e603c062918d2d173fc3 Mon Sep 17 00:00:00 2001 From: Jonathan Wakely Date: Thu, 27 Nov 2025 16:13:44 +0000 Subject: [PATCH 085/373] analyzer: Add missing 'const' to equiv_class::operator== MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This produces a warning in C++20: /home/test/src/gcc/gcc/analyzer/constraint-manager.cc: In member function ‘bool ana::constraint_manager::operator==(const ana::constraint_manager&) const’: /home/test/src/gcc/gcc/analyzer/constraint-manager.cc:1610:42: warning: C++20 says that these are ambiguous, even though the second is reversed: 1610 | if (!(*ec == *other.m_equiv_classes[i])) | ^ /home/test/src/gcc/gcc/analyzer/constraint-manager.cc:1178:1: note: candidate 1: ‘bool ana::equiv_class::operator==(const ana::equiv_class&)’ 1178 | equiv_class::operator== (const equiv_class &other) | ^~~~~~~~~~~ /home/test/src/gcc/gcc/analyzer/constraint-manager.cc:1178:1: note: candidate 2: ‘bool ana::equiv_class::operator==(const ana::equiv_class&)’ (reversed) /home/test/src/gcc/gcc/analyzer/constraint-manager.cc:1178:1: note: try making the operator a ‘const’ member function gcc/analyzer/ChangeLog: * constraint-manager.cc (equiv_class::operator==): Add const qualifier. * constraint-manager.h (equiv_class::operator==): Likewise. --- gcc/analyzer/constraint-manager.cc | 2 +- gcc/analyzer/constraint-manager.h | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/analyzer/constraint-manager.cc b/gcc/analyzer/constraint-manager.cc index 58c60feae369..c8cc71593cc0 100644 --- a/gcc/analyzer/constraint-manager.cc +++ b/gcc/analyzer/constraint-manager.cc @@ -1175,7 +1175,7 @@ equiv_class::hash () const meaningful. */ bool -equiv_class::operator== (const equiv_class &other) +equiv_class::operator== (const equiv_class &other) const { if (m_constant != other.m_constant) return false; // TODO: use tree equality here? diff --git a/gcc/analyzer/constraint-manager.h b/gcc/analyzer/constraint-manager.h index 4339ea665d84..38686b7e696b 100644 --- a/gcc/analyzer/constraint-manager.h +++ b/gcc/analyzer/constraint-manager.h @@ -258,7 +258,7 @@ class equiv_class equiv_class (const equiv_class &other); hashval_t hash () const; - bool operator== (const equiv_class &other); + bool operator== (const equiv_class &other) const; void add (const svalue *sval); bool del (const svalue *sval); From a651bb353554ecb79898d48dd077b7cd288467df Mon Sep 17 00:00:00 2001 From: Andrew Pinski Date: Wed, 26 Nov 2025 13:55:41 -0800 Subject: [PATCH 086/373] reassociation: Fix canonical ordering in some cases This was noticed in PR122843 were sometimes reassociation would create the uncanonical order of operands. This fixes the problem by swapping the order as the rewrite happens. Wstringop-overflow.c needed to be xfailed since it started not to warn because well the warning is too dependent on the order of operands to MIN_EXPR. This testcase failed if we had supplied -fno-tree-reassoc before too; but nothing in the IR changes except the order of 2 operands of MIN_EXPR. I filed PR 122881 for this xfail. Bootstrapped and tested on x86_64-linux-gnu. gcc/ChangeLog: * tree-ssa-reassoc.cc (rewrite_expr_tree): Swap oe1 and oe2 if commutative code and not in canonical order. gcc/testsuite/ChangeLog: * c-c++-common/Wstringop-overflow.c: Xfail, PR 122881. Signed-off-by: Andrew Pinski --- gcc/testsuite/c-c++-common/Wstringop-overflow.c | 4 ++-- gcc/tree-ssa-reassoc.cc | 3 +++ 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/gcc/testsuite/c-c++-common/Wstringop-overflow.c b/gcc/testsuite/c-c++-common/Wstringop-overflow.c index 5757a23141ed..9829fe14116f 100644 --- a/gcc/testsuite/c-c++-common/Wstringop-overflow.c +++ b/gcc/testsuite/c-c++-common/Wstringop-overflow.c @@ -90,8 +90,8 @@ void test_strncat (char **d, const char* s, int i) } { - size_t n = i < strlen (s) ? i : strlen (s); /* { dg-message "length computed here" } */ - T (d, s, n); /* { dg-message ".strncat\[^\n\r\]* specified bound depends on the length of the source argument" } */ + size_t n = i < strlen (s) ? i : strlen (s); /* { dg-message "length computed here" "PR122881" { xfail *-*-* } } */ + T (d, s, n); /* { dg-message ".strncat\[^\n\r\]* specified bound depends on the length of the source argument" "PR122881" { xfail *-*-* } } */ } } diff --git a/gcc/tree-ssa-reassoc.cc b/gcc/tree-ssa-reassoc.cc index c140f76766eb..6e220e02ecd6 100644 --- a/gcc/tree-ssa-reassoc.cc +++ b/gcc/tree-ssa-reassoc.cc @@ -5268,6 +5268,9 @@ rewrite_expr_tree (gimple *stmt, enum tree_code rhs_code, unsigned int opindex, oe1 = ops[opindex]; oe2 = ops[opindex + 1]; + if (commutative_tree_code (rhs_code) + && tree_swap_operands_p (oe1->op, oe2->op)) + std::swap (oe1, oe2); if (rhs1 != oe1->op || rhs2 != oe2->op) { From a3d141316c413256adc59f49cb9094d3f76a017f Mon Sep 17 00:00:00 2001 From: Wilco Dijkstra Date: Wed, 17 Sep 2025 16:36:33 +0000 Subject: [PATCH 087/373] AArch64: Use dmb ishld+ishst for release fence Use dmb ishld and dmb ishst for a release fence since this is less restrictive than dmb ish. gcc: * config/aarch64/atomics.md (*dmb): Expand release fence into dmb ishld and dmb ishst. --- gcc/config/aarch64/atomics.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/gcc/config/aarch64/atomics.md b/gcc/config/aarch64/atomics.md index ea4a9367fc88..d4b4afb5815d 100644 --- a/gcc/config/aarch64/atomics.md +++ b/gcc/config/aarch64/atomics.md @@ -870,7 +870,13 @@ enum memmodel model = memmodel_from_int (INTVAL (operands[1])); if (is_mm_acquire (model)) return "dmb\\tishld"; + else if (is_mm_release (model)) + return "dmb\\tishld\;dmb\\tishst"; else return "dmb\\tish"; } + [(set (attr "length") + (if_then_else + (match_test "is_mm_release (memmodel_from_int (INTVAL (operands[1])))") + (const_int 8) (const_int 4)))] ) From 7fdfeb27c6945c98cff3edf399c855c6df44fa1e Mon Sep 17 00:00:00 2001 From: Wilco Dijkstra Date: Thu, 6 Nov 2025 20:49:22 +0000 Subject: [PATCH 088/373] AArch64: Improve ctz and ffs Use the ctz insn in the ffs expansion so it uses ctz if CSSC is available. Rather than splitting, keep ctz as a single insn for simplicity and possible fusion opportunities. Move clz, ctz, clrsb, rbit and ffs instructions together. gcc: * config/aarch64/aarch64.md (ffs2): Use gen_ctz. (ctz2): Model ctz as a single target instruction. gcc/testsuite: * gcc.target/aarch64/ffs.c: Improve test. --- gcc/config/aarch64/aarch64.md | 74 +++++++++++++------------- gcc/testsuite/gcc.target/aarch64/ffs.c | 65 +++++++++++++++++++--- 2 files changed, 95 insertions(+), 44 deletions(-) diff --git a/gcc/config/aarch64/aarch64.md b/gcc/config/aarch64/aarch64.md index 8dcb5e3f0ecb..f62247f3e39c 100644 --- a/gcc/config/aarch64/aarch64.md +++ b/gcc/config/aarch64/aarch64.md @@ -5697,6 +5697,8 @@ [(set_attr "type" "logics_shift_imm")] ) +;; CLZ, CTZ, CLS, RBIT instructions. + (define_insn "clz2" [(set (match_operand:GPI 0 "register_operand" "=r") (clz:GPI (match_operand:GPI 1 "register_operand" "r")))] @@ -5705,6 +5707,40 @@ [(set_attr "type" "clz")] ) +;; Model ctz as a target instruction. +;; If TARGET_CSSC is not available, emit rbit and clz. + +(define_insn "ctz2" + [(set (match_operand:GPI 0 "register_operand" "=r") + (ctz:GPI (match_operand:GPI 1 "register_operand" "r")))] + "" + { + if (TARGET_CSSC) + return "ctz\\t%0, %1"; + return "rbit\\t%0, %1\;clz\\t%0, %0"; + } + [(set_attr "type" "clz") + (set (attr "length") (if_then_else (match_test "TARGET_CSSC") + (const_int 4) (const_int 8))) + ] +) + +(define_insn "clrsb2" + [(set (match_operand:GPI 0 "register_operand" "=r") + (clrsb:GPI (match_operand:GPI 1 "register_operand" "r")))] + "" + "cls\\t%0, %1" + [(set_attr "type" "clz")] +) + +(define_insn "@aarch64_rbit" + [(set (match_operand:GPI 0 "register_operand" "=r") + (bitreverse:GPI (match_operand:GPI 1 "register_operand" "r")))] + "" + "rbit\\t%0, %1" + [(set_attr "type" "rbit")] +) + (define_expand "ffs2" [(match_operand:GPI 0 "register_operand") (match_operand:GPI 1 "register_operand")] @@ -5712,9 +5748,7 @@ { rtx ccreg = aarch64_gen_compare_reg (EQ, operands[1], const0_rtx); rtx x = gen_rtx_NE (VOIDmode, ccreg, const0_rtx); - - emit_insn (gen_aarch64_rbit (mode, operands[0], operands[1])); - emit_insn (gen_clz2 (operands[0], operands[0])); + emit_insn (gen_ctz2 (operands[0], operands[1])); emit_insn (gen_csinc3_insn (operands[0], x, operands[0], const0_rtx)); DONE; } @@ -5809,40 +5843,6 @@ DONE; }) -(define_insn "clrsb2" - [(set (match_operand:GPI 0 "register_operand" "=r") - (clrsb:GPI (match_operand:GPI 1 "register_operand" "r")))] - "" - "cls\\t%0, %1" - [(set_attr "type" "clz")] -) - -(define_insn "@aarch64_rbit" - [(set (match_operand:GPI 0 "register_operand" "=r") - (bitreverse:GPI (match_operand:GPI 1 "register_operand" "r")))] - "" - "rbit\\t%0, %1" - [(set_attr "type" "rbit")] -) - -;; Split after reload into RBIT + CLZ. Since RBIT is represented as an UNSPEC -;; it is unlikely to fold with any other operation, so keep this as a CTZ -;; expression and split after reload to enable scheduling them apart if -;; needed. For TARGET_CSSC we have a single CTZ instruction that can do this. - -(define_insn_and_split "ctz2" - [(set (match_operand:GPI 0 "register_operand" "=r") - (ctz:GPI (match_operand:GPI 1 "register_operand" "r")))] - "" - { return TARGET_CSSC ? "ctz\\t%0, %1" : "#"; } - "reload_completed && !TARGET_CSSC" - [(const_int 0)] - " - emit_insn (gen_aarch64_rbit (mode, operands[0], operands[1])); - emit_insn (gen_clz2 (operands[0], operands[0])); - DONE; -") - (define_insn "*and_compare0" [(set (reg:CC_Z CC_REGNUM) (compare:CC_Z diff --git a/gcc/testsuite/gcc.target/aarch64/ffs.c b/gcc/testsuite/gcc.target/aarch64/ffs.c index a3447619d235..a303bee5fd47 100644 --- a/gcc/testsuite/gcc.target/aarch64/ffs.c +++ b/gcc/testsuite/gcc.target/aarch64/ffs.c @@ -1,12 +1,63 @@ /* { dg-do compile } */ -/* { dg-options "-O2" } */ +/* { dg-additional-options "--save-temps -O2" } */ +/* { dg-final { check-function-bodies "**" "" "" } } */ -unsigned int functest(unsigned int x) +#include + +#pragma GCC target "+nocssc" + +/* +** ffsw1: +** cmp w1, 0 +** rbit w0, w1 +** clz w0, w0 +** csinc w0, wzr, w0, eq +** ret +*/ + +int ffsw1 (int y, uint32_t x) +{ + return __builtin_ffs (x); +} + +/* +** ffsx1: +** cmp x1, 0 +** rbit x0, x1 +** clz x0, x0 +** csinc x0, xzr, x0, eq +** ret +*/ + +int ffsx1 (int y, uint64_t x) { - return __builtin_ffs(x); + return __builtin_ffsll (x); } -/* { dg-final { scan-assembler "cmp\tw" } } */ -/* { dg-final { scan-assembler "rbit\tw" } } */ -/* { dg-final { scan-assembler "clz\tw" } } */ -/* { dg-final { scan-assembler "csinc\tw" } } */ +#pragma GCC target "+cssc" + +/* +** ffsw2: +** cmp w1, 0 +** ctz w0, w1 +** csinc w0, wzr, w0, eq +** ret +*/ + +int ffsw2 (int y, uint32_t x) +{ + return __builtin_ffs (x); +} + +/* +** ffsx2: +** cmp x1, 0 +** ctz x0, x1 +** csinc x0, xzr, x0, eq +** ret +*/ + +int ffsx2 (int y, uint64_t x) +{ + return __builtin_ffsll (x); +} From c9f702dc6ae89f9bf195d5cd449d1c24856b9a5c Mon Sep 17 00:00:00 2001 From: Wilco Dijkstra Date: Wed, 12 Nov 2025 19:46:19 +0000 Subject: [PATCH 089/373] AArch64: Add cssc as arch attr Add 'cssc' as an arch attribute. This allows the compact syntax to be used in ctz2 which makes it cleaner. gcc: * config/aarch64/aarch64.md (ctz2): Use compact syntax. --- gcc/config/aarch64/aarch64.md | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/gcc/config/aarch64/aarch64.md b/gcc/config/aarch64/aarch64.md index f62247f3e39c..fde4fabb7ef4 100644 --- a/gcc/config/aarch64/aarch64.md +++ b/gcc/config/aarch64/aarch64.md @@ -479,7 +479,7 @@ ;; Q registers and is equivalent to "simd". (define_enum "arches" [any rcpc8_4 fp fp_q base_simd nobase_simd - simd nosimd sve fp16 sme]) + simd nosimd sve fp16 sme cssc]) (define_enum_attr "arch" "arches" (const_string "any")) @@ -551,6 +551,9 @@ (and (eq_attr "arch" "fp16") (match_test "TARGET_FP_F16INST")) + (and (eq_attr "arch" "cssc") + (match_test "TARGET_CSSC")) + (and (eq_attr "arch" "sve") (match_test "TARGET_SVE")) @@ -5711,18 +5714,13 @@ ;; If TARGET_CSSC is not available, emit rbit and clz. (define_insn "ctz2" - [(set (match_operand:GPI 0 "register_operand" "=r") - (ctz:GPI (match_operand:GPI 1 "register_operand" "r")))] + [(set (match_operand:GPI 0 "register_operand") + (ctz:GPI (match_operand:GPI 1 "register_operand")))] "" - { - if (TARGET_CSSC) - return "ctz\\t%0, %1"; - return "rbit\\t%0, %1\;clz\\t%0, %0"; + {@ [ cons: =0, 1; attrs: type, arch, length ] + [ r , r; clz, cssc, 4 ] ctz\\t%0, %1 + [ r , r; clz, * , 8 ] rbit\\t%0, %1\;clz\\t%0, %0 } - [(set_attr "type" "clz") - (set (attr "length") (if_then_else (match_test "TARGET_CSSC") - (const_int 4) (const_int 8))) - ] ) (define_insn "clrsb2" From 6247a9086ca7a29ba1db9680010a319769717150 Mon Sep 17 00:00:00 2001 From: Matthieu Longo Date: Mon, 24 Nov 2025 14:56:19 +0000 Subject: [PATCH 090/373] aarch64: Define __ARM_BUILDATTR64_FV Support for Build Attributes (BA) was originally added in [1]. To facilitate their use in customers codebases and avoid requiring a new Autotools test for BA support, the specification was later amended. Toolchains that generate BA sections and support the assembler directives should define the following preprocessor macro: __ARM_BUILDATTR64_FV Where is the same value as in [2]. Currently, only version 'A' (0x41) is defined. This patch also introduces two tests: one that verifies the macro definition for positive detection of BA support; and another that ensures that no such macro is defined when BA support is absent. [1]: 98f5547dce2503d9d0f0cd454184d6870a315538 [2]: [Formal syntax of an ELF Attributes Section](https://github.com/smithp35/ abi-aa/blob/build-attributes/buildattr64/buildattr64.rst#formal-syntax-of-an-elf -attributes-section) gcc/ChangeLog: * config/aarch64/aarch64-c.cc (aarch64_define_unconditional_macros): Define __ARM_BUILDATTR64_FV when BA support is detected in GAS. gcc/testsuite/ChangeLog: * gcc.target/aarch64/build-attributes/build-attribute-define-nok.c: New test. * gcc.target/aarch64/build-attributes/build-attribute-define-ok.c: New test. --- gcc/config/aarch64/aarch64-c.cc | 5 +++++ .../aarch64/build-attributes/build-attribute-define-nok.c | 5 +++++ .../aarch64/build-attributes/build-attribute-define-ok.c | 7 +++++++ 3 files changed, 17 insertions(+) create mode 100644 gcc/testsuite/gcc.target/aarch64/build-attributes/build-attribute-define-nok.c create mode 100644 gcc/testsuite/gcc.target/aarch64/build-attributes/build-attribute-define-ok.c diff --git a/gcc/config/aarch64/aarch64-c.cc b/gcc/config/aarch64/aarch64-c.cc index c3957c762eff..de4444bacb79 100644 --- a/gcc/config/aarch64/aarch64-c.cc +++ b/gcc/config/aarch64/aarch64-c.cc @@ -65,6 +65,11 @@ aarch64_define_unconditional_macros (cpp_reader *pfile) builtin_define_with_int_value ("__ARM_ARCH_PROFILE", TARGET_V8R ? 'R' : 'A'); + +#if HAVE_AS_AEABI_BUILD_ATTRIBUTES + builtin_define_with_int_value ("__ARM_BUILDATTR64_FV", 'A'); +#endif + builtin_define ("__ARM_FEATURE_CLZ"); builtin_define ("__ARM_FEATURE_IDIV"); builtin_define ("__ARM_FEATURE_UNALIGNED"); diff --git a/gcc/testsuite/gcc.target/aarch64/build-attributes/build-attribute-define-nok.c b/gcc/testsuite/gcc.target/aarch64/build-attributes/build-attribute-define-nok.c new file mode 100644 index 000000000000..55b9de905d38 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/build-attributes/build-attribute-define-nok.c @@ -0,0 +1,5 @@ +/* { dg-do compile { target { aarch64*-*-linux* && { ! aarch64_gas_has_build_attributes } } } } */ + +#if defined(__ARM_BUILDATTR64_FV) +#error "Support for build attributes should not be enabled in this toolchain." +#endif diff --git a/gcc/testsuite/gcc.target/aarch64/build-attributes/build-attribute-define-ok.c b/gcc/testsuite/gcc.target/aarch64/build-attributes/build-attribute-define-ok.c new file mode 100644 index 000000000000..7ecb9297baed --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/build-attributes/build-attribute-define-ok.c @@ -0,0 +1,7 @@ +/* { dg-do compile { target { aarch64*-*-linux* && { aarch64_gas_has_build_attributes } } } } */ + +#if ! defined(__ARM_BUILDATTR64_FV) +#error "Support for build attributes should be enabled in this toolchain." +#elif __ARM_BUILDATTR64_FV != 'A' +#error "The current build attributes version does not match the expected one." +#endif From cf6a14ef153a4f139ed7452fd7aebd86c5031fbb Mon Sep 17 00:00:00 2001 From: Arthur Cohen Date: Thu, 27 Nov 2025 18:55:26 +0100 Subject: [PATCH 091/373] gccrs: Fix bootstrap with C++20 Remove container of incomplete type and reorder headers. gcc/rust/ChangeLog: * typecheck/rust-tyty-subst.h: Remove now useless inclusion. * typecheck/rust-tyty.h (class TypeBoundPredicate): New, moved from rust-tyty-bounds.h (class TypeBoundsMappings): Likewise. * typecheck/rust-tyty-bounds.h: Removed. --- gcc/rust/typecheck/rust-tyty-bounds.h | 66 -------- gcc/rust/typecheck/rust-tyty-subst.h | 1 - gcc/rust/typecheck/rust-tyty.h | 216 +++++++++++++++----------- 3 files changed, 121 insertions(+), 162 deletions(-) delete mode 100644 gcc/rust/typecheck/rust-tyty-bounds.h diff --git a/gcc/rust/typecheck/rust-tyty-bounds.h b/gcc/rust/typecheck/rust-tyty-bounds.h deleted file mode 100644 index 6392af1fed4f..000000000000 --- a/gcc/rust/typecheck/rust-tyty-bounds.h +++ /dev/null @@ -1,66 +0,0 @@ -// Copyright (C) 2020-2025 Free Software Foundation, Inc. - -// This file is part of GCC. - -// GCC is free software; you can redistribute it and/or modify it under -// the terms of the GNU General Public License as published by the Free -// Software Foundation; either version 3, or (at your option) any later -// version. - -// GCC is distributed in the hope that it will be useful, but WITHOUT ANY -// WARRANTY; without even the implied warranty of MERCHANTABILITY or -// FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -// for more details. - -// You should have received a copy of the GNU General Public License -// along with GCC; see the file COPYING3. If not see -// . - -#ifndef RUST_TYTY_BOUNDS_H -#define RUST_TYTY_BOUNDS_H - -#include "rust-location.h" -#include "rust-mapping-common.h" - -namespace Rust { - -namespace Resolver { -class TraitReference; -class TraitItemReference; -class AssociatedImplTrait; -} // namespace Resolver - -namespace TyTy { - -class BaseType; -class TypeBoundPredicate; -class TypeBoundsMappings -{ -protected: - TypeBoundsMappings (std::vector specified_bounds); - -public: - std::vector &get_specified_bounds (); - - const std::vector &get_specified_bounds () const; - - TypeBoundPredicate lookup_predicate (DefId id); - - size_t num_specified_bounds () const; - - std::string raw_bounds_as_string () const; - - std::string bounds_as_string () const; - - std::string raw_bounds_as_name () const; - -protected: - void add_bound (TypeBoundPredicate predicate); - - std::vector specified_bounds; -}; - -} // namespace TyTy -} // namespace Rust - -#endif // RUST_TYTY_BOUNDS_H diff --git a/gcc/rust/typecheck/rust-tyty-subst.h b/gcc/rust/typecheck/rust-tyty-subst.h index c1bc96a7f8a5..d09e180147a1 100644 --- a/gcc/rust/typecheck/rust-tyty-subst.h +++ b/gcc/rust/typecheck/rust-tyty-subst.h @@ -22,7 +22,6 @@ #include "rust-system.h" #include "rust-location.h" #include "rust-hir-full-decls.h" -#include "rust-tyty-bounds.h" #include "rust-tyty-region.h" #include "rust-ast.h" #include "optional.h" diff --git a/gcc/rust/typecheck/rust-tyty.h b/gcc/rust/typecheck/rust-tyty.h index ed3cd76807cd..50f6347e33f7 100644 --- a/gcc/rust/typecheck/rust-tyty.h +++ b/gcc/rust/typecheck/rust-tyty.h @@ -24,7 +24,6 @@ #include "rust-common.h" #include "rust-identifier.h" #include "rust-abi.h" -#include "rust-tyty-bounds.h" #include "rust-tyty-util.h" #include "rust-tyty-subst.h" #include "rust-tyty-region.h" @@ -92,6 +91,127 @@ class TypeKindFormat class TyVisitor; class TyConstVisitor; class BaseConstType; + +class TypeBoundPredicate : public SubstitutionRef +{ +public: + TypeBoundPredicate (const Resolver::TraitReference &trait_reference, + BoundPolarity polarity, location_t locus); + + TypeBoundPredicate (DefId reference, + std::vector substitutions, + BoundPolarity polarity, location_t locus); + + TypeBoundPredicate (const TypeBoundPredicate &other); + + virtual ~TypeBoundPredicate () {} + + TypeBoundPredicate &operator= (const TypeBoundPredicate &other); + + static TypeBoundPredicate error (); + + std::string as_string () const; + + std::string as_name () const; + + const Resolver::TraitReference *get () const; + + location_t get_locus () const { return locus; } + + std::string get_name () const; + + // check that this is object-safe see: + // https://doc.rust-lang.org/reference/items/traits.html#object-safety + bool is_object_safe (bool emit_error, location_t locus) const; + + void apply_generic_arguments (HIR::GenericArgs *generic_args, + bool has_associated_self, bool is_super_trait); + + void apply_argument_mappings (SubstitutionArgumentMappings &arguments, + bool is_super_trait); + + bool contains_item (const std::string &search) const; + + tl::optional + lookup_associated_item (const std::string &search) const; + + tl::optional + lookup_associated_item (const Resolver::TraitItemReference *ref) const; + + // WARNING THIS WILL ALWAYS RETURN NULLPTR + BaseType * + handle_substitions (SubstitutionArgumentMappings &mappings) override final; + + bool is_error () const; + + bool requires_generic_args () const; + + bool contains_associated_types () const; + + DefId get_id () const { return reference; } + + BoundPolarity get_polarity () const { return polarity; } + + std::vector get_associated_type_items (); + + size_t get_num_associated_bindings () const override final; + + TypeBoundPredicateItem + lookup_associated_type (const std::string &search) override final; + + bool is_equal (const TypeBoundPredicate &other) const; + + bool validate_type_implements_super_traits (TyTy::BaseType &self, + HIR::Type &impl_type, + HIR::Type &trait) const; + + bool validate_type_implements_this (TyTy::BaseType &self, + HIR::Type &impl_type, + HIR::Type &trait) const; + +private: + struct mark_is_error + { + }; + + TypeBoundPredicate (mark_is_error); + + void get_trait_hierachy ( + std::function callback) const; + + DefId reference; + location_t locus; + bool error_flag; + BoundPolarity polarity; + std::vector super_traits; +}; + +class TypeBoundsMappings +{ +protected: + TypeBoundsMappings (std::vector specified_bounds); + +public: + std::vector &get_specified_bounds (); + + const std::vector &get_specified_bounds () const; + + TypeBoundPredicate lookup_predicate (DefId id); + + size_t num_specified_bounds () const; + + std::string raw_bounds_as_string () const; + + std::string bounds_as_string () const; + + std::string raw_bounds_as_name () const; + +protected: + void add_bound (TypeBoundPredicate predicate); + + std::vector specified_bounds; +}; + class BaseType : public TypeBoundsMappings { public: @@ -671,100 +791,6 @@ class TupleType : public BaseType std::vector fields; }; -class TypeBoundPredicate : public SubstitutionRef -{ -public: - TypeBoundPredicate (const Resolver::TraitReference &trait_reference, - BoundPolarity polarity, location_t locus); - - TypeBoundPredicate (DefId reference, - std::vector substitutions, - BoundPolarity polarity, location_t locus); - - TypeBoundPredicate (const TypeBoundPredicate &other); - - virtual ~TypeBoundPredicate () {} - - TypeBoundPredicate &operator= (const TypeBoundPredicate &other); - - static TypeBoundPredicate error (); - - std::string as_string () const; - - std::string as_name () const; - - const Resolver::TraitReference *get () const; - - location_t get_locus () const { return locus; } - - std::string get_name () const; - - // check that this is object-safe see: - // https://doc.rust-lang.org/reference/items/traits.html#object-safety - bool is_object_safe (bool emit_error, location_t locus) const; - - void apply_generic_arguments (HIR::GenericArgs *generic_args, - bool has_associated_self, bool is_super_trait); - - void apply_argument_mappings (SubstitutionArgumentMappings &arguments, - bool is_super_trait); - - bool contains_item (const std::string &search) const; - - tl::optional - lookup_associated_item (const std::string &search) const; - - tl::optional - lookup_associated_item (const Resolver::TraitItemReference *ref) const; - - // WARNING THIS WILL ALWAYS RETURN NULLPTR - BaseType * - handle_substitions (SubstitutionArgumentMappings &mappings) override final; - - bool is_error () const; - - bool requires_generic_args () const; - - bool contains_associated_types () const; - - DefId get_id () const { return reference; } - - BoundPolarity get_polarity () const { return polarity; } - - std::vector get_associated_type_items (); - - size_t get_num_associated_bindings () const override final; - - TypeBoundPredicateItem - lookup_associated_type (const std::string &search) override final; - - bool is_equal (const TypeBoundPredicate &other) const; - - bool validate_type_implements_super_traits (TyTy::BaseType &self, - HIR::Type &impl_type, - HIR::Type &trait) const; - - bool validate_type_implements_this (TyTy::BaseType &self, - HIR::Type &impl_type, - HIR::Type &trait) const; - -private: - struct mark_is_error - { - }; - - TypeBoundPredicate (mark_is_error); - - void get_trait_hierachy ( - std::function callback) const; - - DefId reference; - location_t locus; - bool error_flag; - BoundPolarity polarity; - std::vector super_traits; -}; - class TypeBoundPredicateItem { public: From f768b1543c36d3d0557dfb07d3c27746ee7058a7 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Thu, 27 Nov 2025 19:04:58 +0100 Subject: [PATCH 092/373] gccrs: Partially unbreak rust build with C++20 I've committed earlier today https://gcc.gnu.org/r16-5628 to switch C++ to -std=gnu++20 by default. That apparently broke rust build (I don't have cargo installed, so am not testing rust at all). Here is a completely untested attempt to fix that. Note, in C++20 u8"abc" literal has const char8_t[4] type rather than const char[4] which was the case in C++17, and there is std::u8string etc. The casts below to (const char *) is what I've used in libcody as well to make it compilable with all of C++11 to C++26. Another thing is that the source for some reason expects -fexec-charset= to be ASCII compatible and -fwide-exec-charset= to be UTF-16 or UTF-32 or something similar. That is certainly not guaranteed. Now, if rust-lex.cc can be only compiled with C++17 or later, we could just use u8'_' etc., but as GCC still only requires C++14, I'd go with u'_' etc. 2025-11-27 Jakub Jelinek * lex/rust-lex.cc (rust_input_source_test): Cast char8_t string literals to (const char *) to make it compilable with C++20. Use char16_t or char32_t character literals instead of ordinary character literals or wide character literals in expected initializers. --- gcc/rust/lex/rust-lex.cc | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/gcc/rust/lex/rust-lex.cc b/gcc/rust/lex/rust-lex.cc index 214161fcca61..4d94a202a1f4 100644 --- a/gcc/rust/lex/rust-lex.cc +++ b/gcc/rust/lex/rust-lex.cc @@ -2639,37 +2639,37 @@ void rust_input_source_test () { // ASCII - std::string src = u8"_abcde\tXYZ\v\f"; + std::string src = (const char *) u8"_abcde\tXYZ\v\f"; std::vector expected - = {'_', 'a', 'b', 'c', 'd', 'e', '\t', 'X', 'Y', 'Z', '\v', '\f'}; + = {u'_', u'a', u'b', u'c', u'd', u'e', u'\t', u'X', u'Y', u'Z', u'\v', u'\f'}; test_buffer_input_source (src, expected); // BOM - src = u8"\xef\xbb\xbfOK"; - expected = {'O', 'K'}; + src = (const char *) u8"\xef\xbb\xbfOK"; + expected = {u'O', u'K'}; test_buffer_input_source (src, expected); // Russian - src = u8"приве́т"; - expected = {L'п', - L'р', - L'и', - L'в', + src = (const char *) u8"приве́т"; + expected = {u'п', + u'р', + u'и', + u'в', 0x0435 /* CYRILLIC SMALL LETTER IE е */, 0x301 /* COMBINING ACUTE ACCENT ́ */, - L'т'}; + u'т'}; test_buffer_input_source (src, expected); - src = u8"❤️🦀"; + src = (const char *) u8"❤️🦀"; expected = {0x2764 /* HEAVY BLACK HEART */, - 0xfe0f /* VARIATION SELECTOR-16 */, L'🦀'}; + 0xfe0f /* VARIATION SELECTOR-16 */, U'🦀'}; test_buffer_input_source (src, expected); - src = u8"こんにちは"; - expected = {L'こ', L'ん', L'に', L'ち', L'は'}; + src = (const char *) u8"こんにちは"; + expected = {u'こ', u'ん', u'に', u'ち', u'は'}; test_file_input_source (src, expected); - src = u8"👮‍♂👩‍⚕"; + src = (const char *) u8"👮‍♂👩‍⚕"; expected = {0x1f46e /* POLICE OFFICER */, 0x200d /* ZERO WIDTH JOINER */, 0x2642 /* MALE SIGN */, 0x1f469 /* WOMAN */, From ca19686a6b87696c0ecea5e9fce825b5e5e10144 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Thu, 27 Nov 2025 20:18:57 +0100 Subject: [PATCH 093/373] c: Fix ICE in c_type_tag on va_list [PR121506] The C and C++ FEs disagree on what TYPE_NAME on RECORD_TYPE for structure/class definition is (rather than typedef/using, for those both have TYPE_NAME of TYPE_DECL with DECL_ORIGINAL_TYPE), the C FE just uses IDENTIFIER_NODE as TYPE_NAME on RECORD_TYPE, while the C++ FE uses TYPE_DECL as TYPENAME on RECORD_TYPE and only DECL_NAME on the TYPE_DECL provides the IDENTIFIER_NODE. The reason for the C++ FE way is that there can be type definitions at class scope (rather than just typedefs) and those need to be among TYPE_FIELDS (so the corresponding TYPE_DECL is in that chain) etc. The middle-end can cope with it, e.g. if (TREE_CODE (TYPE_NAME (node)) == IDENTIFIER_NODE) pp_tree_identifier (pp, TYPE_NAME (node)); else if (TREE_CODE (TYPE_NAME (node)) == TYPE_DECL && DECL_NAME (TYPE_NAME (node))) dump_decl_name (pp, TYPE_NAME (node), flags); and many other places. Now, the backends on various targets create artificial structure definitions for va_list, e.g. x86 creates struct __va_list_tag and they do it the C++ FE way so that the C++ FE can cope with those. Except the new c_type_tag can't deal with that and ICEs. The following patch fixes it so that it can handle it too. 2025-11-27 Jakub Jelinek PR c/121506 * c-typeck.cc (c_type_tag): If TYPE_NAME is TYPE_DECL with non-NULL DECL_NAME, return that. * gcc.dg/pr121506.c: New test. --- gcc/c/c-typeck.cc | 6 +++--- gcc/testsuite/gcc.dg/pr121506.c | 8 ++++++++ 2 files changed, 11 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gcc.dg/pr121506.c diff --git a/gcc/c/c-typeck.cc b/gcc/c/c-typeck.cc index 7eb413885b87..a34ca2ab97c4 100644 --- a/gcc/c/c-typeck.cc +++ b/gcc/c/c-typeck.cc @@ -610,9 +610,9 @@ c_type_tag (const_tree t) return NULL_TREE; if (TREE_CODE (name) == TYPE_DECL) { - /* A TYPE_DECL added by add_decl_expr. */ - gcc_checking_assert (!DECL_NAME (name)); - return NULL_TREE; + if (!DECL_NAME (name)) + return NULL_TREE; + name = DECL_NAME (name); } gcc_checking_assert (TREE_CODE (name) == IDENTIFIER_NODE); return name; diff --git a/gcc/testsuite/gcc.dg/pr121506.c b/gcc/testsuite/gcc.dg/pr121506.c new file mode 100644 index 000000000000..0d0664739aca --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr121506.c @@ -0,0 +1,8 @@ +/* PR c/121506 */ +/* { dg-do compile } */ + +#include + +struct A; +void foo (struct A *); /* { dg-message "previous declaration of 'foo' with type 'void\\\(struct A \\\*\\\)'" } */ +void foo (va_list); /* { dg-error "conflicting types for 'foo'; have" } */ From c64308e297a13d0f0e19ec871b5e81348b4da484 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Fri, 28 Nov 2025 00:21:32 +0000 Subject: [PATCH 094/373] Daily bump. --- gcc/ChangeLog | 126 +++++++++++++++++++++++++++++++++ gcc/DATESTAMP | 2 +- gcc/ada/ChangeLog | 150 ++++++++++++++++++++++++++++++++++++++++ gcc/analyzer/ChangeLog | 6 ++ gcc/c/ChangeLog | 6 ++ gcc/rust/ChangeLog | 15 ++++ gcc/testsuite/ChangeLog | 44 ++++++++++++ libgcc/ChangeLog | 6 ++ libstdc++-v3/ChangeLog | 77 +++++++++++++++++++++ 9 files changed, 431 insertions(+), 1 deletion(-) diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 2333706380ae..af44c22d36ba 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,129 @@ +2025-11-27 Matthieu Longo + + * config/aarch64/aarch64-c.cc (aarch64_define_unconditional_macros): Define + __ARM_BUILDATTR64_FV when BA support is detected in GAS. + +2025-11-27 Wilco Dijkstra + + * config/aarch64/aarch64.md (ctz2): Use compact syntax. + +2025-11-27 Wilco Dijkstra + + * config/aarch64/aarch64.md (ffs2): Use gen_ctz. + (ctz2): Model ctz as a single target instruction. + +2025-11-27 Wilco Dijkstra + + * config/aarch64/atomics.md (*dmb): Expand release fence into dmb ishld + and dmb ishst. + +2025-11-27 Andrew Pinski + + * tree-ssa-reassoc.cc (rewrite_expr_tree): Swap + oe1 and oe2 if commutative code and not in + canonical order. + +2025-11-27 Georg-Johann Lay + + * config/avr/avr-mcus.def (AVR_MCUS): Add avr16la14, avr16la20, + avr16la28, avr16la32, avr32la14, avr32la20, avr32la28, avr32la32. + * doc/avr-mmcu.texi: Rebuild. + +2025-11-27 Robin Dapp + + PR tree-optimization/122855 + PR tree-optimization/122850 + * tree-ssa-forwprop.cc (simplify_vector_constructor): Nop + convert input if necessary. + +2025-11-27 Andrew Stubbs + + * config/gcn/gcn.cc (gcn_init_cumulative_args): Emit a warning if the + -mxnack setting looks wrong. + * config/gcn/mkoffload.cc: Include tree.h and omp-general.h. + (process_asm): Add omp_requires parameter. + Emit HSA_XNACK code into mkoffload_setup, as required. + (main): Modify HSACO_ATTR_OFF to preserve user-set -mxnack. + Pass omp_requires to process_asm. + +2025-11-27 Jakub Jelinek + + PR target/122714 + * gimple-lower-bitint.cc (bitint_large_huge::limb_access): Adjust + MEM_REFs offset for bitint_big_endian if ltype doesn't have the + same byte size as m_limb_type. + +2025-11-27 Richard Biener + + * tree-vect-stmts.cc (vectorizable_simd_clone_call): Fix + recording of the mask type again. Adjust placing of + mask arguments for non-masked calls. + +2025-11-27 Dhruv Chawla + + PR tree-optimization/122733 + * match.pd ((y << x) {<,<=,>,>=} x): Remove. + ((y << x) {==,!=} x): Call constant_boolean_node instead of + build_one_cst/build_zero_cst and combine into one pattern. + +2025-11-27 Jakub Jelinek + + * fold-const.h (expr_not_equal_to): Add gimple * argument defaulted + to NULL. + * fold-const.cc (expr_not_equal_to): Likewise, pass it through to + range_of_expr. + * generic-match-head.cc (gimple_match_ctx): New static inline. + * match.pd (X % -Y -> X % Y): Capture NEGATE and pass + gimple_match_ctx (@2) as new 3rd argument to expr_not_equal_to. + ((A * C) +- (B * C) -> (A+-B) * C): Pass gimple_match_ctx (@3) + as new 3rd argument to expr_not_equal_to. + (a rrotate (bitsize-b) -> a lrotate b): Likewise. + +2025-11-27 Jakub Jelinek + + PR tree-optimization/119683 + * gimple-match.h (gimple_match_ctx): Move to ... + * gimple-match-head.cc (gimple_match_ctx): ... here. Make static. + (gimple_match_range_of_expr): New static inline. + * match.pd ((mult (plus:s (mult:s @0 @1) @2) @3)): Use + gimple_match_range_of_expr. + ((plus (mult:s (plus:s @0 @1) @2) @3)): Likewise. + ((t * u) / u -> t): Likewise. + ((t * u) / v -> t * (u / v)): Likewise. + ((X + M*N) / N -> X / N + M): Likewise. + ((X - M*N) / N -> X / N - M): Likewise. + ((X + C) / N -> X / N + C / N): Likewise. + (((T)(A)) + CST -> (T)(A + CST)): Likewise + (x_5 == cstN ? cst4 : cst3): Likewise. Do r.set_varying + even when gimple_match_range_of_expr failed. + +2025-11-27 Christophe Lyon + + * config/arm/arm-builtins.cc (arm_init_mve_builtins): Remove + volatile qualifier. + +2025-11-27 Richard Biener + + PR tree-optimization/122885 + * tree-vect-loop.cc (vect_find_reusable_accumulator): Reject + mask vectors which do not use integer vector modes. + (vect_create_partial_epilog): Assert the same. + +2025-11-27 liuhongt + + * config/i386/i386-options.cc (set_ix86_tune_features): Set + gather/scatter tune if OPTION_SET_P. + * config/i386/i386.opt: Refactor mgather/mscatter. + +2025-11-27 Lulu Cheng + + * doc/extend.texi: Remove the incorrect prompt message. + +2025-11-27 Sandra Loosemore + + * doc/invoke.texi (Option Summary) : + Add --compile-std-module. + 2025-11-26 Jeff Law Revert: diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index d8e427a9c3e1..1ae1ab83d643 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20251127 +20251128 diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8cbdbfe17701..4837ac186ee1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,153 @@ +2025-11-27 Eric Botcazou + + * exp_ch6.adb (Expand_Actuals): Do not create activation chain and + master for build-in-place calls here but... + (Make_Build_In_Place_Call_In_Allocator): Use Unqual_Conv. + (Make_Build_In_Place_Call_In_Anonymous_Context): ...here instead. + Call Make_Build_In_Place_Call_In_Object_Declaration directly. + (Make_Build_In_Place_Iface_Call_In_Anonymous_Context): ...and here + instead. Add missing rewriting of the call. + +2025-11-27 Ronan Desplanques + + * doc/gnat_ugn/about_this_guide.rst: Minor fixes + * gnat_ugn.texi: Regenerate. + +2025-11-27 Eric Botcazou + + PR ada/122574 + * doc/gnat_ugn/building_executable_programs_with_gnat.rst (-gnatwp): + Replace reference to -gnatN with -gnatn and adjust accordingly. + * inline.adb: Remove clauses for Exp_Tss. + (Has_Initialized_Type): Delete. + (Add_Inlined_Subprogram): Test that the Is_Inlined flag is still set + on the subprogram. + * usage.adb (Usage): Adjust description of -gnatwp. + * gnat_ugn.texi: Regenerate. + +2025-11-27 Denis Mazzucato + + * sem_ch5.adb: Skip check for assignment that doesn't come from source. + +2025-11-27 Ronan Desplanques + + * exp_aggr.adb (Gen_Loop): Only preanalyze expressions we know won't + evaluated. + +2025-11-27 Tom Tromey + + * repinfo.adb (Visit): New procedure. + (List_GCC_Expression): Rewrite. + * repinfo.ads (Visit): New generic procedure. + +2025-11-27 Ghjuvan Lacambre + + * sem_ch13.adb (Analyze_Code_Statement): Do not emit error + message when only checking relaxed semantics. + +2025-11-27 Eric Botcazou + + * exp_ch7.adb (Build_Finalizer_Call): Delete. + (Build_Finalizer): Always insert the finalizer at the end of the + statement list in the non-package case. + (Expand_Cleanup_Actions): Attach the finalizer manually, if any. + * exp_smem.adb (Add_Shared_Var_Lock_Procs): Insert all the actions + directly in the transient scope. + +2025-11-27 Eric Botcazou + + * exp_ch11.adb (Expand_N_Handled_Sequence_Of_Statement): Merge the + eslif condition with the if condition for cleanup actions. + * sem_ch6.adb (Analyze_Procedure_Call.Analyze_Call_And_Resolve): Get + rid of if statement whose condition is always true. + * sinfo.ads (Finally_Statements): Document their purpose. + +2025-11-27 Eric Botcazou + + * gen_il-gen-gen_nodes.adb (N_Extended_Return_Statement): Add + Activation_Chain_Entity semantic field. + * exp_ch3.adb (Build_Master): Use Build_Master_{Entity,Renaming} in + all cases. + (Expand_N_Object_Declaration): Small tweak. + * exp_ch6.adb (Make_Build_In_Place_Iface_Call_In_Allocator): Use + Build_Master_{Entity,Renaming} to build the master. + * exp_ch7.adb (Expand_N_Package_Declaration): Do not guard the call + to Build_Task_Activation_Call for the sake of consistency. + * exp_ch9.ads (Build_Class_Wide_Master): Delete. + (Find_Master_Scope): Likewise. + (Build_Protected_Subprogram_Call_Cleanup): Move to... + (First_Protected_Operation): Move to... + (Mark_Construct_As_Task_Master): New procedure. + * exp_ch9.adb (Build_Protected_Subprogram_Call_Cleanup): ...here. + (First_Protected_Operation): ...here. + (Build_Activation_Chain_Entity): Streamline handling of extended + return statements. + (Build_Class_Wide_Master): Delete. + (Build_Master_Entity): Streamline handling of extended return + statements and call Mark_Construct_As_Task_Master on the context. + (Build_Task_Activation_Call): Assert that the owner is not an + extended return statement. + (Find_Master_Scope): Delete. + (Mark_Construct_As_Task_Master): New procedure. + * sem_ch3.adb (Access_Definition): Use Build_Master_{Entity,Renaming} + in all cases to build a master. + * sem_ch6.adb (Check_Anonymous_Return): Rename to... + (Check_Anonymous_Access_Return_With_Tasks): ...this. At the end, + call Mark_Construct_As_Task_Master on the parent node. + (Analyze_Subprogram_Body_Helper): Adjust to above renaming. + (Create_Extra_Formals): Do not set Has_Master_Entity here. + * sinfo.ads (Activation_Chain_Entity): Adjust description. + +2025-11-27 Bob Duff + + * sem_ch13.adb (Aspect_Annotate): Avoid disturbing the tree of the + aspect. + * vast.adb: Enable Check_Parent_Present. + * exp_ch6.adb (Validate_Subprogram_Calls): Minor reformatting. + +2025-11-27 Eric Botcazou + + * exp_ch4.adb (Expand_N_Case_Expression): When not optimizing for a + specific context, call Make_Build_In_Place_Call_In_Anonymous_Context + on expressions of alternatives when they are calls to BIP functions. + (Expand_N_If_Expression): Likewise for the Then & Else expressions. + +2025-11-27 Bob Duff + + * frontend.adb: Move call to VAST from here... + * gnat1drv.adb: ...to here. + * vast.ads (VAST_If_Enabled): Rename main entry point of VAST from + VAST to VAST_If_Enabled. + * vast.adb: Miscellaneous improvements. Mostly debugging + improvements. Also enable Check_Error_Nodes. Also add checks: + Check_FE_Only, Check_Scope_Present, Check_Scope_Correct. + * debug.ads: Minor comment tweaks. The comment, "In the checks off + version of debug, the call to Set_Debug_Flag is always a null + operation." appears to be false, so is removed. + * debug.adb: Minor: Remove some code duplication. + * sinfo-utils.adb (nnd): Add comment warning about C vs. Ada + confusion. + +2025-11-27 Eric Botcazou + + * exp_ch6.ads (Needs_BIP_Task_Actuals): Adjust description. + * exp_ch6.adb (Expand_N_Extended_Return_Statement): Move activation + chain for every build-in-place function with task formal parameters + when the type of the return object might have tasks. + +2025-11-27 Ronan Desplanques + + * libgnat/s-dwalin.ads (Display_Mode_Type): New enumerated type. + (Symbolic_Traceback): Use new type in profile. + * libgnat/s-dwalin.adb (Symbolic_Traceback): Use new type in profile + and adapt body. + * libgnat/s-trasym__dwarf.adb (Multi_Module_Symbolic_Traceback): Fix + wrong call in body of one overload. Use new type in profile. Adapt + body. + (Symbolic_Traceback, Symbolic_Traceback_No_Lock, + Module_Symbolic_Traceback): Use new type in profile and adapt body. + (Calling_Entity): Adapt body. + 2025-11-24 Eric Botcazou PR ada/81106 diff --git a/gcc/analyzer/ChangeLog b/gcc/analyzer/ChangeLog index 70fe4dd2b826..9e18914aad9f 100644 --- a/gcc/analyzer/ChangeLog +++ b/gcc/analyzer/ChangeLog @@ -1,3 +1,9 @@ +2025-11-27 Jonathan Wakely + + * constraint-manager.cc (equiv_class::operator==): Add const + qualifier. + * constraint-manager.h (equiv_class::operator==): Likewise. + 2025-11-25 David Malcolm * sm-malloc.cc (deref_before_check::emit): Add logging of the diff --git a/gcc/c/ChangeLog b/gcc/c/ChangeLog index bda28d1c64a8..974dd6d768fc 100644 --- a/gcc/c/ChangeLog +++ b/gcc/c/ChangeLog @@ -1,3 +1,9 @@ +2025-11-27 Jakub Jelinek + + PR c/121506 + * c-typeck.cc (c_type_tag): If TYPE_NAME is TYPE_DECL + with non-NULL DECL_NAME, return that. + 2025-11-26 Alejandro Colomar * c-parser.cc (c_parser_maxof_or_minof_expression): New func. diff --git a/gcc/rust/ChangeLog b/gcc/rust/ChangeLog index c581e08ffbb6..5ba3ddadd180 100644 --- a/gcc/rust/ChangeLog +++ b/gcc/rust/ChangeLog @@ -1,3 +1,18 @@ +2025-11-27 Jakub Jelinek + + * lex/rust-lex.cc (rust_input_source_test): Cast char8_t string + literals to (const char *) to make it compilable with C++20. Use + char16_t or char32_t character literals instead of ordinary + character literals or wide character literals in expected + initializers. + +2025-11-27 Arthur Cohen + + * typecheck/rust-tyty-subst.h: Remove now useless inclusion. + * typecheck/rust-tyty.h (class TypeBoundPredicate): New, moved from rust-tyty-bounds.h + (class TypeBoundsMappings): Likewise. + * typecheck/rust-tyty-bounds.h: Removed. + 2025-11-25 Lúcio Boari Fleury * parse/rust-parse-impl.h: Add early exit condition to parsing loop. diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f28baf01803d..b3dbc89c32df 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,47 @@ +2025-11-27 Jakub Jelinek + + PR c/121506 + * gcc.dg/pr121506.c: New test. + +2025-11-27 Matthieu Longo + + * gcc.target/aarch64/build-attributes/build-attribute-define-nok.c: New test. + * gcc.target/aarch64/build-attributes/build-attribute-define-ok.c: New test. + +2025-11-27 Wilco Dijkstra + + * gcc.target/aarch64/ffs.c: Improve test. + +2025-11-27 Andrew Pinski + + * c-c++-common/Wstringop-overflow.c: Xfail, PR 122881. + +2025-11-27 Robin Dapp + + PR tree-optimization/122855 + PR tree-optimization/122850 + * gcc.dg/vect/pr122850.c: New test. + * gcc.dg/vect/pr122855.c: New test. + +2025-11-27 Pan Li + + * gcc.target/riscv/rvv/autovec/pr121959-run-1.c: Update + the reference for run test. + +2025-11-27 Dhruv Chawla + + PR tree-optimization/122733 + * gcc.dg/match-shift-cmp-1.c: Update test to only check + equality. + * gcc.dg/match-shift-cmp-2.c: Likewise. + * gcc.dg/match-shift-cmp-3.c: Likewise. + * gcc.dg/match-shift-cmp-4.c: Removed. + +2025-11-27 Richard Biener + + PR tree-optimization/122885 + * gcc.dg/torture/pr122873.c: New testcase. + 2025-11-26 Jeff Law Revert: diff --git a/libgcc/ChangeLog b/libgcc/ChangeLog index 3ba5043fb049..a9f4a1f51d96 100644 --- a/libgcc/ChangeLog +++ b/libgcc/ChangeLog @@ -1,3 +1,9 @@ +2025-11-27 Lulu Cheng + + * config/loongarch/cpuinfo.c (HWCAP_LOONGARCH_LSX): Define + it if it is not defined. + (HWCAP_LOONGARCH_LASX): Likewise. + 2025-11-21 LIU Hao PR target/122275 diff --git a/libstdc++-v3/ChangeLog b/libstdc++-v3/ChangeLog index 833ba0a6d1ba..cb6bd547b25a 100644 --- a/libstdc++-v3/ChangeLog +++ b/libstdc++-v3/ChangeLog @@ -1,3 +1,80 @@ +2025-11-27 Jonathan Wakely + + * testsuite/performance/23_containers/sort_search/list.cc: Cast + results to void to suppress -Wunused-result warnings from + nodiscard functions. + * testsuite/performance/25_algorithms/equal_deque_iterators.cc: + Likewise. + * testsuite/performance/25_algorithms/search_n.cc: Likewise. + +2025-11-27 Jonathan Wakely + + * testsuite/Makefile.am: Fix typo in comment. + * testsuite/Makefile.in: Regenerate. + +2025-11-27 Tomasz Kamiński + + * include/std/ranges (__func_handle::__select): Named function + extracted from local lambda. + (__detail::__func_handle_t): Define using __func_handle::__select. + (__func_handle::_Inplace): Raname _M_ptr to _M_fn. + +2025-11-27 Jonathan Wakely + + * config/abi/pre/gnu.ver: Adjust exports. + * include/bits/atomic_timed_wait.h (_GLIBCXX_HAVE_PLATFORM_TIMED_WAIT): + Do not define this macro. + (__atomic_wait_address_until_v, __atomic_wait_address_for_v): + Adjust assertions to check that __platform_wait_uses_type is + true. + * include/bits/atomic_wait.h (__waitable): New concept. + (__platform_wait_uses_type): Different separately for platforms + with and without platform wait. + (_GLIBCXX_HAVE_PLATFORM_WAIT): Do not define this macro. + (__wait_value_type): New typedef. + (__wait_result_type): Change _M_val to __wait_value_type. + (__wait_flags): Remove __proxy_wait enumerator. Reduce range + reserved for ABI version by the commented-out value. + (__wait_args_base::_M_old): Change type to __wait_args_base. + (__wait_args_base::_M_obj, __wait_args_base::_M_obj_size): New + data members. + (__wait_args::__wait_args): Set _M_obj and _M_obj_size on + construction. + (__wait_args::_M_setup_wait): Change void* parameter to deduced + type. Adjust bit_cast to work for types of different sizes. + (__wait_args::_M_load_proxy_wait_val): Remove function, replace + with ... + (__wait_args::_M_setup_proxy_wait): New function. + (__wait_args::_S_flags_for): Do not set __proxy_wait flag. + (__atomic_wait_address_v): Adjust assertion to check that + __platform_wait_uses_type is true. + * src/c++20/atomic.cc (_GLIBCXX_HAVE_PLATFORM_WAIT): Define here + instead of in header. Check _GLIBCXX_HAVE_PLATFORM_WAIT instead + of _GLIBCXX_HAVE_PLATFORM_TIMED_WAIT. + (__platform_wait, __platform_notify, __platform_wait_until): Add + unused parameter for _M_obj_size. + (__spin_impl): Adjust for 64-bit __wait_args_base::_M_old. + (use_proxy_wait): New function. + (__wait_args::_M_load_proxy_wait_val): Replace with ... + (__wait_args::_M_setup_proxy_wait): New function. Call + use_proxy_wait to decide at runtime whether to wait on the + pointer directly instead of using a proxy. If a proxy is needed, + set _M_obj and _M_obj_size to refer to its _M_ver member. Adjust + for change to type of _M_old. + (__wait_impl): Wait on _M_obj unconditionally. Pass _M_obj_size + to __platform_wait. + (__notify_impl): Call use_proxy_wait to decide whether to notify + on the address parameter or a proxy + (__spin_until_impl): Adjust for change to type of _M_val. + (__wait_until_impl): Wait on _M_obj unconditionally. Pass + _M_obj_size to __platform_wait_until. + +2025-11-27 Jonathan Wakely + + * include/bits/semaphore_base.h (__platform_semaphore::_S_max): + Limit to PTRDIFF_MAX to avoid negative values. + * testsuite/30_threads/semaphore/least_max_value.cc: New test. + 2025-11-26 Tomasz Kamiński PR libstdc++/122864 From 28bac52566bc4a42b1dcfb1dde0a12fe3b75ed36 Mon Sep 17 00:00:00 2001 From: Tamar Christina Date: Fri, 28 Nov 2025 07:45:51 +0000 Subject: [PATCH 095/373] middle-end: check that the argument is an SSA_NAME before calling get_gimple_for_ssa_name [PR122890] This checks if the arguments of the boolean operation are an SSA_NAME before we try to lookup their definition. gcc/ChangeLog: PR middle-end/122890 * optabs.cc (emit_cmp_and_jump_insns): Check for SSA Name. gcc/testsuite/ChangeLog: PR middle-end/122890 * g++.target/aarch64/pr122890.C: New test. --- gcc/optabs.cc | 13 ++++++++----- gcc/testsuite/g++.target/aarch64/pr122890.C | 16 ++++++++++++++++ 2 files changed, 24 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/g++.target/aarch64/pr122890.C diff --git a/gcc/optabs.cc b/gcc/optabs.cc index 0f1495545a49..183ad910fcd7 100644 --- a/gcc/optabs.cc +++ b/gcc/optabs.cc @@ -4854,13 +4854,15 @@ emit_cmp_and_jump_insns (rtx x, rtx y, enum rtx_code comparison, rtx size, gimple *mask_def = NULL; tree rhs1 = gimple_assign_rhs1 (def_stmt); tree rhs2 = gimple_assign_rhs2 (def_stmt); - if ((mask_def = get_gimple_for_ssa_name (rhs1)) + if (TREE_CODE (rhs1) == SSA_NAME + && (mask_def = get_gimple_for_ssa_name (rhs1)) && is_gimple_assign (mask_def) && TREE_CODE_CLASS (gimple_assign_rhs_code (mask_def))) masked_op = rhs2; - else if ((mask_def = get_gimple_for_ssa_name (rhs2)) - && is_gimple_assign (mask_def) - && TREE_CODE_CLASS (gimple_assign_rhs_code (mask_def))) + else if (TREE_CODE (rhs2) == SSA_NAME + && (mask_def = get_gimple_for_ssa_name (rhs2)) + && is_gimple_assign (mask_def) + && TREE_CODE_CLASS (gimple_assign_rhs_code (mask_def))) masked_op = rhs1; if (masked_op) @@ -4890,7 +4892,8 @@ emit_cmp_and_jump_insns (rtx x, rtx y, enum rtx_code comparison, rtx size, len_bias = gimple_call_arg (call, 4); tree arg0 = gimple_call_arg (call, 0); - def_stmt = get_gimple_for_ssa_name (arg0); + if (TREE_CODE (arg0) == SSA_NAME) + def_stmt = get_gimple_for_ssa_name (arg0); } } diff --git a/gcc/testsuite/g++.target/aarch64/pr122890.C b/gcc/testsuite/g++.target/aarch64/pr122890.C new file mode 100644 index 000000000000..2b7426486d42 --- /dev/null +++ b/gcc/testsuite/g++.target/aarch64/pr122890.C @@ -0,0 +1,16 @@ +/* { dg-do compile } */ +/* { dg-options "-march=armv8-a -std=c++11 -Ofast" } */ + +#include + +int foo() +{ + bool xs[] = { true, true, false, true }; + bool s[] = { true, true, false }; + std::vector x(xs, xs+4); + std::vector g(s, s+3); + g.push_back(true); + if (g != x) + __builtin_abort(); + return 0; +} From 9785d99e281d829b1b97110859ee3b73dffa3b51 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Fri, 28 Nov 2025 10:04:53 +0100 Subject: [PATCH 096/373] match.pd: Re-add (y << x) {<,<=,>,>=} x simplifications [PR122733] Here is my attempt to implement what has been reverted in r16-5648 using ranger. Note also the changes to the equality pattern, first of all, there could be e.g. vector << scalar shifts, although they'll likely fail on the nop_convert vs. nop_convert, but also it would never match for say unsigned long long @0 and unsigned int @1 etc., pretty common cases. The new simplifier asks the ranger about ranges and bitmasks, verifies @0 is non-zero and that clz of the @0 nonzero bits bitmask (i.e. the minimum clz of all possible values of @0) is greater than (or greater than or equal to) maximum shift count. Which one of those depends on if the actual non-equality comparison is signed or unsigned. And gimple_match_range_of_expr now includes in itself undefined_p check and returns false even for that, so that many of the callers don't need to check that. 2025-11-28 Jakub Jelinek PR tree-optimization/122733 * gimple-match-head.cc (gimple_match_range_of_expr): Return false even when range_of_expr returns true, but the range is undefined_p. * match.pd ((mult (plus:s@5 (mult:s@4 @0 @1) @2) @3)): Remove vr0.undefined_p () check. ((plus (mult:s@5 (plus:s@4 @0 @1) @2) @3)): Likewise. ((X + M*N) / N -> X / N + M): Remove vr4.undefined_p () check. ((X - M*N) / N -> X / N - M): Likewise. ((y << x) == x, (y << x) != x): Use convert2? instead of nop_convert2? and test INTEGRAL_TYPE_P on TREE_TYPE (@0) rather than TREE_TYPE (@1). ((y << x) {<,<=,>,>=} x): New simplification. (((T)(A)) + CST -> (T)(A + CST)): Remove vr.undefined_p () check. (x_5 == cstN ? cst4 : cst3): Remove r.undefined_p () check. * gcc.dg/match-shift-cmp-4.c: New test. * gcc.dg/match-shift-cmp-5.c: New test. --- gcc/gimple-match-head.cc | 8 ++-- gcc/match.pd | 42 ++++++++++++++++----- gcc/testsuite/gcc.dg/match-shift-cmp-4.c | 47 ++++++++++++++++++++++++ gcc/testsuite/gcc.dg/match-shift-cmp-5.c | 47 ++++++++++++++++++++++++ 4 files changed, 131 insertions(+), 13 deletions(-) create mode 100644 gcc/testsuite/gcc.dg/match-shift-cmp-4.c create mode 100644 gcc/testsuite/gcc.dg/match-shift-cmp-5.c diff --git a/gcc/gimple-match-head.cc b/gcc/gimple-match-head.cc index f8d0acf81462..895d390455d3 100644 --- a/gcc/gimple-match-head.cc +++ b/gcc/gimple-match-head.cc @@ -529,7 +529,9 @@ gimple_match_ctx (tree op) static inline bool gimple_match_range_of_expr (vrange &r, tree op, tree ctx = NULL_TREE) { - return get_range_query (cfun)->range_of_expr (r, op, - ctx ? gimple_match_ctx (ctx) - : NULL); + if (!get_range_query (cfun)->range_of_expr (r, op, + ctx ? gimple_match_ctx (ctx) + : NULL)) + return false; + return !r.undefined_p (); } diff --git a/gcc/match.pd b/gcc/match.pd index 4ebf394d4a4a..f164ec591008 100644 --- a/gcc/match.pd +++ b/gcc/match.pd @@ -662,7 +662,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) int_range_max vr0; if (ovf1 == wi::OVF_NONE && ovf2 == wi::OVF_NONE && gimple_match_range_of_expr (vr0, @4, @5) - && !vr0.varying_p () && !vr0.undefined_p ()) + && !vr0.varying_p ()) { wide_int wmin0 = vr0.lower_bound (); wide_int wmax0 = vr0.upper_bound (); @@ -703,7 +703,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) int_range_max vr0; if (ovf1 == wi::OVF_NONE && ovf2 == wi::OVF_NONE && gimple_match_range_of_expr (vr0, @0, @4) - && !vr0.varying_p () && !vr0.undefined_p ()) + && !vr0.varying_p ()) { wide_int wmin0 = vr0.lower_bound (); wide_int wmax0 = vr0.upper_bound (); @@ -1079,7 +1079,6 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) /* "X+(N*M)" doesn't overflow. */ && range_op_handler (PLUS_EXPR).overflow_free_p (vr0, vr3) && gimple_match_range_of_expr (vr4, @4) - && !vr4.undefined_p () /* "X+N*M" is not with opposite sign as "X". */ && (TYPE_UNSIGNED (type) || (vr0.nonnegative_p () && vr4.nonnegative_p ()) @@ -1100,7 +1099,6 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) /* "X - (N*M)" doesn't overflow. */ && range_op_handler (MINUS_EXPR).overflow_free_p (vr0, vr3) && gimple_match_range_of_expr (vr4, @4) - && !vr4.undefined_p () /* "X-N*M" is not with opposite sign as "X". */ && (TYPE_UNSIGNED (type) || (vr0.nonnegative_p () && vr4.nonnegative_p ()) @@ -1343,11 +1341,37 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) /* (y << x) == x -> false and (y << x) != x -> true when y != 0. */ (for cmp (eq ne) (simplify - (cmp:c (nop_convert1? (lshift @0 @1)) (nop_convert2? @1)) - (if (INTEGRAL_TYPE_P (TREE_TYPE (@1)) + (cmp:c (nop_convert1? (lshift @0 @1)) (convert2? @1)) + (if (INTEGRAL_TYPE_P (TREE_TYPE (@0)) && tree_expr_nonzero_p (@0)) { constant_boolean_node (cmp != EQ_EXPR, type); }))) +#if GIMPLE +/* (y << x) {<,<=} x -> false and (y << x) {>,>=} x -> true when y != 0 + and (y << x) >> x == y and for signed comparison (y << x) >= 0. */ +(for cmp (gt ge lt le) + (simplify + (cmp:c (nop_convert1?@3 (lshift@2 @0 @1)) (convert2? @1)) + (if (INTEGRAL_TYPE_P (TREE_TYPE (@0))) + (with { bool ok = false; + int_range_max vr0, vr1; + if (gimple_match_range_of_expr (vr0, @0, @2) + && !vr0.varying_p () + && gimple_match_range_of_expr (vr1, @1, @2) + && !vr1.varying_p () + && !vr0.contains_p (wi::zero (TYPE_PRECISION (TREE_TYPE (@0))))) + { + unsigned lz = wi::clz (vr0.get_nonzero_bits ()); + if (!wi::neg_p (vr1.upper_bound (), TYPE_SIGN (TREE_TYPE (@1))) + && wi::ltu_p (vr1.upper_bound (), + wi::uhwi (lz + TYPE_UNSIGNED (TREE_TYPE (@3)), + TYPE_PRECISION (TREE_TYPE (@1))))) + ok = true; + } } + (if (ok) + { constant_boolean_node (cmp == GT_EXPR || cmp == GE_EXPR, type); }))))) +#endif + /* Fold (1 << (C - x)) where C = precision(type) - 1 into ((1 << C) >> x). */ (simplify @@ -4446,8 +4470,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) TYPE_SIGN (inner_type)); int_range_max vr; - if (gimple_match_range_of_expr (vr, @0, @2) - && !vr.varying_p () && !vr.undefined_p ()) + if (gimple_match_range_of_expr (vr, @0, @2) && !vr.varying_p ()) { wide_int wmin0 = vr.lower_bound (); wide_int wmax0 = vr.upper_bound (); @@ -6531,8 +6554,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) || wi::to_widest (@2) == wi::to_widest (@3) + 1)) (with { int_range_max r; - if (!gimple_match_range_of_expr (r, @0, @4) - || r.undefined_p ()) + if (!gimple_match_range_of_expr (r, @0, @4)) r.set_varying (TREE_TYPE (@0)); wide_int min = r.lower_bound (); diff --git a/gcc/testsuite/gcc.dg/match-shift-cmp-4.c b/gcc/testsuite/gcc.dg/match-shift-cmp-4.c new file mode 100644 index 000000000000..c2458d995156 --- /dev/null +++ b/gcc/testsuite/gcc.dg/match-shift-cmp-4.c @@ -0,0 +1,47 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ +/* { dg-final { scan-tree-dump-times "return 0;" 4 "optimized" { target bitint575 } } } */ +/* { dg-final { scan-tree-dump-times "return 0;" 2 "optimized" { target { ! bitint575 } } } } */ +/* { dg-final { scan-tree-dump-not " << " "optimized" } } */ + +bool +foo (unsigned long long x, unsigned y) +{ + if (x >= 64 || x == 0) + __builtin_unreachable (); + if (y > sizeof (unsigned long long) * __CHAR_BIT__ - 6) + __builtin_unreachable (); + return (x << y) <= y; +} + +#if __BITINT_MAXWIDTH__ >= 575 +bool +bar (unsigned _BitInt(575) x, unsigned y) +{ + if (x >= 1361129467683753853853498429727072845823uwb || x == 0) + __builtin_unreachable (); + if (y > 575 - 130) + __builtin_unreachable (); + return (x << y) < y; +} + +bool +baz (unsigned _BitInt(575) x, unsigned y) +{ + if (x >= 1361129467683753853853498429727072845823uwb || x == 0) + __builtin_unreachable (); + if (y >= 575 - 130) + __builtin_unreachable (); + return ((signed _BitInt(575)) (x << y)) < y; +} +#endif + +bool +qux (int x, int y) +{ + if (x >= 128 || x <= 0) + __builtin_unreachable (); + if (y >= sizeof (int) * __CHAR_BIT__ - 7) + __builtin_unreachable (); + return (x << y) <= y; +} diff --git a/gcc/testsuite/gcc.dg/match-shift-cmp-5.c b/gcc/testsuite/gcc.dg/match-shift-cmp-5.c new file mode 100644 index 000000000000..7768f5911501 --- /dev/null +++ b/gcc/testsuite/gcc.dg/match-shift-cmp-5.c @@ -0,0 +1,47 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-optimized" } */ +/* { dg-final { scan-tree-dump-times "return 1;" 4 "optimized" { target bitint575 } } } */ +/* { dg-final { scan-tree-dump-times "return 1;" 2 "optimized" { target { ! bitint575 } } } } */ +/* { dg-final { scan-tree-dump-not " << " "optimized" } } */ + +bool +foo (unsigned long long x, unsigned y) +{ + if (x >= 64 || x == 0) + __builtin_unreachable (); + if (y > sizeof (unsigned long long) * __CHAR_BIT__ - 6) + __builtin_unreachable (); + return (x << y) >= y; +} + +#if __BITINT_MAXWIDTH__ >= 575 +bool +bar (unsigned _BitInt(575) x, unsigned y) +{ + if (x >= 1361129467683753853853498429727072845823uwb || x == 0) + __builtin_unreachable (); + if (y > 575 - 130) + __builtin_unreachable (); + return (x << y) > y; +} + +bool +baz (unsigned _BitInt(575) x, unsigned y) +{ + if (x >= 1361129467683753853853498429727072845823uwb || x == 0) + __builtin_unreachable (); + if (y >= 575 - 130) + __builtin_unreachable (); + return ((signed _BitInt(575)) (x << y)) > y; +} +#endif + +bool +qux (int x, int y) +{ + if (x >= 128 || x <= 0) + __builtin_unreachable (); + if (y >= sizeof (int) * __CHAR_BIT__ - 7) + __builtin_unreachable (); + return (x << y) >= y; +} From 6432b911220b94c2f9d52f61548a28de3dc87498 Mon Sep 17 00:00:00 2001 From: Kuan-Lin Chen Date: Thu, 27 Nov 2025 09:19:28 +0800 Subject: [PATCH 097/373] RISC-V: Add Andes 23 series pipeline description. The Andes 23 series is a 3-stage, in-order execution pipeline and configurable dual-ALU execution. Co-author: Allen Bing-Sung Lu (allen@andestech.com) gcc/ChangeLog: * config/riscv/riscv-cores.def (RISCV_TUNE): Add andes-23-series. (RISCV_CORE): Add Andes 23-series cpu list. * config/riscv/riscv-opts.h (enum riscv_microarchitecture_type): Add andes_23_series. * config/riscv/riscv.cc: Add andes_23_tune_info. * config/riscv/riscv.md: Add andes_23. * doc/riscv-mcpu.texi: Regenerated for Andes cpu list. * doc/riscv-mtune.texi: Regenerated for andes-23-series. * config/riscv/andes-23-series.md: New file. --- gcc/config/riscv/andes-23-series.md | 190 ++++++++++++++++++++++++++++ gcc/config/riscv/riscv-cores.def | 7 + gcc/config/riscv/riscv-opts.h | 1 + gcc/config/riscv/riscv.cc | 25 ++++ gcc/config/riscv/riscv.md | 3 +- gcc/doc/riscv-mcpu.texi | 4 + gcc/doc/riscv-mtune.texi | 2 + 7 files changed, 231 insertions(+), 1 deletion(-) create mode 100644 gcc/config/riscv/andes-23-series.md diff --git a/gcc/config/riscv/andes-23-series.md b/gcc/config/riscv/andes-23-series.md new file mode 100644 index 000000000000..8e19e05da17d --- /dev/null +++ b/gcc/config/riscv/andes-23-series.md @@ -0,0 +1,190 @@ +;; DFA-based pipeline description for Andes 23 series. +;; +;; Copyright (C) 2025 Free Software Foundation, Inc. +;; +;; This file is part of GCC. +;; +;; GCC is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; GCC is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +;; License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GCC; see the file COPYING3. If not see +;; . + +(define_automaton "andes_23_arch") + +(define_cpu_unit + "andes_23_alu0, andes_23_alu1, andes_23_lsu0, + andes_23_lsu1, andes_23_lsu2" + "andes_23_arch") + +(define_cpu_unit "andes_23_mdu" "andes_23_arch") +(define_cpu_unit "andes_23_fpu" "andes_23_arch") + +;; andes 23 unsupported insns are mapped to dummies reservations +(define_reservation "andes_23_dummies" + "andes_23_alu0 | andes_23_alu1 | andes_23_lsu0 | andes_23_lsu1 | + andes_23_lsu2 | andes_23_mdu | andes_23_fpu") + +(define_reservation "andes_23_alu" + "andes_23_alu0 | andes_23_alu1") + +(define_reservation "andes_23_lsu" + "andes_23_lsu0 | andes_23_lsu1 | andes_23_lsu2") + +(define_reservation "andes_23_pipe_unify" + "andes_23_alu0 + andes_23_alu1") + +(define_insn_reservation "andes_23_alu_insn" 1 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "unknown,const,arith,slt,multi,nop,move, + shift,logical,mvpair,auipc")) + "andes_23_alu") + +(define_insn_reservation "andes_23_load" 3 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "load")) + "andes_23_pipe_unify, andes_23_lsu*3") + +(define_insn_reservation "andes_23_store" 0 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "store")) + "andes_23_pipe_unify,andes_23_lsu*3") + +(define_insn_reservation "andes_23_branch" 0 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "branch,jump,call,jalr,ret,trap")) + "andes_23_pipe_unify") + +(define_insn_reservation "andes_23_imul" 2 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "imul")) + "andes_23_alu0, andes_23_mdu") + +(define_insn_reservation "andes_23_idivsi" 35 + (and (eq_attr "tune" "andes_23_series") + (and (eq_attr "type" "idiv") + (eq_attr "mode" "SI"))) + "andes_23_pipe_unify, andes_23_mdu* 34") + +(define_insn_reservation "andes_23_idivdi" 35 + (and (eq_attr "tune" "andes_23_series") + (and (eq_attr "type" "idiv") + (eq_attr "mode" "DI"))) + "andes_23_pipe_unify, andes_23_mdu* 34") + +(define_insn_reservation "andes_23_xfer" 1 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "mfc,mtc")) + "andes_23_alu") + +(define_insn_reservation "andes_23_fpu_alu" 4 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "fadd")) + "andes_23_pipe_unify, andes_23_fpu") + +(define_insn_reservation "andes_23_fpu_mul" 4 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "fmul")) + "andes_23_pipe_unify, andes_23_fpu") + +(define_insn_reservation "andes_23_fpu_mac" 4 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "fmadd")) + "andes_23_pipe_unify, andes_23_fpu") + +(define_insn_reservation "andes_23_fpu_div" 33 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "fdiv")) + "andes_23_pipe_unify, andes_23_fpu*33") + +(define_insn_reservation "andes_23_fpu_sqrt" 33 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "fsqrt")) + "andes_23_pipe_unify, andes_23_fpu*33") + +(define_insn_reservation "andes_23_fpu_move" 2 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "fmove,mtc,mfc")) + "andes_23_pipe_unify, andes_23_fpu") + +(define_insn_reservation "andes_23_fpu_cmp" 3 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "fcmp")) + "andes_23_pipe_unify, andes_23_fpu") + +(define_insn_reservation "andes_23_fpu_cvt" 3 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "fcvt,fcvt_i2f,fcvt_f2i")) + "andes_23_pipe_unify, andes_23_fpu") + +(define_insn_reservation "andes_23_fpu_load" 3 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "fpload")) + "andes_23_pipe_unify, andes_23_lsu*3") + +(define_insn_reservation "andes_23_fpu_store" 0 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "fpstore")) + "andes_23_pipe_unify, andes_23_lsu*3") + +(define_insn_reservation "andes_23_bitmanip" 1 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "bitmanip,minu,maxu,min,max,clmul,rotate,cpop,clz,ctz")) + "andes_23_alu0") + +(define_insn_reservation "andes_23_crypto" 1 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "crypto")) + "andes_23_alu0") + +(define_bypass 3 + "andes_23_fpu_mul" + "andes_23_fpu_alu,andes_23_fpu_mac, + andes_23_fpu_div,andes_23_fpu_sqrt") + +(define_bypass 3 + "andes_23_fpu_alu" + "andes_23_fpu_mul,andes_23_fpu_alu,andes_23_fpu_mac, + andes_23_fpu_div,andes_23_fpu_sqrt") + +(define_bypass 3 + "andes_23_fpu_mac" + "andes_23_fpu_mul,andes_23_fpu_alu,andes_23_fpu_mac, + andes_23_fpu_div,andes_23_fpu_sqrt") + +(define_bypass 2 + "andes_23_fpu_load" + "andes_23_fpu_div,andes_23_fpu_sqrt") + +(define_insn_reservation "andes_23_unknown" 1 + (and (eq_attr "tune" "andes_23_series") + (eq_attr "type" "ghost,zicond,mvpair,sfb_alu,condmove,atomic, + vclz,vror,vsha2ch,vsm4k,vaesef,vghsh,vsm4r,vsm3c, + vaeskf1,vandn,vaesdm,vclmul,vclmulh,vrol,vcpop,vbrev8, + vsm3me,vbrev,vctz,vgmul,vsha2ms,vaesz,vrev8, + vaeskf2,vsha2cl,vwsll,vaesdf,vaesem,vfwmaccbf16, + sf_vqmacc,sf_vc,sf_vc_se,sf_vfnrclip,vmsfs,vfwalu, + vnshift,vldm,vslidedown,vicmp,vfcvtftoi,vmffs,vlsegdux, + vfredo,vstux,vsshift,vfwcvtbf16,vmpop,vicalu,vldff, + vislide1down,vstox,vfwcvtftof,vfmov,vislide1up,vldr, + vfmul,vfrecp,vfncvtitof,vfwcvtftoi,vsts,viminmax,vext, + vaalu,vfdiv,vidiv,viwalu,vssegte,wrvxrm,vfmovvf,vlde, + vfclass,vshift,vimovxv,vssegtox,vfsqrt,vector,vmalu, + vfcvtitof,vlsegdff,vfslide1down,vimov,vialu,vmidx, + vsalu,vfmerge,rdvl,vlds,vfmuladd,vfsgnj,vslideup, + vfcmp,vfmovfv,vfwcvtitof,vfwmuladd,vfwredo,vlsegdox, + viwmul,vldox,vsmul,vstm,vfminmax,vmov,vfalu,vfncvtbf16, + vnclip,vimerge,vfwmul,vimovvx,vfncvtftoi,viwred,rdvlenb, + vfslide1up,vfncvtftof,vsetvl,viwmuladd,vfredu,vfwredu, + vlsegde,vmiota,vstr,vgather,vssegts,vldux,vlsegds,vimul, + vste,vsetvl_pre,vimuladd,vcompress,vssegtux,wrfrm,rdfrm, + vired")) + "andes_23_dummies") diff --git a/gcc/config/riscv/riscv-cores.def b/gcc/config/riscv/riscv-cores.def index abe9d496cda6..e5f093e58192 100644 --- a/gcc/config/riscv/riscv-cores.def +++ b/gcc/config/riscv/riscv-cores.def @@ -55,6 +55,7 @@ RISCV_TUNE("generic-ooo", generic_ooo, generic_ooo_tune_info) RISCV_TUNE("size", generic, optimize_size_tune_info) RISCV_TUNE("mips-p8700", mips_p8700, mips_p8700_tune_info) RISCV_TUNE("andes-25-series", andes_25_series, andes_25_tune_info) +RISCV_TUNE("andes-23-series", andes_23_series, andes_23_tune_info) #undef RISCV_TUNE @@ -181,6 +182,12 @@ RISCV_CORE("andes-nx25", "rv64imc_zicsr_zifencei_xandesperf", "andes-25- RISCV_CORE("andes-ax25", "rv64imafdc_zicsr_zifencei_xandesperf", "andes-25-series") RISCV_CORE("andes-a27", "rv32imafdc_zicsr_zifencei_xandesperf", "andes-25-series") RISCV_CORE("andes-ax27", "rv64imafdc_zicsr_zifencei_xandesperf", "andes-25-series") +RISCV_CORE("andes-n225", "rv32im_zicsr_zifencei_zca_zcb_zcmp_zcmt_" + "zba_zbb_zbc_zbs_xandesperf", + "andes-23-series") +RISCV_CORE("andes-d23", "rv32im_zicsr_zifencei_zicbop_zicbom_zicboz_" + "zca_zcb_zcmp_zcmt_zba_zbb_zbc_zbs_xandesperf", + "andes-23-series") RISCV_CORE("spacemit-x60", "rv64imafdcv_zba_zbb_zbc_zbs_zicboz_zicond_" "zbkc_zfh_zvfh_zvkt_zvl256b_sscofpmf", "spacemit-x60") diff --git a/gcc/config/riscv/riscv-opts.h b/gcc/config/riscv/riscv-opts.h index bca5382485c3..ec58554b1728 100644 --- a/gcc/config/riscv/riscv-opts.h +++ b/gcc/config/riscv/riscv-opts.h @@ -62,6 +62,7 @@ enum riscv_microarchitecture_type { mips_p8700, tt_ascalon_d8, andes_25_series, + andes_23_series, spacemit_x60, }; extern enum riscv_microarchitecture_type riscv_microarchitecture; diff --git a/gcc/config/riscv/riscv.cc b/gcc/config/riscv/riscv.cc index 2d14b3c92f57..c3c4021c6a8b 100644 --- a/gcc/config/riscv/riscv.cc +++ b/gcc/config/riscv/riscv.cc @@ -784,6 +784,31 @@ static const struct riscv_tune_param spacemit_x60_tune_info= { true, /* prefer-agnostic. */ }; +/* Costs to use when optimizing for Andes 23 series. */ +static const struct riscv_tune_param andes_23_tune_info = { + {COSTS_N_INSNS (4), COSTS_N_INSNS (5)}, /* fp_add */ + {COSTS_N_INSNS (4), COSTS_N_INSNS (5)}, /* fp_mul */ + {COSTS_N_INSNS (20), COSTS_N_INSNS (20)}, /* fp_div */ + {COSTS_N_INSNS (2), COSTS_N_INSNS (2)}, /* int_mul */ + {COSTS_N_INSNS (24), COSTS_N_INSNS (24)}, /* int_div */ + 2, /* issue_rate */ + 3, /* branch_cost */ + 3, /* memory_cost */ + 8, /* fmv_cost */ + false, /* slow_unaligned_access */ + false, /* vector_unaligned_access */ + true, /* use_divmod_expansion */ + false, /* overlap_op_by_pieces */ + false, /* use_zero_stride_load */ + false, /* speculative_sched_vsetvl */ + RISCV_FUSE_NOTHING, /* fusible_ops */ + NULL, /* vector cost */ + NULL, /* function_align */ + NULL, /* jump_align */ + NULL, /* loop_align */ + true, /* prefer-agnostic. */ +}; + static bool riscv_avoid_shrink_wrapping_separate (); static tree riscv_handle_fndecl_attribute (tree *, tree, tree, int, bool *); static tree riscv_handle_type_attribute (tree *, tree, tree, int, bool *); diff --git a/gcc/config/riscv/riscv.md b/gcc/config/riscv/riscv.md index affccec2b5e6..aa4631e15a4c 100644 --- a/gcc/config/riscv/riscv.md +++ b/gcc/config/riscv/riscv.md @@ -674,7 +674,7 @@ ;; Keep this in sync with enum riscv_microarchitecture. (define_attr "tune" "generic,sifive_7,sifive_p400,sifive_p600,xiangshan,generic_ooo,mips_p8700, - tt_ascalon_d8,andes_25_series,spacemit_x60" + tt_ascalon_d8,andes_25_series,andes_23_series,spacemit_x60" (const (symbol_ref "((enum attr_tune) riscv_microarchitecture)"))) ;; Describe a user's asm statement. @@ -4989,5 +4989,6 @@ (include "generic-vector-ooo.md") (include "generic-ooo.md") (include "tt-ascalon-d8.md") +(include "andes-23-series.md") (include "andes-25-series.md") (include "spacemit-x60.md") diff --git a/gcc/doc/riscv-mcpu.texi b/gcc/doc/riscv-mcpu.texi index 8fcba597ad19..8875ff5bcb99 100644 --- a/gcc/doc/riscv-mcpu.texi +++ b/gcc/doc/riscv-mcpu.texi @@ -82,4 +82,8 @@ by particular CPU name. Permissible values for this option are: @samp{andes-ax27}, +@samp{andes-n225}, + +@samp{andes-d23}, + @samp{spacemit-x60}. diff --git a/gcc/doc/riscv-mtune.texi b/gcc/doc/riscv-mtune.texi index 02fcd342384a..578a641b2ba7 100644 --- a/gcc/doc/riscv-mtune.texi +++ b/gcc/doc/riscv-mtune.texi @@ -60,4 +60,6 @@ particular CPU name. Permissible values for this option are: @samp{andes-25-series}, +@samp{andes-23-series}, + and all valid options for @option{-mcpu=}. From 3d3a3e20a052363358f47434b0d2d93d974d401f Mon Sep 17 00:00:00 2001 From: Kuan-Lin Chen Date: Thu, 27 Nov 2025 09:33:54 +0800 Subject: [PATCH 098/373] RISC-V: Add Andes 45 series pipeline description. The Andes 45 series is a 8-stage, in-order, and dual-issue execution pipeline. Co-author: Allen Bing-Sung Lu (allen@andestech.com) gcc/ChangeLog: * config/riscv/riscv-cores.def (RISCV_TUNE): Add andes-45-sereis. (RISCV_CORE): Add Andes 45 series cpu list. * config/riscv/riscv-opts.h (enum riscv_microarchitecture_type): Add andes_45_series. * config/riscv/riscv.cc: Add andes_45_tune_info. * config/riscv/riscv.md: Add andes_45. * doc/riscv-mcpu.texi: Regenerated for Andes cpu list. * doc/riscv-mtune.texi: Regenerated for andes-45-series. * config/riscv/andes-45-series.md: New file. --- gcc/config/riscv/andes-45-series.md | 379 ++++++++++++++++++++++++++++ gcc/config/riscv/riscv-cores.def | 6 + gcc/config/riscv/riscv-opts.h | 1 + gcc/config/riscv/riscv.cc | 25 ++ gcc/config/riscv/riscv.md | 3 +- gcc/doc/riscv-mcpu.texi | 8 + gcc/doc/riscv-mtune.texi | 2 + 7 files changed, 423 insertions(+), 1 deletion(-) create mode 100644 gcc/config/riscv/andes-45-series.md diff --git a/gcc/config/riscv/andes-45-series.md b/gcc/config/riscv/andes-45-series.md new file mode 100644 index 000000000000..7693db84746b --- /dev/null +++ b/gcc/config/riscv/andes-45-series.md @@ -0,0 +1,379 @@ +;; DFA-based pipeline description for Andes 45 series. +;; +;; Copyright (C) 2025 Free Software Foundation, Inc. +;; +;; This file is part of GCC. +;; +;; GCC is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published +;; by the Free Software Foundation; either version 3, or (at your +;; option) any later version. + +;; GCC is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +;; License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GCC; see the file COPYING3. If not see +;; . + +(define_automaton "andes_45_arch, andes_45_vector") + +(define_cpu_unit "andes_45_pipe0" "andes_45_arch") +(define_cpu_unit "andes_45_pipe1" "andes_45_arch") +(define_cpu_unit "andes_45_vpu_pipe0" "andes_45_vector") +(define_cpu_unit "andes_45_vpu_pipe1" "andes_45_vector") + +(define_reservation "andes_45_vpu_pipe" "(andes_45_vpu_pipe0 + andes_45_pipe0 | andes_45_vpu_pipe1 + andes_45_pipe1)") + +(define_cpu_unit "andes_45_mdu,andes_45_alu0,andes_45_alu1,andes_45_bru0,andes_45_bru1,andes_45_lsu" "andes_45_arch") +(define_cpu_unit "andes_45_fpu_fmac,andes_45_fpu_fdiv,andes_45_fpu_fmis,andes_45_fpu_fmv" "andes_45_arch") +(define_cpu_unit "andes_45_vpu_alu,andes_45_vpu_mac,andes_45_vpu_fmis,andes_45_vpu_permut, + andes_45_vpu_div,andes_45_vpu_fdiv,andes_45_vpu_mask,andes_45_vpu_lsu" "andes_45_vector") + +(define_reservation "andes_45_fpu_arith" + "andes_45_pipe0 + andes_45_fpu_fmac | andes_45_pipe1 + andes_45_fpu_fmac") + +;; andes 45 series unsupported insns are mapped to dummies reservations +(define_reservation "andes_45_dummies" + "andes_45_pipe0 | andes_45_pipe1, andes_45_alu0 | andes_45_alu1") + +;; andes 45 series vector unsupported insns are mapped to dummies reservations +(define_reservation "andes_45_vector_dummies" + "andes_45_pipe0 | andes_45_pipe1, andes_45_vpu_alu") + +(define_insn_reservation "andes_45_alu_insn_s" 1 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "shift,nop,logical")) + "andes_45_pipe0 + andes_45_alu0 | andes_45_pipe1 + andes_45_alu1") + +(define_insn_reservation "andes_45_alu_insn_l" 2 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "unknown,const,arith,multi,slt,move,auipc,atomic,bitmanip")) + "andes_45_pipe0 + andes_45_alu0 | andes_45_pipe1 + andes_45_alu1") + +(define_insn_reservation "andes_45_cmov" 1 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "condmove")) + "andes_45_pipe0 + andes_45_alu0 + andes_45_pipe1 + andes_45_alu1") + +(define_insn_reservation "andes_45_load_wd" 4 + (and (eq_attr "tune" "andes_45_series") + (and (eq_attr "type" "load") + (not (eq_attr "mode" "QI,HI")))) + "andes_45_pipe0 + andes_45_lsu | andes_45_pipe1 + andes_45_lsu") + +(define_insn_reservation "andes_45_load_bh" 5 + (and (eq_attr "tune" "andes_45_series") + (and (eq_attr "type" "load") + (eq_attr "mode" "QI,HI"))) + "andes_45_pipe0 + andes_45_lsu | andes_45_pipe1 + andes_45_lsu") + +(define_insn_reservation "andes_45_store_d" 0 + (and (eq_attr "tune" "andes_45_series") + (and (eq_attr "type" "store") + (eq_attr "mode" "DI,SI"))) + "andes_45_pipe0 + andes_45_lsu | andes_45_pipe1 + andes_45_lsu") + +(define_insn_reservation "andes_45_store" 0 + (and (eq_attr "tune" "andes_45_series") + (and (eq_attr "type" "store") + (not (eq_attr "mode" "DI,SI")))) + "andes_45_pipe0 + andes_45_pipe1 + andes_45_lsu") + +(define_insn_reservation "andes_45_branch" 1 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "branch,jump,call,ret,jalr,trap")) + "andes_45_pipe0 + andes_45_bru0 | andes_45_pipe1 + andes_45_bru1") + +(define_insn_reservation "andes_45_imul" 3 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "imul")) + "andes_45_pipe0 + andes_45_alu0 | andes_45_pipe1 + andes_45_alu1, andes_45_mdu * 2") + +(define_insn_reservation "andes_45_idivsi" 38 + (and (eq_attr "tune" "andes_45_series") + (and (eq_attr "type" "idiv") + (eq_attr "mode" "SI"))) + "andes_45_pipe0 + andes_45_alu0 | andes_45_pipe1 + andes_45_alu1, andes_45_mdu * 2") + +(define_insn_reservation "andes_45_idivdi" 70 + (and (eq_attr "tune" "andes_45_series") + (and (eq_attr "type" "idiv") + (eq_attr "mode" "DI"))) + "andes_45_pipe0 + andes_45_alu0 | andes_45_pipe1 + andes_45_alu1, andes_45_mdu * 2") + +(define_insn_reservation "andes_45_xfer" 1 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "mfc,mtc")) + "andes_45_pipe0 + andes_45_alu0 | andes_45_pipe1 + andes_45_alu1") + +(define_insn_reservation "andes_45_fpu_alu_s" 3 + (and (eq_attr "tune" "andes_45_series") + (and (eq_attr "type" "fadd") + (eq_attr "mode" "SF"))) + "andes_45_fpu_arith") + +(define_insn_reservation "andes_45_fpu_alu_d" 4 + (and (eq_attr "tune" "andes_45_series") + (and (eq_attr "type" "fadd") + (eq_attr "mode" "DF"))) + "andes_45_fpu_arith") + +(define_insn_reservation "andes_45_fpu_mul_s" 3 + (and (eq_attr "tune" "andes_45_series") + (and (eq_attr "type" "fmul") + (eq_attr "mode" "SF"))) + "andes_45_fpu_arith") + +(define_insn_reservation "andes_45_fpu_mul_d" 4 + (and (eq_attr "tune" "andes_45_series") + (and (eq_attr "type" "fmul") + (eq_attr "mode" "DF"))) + "andes_45_fpu_arith") + +(define_insn_reservation "andes_45_fpu_mac_s" 3 + (and (eq_attr "tune" "andes_45_series") + (and (eq_attr "type" "fmadd") + (eq_attr "mode" "SF"))) + "(andes_45_pipe0 | andes_45_pipe1) + andes_45_fpu_fmac + andes_45_fpu_fmv + andes_45_fpu_fmis") + +(define_insn_reservation "andes_45_fpu_mac_d" 4 + (and (eq_attr "tune" "andes_45_series") + (and (eq_attr "type" "fmadd") + (eq_attr "mode" "DF"))) + "(andes_45_pipe0 | andes_45_pipe1) + andes_45_fpu_fmac + andes_45_fpu_fmv + andes_45_fpu_fmis") + +(define_insn_reservation "andes_45_fpu_div" 33 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "fdiv")) + "andes_45_pipe0 + andes_45_fpu_fdiv | andes_45_pipe1 + andes_45_fpu_fdiv, andes_45_fpu_fdiv * 27") + +(define_insn_reservation "andes_45_fpu_sqrt" 33 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "fsqrt")) + "andes_45_pipe0 + andes_45_fpu_fdiv | andes_45_pipe1 + andes_45_fpu_fdiv, andes_45_fpu_fdiv * 27") + +(define_insn_reservation "andes_45_fpu_move" 1 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "fmove,mtc,mfc")) + "andes_45_pipe0 + andes_45_fpu_fmv | andes_45_pipe1 + andes_45_fpu_fmv") + +(define_insn_reservation "andes_45_fpu_cmp" 2 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "fcmp")) + "andes_45_pipe0 + andes_45_fpu_fmis | andes_45_pipe1 + andes_45_fpu_fmis") + +(define_insn_reservation "andes_45_fpu_cvt" 2 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "fcvt,fcvt_f2i,fcvt_i2f")) + "andes_45_pipe0 + andes_45_fpu_fmis | andes_45_pipe1 + andes_45_fpu_fmis") + +(define_insn_reservation "andes_45_fpu_load" 4 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "fpload")) + "andes_45_pipe0 + andes_45_pipe1 + andes_45_lsu") + +(define_insn_reservation "andes_45_fpu_store" 0 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "fpstore")) + "andes_45_pipe0 + andes_45_pipe1 + andes_45_lsu") + +(define_insn_reservation "andes_45_vpu_load_e" 8 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vlde,vldm,vldr,vlsegde,vldff,vlsegdff")) + "(andes_45_vpu_pipe + andes_45_vpu_lsu), andes_45_vpu_lsu * 2") + +(define_insn_reservation "andes_45_vpu_load_s" 10 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vlds,vlsegds")) + "(andes_45_vpu_pipe + andes_45_vpu_lsu), andes_45_vpu_lsu * 3") + +(define_insn_reservation "andes_45_vpu_load_x" 12 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vldox,vldux,vlsegdox,vlsegdux")) + "(andes_45_vpu_pipe + andes_45_vpu_lsu), andes_45_vpu_lsu * 4") + +(define_insn_reservation "andes_45_vpu_store" 0 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vste,vstm,vstr,vsts,vstux,vstox,vssegtox,vssegte, + vssegtux,vssegts")) + "andes_45_vpu_pipe + andes_45_lsu + andes_45_vpu_lsu") + +(define_insn_reservation "andes_45_vpu_alu" 2 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vialu,viwalu,vicalu,vsalu,vaalu,vector")) + "andes_45_vpu_pipe + andes_45_vpu_alu") + +(define_insn_reservation "andes_45_vpu_ext" 3 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vext")) + "andes_45_vpu_pipe + andes_45_vpu_permut") + +(define_insn_reservation "andes_45_vpu_shift" 2 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vshift,vnshift,vsshift")) + "andes_45_vpu_pipe + andes_45_vpu_alu") + +(define_insn_reservation "andes_45_vpu_minmax" 2 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "viminmax")) + "andes_45_vpu_pipe + andes_45_vpu_alu") + +(define_insn_reservation "andes_45_vpu_cmp" 2 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vicmp")) + "andes_45_vpu_pipe + andes_45_vpu_alu") + +(define_insn_reservation "andes_45_vpu_mul" 3 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vimul,viwmul,vsmul")) + "andes_45_vpu_pipe + andes_45_vpu_mac") + +(define_insn_reservation "andes_45_vpu_div" 36 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vidiv")) + "andes_45_vpu_pipe + andes_45_vpu_div * 35") + +(define_insn_reservation "andes_45_vpu_madd" 4 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vimuladd,viwmuladd")) + "andes_45_vpu_pipe + andes_45_vpu_mac") + +(define_insn_reservation "andes_45_vpu_merge" 2 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vimerge")) + "andes_45_vpu_pipe + andes_45_vpu_alu") + +(define_insn_reservation "andes_45_vpu_move" 3 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vimov,vimovvx,vimovxv,vmov,vslideup,vslidedown,vislide1up,vislide1down")) + "andes_45_vpu_pipe + andes_45_vpu_permut") + +(define_insn_reservation "andes_45_vpu_clip" 3 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vnclip")) + "andes_45_vpu_pipe + andes_45_vpu_alu") + +(define_insn_reservation "andes_45_vpu_falu" 4 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vfalu,vfwalu,vfmul,vfwmul")) + "andes_45_vpu_pipe + andes_45_vpu_mac") + +(define_insn_reservation "andes_45_vpu_fdiv" 38 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vfdiv,vfsqrt")) + "andes_45_vpu_pipe + andes_45_vpu_fdiv") + +(define_insn_reservation "andes_45_vpu_fmadd" 5 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vfmuladd,vfwmuladd")) + "andes_45_vpu_pipe + andes_45_vpu_mac") + +(define_insn_reservation "andes_45_vpu_fminmax" 2 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vfminmax")) + "andes_45_vpu_pipe + andes_45_vpu_fmis") + +(define_insn_reservation "andes_45_vpu_fcmp" 3 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vfcmp,vfrecp")) + "andes_45_vpu_pipe + andes_45_vpu_fmis") + +(define_insn_reservation "andes_45_vpu_fsgnj" 2 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vfsgnj")) + "andes_45_vpu_pipe + andes_45_vpu_fmis") + +(define_insn_reservation "andes_45_vpu_fclass" 2 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vfclass")) + "andes_45_vpu_pipe + andes_45_vpu_fmis") + +(define_insn_reservation "andes_45_vpu_fmerge" 2 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vfmerge")) + "andes_45_vpu_pipe + andes_45_vpu_fmis") + +(define_insn_reservation "andes_45_vpu_fmove" 2 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vfmov,vfmovvf,vfmovfv,vfslide1up,vfslide1down")) + "andes_45_vpu_pipe + andes_45_vpu_permut") + +(define_insn_reservation "andes_45_vpu_fcvt" 3 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vfcvtitof,vfcvtftoi,vfwcvtitof,vfwcvtftoi,vfwcvtftof, + vfncvtitof,vfncvtftoi,vfncvtftof,vfwcvtbf16,vfncvtbf16")) + "andes_45_vpu_pipe + andes_45_vpu_fmis") + +(define_insn_reservation "andes_45_vpu_red" 9 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vired,viwred")) + "andes_45_vpu_pipe + andes_45_vpu_alu") + +(define_insn_reservation "andes_45_vpu_fredu" 6 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vfredu,vfwredu")) + "andes_45_vpu_pipe + andes_45_vpu_mac") + +(define_insn_reservation "andes_45_vpu_fredo" 34 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vfredo,vfwredo")) + "andes_45_vpu_pipe + andes_45_vpu_mac") + +(define_insn_reservation "andes_45_vpu_malu" 3 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vmalu")) + "andes_45_vpu_pipe + andes_45_vpu_mask") + +(define_insn_reservation "andes_45_vpu_mask" 4 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vmpop,vmffs,vmsfs,vmiota,vmidx")) + "andes_45_vpu_pipe + andes_45_vpu_mask") + +(define_insn_reservation "andes_45_vpu_gather" 2 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vgather")) + "andes_45_vpu_pipe + andes_45_vpu_permut") + +(define_insn_reservation "andes_45_vpu_compress" 4 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vcompress")) + "andes_45_vpu_pipe + andes_45_vpu_permut") + +(define_insn_reservation "andes_45_vcpu_csr" 1 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "wrvxrm,wrfrm,rdvlenb,rdvl,vsetvl,vsetvl_pre")) + "andes_45_vpu_pipe") + +(define_bypass 1 + "andes_45_fpu_alu_s, andes_45_fpu_mul_s, andes_45_fpu_mac_s" + "andes_45_load_wd, andes_45_load_bh, andes_45_store, + andes_45_fpu_load, andes_45_fpu_store") + +(define_bypass 2 + "andes_45_fpu_alu_d, andes_45_fpu_mul_d, andes_45_fpu_mac_d" + "andes_45_load_wd, andes_45_load_bh, andes_45_store, + andes_45_fpu_load, andes_45_fpu_store") + +(define_bypass 1 + "andes_45_fpu_cmp, andes_45_fpu_cvt" + "andes_45_load_wd, andes_45_load_bh, andes_45_store, + andes_45_fpu_load, andes_45_fpu_store, andes_45_alu_insn_s, + andes_45_alu_insn_l, andes_45_xfer") + +(define_insn_reservation "andes_45_unknown" 1 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "ghost,cpop,clz,ctz,zicond,mvpair,sfb_alu,minu,maxu, + min,max,clmul,rotate,crypto,condmove,rdfrm")) + "andes_45_dummies") + +(define_insn_reservation "andes_45_vector_unknown" 1 + (and (eq_attr "tune" "andes_45_series") + (eq_attr "type" "vclz,vror,vsha2ch,vsm4k,vaesef,vghsh,vsm4r,vsm3c, + vaeskf1,vandn,vaesdm,vclmul,vclmulh,vrol,vcpop,vbrev8, + vsm3me,vbrev,vctz,vgmul,vsha2ms,vaesz,vrev8, + vaeskf2,vsha2cl,vwsll,vaesdf,vaesem,vfwmaccbf16, + sf_vqmacc,sf_vc,sf_vc_se,sf_vfnrclip,vlsegde")) + "andes_45_vector_dummies") diff --git a/gcc/config/riscv/riscv-cores.def b/gcc/config/riscv/riscv-cores.def index e5f093e58192..12b27c959585 100644 --- a/gcc/config/riscv/riscv-cores.def +++ b/gcc/config/riscv/riscv-cores.def @@ -56,6 +56,7 @@ RISCV_TUNE("size", generic, optimize_size_tune_info) RISCV_TUNE("mips-p8700", mips_p8700, mips_p8700_tune_info) RISCV_TUNE("andes-25-series", andes_25_series, andes_25_tune_info) RISCV_TUNE("andes-23-series", andes_23_series, andes_23_tune_info) +RISCV_TUNE("andes-45-series", andes_45_series, andes_45_tune_info) #undef RISCV_TUNE @@ -188,6 +189,11 @@ RISCV_CORE("andes-n225", "rv32im_zicsr_zifencei_zca_zcb_zcmp_zcmt_" RISCV_CORE("andes-d23", "rv32im_zicsr_zifencei_zicbop_zicbom_zicboz_" "zca_zcb_zcmp_zcmt_zba_zbb_zbc_zbs_xandesperf", "andes-23-series") +RISCV_CORE("andes-n45", "rv32imc_zicsr_zifencei_xandesperf", "andes-45-series") +RISCV_CORE("andes-nx45", "rv64imc_zicsr_zifencei_xandesperf", "andes-45-series") +RISCV_CORE("andes-a45", "rv32imafdc_zicsr_zifencei_xandesperf", "andes-45-series") +RISCV_CORE("andes-ax45", "rv64imafdc_zicsr_zifencei_xandesperf", "andes-45-series") + RISCV_CORE("spacemit-x60", "rv64imafdcv_zba_zbb_zbc_zbs_zicboz_zicond_" "zbkc_zfh_zvfh_zvkt_zvl256b_sscofpmf", "spacemit-x60") diff --git a/gcc/config/riscv/riscv-opts.h b/gcc/config/riscv/riscv-opts.h index ec58554b1728..9b92a965e27f 100644 --- a/gcc/config/riscv/riscv-opts.h +++ b/gcc/config/riscv/riscv-opts.h @@ -63,6 +63,7 @@ enum riscv_microarchitecture_type { tt_ascalon_d8, andes_25_series, andes_23_series, + andes_45_series, spacemit_x60, }; extern enum riscv_microarchitecture_type riscv_microarchitecture; diff --git a/gcc/config/riscv/riscv.cc b/gcc/config/riscv/riscv.cc index c3c4021c6a8b..63ac9d841831 100644 --- a/gcc/config/riscv/riscv.cc +++ b/gcc/config/riscv/riscv.cc @@ -809,6 +809,31 @@ static const struct riscv_tune_param andes_23_tune_info = { true, /* prefer-agnostic. */ }; +/* Costs to use when optimizing for Andes 45 series. */ +static const struct riscv_tune_param andes_45_tune_info = { + {COSTS_N_INSNS (4), COSTS_N_INSNS (5)}, /* fp_add */ + {COSTS_N_INSNS (4), COSTS_N_INSNS (5)}, /* fp_mul */ + {COSTS_N_INSNS (20), COSTS_N_INSNS (20)}, /* fp_div */ + {COSTS_N_INSNS (2), COSTS_N_INSNS (2)}, /* int_mul */ + {COSTS_N_INSNS (24), COSTS_N_INSNS (24)}, /* int_div */ + 2, /* issue_rate */ + 3, /* branch_cost */ + 3, /* memory_cost */ + 8, /* fmv_cost */ + false, /* slow_unaligned_access */ + false, /* vector_unaligned_access */ + true, /* use_divmod_expansion */ + false, /* overlap_op_by_pieces */ + false, /* use_zero_stride_load */ + false, /* speculative_sched_vsetvl */ + RISCV_FUSE_NOTHING, /* fusible_ops */ + NULL, /* vector cost */ + NULL, /* function_align */ + NULL, /* jump_align */ + NULL, /* loop_align */ + true, /* prefer-agnostic. */ +}; + static bool riscv_avoid_shrink_wrapping_separate (); static tree riscv_handle_fndecl_attribute (tree *, tree, tree, int, bool *); static tree riscv_handle_type_attribute (tree *, tree, tree, int, bool *); diff --git a/gcc/config/riscv/riscv.md b/gcc/config/riscv/riscv.md index aa4631e15a4c..6f8cd26e5c95 100644 --- a/gcc/config/riscv/riscv.md +++ b/gcc/config/riscv/riscv.md @@ -674,7 +674,7 @@ ;; Keep this in sync with enum riscv_microarchitecture. (define_attr "tune" "generic,sifive_7,sifive_p400,sifive_p600,xiangshan,generic_ooo,mips_p8700, - tt_ascalon_d8,andes_25_series,andes_23_series,spacemit_x60" + tt_ascalon_d8,andes_25_series,andes_23_series,andes_45_series,spacemit_x60" (const (symbol_ref "((enum attr_tune) riscv_microarchitecture)"))) ;; Describe a user's asm statement. @@ -4991,4 +4991,5 @@ (include "tt-ascalon-d8.md") (include "andes-23-series.md") (include "andes-25-series.md") +(include "andes-45-series.md") (include "spacemit-x60.md") diff --git a/gcc/doc/riscv-mcpu.texi b/gcc/doc/riscv-mcpu.texi index 8875ff5bcb99..eaf96933b107 100644 --- a/gcc/doc/riscv-mcpu.texi +++ b/gcc/doc/riscv-mcpu.texi @@ -86,4 +86,12 @@ by particular CPU name. Permissible values for this option are: @samp{andes-d23}, +@samp{andes-n45}, + +@samp{andes-nx45}, + +@samp{andes-a45}, + +@samp{andes-ax45}, + @samp{spacemit-x60}. diff --git a/gcc/doc/riscv-mtune.texi b/gcc/doc/riscv-mtune.texi index 578a641b2ba7..3e61d11462a9 100644 --- a/gcc/doc/riscv-mtune.texi +++ b/gcc/doc/riscv-mtune.texi @@ -62,4 +62,6 @@ particular CPU name. Permissible values for this option are: @samp{andes-23-series}, +@samp{andes-45-series}, + and all valid options for @option{-mcpu=}. From 28e6f019d87c4993a2f650368abe25986e8fd7cc Mon Sep 17 00:00:00 2001 From: Mark Zhuang Date: Thu, 27 Nov 2025 21:26:24 +0800 Subject: [PATCH 099/373] RISC-V: Run gen-riscv-ext-opt to regenerate riscv-ext.opt [NFC] gcc/ChangeLog: * config/riscv/riscv-ext.opt: Generated file. --- gcc/config/riscv/riscv-ext.opt | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/gcc/config/riscv/riscv-ext.opt b/gcc/config/riscv/riscv-ext.opt index 2036c16498b6..a24f4531731b 100644 --- a/gcc/config/riscv/riscv-ext.opt +++ b/gcc/config/riscv/riscv-ext.opt @@ -403,18 +403,6 @@ Mask(SVADE) Var(riscv_sv_subext) Mask(SVBARE) Var(riscv_sv_subext) -Mask(XANDESPERF) Var(riscv_xandes_subext) - -Mask(XANDESBFHCVT) Var(riscv_xandes_subext) - -Mask(XANDESVBFHCVT) Var(riscv_xandes_subext) - -Mask(XANDESVSINTLOAD) Var(riscv_xandes_subext) - -Mask(XANDESVPACKFPH) Var(riscv_xandes_subext) - -Mask(XANDESVDOT) Var(riscv_xandes_subext) - Mask(XCVALU) Var(riscv_xcv_subext) Mask(XCVBI) Var(riscv_xcv_subext) @@ -466,3 +454,16 @@ Mask(XVENTANACONDOPS) Var(riscv_xventana_subext) Mask(XMIPSCMOV) Var(riscv_xmips_subext) Mask(XMIPSCBOP) Var(riscv_xmips_subext) + +Mask(XANDESPERF) Var(riscv_xandes_subext) + +Mask(XANDESBFHCVT) Var(riscv_xandes_subext) + +Mask(XANDESVBFHCVT) Var(riscv_xandes_subext) + +Mask(XANDESVSINTLOAD) Var(riscv_xandes_subext) + +Mask(XANDESVPACKFPH) Var(riscv_xandes_subext) + +Mask(XANDESVDOT) Var(riscv_xandes_subext) + From b028abd09278b8e7fdd8012d4592e3cc0aaff5f4 Mon Sep 17 00:00:00 2001 From: Mark Zhuang Date: Fri, 28 Nov 2025 11:09:55 +0800 Subject: [PATCH 100/373] RISC-V: Add SpacemiT extension xsmtvdot gcc/ChangeLog: * config/riscv/riscv-cores.def (RISCV_CORE): Add xsmtvdot to spacemit-x60 * config/riscv/riscv-ext.def: Add xsmtvdot * config/riscv/riscv-ext.opt: Ditto * config/riscv/t-riscv: Ditto * doc/riscv-ext.texi: Ditto * config/riscv/riscv-ext-spacemit.def: Define xsmtvdot gcc/testsuite/ChangeLog: * gcc.target/riscv/predef-smt-1.c: New test. --- gcc/config/riscv/riscv-cores.def | 2 +- gcc/config/riscv/riscv-ext-spacemit.def | 36 +++++++++++++++++++ gcc/config/riscv/riscv-ext.def | 1 + gcc/config/riscv/riscv-ext.opt | 5 +++ gcc/config/riscv/t-riscv | 3 +- gcc/doc/riscv-ext.texi | 4 +++ gcc/testsuite/gcc.target/riscv/predef-smt-1.c | 14 ++++++++ 7 files changed, 63 insertions(+), 2 deletions(-) create mode 100644 gcc/config/riscv/riscv-ext-spacemit.def create mode 100644 gcc/testsuite/gcc.target/riscv/predef-smt-1.c diff --git a/gcc/config/riscv/riscv-cores.def b/gcc/config/riscv/riscv-cores.def index 12b27c959585..7266b5eac113 100644 --- a/gcc/config/riscv/riscv-cores.def +++ b/gcc/config/riscv/riscv-cores.def @@ -195,7 +195,7 @@ RISCV_CORE("andes-a45", "rv32imafdc_zicsr_zifencei_xandesperf", "andes-45- RISCV_CORE("andes-ax45", "rv64imafdc_zicsr_zifencei_xandesperf", "andes-45-series") RISCV_CORE("spacemit-x60", "rv64imafdcv_zba_zbb_zbc_zbs_zicboz_zicond_" - "zbkc_zfh_zvfh_zvkt_zvl256b_sscofpmf", + "zbkc_zfh_zvfh_zvkt_zvl256b_sscofpmf_xsmtvdot", "spacemit-x60") #undef RISCV_CORE diff --git a/gcc/config/riscv/riscv-ext-spacemit.def b/gcc/config/riscv/riscv-ext-spacemit.def new file mode 100644 index 000000000000..3482384e1c41 --- /dev/null +++ b/gcc/config/riscv/riscv-ext-spacemit.def @@ -0,0 +1,36 @@ +/* SpacemiT extension definition file for RISC-V. + Copyright (C) 2025 Free Software Foundation, Inc. + +This file is part of GCC. + +GCC is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +GCC is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GCC; see the file COPYING3. If not see +. + +Please run `make riscv-regen` in build folder to make sure updated anything. + +Format of DEFINE_RISCV_EXT, please refer to riscv-ext.def. */ + +DEFINE_RISCV_EXT( + /* NAME */ xsmtvdot, + /* UPPERCASE_NAME */ XSMTVDOT, + /* FULL_NAME */ "SpacemiT vector dot product extension", + /* DESC */ "", + /* URL */ , + /* DEP_EXTS */ ({"zve32x"}), + /* SUPPORTED_VERSIONS */ ({{1, 0}}), + /* FLAG_GROUP */ xsmt, + /* BITMASK_GROUP_ID */ BITMASK_NOT_YET_ALLOCATED, + /* BITMASK_BIT_POSITION*/ BITMASK_NOT_YET_ALLOCATED, + /* EXTRA_EXTENSION_FLAGS */ 0) + diff --git a/gcc/config/riscv/riscv-ext.def b/gcc/config/riscv/riscv-ext.def index 80f534c64614..62d638015f35 100644 --- a/gcc/config/riscv/riscv-ext.def +++ b/gcc/config/riscv/riscv-ext.def @@ -2084,3 +2084,4 @@ DEFINE_RISCV_EXT( #include "riscv-ext-ventana.def" #include "riscv-ext-mips.def" #include "riscv-ext-andes.def" +#include "riscv-ext-spacemit.def" diff --git a/gcc/config/riscv/riscv-ext.opt b/gcc/config/riscv/riscv-ext.opt index a24f4531731b..af8e556842bf 100644 --- a/gcc/config/riscv/riscv-ext.opt +++ b/gcc/config/riscv/riscv-ext.opt @@ -55,6 +55,9 @@ int riscv_xmips_subext TargetVariable int riscv_xsf_subext +TargetVariable +int riscv_xsmt_subext + TargetVariable int riscv_xthead_subext @@ -467,3 +470,5 @@ Mask(XANDESVPACKFPH) Var(riscv_xandes_subext) Mask(XANDESVDOT) Var(riscv_xandes_subext) +Mask(XSMTVDOT) Var(riscv_xsmt_subext) + diff --git a/gcc/config/riscv/t-riscv b/gcc/config/riscv/t-riscv index 3f92feab50ec..2761e5e20c00 100644 --- a/gcc/config/riscv/t-riscv +++ b/gcc/config/riscv/t-riscv @@ -222,7 +222,8 @@ RISCV_EXT_DEFS = \ $(srcdir)/config/riscv/riscv-ext-thead.def \ $(srcdir)/config/riscv/riscv-ext-ventana.def \ $(srcdir)/config/riscv/riscv-ext-mips.def \ - $(srcdir)/config/riscv/riscv-ext-andes.def + $(srcdir)/config/riscv/riscv-ext-andes.def \ + $(srcdir)/config/riscv/riscv-ext-spacemit.def $(srcdir)/config/riscv/riscv-ext.opt: $(RISCV_EXT_DEFS) diff --git a/gcc/doc/riscv-ext.texi b/gcc/doc/riscv-ext.texi index 13056e73bad9..0dc667b561ca 100644 --- a/gcc/doc/riscv-ext.texi +++ b/gcc/doc/riscv-ext.texi @@ -746,4 +746,8 @@ @tab 5.0 @tab Andes vector dot product extension +@item xsmtvdot +@tab 1.0 +@tab SpacemiT vector dot product extension + @end multitable diff --git a/gcc/testsuite/gcc.target/riscv/predef-smt-1.c b/gcc/testsuite/gcc.target/riscv/predef-smt-1.c new file mode 100644 index 000000000000..4556953ed48a --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/predef-smt-1.c @@ -0,0 +1,14 @@ +/* { dg-do compile } */ +/* { dg-options "-march=rv64g_xsmtvdot -mabi=lp64" } */ + +int main () { +#if !defined(__riscv) +#error "__riscv" +#endif + +#if !defined(__riscv_xsmtvdot) +#error "__riscv_xsmtvdot" +#endif + + return 0; +} From 5be645aae5b261cb238a2a8a953c12eea2bc01b1 Mon Sep 17 00:00:00 2001 From: Charlie Jenkins Date: Wed, 26 Nov 2025 11:29:51 -0800 Subject: [PATCH 101/373] RISC-V: Support --with-cpu The --with-cpu will allow riscv compilers to have a default mcpu flag. Setting -mcpu or -march at compile time will override the configured --with-cpu. gcc/ChangeLog: * config.gcc: Add cpu to supported configure options * config/riscv/riscv.h (riscv_arch_help): Use --with-cpu during compilation * doc/install.texi: Mention in docs that --with-cpu is supported --- gcc/config.gcc | 2 +- gcc/config/riscv/riscv.h | 5 +++-- gcc/doc/install.texi | 8 ++++---- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/gcc/config.gcc b/gcc/config.gcc index 6ac00ebdcb30..703554263969 100644 --- a/gcc/config.gcc +++ b/gcc/config.gcc @@ -4753,7 +4753,7 @@ case "${target}" in ;; riscv*-*-*) - supported_defaults="abi arch tune riscv_attribute isa_spec tls cmodel" + supported_defaults="abi arch cpu tune riscv_attribute isa_spec tls cmodel" case "${target}" in riscv-* | riscv32*) xlen=32 ;; diff --git a/gcc/config/riscv/riscv.h b/gcc/config/riscv/riscv.h index a0ad75c765a1..6a3e5372d3b5 100644 --- a/gcc/config/riscv/riscv.h +++ b/gcc/config/riscv/riscv.h @@ -60,17 +60,18 @@ extern const char *riscv_arch_help (int argc, const char **argv); { "riscv_arch_help", riscv_arch_help }, /* Support for a compile-time default CPU, et cetera. The rules are: - --with-arch is ignored if -march or -mcpu is specified. + --with-arch and --with-cpu are ignored if -march or -mcpu is specified. --with-abi is ignored if -mabi is specified. --with-tune is ignored if -mtune or -mcpu is specified. --with-isa-spec is ignored if -misa-spec is specified. --with-tls is ignored if -mtls-dialect is specified. - But using default -march/-mtune value if -mcpu don't have valid option. */ + Uses default values if -mcpu doesn't have a valid option. */ #define OPTION_DEFAULT_SPECS \ {"tune", "%{!mtune=*:" \ " %{!mcpu=*:-mtune=%(VALUE)}" \ " %{mcpu=*:-mtune=%:riscv_default_mtune(%* %(VALUE))}}" }, \ + {"cpu", "%{!march=*:%{!mcpu=*:%:riscv_expand_arch_from_cpu(%(VALUE))}}" }, \ {"arch", "%{!march=*|march=unset:" \ " %{!mcpu=*:-march=%(VALUE)}" \ " %{mcpu=*:%:riscv_expand_arch_from_cpu(%* %(VALUE))}}" }, \ diff --git a/gcc/doc/install.texi b/gcc/doc/install.texi index 437e4636db33..7f4321c424b9 100644 --- a/gcc/doc/install.texi +++ b/gcc/doc/install.texi @@ -1687,10 +1687,10 @@ not use transactional memory. Specify which cpu variant the compiler should generate code for by default. @var{cpu} will be used as the default value of the @option{-mcpu=} switch. This option is only supported on some targets, including ARC, ARM, i386, M68k, -PowerPC, and SPARC@. It is mandatory for ARC@. The @option{--with-cpu-32} and -@option{--with-cpu-64} options specify separate default CPUs for -32-bit and 64-bit modes; these options are only supported for aarch64, i386, -x86-64, PowerPC, and SPARC@. +PowerPC, RISC-V, and SPARC@. It is mandatory for ARC@. The +@option{--with-cpu-32} and @option{--with-cpu-64} options specify separate +default CPUs for 32-bit and 64-bit modes; these options are only supported for +aarch64, i386, x86-64, PowerPC, and SPARC@. @item --with-schedule=@var{cpu} @itemx --with-arch=@var{cpu} From 99052ad691ffc058f5b89794fd59b64b1d001425 Mon Sep 17 00:00:00 2001 From: Jim Lin Date: Thu, 27 Nov 2025 15:02:20 +0800 Subject: [PATCH 102/373] RISC-V: Emit \n\t at the end of instruction instead of ; Instead of emitting only one line `fmv.x.s a5,fa0;slli a5,a5,16;srai a5,a5,16` gcc/ChangeLog: * config/riscv/riscv.cc (riscv_output_move): Use \n\t instead of semicolon to separate instructions in fmv.x.h emulation. --- gcc/config/riscv/riscv.cc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/config/riscv/riscv.cc b/gcc/config/riscv/riscv.cc index 63ac9d841831..3e737d54d57f 100644 --- a/gcc/config/riscv/riscv.cc +++ b/gcc/config/riscv/riscv.cc @@ -5014,7 +5014,7 @@ riscv_output_move (rtx dest, rtx src) if (TARGET_ZFHMIN || TARGET_ZFBFMIN) return "fmv.x.h\t%0,%1"; /* Using fmv.x.s + sign-extend to emulate fmv.x.h. */ - return "fmv.x.s\t%0,%1;slli\t%0,%0,16;srai\t%0,%0,16"; + return "fmv.x.s\t%0,%1\n\tslli\t%0,%0,16\n\tsrai\t%0,%0,16"; case 4: return "fmv.x.s\t%0,%1"; case 8: From 0367efb112795290831bbc3eff181707fdfcc52c Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Fri, 28 Nov 2025 10:59:35 +0100 Subject: [PATCH 103/373] c++: Remove PMF special cases from cxx_get_alias_set [PR119969] The use of 0 alias set for PMF * types seems to break modref for some reason, but because PMFs are canonicalized, there should be no reason to special case the alias set of PMF or PMF * anymore. 2025-11-27 Jakub Jelinek PR c++/119969 * cp-objcp-common.cc (cxx_get_alias_set): Remove special cases for TYPE_PTRMEMFUNC_P and INDIRECT_TYPE_P for TYPE_PTRMEMFUNC_P. * g++.dg/torture/pr119969.C: New test. --- gcc/cp/cp-objcp-common.cc | 6 ---- gcc/testsuite/g++.dg/torture/pr119969.C | 46 +++++++++++++++++++++++++ 2 files changed, 46 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/g++.dg/torture/pr119969.C diff --git a/gcc/cp/cp-objcp-common.cc b/gcc/cp/cp-objcp-common.cc index c7e88cb7bfea..859c7d69746d 100644 --- a/gcc/cp/cp-objcp-common.cc +++ b/gcc/cp/cp-objcp-common.cc @@ -180,12 +180,6 @@ cxx_get_alias_set (tree t) complete type. */ return get_alias_set (TYPE_CONTEXT (t)); - /* Punt on PMFs until we canonicalize functions properly. */ - if (TYPE_PTRMEMFUNC_P (t) - || (INDIRECT_TYPE_P (t) - && TYPE_PTRMEMFUNC_P (TREE_TYPE (t)))) - return 0; - return c_common_get_alias_set (t); } diff --git a/gcc/testsuite/g++.dg/torture/pr119969.C b/gcc/testsuite/g++.dg/torture/pr119969.C new file mode 100644 index 000000000000..25a4053c3f87 --- /dev/null +++ b/gcc/testsuite/g++.dg/torture/pr119969.C @@ -0,0 +1,46 @@ +// PR c++/119969 +// { dg-do run } + +struct S {}; +using PMF = void (S::*)(); +using Block = PMF[16]; +using BlockPtr = Block*; + +struct IteratorImp { + Block** d_blockPtr_p; + PMF* d_value_p; + + void operator++(); + PMF& operator*() const { return *d_value_p; } +}; + +void IteratorImp::operator++() { + int offset = 1 + (d_value_p - **d_blockPtr_p); + d_blockPtr_p += offset / 16; + d_value_p = **d_blockPtr_p + (offset % 16); +} + +struct iterator { + IteratorImp d_imp; +}; + +struct D { + Block* d_blockPtrs[1]; + Block d_block; + PMF* d_start_p; +}; + +D mX; + +void privateInit(int numElements) { + mX.d_blockPtrs[0] = &mX.d_block; + mX.d_start_p = mX.d_block + (numElements + 7); +} + +int main() { + privateInit(0); + iterator cbgn = {{mX.d_blockPtrs, mX.d_block + 7}}; + auto clast = cbgn; + ++clast.d_imp; + if (&*cbgn.d_imp == &*clast.d_imp) return 1; +} From 67b143a07bac3df9542b3a474bb2ffe6160da22c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 28 Nov 2025 11:44:41 +0100 Subject: [PATCH 104/373] OpenMP/Fortran: Reject ALLOCATE on non-local static variables with trait:cgroup/pteam/thread [PR122892] OpenMP 6.0 clarified that static-storage objects may only specify the omp_cgroup_mem_alloc, omp_pteam_mem_alloc, or omp_thread_mem_alloc allocator inside a BLOCK or procedure. Let's check for this for Fortran. PR c/122892 gcc/fortran/ChangeLog: * openmp.cc (gfc_resolve_omp_allocate): Reject non-local static variables with cgroup/pteam/thread allocators. * parse.cc: Permit OMP ALLOCATE in BLOCK DATA. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/allocate-15.f90: Use another allocator as omp_{cgroup,pteam}_mem_alloc is invalid for non-local static vars. * gfortran.dg/gomp/allocate-7.f90: Likewise. * gfortran.dg/gomp/allocate-static-3.f90: New test. --- gcc/fortran/openmp.cc | 27 +- gcc/fortran/parse.cc | 1 + .../gfortran.dg/gomp/allocate-15.f90 | 2 +- gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 | 4 +- .../gfortran.dg/gomp/allocate-static-3.f90 | 245 ++++++++++++++++++ 5 files changed, 275 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-static-3.f90 diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index f047028187f6..e847c1c0c084 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -8682,7 +8682,8 @@ gfc_resolve_omp_allocate (gfc_namespace *ns, gfc_omp_namelist *list) if (n->sym->attr.in_common || n->sym->attr.save || n->sym->ns->save_all || (n->sym->ns->proc_name && (n->sym->ns->proc_name->attr.flavor == FL_PROGRAM - || n->sym->ns->proc_name->attr.flavor == FL_MODULE))) + || n->sym->ns->proc_name->attr.flavor == FL_MODULE + || n->sym->ns->proc_name->attr.flavor == FL_BLOCK_DATA))) { bool com = n->sym->attr.in_common; if (!n->u2.allocator) @@ -8696,6 +8697,30 @@ gfc_resolve_omp_allocate (gfc_namespace *ns, gfc_omp_namelist *list) &n->u2.allocator->where, com ? "/" : "", com ? n->sym->common_head->name : n->sym->name, com ? "/" : "", &n->where); + /* Only local static variables might use omp_cgroup_mem_alloc (6), + omp_pteam_mem_alloc (7), or omp_thread_mem_alloc (8). */ + else if ((!ns->proc_name + || ns->proc_name->attr.flavor == FL_PROGRAM + || ns->proc_name->attr.flavor == FL_BLOCK_DATA + || ns->proc_name->attr.flavor == FL_MODULE + || com) + && mpz_cmp_si (n->u2.allocator->value.integer, + 6 /* cgroup */) >= 0 + && mpz_cmp_si (n->u2.allocator->value.integer, + 8 /* thread */) <= 0) + { + const char *alloc_name[] = {"omp_cgroup_mem_alloc", + "omp_pteam_mem_alloc", + "omp_thread_mem_alloc" }; + gfc_error ("Predefined allocator %qs in ALLOCATOR clause at %L, " + "used for list item %<%s%s%s%> at %L, may only be used" + " for local static variables", + alloc_name[mpz_get_ui (n->u2.allocator->value.integer) + - 6 /* cgroup */], &n->u2.allocator->where, + com ? "/" : "", + com ? n->sym->common_head->name : n->sym->name, + com ? "/" : "", &n->where); + } while (n->sym->attr.in_common && n->next && n->next->sym && n->sym->common_head == n->next->sym->common_head) n = n->next; diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index 3fd45b9518ec..df8570bad289 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -4444,6 +4444,7 @@ parse_spec (gfc_statement st) case ST_EQUIVALENCE: case ST_IMPLICIT: case ST_IMPLICIT_NONE: + case ST_OMP_ALLOCATE: case ST_OMP_GROUPPRIVATE: case ST_OMP_THREADPRIVATE: case ST_PARAMETER: diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-15.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-15.f90 index e3ef841442b3..55e4a1a65773 100644 --- a/gcc/testsuite/gfortran.dg/gomp/allocate-15.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-15.f90 @@ -25,7 +25,7 @@ subroutine common use m integer :: a,b,c(5) common /my/ a,b,c ! { dg-error "Sorry, !.OMP allocate for COMMON block variable 'my' at .1. not supported" } - !$omp allocate(/my/) allocator(omp_cgroup_mem_alloc) + !$omp allocate(/my/) allocator(omp_low_lat_mem_alloc) end integer function allocators() result(res) diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 index ab85e327795a..e919f78ce6da 100644 --- a/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-7.f90 @@ -72,9 +72,9 @@ subroutine three(n) allocatable :: q pointer :: b !$omp allocate (c, d) allocator (omp_pteam_mem_alloc) -!$omp allocate (/com4/) allocator (omp_pteam_mem_alloc) +!$omp allocate (/com4/) allocator (omp_low_lat_mem_alloc) !$omp allocate (c) allocator (omp_pteam_mem_alloc) ! { dg-error "Duplicated variable 'c' in !.OMP ALLOCATE" } -!$omp allocate (/com4/) allocator (omp_pteam_mem_alloc) ! { dg-error "Duplicated common block '/com4/' in !.OMP ALLOCATE" } +!$omp allocate (/com4/) allocator (omp_low_lat_mem_alloc) ! { dg-error "Duplicated common block '/com4/' in !.OMP ALLOCATE" } !$omp allocate(q,x) ! { dg-error "Unexpected allocatable variable 'q' at .1. in declarative !.OMP ALLOCATE directive" } !$omp allocate(b,e) ! { dg-error "Unexpected pointer variable 'b' at .1. in declarative !.OMP ALLOCATE directive" } diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-static-3.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-static-3.f90 new file mode 100644 index 000000000000..28a638c6f247 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-static-3.f90 @@ -0,0 +1,245 @@ +! { dg-do compile } +! +! PR fortran/122892 +! +! OpenMP 6.0 clarified that the omp_{cgroup,pteam,thread}_mem_alloc +! (i.e. those with access trait != device) may only be used for +! static local variables. +! Check for this! + +module omp_lib_kinds + use iso_c_binding, only: c_int, c_intptr_t + implicit none + private :: c_int, c_intptr_t + integer, parameter :: omp_allocator_handle_kind = c_intptr_t + + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_null_allocator = 0 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_default_mem_alloc = 1 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_large_cap_mem_alloc = 2 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_const_mem_alloc = 3 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_high_bw_mem_alloc = 4 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_low_lat_mem_alloc = 5 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_cgroup_mem_alloc = 6 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_pteam_mem_alloc = 7 + integer (kind=omp_allocator_handle_kind), & + parameter :: omp_thread_mem_alloc = 8 +end module + +block data + use omp_lib_kinds + implicit none + integer :: i1,i2,i3,i4,i5,i6,i7,i8 + common /b_i1/ i1 + common /b_i2/ i2 + common /b_i3/ i3 + common /b_i4/ i4 + common /b_i5/ i5 + common /b_i6/ i6 + common /b_i7/ i7 + common /b_i8/ i8 + + data i1 / 1 / + data i2 / 2 / + data i3 / 3 / + data i4 / 4 / + data i5 / 5 / + data i6 / 6 / + data i7 / 7 / + data i8 / 8 / + + !$omp allocate(/b_i1/) allocator(omp_default_mem_alloc) + !$omp allocate(/b_i2/) allocator(omp_large_cap_mem_alloc) + !$omp allocate(/b_i3/) allocator(omp_const_mem_alloc) + !$omp allocate(/b_i4/) allocator(omp_high_bw_mem_alloc) + !$omp allocate(/b_i5/) allocator(omp_low_lat_mem_alloc) + !$omp allocate(/b_i6/) allocator(omp_cgroup_mem_alloc) ! { dg-error "Predefined allocator 'omp_cgroup_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_i6/' at .2., may only be used for local static variables" } + !$omp allocate(/b_i7/) allocator(omp_pteam_mem_alloc) ! { dg-error "Predefined allocator 'omp_pteam_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_i7/' at .2., may only be used for local static variables" } + !$omp allocate(/b_i8/) allocator(omp_thread_mem_alloc) ! { dg-error "Predefined allocator 'omp_thread_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_i8/' at .2., may only be used for local static variables" } +end block data + +block data my_block_data + use omp_lib_kinds + implicit none + integer :: j1,j2,j3,j4,j5,j6,j7,j8 + common /b_j1/ j1 + common /b_j2/ j2 + common /b_j3/ j3 + common /b_j4/ j4 + common /b_j5/ j5 + common /b_j6/ j6 + common /b_j7/ j7 + common /b_j8/ j8 + + data j1 / 1 / + data j2 / 2 / + data j3 / 3 / + data j4 / 4 / + data j5 / 5 / + data j6 / 6 / + data j7 / 7 / + data j8 / 8 / + + !$omp allocate(/b_j1/) allocator(omp_default_mem_alloc) + !$omp allocate(/b_j2/) allocator(omp_large_cap_mem_alloc) + !$omp allocate(/b_j3/) allocator(omp_const_mem_alloc) + !$omp allocate(/b_j4/) allocator(omp_high_bw_mem_alloc) + !$omp allocate(/b_j5/) allocator(omp_low_lat_mem_alloc) + !$omp allocate(/b_j6/) allocator(omp_cgroup_mem_alloc) ! { dg-error "Predefined allocator 'omp_cgroup_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_j6/' at .2., may only be used for local static variables" } + !$omp allocate(/b_j7/) allocator(omp_pteam_mem_alloc) ! { dg-error "Predefined allocator 'omp_pteam_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_j7/' at .2., may only be used for local static variables" } + !$omp allocate(/b_j8/) allocator(omp_thread_mem_alloc) ! { dg-error "Predefined allocator 'omp_thread_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_j8/' at .2., may only be used for local static variables" } +end block data my_block_data + +module m + use omp_lib_kinds + implicit none + + integer :: a1,a2,a3,a4,a5,a6,a7,a8 + integer :: b1,b2,b3,b4,b5,b6,b7,b8 + common /b_b1/ b1 + common /b_b2/ b2 + common /b_b3/ b3 + common /b_b4/ b4 + common /b_b5/ b5 + common /b_b6/ b6 + common /b_b7/ b7 + common /b_b8/ b8 + + !$omp allocate(a1) allocator(omp_default_mem_alloc) + !$omp allocate(a2) allocator(omp_large_cap_mem_alloc) + !$omp allocate(a3) allocator(omp_const_mem_alloc) + !$omp allocate(a4) allocator(omp_high_bw_mem_alloc) + !$omp allocate(a5) allocator(omp_low_lat_mem_alloc) + !$omp allocate(a6) allocator(omp_cgroup_mem_alloc) ! { dg-error "Predefined allocator 'omp_cgroup_mem_alloc' in ALLOCATOR clause at .1., used for list item 'a6' at .2., may only be used for local static variables" } + !$omp allocate(a7) allocator(omp_pteam_mem_alloc) ! { dg-error "Predefined allocator 'omp_pteam_mem_alloc' in ALLOCATOR clause at .1., used for list item 'a7' at .2., may only be used for local static variables" } + !$omp allocate(a8) allocator(omp_thread_mem_alloc) ! { dg-error "Predefined allocator 'omp_thread_mem_alloc' in ALLOCATOR clause at .1., used for list item 'a8' at .2., may only be used for local static variables" } + + !$omp allocate(/b_b1/) allocator(omp_default_mem_alloc) + !$omp allocate(/b_b2/) allocator(omp_large_cap_mem_alloc) + !$omp allocate(/b_b3/) allocator(omp_const_mem_alloc) + !$omp allocate(/b_b4/) allocator(omp_high_bw_mem_alloc) + !$omp allocate(/b_b5/) allocator(omp_low_lat_mem_alloc) + !$omp allocate(/b_b6/) allocator(omp_cgroup_mem_alloc) ! { dg-error "Predefined allocator 'omp_cgroup_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_b6/' at .2., may only be used for local static variables" } + !$omp allocate(/b_b7/) allocator(omp_pteam_mem_alloc) ! { dg-error "Predefined allocator 'omp_pteam_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_b7/' at .2., may only be used for local static variables" } + !$omp allocate(/b_b8/) allocator(omp_thread_mem_alloc) ! { dg-error "Predefined allocator 'omp_thread_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_b8/' at .2., may only be used for local static variables" } +end + +program main + use omp_lib_kinds + implicit none + + integer m1,m2,m3,m4,m5,m6,m7,m8 + integer n1,n2,n3,n4,n5,n6,n7,n8 + common /b_n1/ n1 + common /b_n2/ n2 + common /b_n3/ n3 + common /b_n4/ n4 + common /b_n5/ n5 + common /b_n6/ n6 + common /b_n7/ n7 + common /b_n8/ n8 + + !$omp allocate(m1) allocator(omp_default_mem_alloc) + !$omp allocate(m2) allocator(omp_large_cap_mem_alloc) + !$omp allocate(m3) allocator(omp_const_mem_alloc) + !$omp allocate(m4) allocator(omp_high_bw_mem_alloc) + !$omp allocate(m5) allocator(omp_low_lat_mem_alloc) + !$omp allocate(m6) allocator(omp_cgroup_mem_alloc) ! { dg-error "Predefined allocator 'omp_cgroup_mem_alloc' in ALLOCATOR clause at .1., used for list item 'm6' at .2., may only be used for local static variables" } + !$omp allocate(m7) allocator(omp_pteam_mem_alloc) ! { dg-error "Predefined allocator 'omp_pteam_mem_alloc' in ALLOCATOR clause at .1., used for list item 'm7' at .2., may only be used for local static variables" } + !$omp allocate(m8) allocator(omp_thread_mem_alloc) ! { dg-error "Predefined allocator 'omp_thread_mem_alloc' in ALLOCATOR clause at .1., used for list item 'm8' at .2., may only be used for local static variables" } + + !$omp allocate(/b_n1/) allocator(omp_default_mem_alloc) + !$omp allocate(/b_n2/) allocator(omp_large_cap_mem_alloc) + !$omp allocate(/b_n3/) allocator(omp_const_mem_alloc) + !$omp allocate(/b_n4/) allocator(omp_high_bw_mem_alloc) + !$omp allocate(/b_n5/) allocator(omp_low_lat_mem_alloc) + !$omp allocate(/b_n6/) allocator(omp_cgroup_mem_alloc) ! { dg-error "Predefined allocator 'omp_cgroup_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_n6/' at .2., may only be used for local static variables" } + !$omp allocate(/b_n7/) allocator(omp_pteam_mem_alloc) ! { dg-error "Predefined allocator 'omp_pteam_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_n7/' at .2., may only be used for local static variables" } + !$omp allocate(/b_n8/) allocator(omp_thread_mem_alloc) ! { dg-error "Predefined allocator 'omp_thread_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_n8/' at .2., may only be used for local static variables" } + + block + integer, save :: o1,o2,o3,o4,o5,o6,o7,o8 + ! NOTE: COMMON statement is not allowed inside of BLOCK + + !$omp allocate(o1) allocator(omp_default_mem_alloc) + !$omp allocate(o2) allocator(omp_large_cap_mem_alloc) + !$omp allocate(o3) allocator(omp_const_mem_alloc) + !$omp allocate(o4) allocator(omp_high_bw_mem_alloc) + !$omp allocate(o5) allocator(omp_low_lat_mem_alloc) + !$omp allocate(o6) allocator(omp_cgroup_mem_alloc) + !$omp allocate(o7) allocator(omp_pteam_mem_alloc) + !$omp allocate(o8) allocator(omp_thread_mem_alloc) + end block +end + +subroutine sub + use omp_lib_kinds + implicit none + + integer, save :: s1,s2,s3,s4,s5,s6,s7,s8 + integer t1,t2,t3,t4,t5,t6,t7,t8 + common /b_t1/ t1 + common /b_t2/ t2 + common /b_t3/ t3 + common /b_t4/ t4 + common /b_t5/ t5 + common /b_t6/ t6 + common /b_t7/ t7 + common /b_t8/ t8 + + !$omp allocate(s1) allocator(omp_default_mem_alloc) + !$omp allocate(s2) allocator(omp_large_cap_mem_alloc) + !$omp allocate(s3) allocator(omp_const_mem_alloc) + !$omp allocate(s4) allocator(omp_high_bw_mem_alloc) + !$omp allocate(s5) allocator(omp_low_lat_mem_alloc) + !$omp allocate(s6) allocator(omp_cgroup_mem_alloc) + !$omp allocate(s7) allocator(omp_pteam_mem_alloc) + !$omp allocate(s8) allocator(omp_thread_mem_alloc) + + !$omp allocate(/b_t1/) allocator(omp_default_mem_alloc) + !$omp allocate(/b_t2/) allocator(omp_large_cap_mem_alloc) + !$omp allocate(/b_t3/) allocator(omp_const_mem_alloc) + !$omp allocate(/b_t4/) allocator(omp_high_bw_mem_alloc) + !$omp allocate(/b_t5/) allocator(omp_low_lat_mem_alloc) + !$omp allocate(/b_t6/) allocator(omp_cgroup_mem_alloc) ! { dg-error "Predefined allocator 'omp_cgroup_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_t6/' at .2., may only be used for local static variables" } + !$omp allocate(/b_t7/) allocator(omp_pteam_mem_alloc) ! { dg-error "Predefined allocator 'omp_pteam_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_t7/' at .2., may only be used for local static variables" } + !$omp allocate(/b_t8/) allocator(omp_thread_mem_alloc) ! { dg-error "Predefined allocator 'omp_thread_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_t8/' at .2., may only be used for local static variables" } +contains + integer function func() + integer, save :: q1,q2,q3,q4,q5,q6,q7,q8 + integer r1,r2,r3,r4,r5,r6,r7,r8 + common /b_r1/ r1 + common /b_r2/ r2 + common /b_r3/ r3 + common /b_r4/ r4 + common /b_r5/ r5 + common /b_r6/ r6 + common /b_r7/ r7 + common /b_r8/ r8 + + !$omp allocate(q1) allocator(omp_default_mem_alloc) + !$omp allocate(q2) allocator(omp_large_cap_mem_alloc) + !$omp allocate(q3) allocator(omp_const_mem_alloc) + !$omp allocate(q4) allocator(omp_high_bw_mem_alloc) + !$omp allocate(q5) allocator(omp_low_lat_mem_alloc) + !$omp allocate(q6) allocator(omp_cgroup_mem_alloc) + !$omp allocate(q7) allocator(omp_pteam_mem_alloc) + !$omp allocate(q8) allocator(omp_thread_mem_alloc) + + !$omp allocate(/b_r1/) allocator(omp_default_mem_alloc) + !$omp allocate(/b_r2/) allocator(omp_large_cap_mem_alloc) + !$omp allocate(/b_r3/) allocator(omp_const_mem_alloc) + !$omp allocate(/b_r4/) allocator(omp_high_bw_mem_alloc) + !$omp allocate(/b_r5/) allocator(omp_low_lat_mem_alloc) + !$omp allocate(/b_r6/) allocator(omp_cgroup_mem_alloc) ! { dg-error "Predefined allocator 'omp_cgroup_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_r6/' at .2., may only be used for local static variables" } + !$omp allocate(/b_r7/) allocator(omp_pteam_mem_alloc) ! { dg-error "Predefined allocator 'omp_pteam_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_r7/' at .2., may only be used for local static variables" } + !$omp allocate(/b_r8/) allocator(omp_thread_mem_alloc) ! { dg-error "Predefined allocator 'omp_thread_mem_alloc' in ALLOCATOR clause at .1., used for list item '/b_r8/' at .2., may only be used for local static variables" } + end function +end subroutine From c90563edba3a7e9b5a25ef2f031cf909c2926214 Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Fri, 28 Nov 2025 10:06:58 +0100 Subject: [PATCH 105/373] tree-optimization/122844 - bogus reduction chain detection We may not strip sign-conversions around MIN/MAX operations. PR tree-optimization/122844 * tree-vect-slp.cc (vect_analyze_slp_reduc_chain): Only try stripping sign conversions around ops where this is valid. * gcc.dg/vect/vect-pr122844.c: New testcase. --- gcc/testsuite/gcc.dg/vect/vect-pr122844.c | 34 +++++++++++++++++++++++ gcc/tree-vect-slp.cc | 4 ++- 2 files changed, 37 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gcc.dg/vect/vect-pr122844.c diff --git a/gcc/testsuite/gcc.dg/vect/vect-pr122844.c b/gcc/testsuite/gcc.dg/vect/vect-pr122844.c new file mode 100644 index 000000000000..52da3ec4cb3e --- /dev/null +++ b/gcc/testsuite/gcc.dg/vect/vect-pr122844.c @@ -0,0 +1,34 @@ +#include "tree-vect.h" + +short c = 2; +short l = 6; +unsigned char m; +int k; +int a = -1; +unsigned long long t[2][2]; + +static void b( short c, int k, short l, unsigned m) +{ + for( signed x=0; x<2; x++) + for( int ab=0; abstmt; if (!is_gimple_assign (stmt) From 9514e082960a01ec1658f056f95b7247d7671079 Mon Sep 17 00:00:00 2001 From: Stefan Schulze Frielinghaus Date: Fri, 28 Nov 2025 13:45:45 +0100 Subject: [PATCH 106/373] s390: Fix deprecated-enum-enum-conversion warnings With the recent switch in commit r16-5628 defaulting to C++20 some enumeration arithmetic errors are thrown during bootstrap, now. Fixed by casting those to type int. I'm using type int here merely because S390_ALL_BUILTIN_MAX is used in comparisons with other operands of type int. gcc/ChangeLog: * config/s390/s390-builtins.h (S390_OVERLOADED_BUILTIN_VAR_OFFSET,S390_ALL_BUILTIN_MAX): Fix enum arithmetic. * config/s390/s390.cc (OB_DEF): Ditto. --- gcc/config/s390/s390-builtins.h | 12 +++++------- gcc/config/s390/s390.cc | 10 ++++------ 2 files changed, 9 insertions(+), 13 deletions(-) diff --git a/gcc/config/s390/s390-builtins.h b/gcc/config/s390/s390-builtins.h index e19fc7eec51b..1e596aef7ce4 100644 --- a/gcc/config/s390/s390-builtins.h +++ b/gcc/config/s390/s390-builtins.h @@ -134,10 +134,10 @@ S390_OVERLOADED_BUILTIN_VAR_MAX #define S390_OVERLOADED_BUILTIN_OFFSET S390_BUILTIN_MAX #define S390_OVERLOADED_BUILTIN_VAR_OFFSET \ - (S390_BUILTIN_MAX + S390_OVERLOADED_BUILTIN_MAX) -#define S390_ALL_BUILTIN_MAX \ - (S390_BUILTIN_MAX + S390_OVERLOADED_BUILTIN_MAX + \ - S390_OVERLOADED_BUILTIN_VAR_MAX) + ((int)S390_BUILTIN_MAX + (int)S390_OVERLOADED_BUILTIN_MAX) +#define S390_ALL_BUILTIN_MAX \ + ((int)S390_BUILTIN_MAX + (int)S390_OVERLOADED_BUILTIN_MAX + \ + (int)S390_OVERLOADED_BUILTIN_VAR_MAX) extern const unsigned int bflags_builtin[S390_BUILTIN_MAX + 1]; extern const unsigned int opflags_builtin[S390_BUILTIN_MAX + 1]; @@ -172,6 +172,4 @@ opflags_for_builtin (int fcode) return opflags_builtin[fcode]; } -extern GTY(()) tree s390_builtin_decls[S390_BUILTIN_MAX + - S390_OVERLOADED_BUILTIN_MAX + - S390_OVERLOADED_BUILTIN_VAR_MAX]; +extern GTY(()) tree s390_builtin_decls[S390_ALL_BUILTIN_MAX]; diff --git a/gcc/config/s390/s390.cc b/gcc/config/s390/s390.cc index d65109026f2a..359ea1c3d64b 100644 --- a/gcc/config/s390/s390.cc +++ b/gcc/config/s390/s390.cc @@ -686,9 +686,7 @@ opflags_overloaded_builtin_var[S390_OVERLOADED_BUILTIN_VAR_MAX + 1] = tree s390_builtin_types[BT_MAX]; tree s390_builtin_fn_types[BT_FN_MAX]; -tree s390_builtin_decls[S390_BUILTIN_MAX + - S390_OVERLOADED_BUILTIN_MAX + - S390_OVERLOADED_BUILTIN_VAR_MAX]; +tree s390_builtin_decls[S390_ALL_BUILTIN_MAX]; static enum insn_code const code_for_builtin[S390_BUILTIN_MAX + 1] = { #undef B_DEF @@ -771,12 +769,12 @@ s390_init_builtins (void) ATTRS); #undef OB_DEF #define OB_DEF(NAME, FIRST_VAR_NAME, LAST_VAR_NAME, BFLAGS, FNTYPE) \ - if (s390_builtin_decls[S390_OVERLOADED_BUILTIN_##NAME + S390_BUILTIN_MAX] \ + if (s390_builtin_decls[(int)S390_OVERLOADED_BUILTIN_##NAME + (int)S390_BUILTIN_MAX] \ == NULL) \ - s390_builtin_decls[S390_OVERLOADED_BUILTIN_##NAME + S390_BUILTIN_MAX] = \ + s390_builtin_decls[(int)S390_OVERLOADED_BUILTIN_##NAME + (int)S390_BUILTIN_MAX] = \ add_builtin_function ("__builtin_" #NAME, \ s390_builtin_fn_types[FNTYPE], \ - S390_OVERLOADED_BUILTIN_##NAME + S390_BUILTIN_MAX, \ + (int)S390_OVERLOADED_BUILTIN_##NAME + (int)S390_BUILTIN_MAX, \ BUILT_IN_MD, \ NULL, \ 0); From b03a916cebd68a8023bea164af239e0872f02024 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 28 Nov 2025 14:56:30 +0100 Subject: [PATCH 107/373] GCN: Use generic instead of specific arch for default-built multilibs MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit GCC 15 and ROCm 6.4.0 (released April/May 2025) support generic archs. Thus, by moving to generic archs, the number of multilibs build by GCC can be reduced - while the number of supported devices increases. This commit now replaces the specific gfx... by gfx{9,9-4,10-3,11}-generic, keeping gfx908 and gfx09a as no generic exists for those. When building for a device without a multilib but the generic one exists, there is a diagnostic like: gcn mkoffload: fatal error: GCC was built without library support for ‘-march=gfx1150’; consider compiling for the associated generic architecture ‘-march=gfx11-generic’ instead As gfx900 is no longer build by default, gfx90a was picked as new default device. gcc/ChangeLog: * config.gcc (amdgcn-*-*): Use gfx90a for 'with_arch'. For TM_MULTILIB_CONFIG, replace specific archs by gfx{9,9-4,10-3,11}-generic, keep gfx90{8,a}. * config/gcn/gcn.opt (march=, mtune=): Use gfx90a. * doc/install.texi (amdgcn): Update accordingly. --- gcc/config.gcc | 4 ++-- gcc/config/gcn/gcn.opt | 4 ++-- gcc/doc/install.texi | 19 ++++++++++--------- 3 files changed, 14 insertions(+), 13 deletions(-) diff --git a/gcc/config.gcc b/gcc/config.gcc index 703554263969..e17354b3e654 100644 --- a/gcc/config.gcc +++ b/gcc/config.gcc @@ -4640,14 +4640,14 @@ case "${target}" in exit 1 fi done - [ "x$with_arch" = x ] && with_arch=gfx900 + [ "x$with_arch" = x ] && with_arch=gfx90a case "x${with_multilib_list}" in x | xno) TM_MULTILIB_CONFIG= ;; xdefault | xyes) - TM_MULTILIB_CONFIG=`echo "gfx900,gfx906,gfx908,gfx90a,gfx90c,gfx1030,gfx1036,gfx1100,gfx1103" | sed "s/${with_arch},\?//;s/,$//"` + TM_MULTILIB_CONFIG=`echo "gfx908,gfx90a,gfx9-generic,gfx9-4-generic,gfx10-3-generic,gfx11-generic" | sed "s/${with_arch},\?//;s/,$//"` ;; *) TM_MULTILIB_CONFIG="${with_multilib_list}" diff --git a/gcc/config/gcn/gcn.opt b/gcc/config/gcn/gcn.opt index 99d6aeb2b30f..1b2d5cca289e 100644 --- a/gcc/config/gcn/gcn.opt +++ b/gcc/config/gcn/gcn.opt @@ -22,11 +22,11 @@ HeaderInclude config/gcn/gcn-opts.h march= -Target RejectNegative Negative(march=) Joined ToLower Enum(gpu_type) Var(gcn_arch) Init(PROCESSOR_GFX900) +Target RejectNegative Negative(march=) Joined ToLower Enum(gpu_type) Var(gcn_arch) Init(PROCESSOR_GFX90A) Specify the name of the target GPU. mtune= -Target RejectNegative Negative(mtune=) Joined ToLower Enum(gpu_type) Var(gcn_tune) Init(PROCESSOR_GFX900) +Target RejectNegative Negative(mtune=) Joined ToLower Enum(gpu_type) Var(gcn_tune) Init(PROCESSOR_GFX90A) Specify the name of the target GPU. m32 diff --git a/gcc/doc/install.texi b/gcc/doc/install.texi index 7f4321c424b9..1ca0119fe76e 100644 --- a/gcc/doc/install.texi +++ b/gcc/doc/install.texi @@ -4084,16 +4084,17 @@ supported ISAs as multilib; use @code{--with-multilib-list=} to tailor the built multilibs. Note that mixing ISAs in the same binary is not supported and gives a linker error. -By default, multilib support is built for @code{gfx900}, @code{gfx906}, -@code{gfx908}, @code{gfx90a}, @code{gfx90c}, @code{gfx1030}, @code{gfx1036}, -@code{gfx1100} and @code{gfx1103}. The default multilib configuration -requires LLVM 15 or newer. LLVM 13.0.1 or LLVM 14 can be used by specifying -a @code{--with-multilib-list=} that does not list any GFX 11 device nor -@code{gfx1036}. At least LLVM 16 is required for @code{gfx1150} and -@code{gfx1151}, LLVM 18 for @code{gfx942}, LLVM 19 for the generic +By default, multilib support is built for @code{gfx908}, @code{gfx90a}, @code{gfx9-generic}, @code{gfx9-4-generic}, @code{gfx10-3-generic}, and -@code{gfx11-generic} targets and for @code{gfx1152}, while LLVM 20 is required -for @code{gfx950} and @code{gfx1153}. +@code{gfx11-generic}, which covers all supported archs. The default multilib +configuration requires LLVM 19 or newer. LLVM 13.0.1 or LLVM 14 can be used by +specifying a @code{--with-multilib-list=} that only lists GFX9 or GFX10-3 +devices, while LLVM 15 is required for GFX 11 device and @code{gfx1036}. +At least LLVM 16 is required for @code{gfx1150} and @code{gfx1151}, +LLVM 18 for @code{gfx942}, LLVM 19 for the generic @code{gfx9-generic}, +@code{gfx9-4-generic}, @code{gfx10-3-generic}, and @code{gfx11-generic} +targets and for @code{gfx1152}, while LLVM 20 is required for +@code{gfx950} and @code{gfx1153}. The supported ISA architectures are listed in the GCC manual. The generic ISA targets @code{gfx9-generic}, @code{gfx10-3-generic}, and From 1ff32875e93be6617e093c0ef1413d506c58f045 Mon Sep 17 00:00:00 2001 From: Andrew MacLeod Date: Wed, 26 Nov 2025 14:21:13 -0500 Subject: [PATCH 108/373] Undefined bitmasks imply undefined ranges. bitmask have no way of representing UNDEFINED, and as such, bitmask intersection returns an unknown_p values instead. This patch has the function return false in this case, which will indicate UNDEFINED. PR tree-optimization/122686 gcc/ * range-op.cc (operator_bitwise_and::op1_range): Check for undefined bitmask. * value-range.cc (prange::intersect): Handle undefined bitmask intersection. (irange::get_bitmask): Ditto. (irange::intersect_bitmask): Ditto. * value-range.h (irange_bitmask::intersect): Return false if the result is UNDEFINED. --- gcc/range-op.cc | 9 ++++++--- gcc/value-range.cc | 15 ++++++++++----- gcc/value-range.h | 17 +++++++---------- 3 files changed, 23 insertions(+), 18 deletions(-) diff --git a/gcc/range-op.cc b/gcc/range-op.cc index 82a994b4ca55..fb7d4742bb6d 100644 --- a/gcc/range-op.cc +++ b/gcc/range-op.cc @@ -3848,9 +3848,12 @@ operator_bitwise_and::op1_range (irange &r, tree type, // extraneous values thats are not convered by the mask. wide_int op1_value = lhs_bm.value () & ~op1_mask; irange_bitmask op1_bm (op1_value, op1_mask); - // INtersect this mask with anything already known about the value. - op1_bm.intersect (r.get_bitmask ()); - r.update_bitmask (op1_bm); + // Intersect this mask with anything already known about the value. + // A return valueof false indicated the bitmask is an UNDEFINED range. + if (op1_bm.intersect (r.get_bitmask ())) + r.update_bitmask (op1_bm); + else + r.set_undefined (); return true; } diff --git a/gcc/value-range.cc b/gcc/value-range.cc index f93a7e5c53a2..605f70817375 100644 --- a/gcc/value-range.cc +++ b/gcc/value-range.cc @@ -674,8 +674,10 @@ prange::intersect (const vrange &v) // Intersect all bitmasks: the old one, the new one, and the other operand's. irange_bitmask new_bitmask (m_type, m_min, m_max); - m_bitmask.intersect (new_bitmask); - m_bitmask.intersect (r.m_bitmask); + if (!m_bitmask.intersect (new_bitmask)) + set_undefined (); + else if (!m_bitmask.intersect (r.m_bitmask)) + set_undefined (); if (varying_compatible_p ()) { set_varying (type ()); @@ -2528,10 +2530,9 @@ irange::get_bitmask () const irange_bitmask bm (type (), lower_bound (), upper_bound ()); if (!m_bitmask.unknown_p ()) { - bm.intersect (m_bitmask); // If the new intersection is unknown, it means there are inconstent // bits, so simply return the original bitmask. - if (bm.unknown_p ()) + if (!bm.intersect (m_bitmask)) return m_bitmask; } return bm; @@ -2572,7 +2573,11 @@ irange::intersect_bitmask (const irange &r) irange_bitmask bm = get_bitmask (); irange_bitmask save = bm; - bm.intersect (r.get_bitmask ()); + if (!bm.intersect (r.get_bitmask ())) + { + set_undefined (); + return true; + } // If the new mask is the same, there is no change. if (m_bitmask == bm) diff --git a/gcc/value-range.h b/gcc/value-range.h index 6ae46e179595..11d1ed75744c 100644 --- a/gcc/value-range.h +++ b/gcc/value-range.h @@ -145,7 +145,7 @@ class irange_bitmask bool unknown_p () const; unsigned get_precision () const; void union_ (const irange_bitmask &src); - void intersect (const irange_bitmask &src); + bool intersect (const irange_bitmask &src); bool operator== (const irange_bitmask &src) const; bool operator!= (const irange_bitmask &src) const { return !(*this == src); } void verify_mask () const; @@ -247,20 +247,16 @@ irange_bitmask::union_ (const irange_bitmask &src) verify_mask (); } -inline void +// Return FALSE if the bitmask intersection is undefined. + +inline bool irange_bitmask::intersect (const irange_bitmask &src) { // If we have two known bits that are incompatible, the resulting - // bit is undefined. It is unclear whether we should set the entire - // range to UNDEFINED, or just a subset of it. For now, set the - // entire bitmask to unknown (VARYING). + // bit and therefore entire range is undefined. Return FALSE. if (wi::bit_and (~(m_mask | src.m_mask), m_value ^ src.m_value) != 0) - { - unsigned prec = m_mask.get_precision (); - m_mask = wi::minus_one (prec); - m_value = wi::zero (prec); - } + return false; else { m_mask = m_mask & src.m_mask; @@ -268,6 +264,7 @@ irange_bitmask::intersect (const irange_bitmask &src) } if (flag_checking) verify_mask (); + return true; } // An integer range without any storage. From 2d3142c00934c419755c17dd85ecdb0e72f249d1 Mon Sep 17 00:00:00 2001 From: Patrick Palka Date: Fri, 28 Nov 2025 15:38:04 -0500 Subject: [PATCH 109/373] libstdc++: Correctly implement LWG 3946 changes to const_iterator_t [PR122842] MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit LWG 3946 made const_iterator_t/sentinel_t agree with ranges::cbegin/cend by defining the aliases in terms of the CPOs, but I defined it the other way around in an incorrect way that made the aliases not consider range-ness of const T via __possibly_const_range. This patch reimplements the proposed resolution in a more obviously correct way, mirroring the wording. PR libstdc++/122842 libstdc++-v3/ChangeLog: * include/bits/ranges_base.h (__access:_CBegin): Define in terms of const_iterator directly, not const_iterator_t. (__access::_CEnd): Likewise in terms of const_sentinel vs const_sentinel_t. (const_iterator_t): Move down definition and define in terms of ranges::cbegin as per LWG 3946. (const_sentinel_t): Likewise in terms of ranges::cend. * testsuite/24_iterators/const_iterator/1.cc (test02): Correct test for int[], std::array and std::vector. Also test std::string. Reviewed-by: Tomasz Kamiński Reviewed-by: Jonathan Wakely --- libstdc++-v3/include/bits/ranges_base.h | 20 ++++++++----- .../24_iterators/const_iterator/1.cc | 29 ++++++++++++++----- 2 files changed, 35 insertions(+), 14 deletions(-) diff --git a/libstdc++-v3/include/bits/ranges_base.h b/libstdc++-v3/include/bits/ranges_base.h index 1c4bf432c8f4..0b8151cd65dd 100644 --- a/libstdc++-v3/include/bits/ranges_base.h +++ b/libstdc++-v3/include/bits/ranges_base.h @@ -525,11 +525,7 @@ namespace ranges using sentinel_t = decltype(ranges::end(std::declval<_Range&>())); #if __glibcxx_ranges_as_const // >= C++23 - template - using const_iterator_t = const_iterator>; - - template - using const_sentinel_t = const_sentinel>; + // const_iterator_t and const_sentinel_t defined below. template using range_const_reference_t = iter_const_reference_t>; @@ -683,7 +679,7 @@ namespace ranges (ranges::begin(__access::__possibly_const_range(__t))); } { auto& __r = __access::__possibly_const_range(__t); - return const_iterator_t(ranges::begin(__r)); + return const_iterator(ranges::begin(__r)); } #else template @@ -711,7 +707,7 @@ namespace ranges (ranges::end(__access::__possibly_const_range(__t))); } { auto& __r = __access::__possibly_const_range(__t); - return const_sentinel_t(ranges::end(__r)); + return const_sentinel(ranges::end(__r)); } #else template @@ -815,6 +811,16 @@ namespace ranges inline constexpr ranges::__access::_CData cdata{}; } +#if __glibcxx_ranges_as_const // >= C++23 + // _GLIBCXX_RESOLVE_LIB_DEFECTS + // 3946. The definition of const_iterator_t should be reworked + template + using const_iterator_t = decltype(ranges::cbegin(std::declval<_Range&>())); + + template + using const_sentinel_t = decltype(ranges::cend(std::declval<_Range&>())); +#endif + namespace __detail { template diff --git a/libstdc++-v3/testsuite/24_iterators/const_iterator/1.cc b/libstdc++-v3/testsuite/24_iterators/const_iterator/1.cc index fe952bfad148..f2bcad4f09c9 100644 --- a/libstdc++-v3/testsuite/24_iterators/const_iterator/1.cc +++ b/libstdc++-v3/testsuite/24_iterators/const_iterator/1.cc @@ -42,12 +42,13 @@ test01() } } -template +template void test02() { if constexpr (Const) { + static_assert(Constable); static_assert( ranges::constant_range ); static_assert( std::same_as, ranges::iterator_t> ); static_assert( std::same_as, ranges::sentinel_t> ); @@ -64,9 +65,21 @@ test02() static_assert( !ranges::constant_range ); using Wrapped = std::basic_const_iterator>; - static_assert( std::same_as, Wrapped> ); - if constexpr (ranges::common_range) - static_assert( std::same_as, Wrapped> ); + if constexpr (Constable) + { + // Verify LWG 3946 changes to const_iterator/sentinel_t (PR122842). + static_assert( std::same_as, + ranges::iterator_t> ); + static_assert( std::same_as, + ranges::sentinel_t> ); + } + else + { + static_assert( std::same_as, Wrapped> ); + if constexpr (ranges::common_range) + static_assert( std::same_as, Wrapped> ); + } + static_assert( std::same_as, std::iter_reference_t> ); @@ -138,13 +151,14 @@ main() test01(); test01::const_iterator, true>(); - test02(); + test02(); test02, false>(); test02, false>(); test02, false>(); test02, false>(); - test02, false>(); - test02, false>(); + test02, false, true>(); + test02, false, true>(); + test02(); test02(); test02, true>(); @@ -155,6 +169,7 @@ main() test02, true>(); test02(); test02, true>(); + test02(); test03(); test04(); From a6a24813c8f9fc7af25fa7f48ac395f40e48aa71 Mon Sep 17 00:00:00 2001 From: Sam James Date: Fri, 28 Nov 2025 20:53:43 +0000 Subject: [PATCH 110/373] gcc: fix typo in comment Just testing pushing after sw migration. gcc/ChangeLog: * crc-verification.cc (crc_symbolic_execution::is_used_outside_the_loop): Fix 'assignment' typo. --- gcc/crc-verification.cc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/crc-verification.cc b/gcc/crc-verification.cc index c7b0fedd6e4d..4b0018de5d67 100644 --- a/gcc/crc-verification.cc +++ b/gcc/crc-verification.cc @@ -58,7 +58,7 @@ crc_symbolic_execution::is_used_outside_the_loop (tree def) return false; } -/* Calculate value of the rhs operation of GS assigment statement +/* Calculate value of the rhs operation of GS assignment statement and assign it to lhs variable. */ bool From 2d3bc20a040978461a18210d678874d90f29dd1f Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Fri, 28 Nov 2025 22:03:19 +0100 Subject: [PATCH 111/373] riscv: RISCV backend, meet C++20 C++20, in particular https://wg21.link/P1120R0 paper voted into it, deprecates various operations between enumerators from different enumeration types etc., and as we've switched to -std=gnu++20 by default, this now results in warnings or errors during stage2 and onwards. The following patch should fix riscv build. 2025-11-28 Jakub Jelinek * config/riscv/riscv-v.cc (expand_const_vector_onestep): Avoid bitwise ops between enumerators from different enum types. (emit_vec_cvt_x_f): Likewise. (emit_vec_cvt_x_f_rtz): Likewise. * config/riscv/riscv.cc (riscv_unspec_address_offset): Avoid arithmetics between enumerators from different enum types. --- gcc/config/riscv/riscv-v.cc | 7 ++++--- gcc/config/riscv/riscv.cc | 2 +- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/gcc/config/riscv/riscv-v.cc b/gcc/config/riscv/riscv-v.cc index c6c22371d9a9..5e30b77b4ebf 100644 --- a/gcc/config/riscv/riscv-v.cc +++ b/gcc/config/riscv/riscv-v.cc @@ -1811,7 +1811,8 @@ expand_const_vector_onestep (rtx target, rvv_builder &builder) rtx dest = gen_reg_rtx (mode); insn_code icode = code_for_pred_mov (mode); rtx ops3[] = {dest, tmp3, tmp1}; - emit_nonvlmax_insn (icode, __MASK_OP_TUMA | UNARY_OP_P, ops3, GEN_INT (n)); + emit_nonvlmax_insn (icode, (unsigned) __MASK_OP_TUMA | UNARY_OP_P, + ops3, GEN_INT (n)); emit_move_insn (target, dest); } @@ -5265,7 +5266,7 @@ emit_vec_cvt_x_f (rtx op_dest, rtx op_src, rtx mask, { insn_code icode = code_for_pred_fcvt_x_f (UNSPEC_VFCVT, vec_mode); - if (type & USE_VUNDEF_MERGE_P) + if (type & (insn_type) USE_VUNDEF_MERGE_P) { rtx cvt_x_ops[] = {op_dest, mask, op_src}; emit_vlmax_insn (icode, type, cvt_x_ops); @@ -5333,7 +5334,7 @@ emit_vec_cvt_x_f_rtz (rtx op_dest, rtx op_src, rtx mask, { insn_code icode = code_for_pred (FIX, vec_mode); - if (type & USE_VUNDEF_MERGE_P) + if (type & (insn_type) USE_VUNDEF_MERGE_P) { rtx cvt_x_ops[] = {op_dest, mask, op_src}; emit_vlmax_insn (icode, type, cvt_x_ops); diff --git a/gcc/config/riscv/riscv.cc b/gcc/config/riscv/riscv.cc index 3e737d54d57f..1804d5a689b4 100644 --- a/gcc/config/riscv/riscv.cc +++ b/gcc/config/riscv/riscv.cc @@ -2864,7 +2864,7 @@ riscv_unspec_address_offset (rtx base, rtx offset, enum riscv_symbol_type symbol_type) { base = gen_rtx_UNSPEC (Pmode, gen_rtvec (1, base), - UNSPEC_ADDRESS_FIRST + symbol_type); + UNSPEC_ADDRESS_FIRST + (int) symbol_type); if (offset != const0_rtx) base = gen_rtx_PLUS (Pmode, base, offset); return gen_rtx_CONST (Pmode, base); From 1121d2cc8e4b06523773a4d8f49f38d9c75aaa53 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Fri, 28 Nov 2025 22:04:25 +0100 Subject: [PATCH 112/373] mips: MIPS backend, meet C++20 C++20, in particular https://wg21.link/P1120R0 paper voted into it, deprecates various operations between enumerators from different enumeration types etc., and as we've switched to -std=gnu++20 by default, this now results in warnings or errors during stage2 and onwards. The following patch should fix mips build. 2025-11-28 Jakub Jelinek * config/mips/mips.cc (mips_unspec_address_offset): Avoid arithmetics between enumerators from different enum types. --- gcc/config/mips/mips.cc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gcc/config/mips/mips.cc b/gcc/config/mips/mips.cc index 42dfc3b35119..abdf0da7a84c 100644 --- a/gcc/config/mips/mips.cc +++ b/gcc/config/mips/mips.cc @@ -3315,7 +3315,7 @@ mips_unspec_address_offset (rtx base, rtx offset, enum mips_symbol_type symbol_type) { base = gen_rtx_UNSPEC (Pmode, gen_rtvec (1, base), - UNSPEC_ADDRESS_FIRST + symbol_type); + UNSPEC_ADDRESS_FIRST + (int) symbol_type); if (offset != const0_rtx) base = gen_rtx_PLUS (Pmode, base, offset); return gen_rtx_CONST (Pmode, base); From e7de6ffc2dad50e99452127fc3875e248fa01766 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Fri, 28 Nov 2025 22:04:57 +0100 Subject: [PATCH 113/373] loongarch: LoongArch backend, meet C++20 C++20, in particular https://wg21.link/P1120R0 paper voted into it, deprecates various operations between enumerators from different enumeration types etc., and as we've switched to -std=gnu++20 by default, this now results in warnings or errors during stage2 and onwards. The following patch should fix loongarch build. 2025-11-28 Jakub Jelinek * config/loongarch/loongarch.cc (loongarch_unspec_address_offset): Avoid arithmetics between enumerators from different enum types. (loongarch_call_tls_get_addr): Likewise. --- gcc/config/loongarch/loongarch.cc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/config/loongarch/loongarch.cc b/gcc/config/loongarch/loongarch.cc index c1a53e3e7ca0..053f77cb994a 100644 --- a/gcc/config/loongarch/loongarch.cc +++ b/gcc/config/loongarch/loongarch.cc @@ -3003,7 +3003,7 @@ loongarch_unspec_address_offset (rtx base, rtx offset, enum loongarch_symbol_type symbol_type) { base = gen_rtx_UNSPEC (Pmode, gen_rtvec (1, base), - UNSPEC_ADDRESS_FIRST + symbol_type); + UNSPEC_ADDRESS_FIRST + (int) symbol_type); if (offset != const0_rtx) base = gen_rtx_PLUS (Pmode, base, offset); return gen_rtx_CONST (Pmode, base); @@ -3223,7 +3223,7 @@ loongarch_call_tls_get_addr (rtx sym, enum loongarch_symbol_type type, rtx v0) rtx sum = gen_rtx_UNSPEC ( Pmode, gen_rtvec (1, loongarch_tls_symbol), UNSPEC_ADDRESS_FIRST - + loongarch_classify_symbol (loongarch_tls_symbol)); + + (int) loongarch_classify_symbol (loongarch_tls_symbol)); set_unique_reg_note (get_last_insn (), REG_EQUAL, sum); } else From 36053843658f349bf645484b9dacd6f41a156d5e Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Fri, 28 Nov 2025 22:05:34 +0100 Subject: [PATCH 114/373] powerpc: PowerPC backend, meet C++20 C++20, in particular https://wg21.link/P1120R0 paper voted into it, deprecates various operations between enumerators from different enumeration types etc., and as we've switched to -std=gnu++20 by default, this now results in warnings or errors during stage2 and onwards. The following patch should fix rs6000 build. 2025-11-28 Jakub Jelinek * config/rs6000/rs6000.cc (complex_multiply_builtin_code): Avoid arithmetics between enumerators from different enum types. (complex_divide_builtin_code): Likewise. --- gcc/config/rs6000/rs6000.cc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gcc/config/rs6000/rs6000.cc b/gcc/config/rs6000/rs6000.cc index 1d5cd25c0f08..bf899adc5315 100644 --- a/gcc/config/rs6000/rs6000.cc +++ b/gcc/config/rs6000/rs6000.cc @@ -28490,7 +28490,7 @@ static inline built_in_function complex_multiply_builtin_code (machine_mode mode) { gcc_assert (IN_RANGE (mode, MIN_MODE_COMPLEX_FLOAT, MAX_MODE_COMPLEX_FLOAT)); - int func = BUILT_IN_COMPLEX_MUL_MIN + mode - MIN_MODE_COMPLEX_FLOAT; + int func = BUILT_IN_COMPLEX_MUL_MIN + (mode - MIN_MODE_COMPLEX_FLOAT); return (built_in_function) func; } @@ -28501,7 +28501,7 @@ static inline built_in_function complex_divide_builtin_code (machine_mode mode) { gcc_assert (IN_RANGE (mode, MIN_MODE_COMPLEX_FLOAT, MAX_MODE_COMPLEX_FLOAT)); - int func = BUILT_IN_COMPLEX_DIV_MIN + mode - MIN_MODE_COMPLEX_FLOAT; + int func = BUILT_IN_COMPLEX_DIV_MIN + (mode - MIN_MODE_COMPLEX_FLOAT); return (built_in_function) func; } From 4eca016d56d7c5ac1ceafe0afb8112f0f72f1957 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Fri, 28 Nov 2025 22:06:30 +0100 Subject: [PATCH 115/373] analyzer: Fix 3 C++20 warnings in analyzer MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit I've noticed ../../gcc/analyzer/known-function-manager.cc:86:33: warning: arithmetic between different enumeration types ‘internal_fn’ and ‘built_in_function’ is deprecated +[-Wdeprecated-enum-enum-conversion] ../../gcc/analyzer/known-function-manager.cc:87:26: warning: arithmetic between different enumeration types ‘internal_fn’ and ‘built_in_function’ is deprecated +[-Wdeprecated-enum-enum-conversion] ../../gcc/analyzer/known-function-manager.cc:140:33: warning: arithmetic between different enumeration types ‘internal_fn’ and ‘built_in_function’ is deprecated +[-Wdeprecated-enum-enum-conversion] warnings. Fixed thusly. 2025-11-28 Jakub Jelinek * known-function-manager.cc (known_function_manager::add): Avoid arithmetics between enumerators from different enum types. (known_function_manager::get_internal_fn): Likewise. --- gcc/analyzer/known-function-manager.cc | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/gcc/analyzer/known-function-manager.cc b/gcc/analyzer/known-function-manager.cc index 3b645a8c90f8..fad34ad38b0f 100644 --- a/gcc/analyzer/known-function-manager.cc +++ b/gcc/analyzer/known-function-manager.cc @@ -83,8 +83,8 @@ known_function_manager::add (enum internal_fn ifn, std::unique_ptr kf) { gcc_assert (ifn < IFN_LAST); - delete m_combined_fns_arr[ifn + END_BUILTINS]; - m_combined_fns_arr[ifn + END_BUILTINS] = kf.release (); + delete m_combined_fns_arr[ifn + int (END_BUILTINS)]; + m_combined_fns_arr[ifn + int (END_BUILTINS)] = kf.release (); } /* Get any known_function for FNDECL for call CD. @@ -137,7 +137,7 @@ const known_function * known_function_manager::get_internal_fn (enum internal_fn ifn) const { gcc_assert (ifn < IFN_LAST); - return m_combined_fns_arr[ifn + END_BUILTINS]; + return m_combined_fns_arr[ifn + int (END_BUILTINS)]; } /* Get any known_function for NAME, without type-checking. From 8a6b9b4161decbc12e26860163379f8e80feabc1 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Sat, 29 Nov 2025 00:16:27 +0000 Subject: [PATCH 116/373] Daily bump. --- gcc/ChangeLog | 136 ++++++++++++++++++++++++++++++++++++++++ gcc/DATESTAMP | 2 +- gcc/analyzer/ChangeLog | 6 ++ gcc/cp/ChangeLog | 6 ++ gcc/fortran/ChangeLog | 7 +++ gcc/testsuite/ChangeLog | 33 ++++++++++ libstdc++-v3/ChangeLog | 14 +++++ 7 files changed, 203 insertions(+), 1 deletion(-) diff --git a/gcc/ChangeLog b/gcc/ChangeLog index af44c22d36ba..584ac66ea036 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,139 @@ +2025-11-28 Jakub Jelinek + + * config/rs6000/rs6000.cc (complex_multiply_builtin_code): + Avoid arithmetics between enumerators from different enum types. + (complex_divide_builtin_code): Likewise. + +2025-11-28 Jakub Jelinek + + * config/loongarch/loongarch.cc (loongarch_unspec_address_offset): + Avoid arithmetics between enumerators from different enum types. + (loongarch_call_tls_get_addr): Likewise. + +2025-11-28 Jakub Jelinek + + * config/mips/mips.cc (mips_unspec_address_offset): Avoid + arithmetics between enumerators from different enum types. + +2025-11-28 Jakub Jelinek + + * config/riscv/riscv-v.cc (expand_const_vector_onestep): Avoid + bitwise ops between enumerators from different enum types. + (emit_vec_cvt_x_f): Likewise. + (emit_vec_cvt_x_f_rtz): Likewise. + * config/riscv/riscv.cc (riscv_unspec_address_offset): Avoid + arithmetics between enumerators from different enum types. + +2025-11-28 Sam James + + * crc-verification.cc (crc_symbolic_execution::is_used_outside_the_loop): + Fix 'assignment' typo. + +2025-11-28 Andrew MacLeod + + PR tree-optimization/122686 + * range-op.cc (operator_bitwise_and::op1_range): Check for + undefined bitmask. + * value-range.cc (prange::intersect): Handle undefined bitmask + intersection. + (irange::get_bitmask): Ditto. + (irange::intersect_bitmask): Ditto. + * value-range.h (irange_bitmask::intersect): Return false if the + result is UNDEFINED. + +2025-11-28 Tobias Burnus + + * config.gcc (amdgcn-*-*): Use gfx90a for 'with_arch'. + For TM_MULTILIB_CONFIG, replace specific archs by + gfx{9,9-4,10-3,11}-generic, keep gfx90{8,a}. + * config/gcn/gcn.opt (march=, mtune=): Use gfx90a. + * doc/install.texi (amdgcn): Update accordingly. + +2025-11-28 Stefan Schulze Frielinghaus + + * config/s390/s390-builtins.h + (S390_OVERLOADED_BUILTIN_VAR_OFFSET,S390_ALL_BUILTIN_MAX): Fix + enum arithmetic. + * config/s390/s390.cc (OB_DEF): Ditto. + +2025-11-28 Richard Biener + + PR tree-optimization/122844 + * tree-vect-slp.cc (vect_analyze_slp_reduc_chain): Only + try stripping sign conversions around ops where this is valid. + +2025-11-28 Jim Lin + + * config/riscv/riscv.cc (riscv_output_move): Use \n\t instead + of semicolon to separate instructions in fmv.x.h emulation. + +2025-11-28 Charlie Jenkins + + * config.gcc: Add cpu to supported configure options + * config/riscv/riscv.h (riscv_arch_help): Use --with-cpu during + compilation + * doc/install.texi: Mention in docs that --with-cpu is supported + +2025-11-28 Mark Zhuang + + * config/riscv/riscv-cores.def (RISCV_CORE): Add xsmtvdot to + spacemit-x60 + * config/riscv/riscv-ext.def: Add xsmtvdot + * config/riscv/riscv-ext.opt: Ditto + * config/riscv/t-riscv: Ditto + * doc/riscv-ext.texi: Ditto + * config/riscv/riscv-ext-spacemit.def: Define xsmtvdot + +2025-11-28 Mark Zhuang + + * config/riscv/riscv-ext.opt: Generated file. + +2025-11-28 Kuan-Lin Chen + + * config/riscv/riscv-cores.def (RISCV_TUNE): Add andes-45-sereis. + (RISCV_CORE): Add Andes 45 series cpu list. + * config/riscv/riscv-opts.h + (enum riscv_microarchitecture_type): Add andes_45_series. + * config/riscv/riscv.cc: Add andes_45_tune_info. + * config/riscv/riscv.md: Add andes_45. + * doc/riscv-mcpu.texi: Regenerated for Andes cpu list. + * doc/riscv-mtune.texi: Regenerated for andes-45-series. + * config/riscv/andes-45-series.md: New file. + +2025-11-28 Kuan-Lin Chen + + * config/riscv/riscv-cores.def (RISCV_TUNE): Add andes-23-series. + (RISCV_CORE): Add Andes 23-series cpu list. + * config/riscv/riscv-opts.h + (enum riscv_microarchitecture_type): Add andes_23_series. + * config/riscv/riscv.cc: Add andes_23_tune_info. + * config/riscv/riscv.md: Add andes_23. + * doc/riscv-mcpu.texi: Regenerated for Andes cpu list. + * doc/riscv-mtune.texi: Regenerated for andes-23-series. + * config/riscv/andes-23-series.md: New file. + +2025-11-28 Jakub Jelinek + + PR tree-optimization/122733 + * gimple-match-head.cc (gimple_match_range_of_expr): Return false + even when range_of_expr returns true, but the range is undefined_p. + * match.pd ((mult (plus:s@5 (mult:s@4 @0 @1) @2) @3)): Remove + vr0.undefined_p () check. + ((plus (mult:s@5 (plus:s@4 @0 @1) @2) @3)): Likewise. + ((X + M*N) / N -> X / N + M): Remove vr4.undefined_p () check. + ((X - M*N) / N -> X / N - M): Likewise. + ((y << x) == x, (y << x) != x): Use convert2? instead of + nop_convert2? and test INTEGRAL_TYPE_P on TREE_TYPE (@0) rather than + TREE_TYPE (@1). + ((y << x) {<,<=,>,>=} x): New simplification. + (((T)(A)) + CST -> (T)(A + CST)): Remove vr.undefined_p () check. + (x_5 == cstN ? cst4 : cst3): Remove r.undefined_p () check. + +2025-11-28 Tamar Christina + + PR middle-end/122890 + * optabs.cc (emit_cmp_and_jump_insns): Check for SSA Name. + 2025-11-27 Matthieu Longo * config/aarch64/aarch64-c.cc (aarch64_define_unconditional_macros): Define diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 1ae1ab83d643..159d5b496831 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20251128 +20251129 diff --git a/gcc/analyzer/ChangeLog b/gcc/analyzer/ChangeLog index 9e18914aad9f..58fc1f406724 100644 --- a/gcc/analyzer/ChangeLog +++ b/gcc/analyzer/ChangeLog @@ -1,3 +1,9 @@ +2025-11-28 Jakub Jelinek + + * known-function-manager.cc (known_function_manager::add): Avoid + arithmetics between enumerators from different enum types. + (known_function_manager::get_internal_fn): Likewise. + 2025-11-27 Jonathan Wakely * constraint-manager.cc (equiv_class::operator==): Add const diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 61f8b6c41f95..2294eaaef216 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,9 @@ +2025-11-28 Jakub Jelinek + + PR c++/119969 + * cp-objcp-common.cc (cxx_get_alias_set): Remove special cases + for TYPE_PTRMEMFUNC_P and INDIRECT_TYPE_P for TYPE_PTRMEMFUNC_P. + 2025-11-26 Marek Polacek PR c++/121325 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 344d47fddeb3..81f8e6231c24 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2025-11-28 Tobias Burnus + + PR c/122892 + * openmp.cc (gfc_resolve_omp_allocate): Reject non-local + static variables with cgroup/pteam/thread allocators. + * parse.cc: Permit OMP ALLOCATE in BLOCK DATA. + 2025-11-26 Tobias Burnus * dump-parse-tree.cc (show_attr): Handle OpenMP's 'local' clause diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index b3dbc89c32df..474547233d1c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,36 @@ +2025-11-28 Richard Biener + + PR tree-optimization/122844 + * gcc.dg/vect/vect-pr122844.c: New testcase. + +2025-11-28 Tobias Burnus + + PR c/122892 + * gfortran.dg/gomp/allocate-15.f90: Use another allocator as + omp_{cgroup,pteam}_mem_alloc is invalid for non-local static vars. + * gfortran.dg/gomp/allocate-7.f90: Likewise. + * gfortran.dg/gomp/allocate-static-3.f90: New test. + +2025-11-28 Jakub Jelinek + + PR c++/119969 + * g++.dg/torture/pr119969.C: New test. + +2025-11-28 Mark Zhuang + + * gcc.target/riscv/predef-smt-1.c: New test. + +2025-11-28 Jakub Jelinek + + PR tree-optimization/122733 + * gcc.dg/match-shift-cmp-4.c: New test. + * gcc.dg/match-shift-cmp-5.c: New test. + +2025-11-28 Tamar Christina + + PR middle-end/122890 + * g++.target/aarch64/pr122890.C: New test. + 2025-11-27 Jakub Jelinek PR c/121506 diff --git a/libstdc++-v3/ChangeLog b/libstdc++-v3/ChangeLog index cb6bd547b25a..fee99ba84725 100644 --- a/libstdc++-v3/ChangeLog +++ b/libstdc++-v3/ChangeLog @@ -1,3 +1,17 @@ +2025-11-28 Patrick Palka + + PR libstdc++/122842 + * include/bits/ranges_base.h (__access:_CBegin): Define in + terms of const_iterator directly, not const_iterator_t. + (__access::_CEnd): Likewise in terms of const_sentinel vs + const_sentinel_t. + (const_iterator_t): Move down definition and define in terms + of ranges::cbegin as per LWG 3946. + (const_sentinel_t): Likewise in terms of ranges::cend. + * testsuite/24_iterators/const_iterator/1.cc (test02): Correct + test for int[], std::array and std::vector. Also test + std::string. + 2025-11-27 Jonathan Wakely * testsuite/performance/23_containers/sort_search/list.cc: Cast From 7920cbcbe3b2e21334f6b584dfe3bafd9bfcfadf Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Thu, 6 Nov 2025 23:34:58 +0000 Subject: [PATCH 117/373] doc, aarch64: Clean up aarch64 options and documentation [PR122243] gcc/ChangeLog PR other/122243 * config/aarch64/aarch64.opt (Wexperimental-fmv-target): Mark as "Undocumented". * doc/invoke.texi (Option Summary) : Don't list "Undocumented" aarch64 options -mverbose-cost-dump or -Wexperimental-fmv-target, or both positive and negative forms of other options. Add missing options. Fix whitespace problems. (AArch64 Options): Light copy-editing. Add missing @opindex entries to match the documented options. Undocument -mverbose-cost-dump and -Wexperimental-fmv-target. --- gcc/config/aarch64/aarch64.opt | 2 +- gcc/doc/invoke.texi | 52 ++++++++++++++++++---------------- 2 files changed, 28 insertions(+), 26 deletions(-) diff --git a/gcc/config/aarch64/aarch64.opt b/gcc/config/aarch64/aarch64.opt index df93b59fe3f3..6c0cbc7b64dd 100644 --- a/gcc/config/aarch64/aarch64.opt +++ b/gcc/config/aarch64/aarch64.opt @@ -457,5 +457,5 @@ also try to opportunistically form writeback opportunities by folding in trailing destructive updates of the base register used by a pair. Wexperimental-fmv-target -Target Var(warn_experimental_fmv) Warning Init(1) +Target Var(warn_experimental_fmv) Warning Init(1) Undocumented This option is deprecated. diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 071aa6d65742..ad8d742bba4a 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -889,22 +889,22 @@ Objective-C and Objective-C++ Dialects}. -menable-sysreg-checking -mgeneral-regs-only -mcmodel=tiny -mcmodel=small -mcmodel=large --mstrict-align -mno-strict-align --momit-leaf-frame-pointer +-mstrict-align -momit-leaf-frame-pointer -mtls-dialect=desc -mtls-dialect=traditional --mtls-size=@var{size} +-mtls-size=@var{size} -mtp=@var{name} -mfix-cortex-a53-835769 -mfix-cortex-a53-843419 -mlow-precision-recip-sqrt -mlow-precision-sqrt -mlow-precision-div +-mmax-vectorization -mautovec-preference=@var{name} -mpc-relative-literal-loads -msign-return-address=@var{scope} -mbranch-protection=@var{features} -mharden-sls=@var{opts} -march=@var{name} -mcpu=@var{name} -mtune=@var{name} --moverride=@var{string} -mverbose-cost-dump --mstack-protector-guard=@var{guard} -mstack-protector-guard-reg=@var{sysreg} --mstack-protector-guard-offset=@var{offset} -mtrack-speculation --moutline-atomics -mearly-ldp-fusion -mlate-ldp-fusion --Wexperimental-fmv-target} +-moverride=@var{string} +-mstack-protector-guard=@var{guard} -mstack-protector-guard-reg=@var{sysreg} +-mstack-protector-guard-offset=@var{offset} -mtrack-speculation +-moutline-atomics -mearly-ra -mearly-ldp-fusion -mlate-ldp-fusion +-msve-vector-bits=@var{bits}} @emph{Adapteva Epiphany Options} (@ref{Adapteva Epiphany Options}) @gccoptlist{-mhalf-reg-file -mprefer-short-insn-regs @@ -22454,6 +22454,11 @@ The @samp{ilp32} model is deprecated. Generate big-endian code. This is the default when GCC is configured for an @samp{aarch64_be-*-*} target. +@opindex mlittle-endian +@item -mlittle-endian +Generate little-endian code. This is the default when GCC is configured for an +@samp{aarch64-*-*} but not an @samp{aarch64_be-*-*} target. + @opindex menable-sysreg-checking @item -menable-sysreg-checking Generates an error message if an attempt is made to access a system register @@ -22461,15 +22466,10 @@ which is not available on the target architecture. @opindex mgeneral-regs-only @item -mgeneral-regs-only -Generate code which uses only the general-purpose registers. This will prevent -the compiler from using floating-point and Advanced SIMD registers but will not +Generate code that uses only the general-purpose registers. This prevents +the compiler from using floating-point and Advanced SIMD registers but does not impose any restrictions on the assembler. -@opindex mlittle-endian -@item -mlittle-endian -Generate little-endian code. This is the default when GCC is configured for an -@samp{aarch64-*-*} but not an @samp{aarch64_be-*-*} target. - @opindex mcmodel= @opindex mcmodel=tiny @item -mcmodel=tiny @@ -22599,6 +22599,8 @@ This option only has an effect if @option{-ffast-math} or precision of division results to about 16 bits for single precision and to 32 bits for double precision. +@opindex mtrack-speculation +@opindex mno-track-speculation @item -mtrack-speculation @itemx -mno-track-speculation Enable or disable generation of additional code to track speculative @@ -22607,6 +22609,8 @@ be used by the compiler when expanding calls to @code{__builtin_speculation_safe_copy} to permit a more efficient code sequence to be generated. +@opindex moutline-atomics +@opindex mno-outline-atomics @item -moutline-atomics @itemx -mno-outline-atomics Enable or disable calls to out-of-line helpers to implement atomic operations. @@ -22621,6 +22625,8 @@ used directly. The same applies when using @option{-mcpu=} when the selected cpu supports the @samp{lse} feature. This option is on by default. +@opindex mmax-vectorization +@opindex mno-max-vectorization @item -mmax-vectorization @itemx -mno-max-vectorization Enable or disable an override to vectorizer cost model making vectorization @@ -22630,6 +22636,7 @@ used for auto-vectorization. Unlike @option{-fno-vect-cost-model} or @option{-fvect-cost-model=unlimited} this option does not turn off cost comparison between different vector modes. +@opindex mautovec-preference @item -mautovec-preference=@var{name} Force an ISA selection strategy for auto-vectorization. The possible values of @var{name} are: @@ -22797,11 +22804,6 @@ across releases. This option is only intended to be useful when developing GCC. -@opindex mverbose-cost-dump -@item -mverbose-cost-dump -Enable verbose cost model dumping in the debug dump files. This option is -provided for use in debugging the compiler. - @opindex mpc-relative-literal-loads @opindex mno-pc-relative-literal-loads @item -mpc-relative-literal-loads @@ -22818,7 +22820,7 @@ Permissible values are @samp{none}, which disables return address signing, @samp{non-leaf}, which enables pointer signing for functions which are not leaf functions, and @samp{all}, which enables pointer signing for all functions. The default value is @samp{none}. This option has been deprecated by --mbranch-protection. +@option{-mbranch-protection}. @opindex mbranch-protection @item -mbranch-protection=@var{features} @@ -22872,12 +22874,16 @@ disables the pass. @option{-Os}. @option{-mearly-ra=none} is the default otherwise. @opindex mearly-ldp-fusion +@opindex mno-early-ldp-fusion @item -mearly-ldp-fusion +@itemx -mno-early-ldp-fusion Enable the copy of the AArch64 load/store pair fusion pass that runs before register allocation. Enabled by default at @samp{-O} and above. @opindex mlate-ldp-fusion +@opindex mno-late-ldp-fusion @item -mlate-ldp-fusion +@itemx -mno-late-ldp-fusion Enable the copy of the AArch64 load/store pair fusion pass that runs after register allocation. Enabled by default at @samp{-O} and above. @@ -22903,10 +22909,6 @@ hardware SVE vector lengths. The default is @samp{-msve-vector-bits=scalable}, which produces vector-length agnostic code. -@opindex Wexperimental-fmv-target -@opindex Wno-experimental-fmv-target -@item -Wexperimental-fmv-target -This option is deprecated. @end table @subsubsection @option{-march} and @option{-mcpu} Feature Modifiers From 671ba57ba3c7a7faf82df2d546d99a90edccefd7 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Sat, 1 Nov 2025 20:35:12 +0000 Subject: [PATCH 118/373] doc, epiphany: Clean up epiphany target options and docs [PR122243] gcc/ChangeLog PR other/122243 * config/epiphany/epiphany.opt (mlong-calls): Make it do something useful. (may-round-for-trunc): Make this undocumented option with a weird name an alias for -mmay-round-for-trunc. (mfp-iarith): Fix doc string. * doc/invoke.texi (Option Summary) : Add missing options. (Adapteva Epiphany Options): Document negative forms also when that is not the default, or where it's unclear. Document -may-round-for-trunc and -mfp-iarith. Fix spelling of -mpost-inc and -mpost-modify. --- gcc/config/epiphany/epiphany.opt | 9 +++-- gcc/doc/invoke.texi | 61 +++++++++++++++++++++++++------- 2 files changed, 56 insertions(+), 14 deletions(-) diff --git a/gcc/config/epiphany/epiphany.opt b/gcc/config/epiphany/epiphany.opt index 9cd93db836a9..4b897540c350 100644 --- a/gcc/config/epiphany/epiphany.opt +++ b/gcc/config/epiphany/epiphany.opt @@ -72,7 +72,7 @@ target Mask(ROUND_NEAREST) Assume round to nearest is selected for purposes of scheduling. mlong-calls -Target Mask(LONG_CALLS) +Target InverseMask(SHORT_CALLS) Generate call insns as indirect calls. mshort-calls @@ -103,7 +103,12 @@ Enum(attr_fp_mode) String(truncate) Value(FP_MODE_ROUND_TRUNC) EnumValue Enum(attr_fp_mode) String(int) Value(FP_MODE_INT) +; This option has never been documented under this name, but it's +; been around since 2012. may-round-for-trunc +Target RejectNegative Undocumented Alias(mmay-round-for-trunc) + +mmay-round-for-trunc Target Mask(MAY_ROUND_FOR_TRUNC) A floating point to integer truncation may be replaced with rounding to save mode switching. @@ -129,7 +134,7 @@ Split unaligned 8 byte vector moves before post-modify address generation. mfp-iarith Target Mask(FP_IARITH) -Use the floating point unit for integer add/subtract. +Use the floating-point unit for integer add/subtract. m1reg- Target RejectNegative Joined Var(epiphany_m1reg) Enum(m1reg) Init(-1) diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index ad8d742bba4a..99279654b915 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -911,7 +911,8 @@ Objective-C and Objective-C++ Dialects}. -mbranch-cost=@var{num} -mcmove -mnops=@var{num} -msoft-cmpsf -msplit-lohi -mpost-inc -mpost-modify -mstack-offset=@var{num} -mround-nearest -mlong-calls -mshort-calls -msmall16 --mfp-mode=@var{mode} -mvect-double -max-vect-align=@var{num} +-mfp-mode=@var{mode} -mmay-round-for-trunc -mfp-iarith +-mvect-double -max-vect-align=@var{num} -msplit-vecmove-early -m1reg-@var{reg}} @emph{AMD GCN Options} (@ref{AMD GCN Options}) @@ -23126,12 +23127,16 @@ These @samp{-m} options are defined for Adapteva Epiphany: @table @gcctabopt @opindex mhalf-reg-file +@opindex mno-half-reg-file @item -mhalf-reg-file +@itemx -mno-half-reg-file Don't allocate any register in the range @code{r32}@dots{}@code{r63}. That allows code to run on hardware variants that lack these registers. @opindex mprefer-short-insn-regs +@opindex mno-prefer-short-insn-regs @item -mprefer-short-insn-regs +@itemx -mno-prefer-short-insn-regs Preferentially allocate registers that allow short instruction generation. This can result in increased instruction count, so this may either reduce or increase overall code size. @@ -23143,7 +23148,9 @@ This cost is only a heuristic and is not guaranteed to produce consistent results across releases. @opindex mcmove +@opindex mno-cmove @item -mcmove +@itemx -mno-cmove Enable the generation of conditional moves. @opindex mnops @@ -23153,6 +23160,7 @@ Emit @var{num} NOPs before every other generated instruction. @opindex mno-soft-cmpsf @opindex msoft-cmpsf @item -mno-soft-cmpsf +@itemx -msoft-cmpsf For single-precision floating-point comparisons, emit an @code{fsub} instruction and test the flags. This is faster than a software comparison, but can get incorrect results in the presence of NaNs, or when two different small @@ -23177,24 +23185,34 @@ toolchain with the appropriate @option{--with-stack-offset=@var{num}} option. @opindex mno-round-nearest @opindex mround-nearest @item -mno-round-nearest -Make the scheduler assume that the rounding mode has been set to +@itemx -mround-nearest +@option{-mno-round-nearest} +makes the scheduler assume that the rounding mode has been set to truncating. The default is @option{-mround-nearest}. @opindex mlong-calls +@opindex mno-long-calls @item -mlong-calls If not otherwise specified by an attribute, assume all calls might be beyond the offset range of the @code{b} / @code{bl} instructions, and therefore load the function address into a register before performing a (otherwise direct) call. This is the default. -@opindex short-calls +@opindex mshort-calls +@opindex mno-short-calls @item -mshort-calls If not otherwise specified by an attribute, assume all direct calls are in the range of the @code{b} / @code{bl} instructions, so use these instructions -for direct calls. The default is @option{-mlong-calls}. +for direct calls. + +The default is @option{-mlong-calls}. Note that @option{-mlong-calls} +is equivalent to @option{-mno-short-calls}, and similarly +@option{-mno-long-calls} is equivalent to @option{-mshort-calls}. @opindex msmall16 +@opindex mno-small16 @item -msmall16 +@itemx -mno-small16 Assume addresses can be loaded as 16-bit unsigned values. This does not apply to function addresses for which @option{-mlong-calls} semantics are in effect. @@ -23236,23 +23254,40 @@ integer multiply, or integer multiply-and-accumulate. The default is @option{-mfp-mode=caller} +@opindex mmay-round-for-trunc +@opindex mno-may-round-for-trunc +@item -mmay-round-for-trunc +@itemx -mno-may-round-for-trunc +This option allows floating point to integer truncation to be replaced +with rounding to save mode switching. It's disabled by default. + +@opindex mfp-iarith +@opindex mno-fp-iarith +@item -mfp-iarith +@itemx -mno-fp-iarith +This option enables use of the floating-point unit for integer add and +subtract. It's disabled by default. + @opindex mno-split-lohi @opindex msplit-lohi -@opindex mno-postinc -@opindex mpostinc +@opindex mno-post-inc +@opindex mpost-inc @opindex mno-postmodify -@opindex mpostmodify -@item -mno-split-lohi -@itemx -mno-postinc -@itemx -mno-postmodify -Code generation tweaks that disable, respectively, splitting of 32-bit +@opindex mpost-modify +@item -msplit-lohi +@itemx -mno-split-lohi +@itemx -mpost-inc +@itemx -mno-post-inc +@itemx -mpost-modify +@itemx -mno-post-modify +Code generation tweaks that control, respectively, splitting of 32-bit loads, generation of post-increment addresses, and generation of post-modify addresses. The defaults are @option{msplit-lohi}, @option{-mpost-inc}, and @option{-mpost-modify}. @opindex mno-vect-double @opindex mvect-double -@item -mnovect-double +@item -mno-vect-double Change the preferred SIMD mode to SImode. The default is @option{-mvect-double}, which uses DImode as preferred SIMD mode. @@ -23265,7 +23300,9 @@ interfaces are unaffected if they don't use SIMD vector modes in places that affect size and/or alignment of relevant types. @opindex msplit-vecmove-early +@opindex mno-split-vecmove-early @item -msplit-vecmove-early +@itemx -mno-split-vecmove-early Split vector moves into single word moves before reload. In theory this can give better register allocation, but so far the reverse seems to be generally the case. From b67da7cf289f51e750cf522280160cfd35586867 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Sat, 1 Nov 2025 22:57:01 +0000 Subject: [PATCH 119/373] doc, gcn: Clean up gcn target options and docs [PR122243] [PR122288] Per PR target/122288, gcn.opt contained some invalid syntax that was quietly accepted by the options processor. This patch fixes that, marks some useless options as "Undocumented", and brings the documentation into sync with the options file. I tested the .opt file changes on both a standalone gcn build (gcc and g++ testsuites) and in an x86_64-linux-gnu build with gcn as offload target (libgomp). gcc/ChangeLog PR other/122243 PR target/122288 * config/gcn/gcn.opt (m32, m64, mgomp): Mark "Undocumented" since these options don't actually do anything useful. (flag_bypass_init_error, stack_size_opt, gang_size_opt): Correct opt file syntax. (mstack-size=): Mark "Undocumented" since it's obsolete. * doc/invoke.texi (Option Summary) : Remove obsolete options, add missing entries for -mgang-private-size=, -msram-ecc=, and -mxnack=. (AMD GCN Options): Likewise. --- gcc/config/gcn/gcn.opt | 20 +++++++++++++++----- gcc/doc/invoke.texi | 21 +++++++++++---------- 2 files changed, 26 insertions(+), 15 deletions(-) diff --git a/gcc/config/gcn/gcn.opt b/gcc/config/gcn/gcn.opt index 1b2d5cca289e..e877912fadc0 100644 --- a/gcc/config/gcn/gcn.opt +++ b/gcc/config/gcn/gcn.opt @@ -29,29 +29,39 @@ mtune= Target RejectNegative Negative(mtune=) Joined ToLower Enum(gpu_type) Var(gcn_tune) Init(PROCESSOR_GFX90A) Specify the name of the target GPU. +; mkoffload passes -m32, -m64, and -mgomp to the offload compiler, but +; nothing in the offload compiler actually uses any of these flags. +; Maybe they're there for compatibility with other offload backends, +; or maybe we can just delete these. In any case, there's no point in +; documenting them for users. m32 -Target RejectNegative InverseMask(ABI64) +Target RejectNegative InverseMask(ABI64) Undocumented Generate code for a 32-bit ABI. m64 -Target RejectNegative Mask(ABI64) +Target RejectNegative Mask(ABI64) Undocumented Generate code for a 64-bit ABI. mgomp -Target RejectNegative +Target RejectNegative Undocumented Enable OpenMP GPU offloading. +; This option seems not to ever have done anything useful, or to have +; been documented. +Variable bool flag_bypass_init_error = false mbypass-init-error -Target RejectNegative Var(flag_bypass_init_error) +Target RejectNegative Var(flag_bypass_init_error) Undocumented +Variable int stack_size_opt = -1 mstack-size= -Target RejectNegative Joined UInteger Var(stack_size_opt) Init(-1) +Target RejectNegative Joined UInteger Var(stack_size_opt) Init(-1) Undocumented Obsolete; use GCN_STACK_SIZE at runtime. +Variable int gang_private_size_opt = -1 mgang-private-size= diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 99279654b915..46dc363a5d59 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -916,7 +916,10 @@ Objective-C and Objective-C++ Dialects}. -msplit-vecmove-early -m1reg-@var{reg}} @emph{AMD GCN Options} (@ref{AMD GCN Options}) -@gccoptlist{-march=@var{gpu} -mtune=@var{gpu} -mstack-size=@var{bytes} +@gccoptlist{-march=@var{gpu} -mtune=@var{gpu} +-mgang-private-size=@var{bytes} +-msram-ecc=@r{[}on@r{|}off@r{|}any@r{]} +-mxnack=@r{[}on@r{|}off@r{|}any@r{]} -Wopenacc-dims} @emph{ARC Options} (@ref{ARC Options}) @@ -23426,6 +23429,11 @@ Compile generic code for GFX11 devices, executable on gfx1100, gfx1101, gfx1102, gfx1103, gfx1150, gfx1151, gfx1152, and gfx1153. @end table +@opindex mgang-private-size +@item -mgang-private-size=@var{bytes} +Set the amount of local data-share (LDS) memory to reserve for +gang-private variables. The default is 512. + @opindex msram-ecc @item -msram-ecc=on @itemx -msram-ecc=off @@ -23435,14 +23443,6 @@ disabled, or either mode. This feature can be enabled per-process on some devices. The compiled code must match the device mode. The default is @samp{any}, for devices that support it. -@opindex mstack-size -@item -mstack-size=@var{bytes} -Specify how many @var{bytes} of stack space will be requested for each GPU -thread (wave-front). Beware that there may be many threads and limited memory -available. The size of the stack allocation may also have an impact on -run-time performance. The default is 32KB when using OpenACC or OpenMP, and -1MB otherwise. - @opindex mxnack @item -mxnack=on @itemx -mxnack=off @@ -23456,7 +23456,8 @@ Memory, and @samp{-mxnack=no} otherwise. @opindex Wopenacc-dims @opindex Wno-openacc-dims @item -Wopenacc-dims -Warn about invalid OpenACC dimensions. +@itemx -Wno-openacc-dims +Control warnings about invalid OpenACC dimensions. @end table From 9708501f9d78e030f5655baa3b0823a3035d1199 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Thu, 6 Nov 2025 23:37:46 +0000 Subject: [PATCH 120/373] doc, arm: Clean up ARM option documentation [PR122243] This patch undocuments ARM target-specific options that have never been implemented, are already marked as "Undocumented" in arm.opt file, and/or are presently documented as obsolete or only useful for back end debugging. I've also cleaned up the option summary to list only one of the positive or negative forms of each option, and to consistently index both forms. gcc/ChangeLog PR other/122243 * config/arm/arm.opt (mapcs-reentrant): Mark as "Undocumented", updatehelp string for internal documentation. (mapcs-stack-check): Likewise update help string. (mprint-tune-info, mneon-for-64bits): Mark as "Undocumented". * doc/invoke.texi (Option Summary) : Remove duplicate entries for negative forms and entries for options that are explicitly "Undocumented". Add missing entry for -mpic-data-is-text-relative. Fix some formatting issues. (ARM Options): Remove documentation for -mapcs-stack-check, -mapcs-reentrant, -mflip-thumb, -mneon-for-64-bits, -mprint-tune-info, and -mverbose-cost-dump. Add index entries for -mno- option forms. Minor editing for clarity. --- gcc/config/arm/arm.opt | 9 ++-- gcc/doc/invoke.texi | 94 +++++++++++++++--------------------------- 2 files changed, 38 insertions(+), 65 deletions(-) diff --git a/gcc/config/arm/arm.opt b/gcc/config/arm/arm.opt index caa08d120cef..f340feeb510e 100644 --- a/gcc/config/arm/arm.opt +++ b/gcc/config/arm/arm.opt @@ -72,11 +72,12 @@ Target Mask(APCS_FRAME) Generate APCS conformant stack frames. mapcs-reentrant -Target Mask(APCS_REENT) -Generate re-entrant, PIC code. +Target Mask(APCS_REENT) Undocumented +Unimplemented option to generate re-entrant, PIC code. mapcs-stack-check Target Mask(APCS_STACK) Undocumented +Unimplemented option to generate stack checking code on function entry. march= Target Save RejectNegative Negative(march=) ToLower Joined Var(arm_arch_string) @@ -248,7 +249,7 @@ Target Save RejectNegative Negative(mtune=) ToLower Joined Var(arm_tune_string) Tune code for the given processor. mprint-tune-info -Target RejectNegative Var(print_tune_info) Init(0) +Target RejectNegative Var(print_tune_info) Init(0) Undocumented Print CPU tuning information as comment in assembler file. This is an option used only for regression testing of the compiler and not intended for ordinary use in compiling code. @@ -302,7 +303,7 @@ Target Var(unaligned_access) Init(2) Save Enable unaligned word and halfword accesses to packed data. mneon-for-64bits -Target WarnRemoved +Target WarnRemoved Undocumented This option is deprecated and has no effect. mslow-flash-data diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 46dc363a5d59..ea6d70595798 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -943,27 +943,22 @@ Objective-C and Objective-C++ Dialects}. -mdiv-rem -mcode-density -mll64 -mfpu=@var{fpu} -mrf16 -mbranch-index} @emph{ARM Options} (@ref{ARM Options}) -@gccoptlist{-mapcs-frame -mno-apcs-frame +@gccoptlist{-mapcs-frame -mapcs -mabi=@var{name} --mapcs-stack-check -mno-apcs-stack-check --mapcs-reentrant -mno-apcs-reentrant --mgeneral-regs-only --msched-prolog -mno-sched-prolog +-mgeneral-regs-only -mno-sched-prolog -mlittle-endian -mbig-endian -mbe8 -mbe32 -mfloat-abi=@var{name} -mfp16-format=@var{name} --mthumb-interwork -mno-thumb-interwork --mcpu=@var{name} -march=@var{name} -mfpu=@var{name} --mtune=@var{name} -mprint-tune-info +-mthumb-interwork +-mcpu=@var{name} -march=@var{name} -mfpu=@var{name} -mtune=@var{name} -mstructure-size-boundary=@var{n} --mabort-on-noreturn --mlong-calls -mno-long-calls --msingle-pic-base -mno-single-pic-base --mpic-register=@var{reg} +-mabort-on-noreturn -mlong-calls +-msingle-pic-base -mpic-register=@var{reg} +-mpic-data-is-text-relative -mnop-fun-dllimport -mpoke-function-name --mthumb -marm -mflip-thumb +-mthumb -marm -mtpcs-frame -mtpcs-leaf-frame -mcaller-super-interworking -mcallee-super-interworking -mtp=@var{name} -mtls-dialect=@var{dialect} @@ -972,15 +967,14 @@ Objective-C and Objective-C++ Dialects}. -mfix-cortex-a57-aes-1742098 -mfix-cortex-a72-aes-1655431 -munaligned-access --mneon-for-64bits -mslow-flash-data -masm-syntax-unified -mrestrict-it --mverbose-cost-dump -mpure-code -mcmse -mfix-cmse-cve-2021-35465 --mstack-protector-guard=@var{guard} -mstack-protector-guard-offset=@var{offset} +-mstack-protector-guard=@var{guard} +-mstack-protector-guard-offset=@var{offset} -mfdpic -mbranch-protection=@var{features}} @@ -24260,6 +24254,7 @@ Generate code for the specified ABI@. Permissible values are: @samp{apcs-gnu}, @samp{atpcs}, @samp{aapcs} and @samp{aapcs-linux}. @opindex mapcs-frame +@opindex mno-apcs-frame @item -mapcs-frame Generate a stack frame that is compliant with the ARM Procedure Call Standard for all functions, even if this is not strictly necessary for @@ -24272,26 +24267,8 @@ This option is deprecated. @item -mapcs This is a synonym for @option{-mapcs-frame} and is deprecated. -@ignore -@c not currently implemented -@opindex mapcs-stack-check -@item -mapcs-stack-check -Generate code to check the amount of stack space available upon entry to -every function (that actually uses some stack space). If there is -insufficient space available then either the function -@code{__rt_stkovf_split_small} or @code{__rt_stkovf_split_big} is -called, depending upon the amount of stack space required. The runtime -system is required to provide these functions. The default is -@option{-mno-apcs-stack-check}, since this produces smaller code. - -@c not currently implemented -@opindex mapcs-reentrant -@item -mapcs-reentrant -Generate reentrant, position-independent code. The default is -@option{-mno-apcs-reentrant}. -@end ignore - @opindex mthumb-interwork +@opindex mno-thumb-interwork @item -mthumb-interwork Generate code that supports calling between the ARM and Thumb instruction sets. Without this option, on pre-v5 architectures, the @@ -24300,12 +24277,14 @@ default is @option{-mno-thumb-interwork}, since slightly larger code is generated when @option{-mthumb-interwork} is specified. In AAPCS configurations this option is meaningless. -@opindex mno-sched-prolog @opindex msched-prolog -@item -mno-sched-prolog -Prevent the reordering of instructions in the function prologue, or the +@opindex mno-sched-prolog +@item -msched-prolog +@itemx -mno-sched-prolog +Allow or prevent the reordering of instructions in the function prologue, or the merging of those instruction with the instructions in the function's -body. This means that all functions start with a recognizable set +body. With @option{-mno-sched-prolog}, +this means that all functions start with a recognizable set of instructions (or in fact one of a choice from a small set of different function prologues), and this information can be used to locate the start of functions inside an executable piece of code. The @@ -25069,6 +25048,7 @@ information using structures or unions. This option is deprecated. @opindex mabort-on-noreturn +@opindex mno-abort-on-noreturn @item -mabort-on-noreturn Generate a call to the function @code{abort} at the end of a @code{noreturn} function. It is executed if the function tries to @@ -25103,6 +25083,7 @@ the compiler generates code to handle function calls via function pointers. @opindex msingle-pic-base +@opindex mno-single-pic-base @item -msingle-pic-base Treat the register used for PIC addressing as read-only, rather than loading it in the prologue for each function. The runtime system is @@ -25118,6 +25099,7 @@ determined by compiler. For single PIC base case, the default is otherwise the default is @samp{R10}. @opindex mpic-data-is-text-relative +@opindex mno-pic-data-is-text-relative @item -mpic-data-is-text-relative Assume that the displacement between the text and data segments is fixed at static link time. This permits using PC-relative addressing @@ -25127,6 +25109,7 @@ disabled on such targets, it will enable @option{-msingle-pic-base} by default. @opindex mpoke-function-name +@opindex mno-poke-function-name @item -mpoke-function-name Write the name of each function into the text section, directly preceding the function prologue. The generated code is similar to this: @@ -25164,25 +25147,22 @@ You can also override the ARM and Thumb mode for each function by using the @code{target("thumb")} and @code{target("arm")} function attributes (@pxref{ARM Function Attributes}) or pragmas (@pxref{Function Specific Option Pragmas}). -@opindex mflip-thumb -@item -mflip-thumb -Switch ARM/Thumb modes on alternating functions. -This option is provided for regression testing of mixed Thumb/ARM code -generation, and is not intended for ordinary use in compiling code. - @opindex mtpcs-frame +@opindex mno-tpcs-frame @item -mtpcs-frame Generate a stack frame that is compliant with the Thumb Procedure Call Standard for all non-leaf functions. (A leaf function is one that does not call any other functions.) The default is @option{-mno-tpcs-frame}. @opindex mtpcs-leaf-frame +@opindex mno-tpcs-leaf-frame @item -mtpcs-leaf-frame Generate a stack frame that is compliant with the Thumb Procedure Call Standard for all leaf functions. (A leaf function is one that does not call any other functions.) The default is @option{-mno-apcs-leaf-frame}. @opindex mcallee-super-interworking +@opindex mno-callee-super-interworking @item -mcallee-super-interworking Gives all externally visible functions in the file being compiled an ARM instruction set header which switches to Thumb mode before executing the @@ -25191,6 +25171,7 @@ non-interworking code. This option is not valid in AAPCS configurations because interworking is enabled by default. @opindex mcaller-super-interworking +@opindex mno-caller-super-interworking @item -mcaller-super-interworking Allows calls via function pointers (including virtual functions) to execute correctly regardless of whether the target code has been @@ -25224,6 +25205,7 @@ library support. Initial and local exec TLS models are unaffected by this option and always use the original scheme. @opindex mword-relocations +@opindex mno-word-relocations @item -mword-relocations Only generate absolute relocations on word-sized values (i.e.@: R_ARM_ABS32). This is enabled by default on targets (uClinux, SymbianOS) where the runtime @@ -25231,6 +25213,7 @@ loader imposes this restriction, and when @option{-fpic} or @option{-fPIC} is specified. This option conflicts with @option{-mslow-flash-data}. @opindex mfix-cortex-m3-ldrd +@opindex mno-fix-cortex-m3-ldrd @item -mfix-cortex-m3-ldrd Some Cortex-M3 cores can cause data corruption when @code{ldrd} instructions with overlapping destination and base registers are used. This option avoids @@ -25263,11 +25246,8 @@ setting of this option. If unaligned access is enabled then the preprocessor symbol @code{__ARM_FEATURE_UNALIGNED} is also defined. -@opindex mneon-for-64bits -@item -mneon-for-64bits -This option is deprecated and has no effect. - @opindex mslow-flash-data +@opindex mno-slow-flash-data @item -mslow-flash-data Assume loading data from flash is slower than fetching instruction. Therefore literal load is minimized for better performance. @@ -25275,6 +25255,7 @@ This option is only supported when compiling for ARMv7 M-profile and off by default. It conflicts with @option{-mword-relocations}. @opindex masm-syntax-unified +@opindex mno-asm-syntax-unified @item -masm-syntax-unified Assume inline assembler is using unified asm syntax. The default is currently off which implies divided syntax. This option has no impact @@ -25282,24 +25263,14 @@ on Thumb2. However, this may change in future releases of GCC. Divided syntax should be considered deprecated. @opindex mrestrict-it +@opindex mno-restrict-it @item -mrestrict-it Restricts generation of IT blocks to conform to the rules of ARMv8-A. IT blocks can only contain a single 16-bit instruction from a select set of instructions. This option is on by default for ARMv8-A Thumb mode. -@opindex mprint-tune-info -@item -mprint-tune-info -Print CPU tuning information as comment in assembler file. This is -an option used only for regression testing of the compiler and not -intended for ordinary use in compiling code. This option is disabled -by default. - -@opindex mverbose-cost-dump -@item -mverbose-cost-dump -Enable verbose cost model dumping in the debug dump files. This option is -provided for use in debugging the compiler. - @opindex mpure-code +@opindex mno-pure-code @item -mpure-code Do not allow constant data to be placed in code sections. Additionally, when compiling for ELF object format give all text sections the @@ -25313,6 +25284,7 @@ Development Tools Engineering Specification", which can be found on @url{https://developer.arm.com/documentation/ecm0359818/latest/}. @opindex mfix-cmse-cve-2021-35465 +@opindex mno-fix-cmse-cve-2021-35465 @item -mfix-cmse-cve-2021-35465 Mitigate against a potential security issue with the @code{VLLDM} instruction in some M-profile devices when using CMSE (CVE-2021-365465). This option is From 0862b729b3f6c6f920cc036e3f2f27744aac5977 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Sun, 2 Nov 2025 16:58:19 +0000 Subject: [PATCH 121/373] doc, blackfin: Don't separately document no- form of Blackfin options [PR122243] The documentation for Blackfin options had separate entries for the positive and negative forms of many options, both in the Option Summary and detailed documentation. This is unnecessarily verbose and counter to the general rule that only one form of each option is documented. gcc/ChangeLog PR other/122243 * doc/invoke.texi (Option Summary) : Remove redundant -mno- entries. (Blackfin Options): Combine explicit -mno-* documentation with that for the corresponding positive form of the option. Add @opindex entries for the negative forms of options that didn't already have one. --- gcc/doc/invoke.texi | 78 ++++++++++++++++++++++----------------------- 1 file changed, 38 insertions(+), 40 deletions(-) diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index ea6d70595798..544f12e27cbd 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -991,12 +991,12 @@ Objective-C and Objective-C++ Dialects}. @emph{Blackfin Options} (@ref{Blackfin Options}) @gccoptlist{-mcpu=@var{cpu}@r{[}-@var{sirevision}@r{]} --msim -momit-leaf-frame-pointer -mno-omit-leaf-frame-pointer --mspecld-anomaly -mno-specld-anomaly -mcsync-anomaly -mno-csync-anomaly --mlow-64k -mno-low64k -mstack-check-l1 -mid-shared-library --mno-id-shared-library -mshared-library-id=@var{n} --mleaf-id-shared-library -mno-leaf-id-shared-library --msep-data -mno-sep-data -mlong-calls -mno-long-calls +-msim -momit-leaf-frame-pointer +-mspecld-anomaly -mcsync-anomaly +-mlow-64k -mstack-check-l1 -mid-shared-library +-mleaf-id-shared-library +-mshared-library-id=@var{n} +-msep-data -mlong-calls -mfast-fp -minline-plt -mmulticore -mcorea -mcoreb -msdram -micplb} @@ -26160,73 +26160,66 @@ Certain other options, such as @option{-mid-shared-library} and @option{-mfdpic}, imply @option{-msim}. @opindex momit-leaf-frame-pointer +@opindex mno-omit-leaf-frame-pointer @item -momit-leaf-frame-pointer Don't keep the frame pointer in a register for leaf functions. This avoids the instructions to save, set up and restore frame pointers and makes an extra register available in leaf functions. @opindex mspecld-anomaly +@opindex mno-specld-anomaly @item -mspecld-anomaly +@itemx -mno-specld-anomaly When enabled, the compiler ensures that the generated code does not contain speculative loads after jump instructions. If this option is used, @code{__WORKAROUND_SPECULATIVE_LOADS} is defined. -@opindex mno-specld-anomaly -@opindex mspecld-anomaly -@item -mno-specld-anomaly -Don't generate extra code to prevent speculative loads from occurring. - @opindex mcsync-anomaly +@opindex mno-csync-anomaly @item -mcsync-anomaly +@itemx -mno-csync-anomaly When enabled, the compiler ensures that the generated code does not contain CSYNC or SSYNC instructions too soon after conditional branches. If this option is used, @code{__WORKAROUND_SPECULATIVE_SYNCS} is defined. -@opindex mno-csync-anomaly -@opindex mcsync-anomaly -@item -mno-csync-anomaly -Don't generate extra code to prevent CSYNC or SSYNC instructions from -occurring too soon after a conditional branch. - @opindex mlow64k +@opindex mno-low64k @item -mlow64k +@itemx -mno-low64k When enabled, the compiler is free to take advantage of the knowledge that -the entire program fits into the low 64k of memory. - -@opindex mno-low64k -@item -mno-low64k -Assume that the program is arbitrarily large. This is the default. +the entire program fits into the low 64k of memory. The default behavior +is to assume that the program is arbitrarily large (@option{-mno-low64k}). @opindex mstack-check-l1 +@opindex mno-stack-check-l1 @item -mstack-check-l1 Do stack checking using information placed into L1 scratchpad memory by the uClinux kernel. @opindex mid-shared-library +@opindex mno-id-shared-library @item -mid-shared-library +@itemx -mno-id-shared-library Generate code that supports shared libraries via the library ID method. This allows for execute in place and shared libraries in an environment without virtual memory management. This option implies @option{-fPIC}. With a @samp{bfin-elf} target, this option implies @option{-msim}. - -@opindex mno-id-shared-library -@opindex mid-shared-library -@item -mno-id-shared-library -Generate code that doesn't assume ID-based shared libraries are being used. -This is the default. +The default is @option{-mno-id-shared-library}, to generate +code that doesn't assume ID-based shared libraries are being used. @opindex mleaf-id-shared-library +@opindex mno-leaf-id-shared-library @item -mleaf-id-shared-library +@itemx -mno-leaf-id-shared-library Generate code that supports shared libraries via the library ID method, but assumes that this library or executable won't link against any other ID shared libraries. That allows the compiler to use faster code for jumps and calls. -@opindex mno-leaf-id-shared-library -@opindex mleaf-id-shared-library -@item -mno-leaf-id-shared-library -Do not assume that the code being compiled won't link against any ID shared -libraries. Slower code is generated for jump and call insns. +The default is @option{-mno-leaf-id-shared-library}, in which the +no assumption is made that the code being compiled won't link +against any ID shared libraries. Slower code is generated for jump +and call insns. @opindex mshared-library-id @item -mshared-library-id=n @@ -26236,17 +26229,15 @@ other values forces the allocation of that number to the current library but is no more space- or time-efficient than omitting this option. @opindex msep-data +@opindex mno-sep-data @item -msep-data +@itemx -mno-sep-data Generate code that allows the data segment to be located in a different area of memory from the text segment. This allows for execute in place in an environment without virtual memory management by eliminating relocations -against the text section. - -@opindex mno-sep-data -@opindex msep-data -@item -mno-sep-data -Generate code that assumes that the data segment follows the text segment. -This is the default. +against the text section. The default is @option{-mno-sep-data}, which +tells GCC to generate code that assumes that the data segment follows +the text segment. @opindex mlong-calls @opindex mno-long-calls @@ -26264,17 +26255,20 @@ switches have no effect on how the compiler generates code to handle function calls via function pointers. @opindex mfast-fp +@opindex mno-fast-fp @item -mfast-fp Link with the fast floating-point library. This library relaxes some of the IEEE floating-point standard's rules for checking inputs against Not-a-Number (NAN), in the interest of performance. @opindex minline-plt +@opindex mno-inline-plt @item -minline-plt Enable inlining of PLT entries in function calls to functions that are not known to bind locally. It has no effect without @option{-mfdpic}. @opindex mmulticore +@opindex mno-multicore @item -mmulticore Build a standalone application for multicore Blackfin processors. This option causes proper start files and link scripts supporting @@ -26291,6 +26285,7 @@ If this option is not used, the single-core application programming model is used. @opindex mcorea +@opindex mno-corea @item -mcorea Build a standalone application for Core A of BF561 when using the one-application-per-core programming model. Proper start files @@ -26299,6 +26294,7 @@ and link scripts are used to support Core A, and the macro This option can only be used in conjunction with @option{-mmulticore}. @opindex mcoreb +@opindex mno-coreb @item -mcoreb Build a standalone application for Core B of BF561 when using the one-application-per-core programming model. Proper start files @@ -26308,6 +26304,7 @@ should be used instead of @code{main}. This option can only be used in conjunction with @option{-mmulticore}. @opindex msdram +@opindex mno-sdram @item -msdram Build a standalone application for SDRAM. Proper start files and link scripts are used to put the application into SDRAM, and the macro @@ -26315,6 +26312,7 @@ link scripts are used to put the application into SDRAM, and the macro The loader should initialize SDRAM before loading the application. @opindex micplb +@opindex mno-icplb @item -micplb Assume that ICPLBs are enabled at run time. This has an effect on certain anomaly workarounds. For Linux targets, the default is to assume ICPLBs From 90c4a63aa8cff750cf599ad4ca5fcd7416d1058f Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Sun, 16 Nov 2025 16:10:30 +0000 Subject: [PATCH 122/373] doc, c6x: Document missing C6X options [PR122243] gcc/ChangeLog PR other/122243 * doc/invoke.texi (Option Summary) : Add -mdbst and -mlong-calls. (C6X Options): Likewise. --- gcc/doc/invoke.texi | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 544f12e27cbd..d150c6654ec2 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -1002,7 +1002,7 @@ Objective-C and Objective-C++ Dialects}. @emph{C6X Options} (@ref{C6X Options}) @gccoptlist{-mbig-endian -mlittle-endian -march=@var{cpu} --msim -msdata=@var{sdata-type}} +-msim -msdata=@var{sdata-type} -mdsbt -mlong-calls} @emph{CRIS Options} (@ref{CRIS Options}) @gccoptlist{-mcpu=@var{cpu} -march=@var{cpu} @@ -26365,6 +26365,17 @@ addresses to access all data. Put all initialized global and static data in the @code{.fardata} section, and all uninitialized data in the @code{.far} section. Put all constant data into the @code{.const} section. + +@opindex mdsbt +@opindex mno-dsbt +@item -mdsbt +Compile for the DSBT shared library ABI. This option is required to +compile with @option{-fpic} or @option{-fPIC}, and implies @option{-fpic}. + +@opindex mlong-calls +@opindex mno-long-calls +@item -mlong-calls +Avoid generating PC-relative calls; use indirection instead. @end table @node CRIS Options From fa149bf843b7bd251085ec103af2eea7699662d8 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Wed, 5 Nov 2025 15:37:48 +0000 Subject: [PATCH 123/373] doc, cris: Clean up CRIS option documentation [PR122243] This is another patch in the series to make documentation of target-specific options in invoke.texi match what is in the corresponding .opt files. The cris.opt file is a bit strange, with many cases where negative forms are listed explicitly as separate options from the positive forms, with both having "RejectNegative" and one (typically the form that is the default) being marked as "Undocumented". I've left that alone since fixing it to the more normal style of having a single option setting a boolean flag would require code changes, and I'm not set up to build or test this target. Beyond that, the "Undocumented" status of options in the .opt file did not in several cases match what was actually documented in the manual. I've generally assumed that the manual is correct, and e.g. the -m32-bit, -m16-bit, and -m8-bit options, all previously marked "Undocumented" but listed in invoke.texi, are preferred to the equivalent options without the hyphen. I've removed the references to the obsolete -melf and -maout options and added documentation in the manual for some options that were previously documented only in the .opt file. gcc/ChangeLog PR other/122243 * config/cris/cris.opt (m32-bit, m16-bit, m8-bit): Remove Undocumented property. (m32bit, m8bit): Add Undocumented property. * doc/invoke.texi (Option Summary) : Remove obsolete -melf and -maout options from table, plus redundant -mno-mul-bug-workaround. (CRIS Options): Add @opindex for -mno- forms that didn't already have one. Remove obsolete -melf documentation. Document -mbest-lib-options, -moverride-best-lib-options, -mtrap-using-break8, -mtrap-unaligned-atomic, and -munaligned-atomic-may-use-library. --- gcc/config/cris/cris.opt | 14 +++++++++----- gcc/doc/invoke.texi | 40 +++++++++++++++++++++++++++++++++++----- 2 files changed, 44 insertions(+), 10 deletions(-) diff --git a/gcc/config/cris/cris.opt b/gcc/config/cris/cris.opt index 9fa9cbfe38c0..55b03ee1f79c 100644 --- a/gcc/config/cris/cris.opt +++ b/gcc/config/cris/cris.opt @@ -108,28 +108,32 @@ Do not tune code and read-only data alignment. ; See cris_handle_option. m32-bit -Target RejectNegative Undocumented +Target RejectNegative +Align code and data to 32 bits. ; See cris_handle_option. m32bit -Target RejectNegative +Target RejectNegative Undocumented Align code and data to 32 bits. ; See cris_handle_option. m16-bit -Target RejectNegative Undocumented +Target RejectNegative +Align code and data to 16 bits. ; See cris_handle_option. m16bit Target RejectNegative Undocumented +Align code and data to 16 bits. ; See cris_handle_option. m8-bit -Target RejectNegative Undocumented +Target RejectNegative +Don't align items in code or data. ; See cris_handle_option. m8bit -Target RejectNegative +Target RejectNegative Undocumented Don't align items in code or data. ; TARGET_PROLOGUE_EPILOGUE: Whether or not to omit function diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index d150c6654ec2..6821a0ce1b38 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -1010,8 +1010,11 @@ Objective-C and Objective-C++ Dialects}. -metrax4 -metrax100 -mpdebug -mcc-init -mno-side-effects -mstack-align -mdata-align -mconst-align -m32-bit -m16-bit -m8-bit -mno-prologue-epilogue --melf -maout -sim -sim2 --mmul-bug-workaround -mno-mul-bug-workaround} +-mbest-lib-options -moverride-best-lib-options +-mtrap-using-break8 -mtrap-unaligned-atomic +-munaligned-atomic-may-use-library +-sim -sim2 +-mmul-bug-workaround} @emph{C-SKY Options} (@ref{C-SKY Options}) @gccoptlist{-march=@var{arch} -mcpu=@var{cpu} @@ -26407,6 +26410,8 @@ Warn when the stack frame of a function exceeds @var{n} bytes. @opindex metrax4 @opindex metrax100 +@opindex mno-etrax4 +@opindex mno-etrax100 @item -metrax4 @itemx -metrax100 The options @option{-metrax4} and @option{-metrax100} are synonyms for @@ -26420,6 +26425,7 @@ Work around a bug in the @code{muls} and @code{mulu} instructions for CPU models where it applies. This option is disabled by default. @opindex mpdebug +@opindex mno-pddebug @item -mpdebug Enable CRIS-specific verbose debug-related information in the assembly code. This option also has the effect of turning off the @samp{#NO_APP} @@ -26427,6 +26433,7 @@ formatted-code indicator to the assembler at the beginning of the assembly file. @opindex mcc-init +@opindex mno-cc-init @item -mcc-init Do not use condition-code results from previous instruction; always emit compare and test instructions before use of condition codes. @@ -26476,9 +26483,32 @@ option only together with visual inspection of the compiled code: no warnings or errors are generated when call-saved registers must be saved, or storage for local variables needs to be allocated. -@opindex melf -@item -melf -Legacy no-op option. +@opindex mbest-lib-options +@opindex moverride-best-lib-options +@item -mbest-lib-options +@itemx -moverride-best-lib-options +@option{-mbest-lib-options} selects the most feature-enabling options +allowed by other options. This option has no @samp{no-} form, but +@option{-moverride-best-lib-options} disables it regardless of the relative +order of the two options on the command line. + +@opindex mtrap-using-break8 +@opindex mno-trap-using-break8 +@item -mtrap-using-break8 +Emit traps as @samp{break 8}. This is the default for CRIS v3 and up. If +disabled, calls to @code{abort} are used instead. + +@opindex mtrap-unaligned-atomic +@opindex mno-trap-unaligned-atomic +@item -mtrap-unaligned-atomic +Emit checks causing @samp{break 8} instructions to execute when +applying atomic builtins on misaligned memory. + +@opindex munaligned-atomic-may-use-library +@opindex mno-unaligned-atomic-may-use-library +@item -munaligned-atomic-may-use-library +Handle atomic builtins that may be applied to unaligned data by calling +library functions. This option overrides @option{-mtrap-unaligned-atomic}. @opindex sim @item -sim From c49c290a33a27d4d4705af0c76629b08f8ffdac3 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Wed, 5 Nov 2025 20:54:16 +0000 Subject: [PATCH 124/373] doc, csky: C-SKY option documentation cleanup [PR122243] gcc/ChangeLog PR other/122243 * doc/invoke.texi (Option Summary) : Remove entries for "Undocumented" options -EB, -EL, -mhard-float, -msoft-float, and nonexistent option -mcse-cc. (C-SKY Options): Likewise. Also remove references to "Undocumented" option -mstm and uniformly index/document the -mno- forms for consistency with other options in this section that already do so. --- gcc/doc/invoke.texi | 53 ++++++++++++++++++++++++++++++--------------- 1 file changed, 35 insertions(+), 18 deletions(-) diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 6821a0ce1b38..1cd517d33394 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -1018,14 +1018,14 @@ Objective-C and Objective-C++ Dialects}. @emph{C-SKY Options} (@ref{C-SKY Options}) @gccoptlist{-march=@var{arch} -mcpu=@var{cpu} --mbig-endian -EB -mlittle-endian -EL --mhard-float -msoft-float -mfpu=@var{fpu} -mdouble-float -mfdivdu +-mbig-endian -mlittle-endian +-mfpu=@var{fpu} -mdouble-float -mfdivdu -mfloat-abi=@var{name} -melrw -mistack -mmp -mcp -mcache -msecurity -mtrust -mdsp -medsp -mvdsp -mdiv -msmart -mhigh-registers -manchor -mpushpop -mmultiple-stld -mconstpool -mstack-size -mccrt --mbranch-cost=@var{n} -mcse-cc -msched-prolog -msim} +-mbranch-cost=@var{n} -msched-prolog -msim} @emph{Cygwin and MinGW Options} (@ref{Cygwin and MinGW Options}) @gccoptlist{-mconsole -mcrtdll=@var{library} -mdll @@ -26557,13 +26557,9 @@ Specify the C-SKY target processor. Valid values for @var{cpu} are: @samp{ck810tv}, @samp{ck810ft}, and @samp{ck810ftv}. @opindex mbig-endian -@opindex EB @opindex mlittle-endian -@opindex EL @item -mbig-endian -@itemx -EB @itemx -mlittle-endian -@itemx -EL Select big- or little-endian code. The default is little-endian. @@ -26584,15 +26580,8 @@ the hard-float and soft-float ABIs are not link-compatible; you must compile your entire program with the same ABI, and link with a compatible set of libraries. -@opindex mhard-float -@opindex msoft-float -@item -mhard-float -@itemx -msoft-float - -Select hardware or software floating-point implementations. -The default is soft float. - @opindex mdouble-float +@opindex mno-double-float @item -mdouble-float @itemx -mno-double-float When @option{-mhard-float} is in effect, enable generation of @@ -26600,6 +26589,7 @@ double-precision float instructions. This is the default except when compiling for CK803. @opindex mfdivdu +@opindex mno-fdivdu @item -mfdivdu @itemx -mno-fdivdu When @option{-mhard-float} is in effect, enable generation of @@ -26616,12 +26606,14 @@ Values for @var{fpu} are @samp{fpv2_divd} (@samp{-mdouble-float -mdivdu}). @opindex melrw +@opindex mno-elrw @item -melrw @itemx -mno-elrw Enable the extended @code{lrw} instruction. This option defaults to on for CK801 and off otherwise. @opindex mistack +@opindex mno-istack @item -mistack @itemx -mno-istack Enable interrupt stack instructions; the default is off. @@ -26631,40 +26623,58 @@ The @option{-mistack} option is required to handle the (@pxref{C-SKY Function Attributes}). @opindex mmp +@opindex mno-mp @item -mmp +@itemx -mno-mp Enable multiprocessor instructions; the default is off. @opindex mcp +@opindex mno-cp @item -mcp +@itemx -mno-cp Enable coprocessor instructions; the default is off. @opindex mcache +@opindex mno-cache @item -mcache +@itemx -mno-cache Enable coprocessor instructions; the default is off. @opindex msecurity +@opindex mno-security @item -msecurity +@itemx -mno-security Enable C-SKY security instructions; the default is off. @opindex mtrust +@opindex mno-trust @item -mtrust +@itemx -mno-trust Enable C-SKY trust instructions; the default is off. @opindex mdsp +@opindex mno-dsp @opindex medsp +@opindex mno-edsp @opindex mvdsp +@opindex mno-vdsp @item -mdsp +@itemx -mno-dsp @itemx -medsp +@itemx -mno-edsp @itemx -mvdsp +@itemx -mno-vdsp Enable C-SKY DSP, Enhanced DSP, or Vector DSP instructions, respectively. All of these options default to off. @opindex mdiv +@opindex mno-div @item -mdiv @itemx -mno-div Generate divide instructions. Default is off. @opindex msmart +@opindex mno-smart @item -msmart @itemx -mno-smart Generate code for Smart Mode, using only registers numbered 0-7 to allow @@ -26673,6 +26683,7 @@ is the required behavior, and it defaults to on for CK802. For other targets, the default is off. @opindex mhigh-registers +@opindex mno-high-registers @item -mhigh-registers @itemx -mno-high-registers Generate code using the high registers numbered 16-31. This option @@ -26680,25 +26691,27 @@ is not supported on CK801, CK802, or CK803, and is enabled by default for other processors. @opindex manchor +@opindex mno-anchor @item -manchor @itemx -mno-anchor Generate code using global anchor symbol addresses. @opindex mpushpop +@opindex mno-pushpop @item -mpushpop @itemx -mno-pushpop Generate code using @code{push} and @code{pop} instructions. This option defaults to on. @opindex mmultiple-stld +@opindex mno-multiple-stld @item -mmultiple-stld -@itemx -mstm @itemx -mno-multiple-stld -@itemx -mno-stm Generate code using @code{stm} and @code{ldm} instructions. This option isn't supported on CK801 but is enabled by default on other processors. @opindex mconstpool +@opindex mno-constpool @item -mconstpool @itemx -mno-constpool Create constant pools in the compiler instead of deferring it to the @@ -26706,12 +26719,14 @@ assembler. This option is the default and required for correct code generation on CK801 and CK802, and is optional on other processors. @opindex mstack-size +@opindex mno-stack-size @item -mstack-size -@item -mno-stack-size +@itemx -mno-stack-size Emit @code{.stack_size} directives for each function in the assembly output. This option defaults to off. @opindex mccrt +@opindex mno-ccrt @item -mccrt @itemx -mno-ccrt Generate code for the C-SKY compiler runtime instead of libgcc. This @@ -26730,7 +26745,9 @@ prologue requirements and that cannot be debugged or backtraced. It is disabled by default. @opindex msim +@opindex mno-sim @item -msim +@itemx -mno-sim Links the library libsemi.a which is in compatible with simulator. Applicable to ELF compiler only. From 393b5b4b189bf8152ec1c427a02769a61c908b01 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Tue, 18 Nov 2025 05:01:02 +0000 Subject: [PATCH 125/373] doc, mingw: Clean up Cygwin and MinGW option documentation [PR122243] gcc/ChangeLog PR other/122243 * doc/invoke.texi (Option Summary) : Correct spelling of -mthreads and add missing options. (Cygwin and MinGW Options): Add @opindex for negative forms. --- gcc/doc/invoke.texi | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 1cd517d33394..8acf0317f737 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -1029,8 +1029,9 @@ Objective-C and Objective-C++ Dialects}. @emph{Cygwin and MinGW Options} (@ref{Cygwin and MinGW Options}) @gccoptlist{-mconsole -mcrtdll=@var{library} -mdll --mnop-fun-dllimport -mthread --municode -mwin32 -mwindows -fno-set-stack-executable} +-mnop-fun-dllimport -mthreads +-municode -mwin32 -mwindows -fno-set-stack-executable +-fwritable-relocated-rdata -mpe-aligned-commons} @emph{Darwin Options} (@ref{Darwin Options}) @gccoptlist{-all_load -allowable_client -arch -arch_errors_fatal @@ -26801,6 +26802,7 @@ generated, enabling the selection of the required runtime startup object and entry point. @opindex mnop-fun-dllimport +@opindex mno-nop-fun-dllimport @item -mnop-fun-dllimport This option is available for Cygwin and MinGW targets. It specifies that the @code{dllimport} attribute should be ignored. @@ -26811,12 +26813,14 @@ This option is available for MinGW targets. It specifies that MinGW-specific thread support is to be used. @opindex municode +@opindex mno-unicode @item -municode This option is available for MinGW-w64 targets. It causes the @code{UNICODE} preprocessor macro to be predefined, and chooses Unicode-capable runtime startup code. @opindex mwin32 +@opindex mno-win32 @item -mwin32 This option is available for Cygwin and MinGW targets. It specifies that the typical Microsoft Windows predefined macros are to @@ -26824,6 +26828,7 @@ be set in the pre-processor, but does not influence the choice of runtime library/startup code. @opindex mwindows +@opindex mno-windows @item -mwindows This option is available for Cygwin and MinGW targets. It specifies that a GUI application is to be generated by From 3b66b18fe806863e7b9a9bcb4bdaa0a6f28e8aab Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Tue, 18 Nov 2025 23:34:09 +0000 Subject: [PATCH 126/373] doc, darwin: Clean up Darwin options and documentation [PR122243] The Darwin target options documentation was a bit of a mess, with several undocumented options, some that were listed in the option summary or mentioned in discussion of other options but not actually documented, and a large number of options listed in darwin.opt as being obsolete. I've undocumented all the obsolete options to streamline things, plus a few others that seem to have been intentially undocumented or supplanted by other options. For the others that were probably supposed to documented, I did my best to guess what they're for by reading the code or just copying the documentation string in the .opt file, but it's certainly possible I screwed some up. gcc/ChangeLog PR other/122243 * config/darwin.opt (findirect-virtual-calls): Mark as Undocumented. (fterminated-vtables): Likewise. (multi_module): Likewise. (multiply_defined): Likewise. (multiply_defined_unused): Likewise. (no_dead_strip_inits_and_terms): Likewise. (noprefixbinding): Likewise. (nomultidefs): Likewise. (noprebind): Likewise. (noseglinkedit): Likewise. (ObjC, ObjC++): Add documentation strings. (object): Mark as Undocumented. (prebind): Likewise. (prebind_all_twolevel_modules): Likewise. (private_bundle): Likewise. (sectobjectsymbols): Likewise. (sectorder): Likewise. (seg_addr_table_filename): Likewise. (segcreate): Likewise. (seglinkedit): Likewise. (single_module): Likewise. (X): Likewise. (y): Likewise. (Mach): Likewise. * doc/invoke.texi (Option Summary) : Improve alphabetization of the list. Remove obsolete/undocumented options and add missing entries. (Darwin Options): Add documentation for -arch, -dependency-file, -fapple-kext, -matt-stubs, -fconstant-cfstrings, -mdynamic-no-pic, -asm_macosx_version_min, -msymbol-stubs, -mtarget-linker, -ObjC, -ObjC++, -Wnonportable-cfstrings. Update the list of options passed to the linker to remove obsolete options and add missing ones; also move the block of @opindex entries before the list items instead of putting it in the middle. --- gcc/config/darwin.opt | 53 ++++---- gcc/doc/invoke.texi | 292 ++++++++++++++++++++++++------------------ 2 files changed, 198 insertions(+), 147 deletions(-) diff --git a/gcc/config/darwin.opt b/gcc/config/darwin.opt index e275d846cd19..d6e6271f9cf2 100644 --- a/gcc/config/darwin.opt +++ b/gcc/config/darwin.opt @@ -169,8 +169,9 @@ filelist Driver RejectNegative Separate Supply a list of objects to be linked from a file, rather than the command line. +; specs turn this into fapple-kext. findirect-virtual-calls -Driver RejectNegative +Driver RejectNegative Undocumented Used for generating code for some older kernel revisions. flat_namespace @@ -189,8 +190,9 @@ framework Driver RejectNegative Separate -framework The linker should search for the framework in the framework search path. +; specs turn this into fapple-kext. fterminated-vtables -Driver RejectNegative +Driver RejectNegative Undocumented Used for generating code for some older kernel revisions. gfull @@ -222,19 +224,19 @@ Driver RejectNegative Usually \"private extern\" (hidden) symbols are made local when linking, this command suppresses that such that they remain exported. multi_module -Driver RejectNegative +Driver RejectNegative Undocumented (Obsolete after 10.4) Multi modules are ignored at runtime since macOS 10.4. multiply_defined -Driver RejectNegative Separate +Driver RejectNegative Separate Undocumented (Obsolete after 10.4) -multiply_defined Provided a mechanism for warning about symbols defined in multiple dylibs. multiply_defined_unused -Driver RejectNegative Separate +Driver RejectNegative Separate Undocumented (Obsolete after 10.4) -multiply_defined_unused Provided a mechanism for warning about symbols defined in the current executable also being defined in linked dylibs. no_dead_strip_inits_and_terms -Driver RejectNegative +Driver RejectNegative Undocumented (Obsolete) Current linkers never dead-strip these items, so the option is not needed. nodefaultexport @@ -246,40 +248,45 @@ Driver RejectNegative Do not add default run paths (for the compiler library directories) to executables, modules or dynamic libraries. nofixprebinding -Driver RejectNegative +Driver RejectNegative Undocumented (Obsolete after 10.3.9) Set MH_NOPREFIXBINDING, in an executable. nomultidefs -Driver RejectNegative +Driver RejectNegative Undocumented (Obsolete after 10.4) Set MH_NOMULTIDEFS in an umbrella framework. noprebind -Driver RejectNegative Negative(prebind) +Driver RejectNegative Negative(prebind) Undocumented (Obsolete) LD_PREBIND is no longer supported. noseglinkedit -Driver RejectNegative Negative(seglinkedit) +Driver RejectNegative Negative(seglinkedit) Undocumented (Obsolete) This is the default. ObjC Driver RejectNegative +Equivalent to -xobjective-c. ObjC++ Driver RejectNegative +Equivalent to -xobjective-c++. +; This option is only used in STARTFILE_SPEC and has never been +; documented since it was added in 2002, so it appears to be +; intentionally undocumented. object -Driver RejectNegative +Driver RejectNegative Undocumented pagezero_size Driver RejectNegative Separate -pagezero_size Allows setting the page 0 size to 4kb when required. prebind -Driver RejectNegative Negative(noprebind) +Driver RejectNegative Negative(noprebind) Undocumented (Obsolete) LD_PREBIND is no longer supported. prebind_all_twolevel_modules -Driver RejectNegative +Driver RejectNegative Undocumented (Obsolete) LD_PREBIND is no longer supported. preload @@ -287,7 +294,7 @@ Driver RejectNegative Produces a Mach-O file suitable for embedded/ROM use. private_bundle -Driver RejectNegative +Driver RejectNegative Undocumented (Obsolete) Allowed linking to proceed with \"-flat_namespace\" when a linked bundle contained a symbol also exported from the main executable. pthread @@ -310,11 +317,11 @@ Driver RejectNegative Separate Args(3) -sectcreate Create section in segment from the contents of . sectobjectsymbols -Driver RejectNegative Separate Args(2) +Driver RejectNegative Separate Args(2) Undocumented (Obsolete) -sectobjectsymbols Setting a local symbol at the start of a section is no longer supported. sectorder -Driver RejectNegative Separate Args(3) +Driver RejectNegative Separate Args(3) Undocumented (Obsolete) -sectorder Replaced by a more general option \"-order_file\". seg_addr_table @@ -323,7 +330,7 @@ Driver RejectNegative Separate ; This is only usable by the ld_classic linker. seg_addr_table_filename -Driver RejectNegative Separate +Driver RejectNegative Separate Undocumented (Obsolete, ld_classic only) -seg_addr_table_filename . seg1addr @@ -336,11 +343,11 @@ Driver RejectNegative Separate Args(2) ; This is only usable by the ld_classic linker. segcreate -Driver RejectNegative Separate Args(3) +Driver RejectNegative Separate Args(3) Undocumented (Obsolete, ld_classic only) -sectcreate Allowed creation of a section from a file. seglinkedit -Driver RejectNegative Negative(noseglinkedit) +Driver RejectNegative Negative(noseglinkedit) Undocumented (Obsolete) Object files with LINKEDIT sections are no longer supported. segprot @@ -356,7 +363,7 @@ Driver RejectNegative Separate -segs_read_write_addr

Specify that
is the base address address of the read-write segments of a dylib. single_module -Driver RejectNegative +Driver RejectNegative Undocumented (Obsolete) This is the default. sub_library @@ -405,12 +412,12 @@ Logs which symbol(s) caused an object to be loaded. ;(Obsolete, ignored) Strip symbols starting with "L", this is the default. X -Driver RejectNegative +Driver RejectNegative Undocumented y -Driver RejectNegative Joined +Driver RejectNegative Joined Undocumented (Obsolete, ignored) Old support similar to \"-whyload\". Mach -Driver RejectNegative +Driver RejectNegative Undocumented (Obsolete and unhandled by ld64, ignored) ld should produce an executable (only handled by ld_classic). diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 8acf0317f737..02f2c9a6e933 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -1034,31 +1034,33 @@ Objective-C and Objective-C++ Dialects}. -fwritable-relocated-rdata -mpe-aligned-commons} @emph{Darwin Options} (@ref{Darwin Options}) -@gccoptlist{-all_load -allowable_client -arch -arch_errors_fatal --arch_only -bind_at_load -bundle -bundle_loader +@gccoptlist{-all_load -allowable_client -arch @var{name} +-arch_errors_fatal -asm_macosx_version_min=@var{version} +-bind_at_load -bundle -bundle_loader -client_name -compatibility_version -current_version -dead_strip --dependency-file -dylib_file -dylinker_install_name +-dependency-file -dylib_file -dylinker -dylinker_install_name -dynamic -dynamiclib -exported_symbols_list --filelist -flat_namespace -force_cpusubtype_ALL --force_flat_namespace -headerpad_max_install_names --iframework --image_base -init -install_name -keep_private_externs --multi_module -multiply_defined -multiply_defined_unused --noall_load -no_dead_strip_inits_and_terms -nodefaultrpaths --nofixprebinding -nomultidefs -noprebind -noseglinkedit --pagezero_size -prebind -prebind_all_twolevel_modules --private_bundle -read_only_relocs -sectalign --sectobjectsymbols -whyload -seg1addr --sectcreate -sectobjectsymbols -sectorder --segaddr -segs_read_only_addr -segs_read_write_addr --seg_addr_table -seg_addr_table_filename -seglinkedit +-fapple-kext -fconstant-cfstrings -ffix-and-continue +-filelist -findirect-data -flat_namespace -force_cpusubtype_ALL +-force_flat_namespace -framework @var{name} -gfull -gused +-headerpad_max_install_names -iframework +-image_base -init @var{symbol-name} -install_name -keep_private_externs +-matt-stubs -mconstant-cfstrings -mdynamic-no-pic +-mfix-and-continue -mkernel -mmacosx-version-min=@var{version} +-mone-byte-bool -msymbol-stubs -mtarget-linker@r{[}=@r{]}@var{version} +-nodefaultexport -nodefaultrpaths +-pagezero_size -preload -read_only_relocs +-sectalign -sectcreate +-seg_addr_table +-seg1addr -segaddr -segprot -segs_read_only_addr -segs_read_write_addr --single_module -static -sub_library -sub_umbrella --twolevel_namespace -umbrella -undefined --unexported_symbols_list -weak_reference_mismatches --whatsloaded -F -gused -gfull -mmacosx-version-min=@var{version} --mkernel -mone-byte-bool} +-sub_library -sub_umbrella +-twolevel_namespace -twolevel_namespace_hints +-umbrella -undefined -unexported_symbols_list +-weak_framework @var{name} -weak_reference_mismatches +-whatsloaded -whyload +-F -ObjC -ObjC++ -Wnonportable-cfstrings} @emph{DEC Alpha Options} (@ref{DEC Alpha Options}) @gccoptlist{-mno-fp-regs -msoft-float @@ -26931,6 +26933,24 @@ directory. The main difference between this @option{-iframework} and warn about constructs contained within header files found via @var{dir}. This option is valid only for the C family of languages. +@opindex arch +@item -arch @var{name} +Generate output for architecture @var{name}. As described above, GCC +generates output for the architecture it was configured for, using its +usual options to select subarchitecture variants. The @option{-arch} +option is accepted for compatibility, but an error is diagnosed if +@var{name} is inconsistent with GCC's own idea of the target architecture. + +@opindex dependency-file +@item -dependency-file @var{filename} +Alias for the preprocessor option @option{-MF @var{filename}}. +@xref{Preprocessor Options}. + +@opindex fapple-kext +@opindex fno-apple-kext +@item -fapple-kext +Generate code for Darwin loadable kernel extensions. + @opindex gused @item -gused Emit debugging information for symbols that are used. For stabs @@ -26941,28 +26961,45 @@ This is by default ON@. @item -gfull Emit debugging information for all symbols and types. -@opindex fconstant-cfstrings -@item -fconstant-cfstrings -The @option{-fconstant-cfstrings} is an alias for @option{-mconstant-cfstrings}. +@opindex matt-stubs +@opindex mno-att-stubs +@item -matt-stubs +@itemx -mno-att-stubs +Enable AT&T-style PIC stubs. This is the default when supported by +the target architecture (currently x86 only). @opindex mconstant-cfstrings +@opindex mno-constant-cfstrings +@opindex fconstant-cfstrings @item -mconstant-cfstrings +@itemx -fconstant-cfstrings When the NeXT runtime is being used (the default on these systems), override any @option{-fconstant-string-class} setting and cause @code{@@"@dots{}"} literals to be laid out as constant CoreFoundation strings. -@opindex mmacosx-version-min -@item -mmacosx-version-min=@var{version} -The earliest version of MacOS X that this executable will run on is -@var{version}. Typical values supported for @var{version} include @code{12}, -@code{10.12}, and @code{10.5.8}. +@option{-fconstant-cfstrings} is an alias for @option{-mconstant-cfstrings}. -If the compiler was built to use the system's headers by default, -then the default for this option is the system version on which the -compiler is running, otherwise the default is to make choices that -are compatible with as many systems and code bases as possible. +@opindex mdynamic-no-pic +@opindex mno-dynamic-no-pic +@item -mdynamic-no-pic +Generate code suitable for executables (not shared libraries). This +option is incompatible with @option{-fpic}, @option{-fPIC}, @option{-fpie}, +or @option{-fPIE}. + +@opindex mfix-and-continue +@opindex mno-fix-and-continue +@opindex ffix-and-continue +@opindex findirect-data +@item -mfix-and-continue +@itemx -ffix-and-continue +@itemx -findirect-data +Generate code suitable for fast turnaround development, such as to +allow GDB to dynamically load @file{.o} files into already-running +programs. @option{-findirect-data} and @option{-ffix-and-continue} +are provided for backwards compatibility. @opindex mkernel +@opindex mno-kernel @item -mkernel Enable kernel development mode. The @option{-mkernel} option sets @option{-static}, @option{-fno-common}, @option{-fno-use-cxa-atexit}, @@ -26972,6 +27009,23 @@ applicable. This mode also sets @option{-mno-altivec}, @option{-msoft-float}, @option{-fno-builtin} and @option{-mlong-branch} for PowerPC targets. +@opindex mmacosx-version-min +@opindex asm_macosx_version_min +@item -mmacosx-version-min=@var{version} +@itemx -asm_macosx_version_min=@var{version} +The @option{-mmacosx-version-min} option specifies +the earliest version of MacOS X that this executable will run on is +@var{version}. Typical values supported for @var{version} include @code{12}, +@code{10.12}, and @code{10.5.8}. + +If the compiler was built to use the system's headers by default, +then the default for this option is the system version on which the +compiler is running, otherwise the default is to make choices that +are compatible with as many systems and code bases as possible. + +@option{-asm_macosx_version_min=@var{version}} is similar, but the GCC +driver passes its @var{version} information only to the assembler. + @opindex mone-byte-bool @item -mone-byte-bool Override the defaults for @code{bool} so that @code{sizeof(bool)==1}. @@ -26985,16 +27039,37 @@ without that switch. Using this switch may require recompiling all other modules in a program, including system libraries. Use this switch to conform to a non-default data model. -@opindex mfix-and-continue -@opindex ffix-and-continue -@opindex findirect-data -@item -mfix-and-continue -@itemx -ffix-and-continue -@itemx -findirect-data -Generate code suitable for fast turnaround development, such as to -allow GDB to dynamically load @file{.o} files into already-running -programs. @option{-findirect-data} and @option{-ffix-and-continue} -are provided for backwards compatibility. +@opindex msymbol-stubs +@opindex mno-symbol-stubs +@item -msymbol-stubs +@itemx -mno-symbol-stubs +Force generation of external symbol indirection stubs for PIC references. +By default, this option is enabled automatically if the target linker +version (@option{-mtarget-linker}) is old enough to require them. + +@opindex mtarget-linker +@item -mtarget-linker=@var{version} +@item -mtarget-linker @var{version} +Specify the target @command{ld64} version, overriding any version specified +in the GCC configuration. Newer linker versions support improved code +generation in some cases, for example for PIC code. + +@opindex ObjC +@item -ObjC +Equivalent to @samp{-x objective-c}; specifies that the input is +is Objective-C source code. + +@opindex ObjC++ +@item -ObjC++ +Equivalent to @samp{-x objective-c++}; specifies that the input is +is Objective-C++ source code. + +@opindex Wnonportable-cfstrings +@opindex Wno-nonportable-cfstrings +@item -Wnonportable-cfstrings +@itemx -Wno-nonportable-cfstrings +Warn if constant CoreFoundation string objects contain non-portable +characters. This warning is enabled by default. @opindex all_load @item -all_load @@ -27039,127 +27114,96 @@ the embedded runpath is added by default unless the user adds @option{-nodefaultrpaths} to the link line. Run paths are needed (and therefore enforced) to build on macOS version 10.11 or later. -@item -allowable_client @var{client_name} -@itemx -client_name -@itemx -compatibility_version -@itemx -current_version -@itemx -dead_strip -@itemx -dependency-file -@itemx -dylib_file -@itemx -dylinker_install_name -@itemx -dynamic -@itemx -exported_symbols_list -@itemx -filelist -@need 800 -@itemx -flat_namespace -@itemx -force_flat_namespace -@itemx -headerpad_max_install_names -@itemx -image_base -@itemx -init -@itemx -install_name -@itemx -keep_private_externs -@itemx -multi_module -@itemx -multiply_defined -@itemx -multiply_defined_unused -@need 800 -@itemx -noall_load -@itemx -no_dead_strip_inits_and_terms -@itemx -nofixprebinding -@itemx -nomultidefs -@itemx -noprebind -@itemx -noseglinkedit -@itemx -pagezero_size -@itemx -prebind -@itemx -prebind_all_twolevel_modules -@itemx -private_bundle -@need 800 -@itemx -read_only_relocs -@itemx -sectalign -@itemx -sectobjectsymbols -@itemx -whyload -@itemx -seg1addr -@itemx -sectcreate -@itemx -sectobjectsymbols -@itemx -sectorder -@itemx -segaddr -@itemx -segs_read_only_addr -@need 800 -@itemx -segs_read_write_addr -@itemx -seg_addr_table -@itemx -seg_addr_table_filename -@itemx -seglinkedit -@itemx -segprot -@itemx -segs_read_only_addr -@itemx -segs_read_write_addr -@itemx -single_module -@itemx -static -@itemx -sub_library -@need 800 +@opindex nodefaultexport +@item -nodefaultexport +Do not add default symbol exports to modules or dynamic libraries. + @opindex allowable_client @opindex client_name @opindex compatibility_version @opindex current_version @opindex dead_strip -@opindex dependency-file @opindex dylib_file +@opindex dylinker @opindex dylinker_install_name @opindex dynamic @opindex exported_symbols_list @opindex filelist @opindex flat_namespace @opindex force_flat_namespace +@opindex framework @opindex headerpad_max_install_names @opindex image_base @opindex init @opindex install_name @opindex keep_private_externs -@opindex multi_module -@opindex multiply_defined -@opindex multiply_defined_unused -@opindex noall_load -@opindex no_dead_strip_inits_and_terms -@opindex nofixprebinding -@opindex nomultidefs -@opindex noprebind -@opindex noseglinkedit @opindex pagezero_size -@opindex prebind -@opindex prebind_all_twolevel_modules -@opindex private_bundle @opindex read_only_relocs @opindex sectalign -@opindex sectobjectsymbols -@opindex whyload -@opindex seg1addr @opindex sectcreate -@opindex sectobjectsymbols -@opindex sectorder -@opindex segaddr -@opindex segs_read_only_addr -@opindex segs_read_write_addr @opindex seg_addr_table -@opindex seg_addr_table_filename -@opindex seglinkedit +@opindex seg1addr +@opindex segaddr @opindex segprot @opindex segs_read_only_addr @opindex segs_read_write_addr -@opindex single_module -@opindex static @opindex sub_library @opindex sub_umbrella @opindex twolevel_namespace +@opindex twolevel_namespace_hints @opindex umbrella @opindex undefined @opindex unexported_symbols_list +@opindex weak_framework @opindex weak_reference_mismatches @opindex whatsloaded +@opindex whyload +@item -allowable_client @var{client_name} +@itemx -client_name +@itemx -compatibility_version +@itemx -current_version +@itemx -dead_strip +@itemx -dylib_file +@itemx -dylinker +@itemx -dylinker_install_name +@itemx -dynamic +@itemx -exported_symbols_list +@itemx -filelist +@need 800 +@itemx -flat_namespace +@itemx -force_flat_namespace +@itemx -framework +@itemx -headerpad_max_install_names +@itemx -image_base +@itemx -init @var{symbol-name} +@itemx -install_name +@itemx -keep_private_externs +@need 800 +@itemx -pagezero_size +@itemx -preload +@need 800 +@itemx -read_only_relocs +@itemx -sectalign +@itemx -sectcreate +@itemx -seg_addr_table +@itemx -seg1addr +@itemx -segaddr +@need 800 +@itemx -segprot +@itemx -segs_read_only_addr +@itemx -segs_read_write_addr +@itemx -sub_library +@need 800 @itemx -sub_umbrella @itemx -twolevel_namespace +@itemx -twolevel_namespace_hints @itemx -umbrella @itemx -undefined @itemx -unexported_symbols_list +@itemx -weak_framework @itemx -weak_reference_mismatches @itemx -whatsloaded +@itemx -whyload These options are passed to the Darwin linker. The Darwin linker man page describes them in detail. @end table From 32bc699760def63853100069c5bae17a493b5060 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Tue, 18 Nov 2025 14:41:33 +0000 Subject: [PATCH 127/373] doc, alpha: Document missing alpha options [PR122243] gcc/ChangeLog PR other/122243 * config/alpha/alpha.opt (mgas): Mark as Undocumented. * doc/invoke.texi (Option Summary) : Add -mtls-kernel, -mtls-size=, -mlong-double-128, and -mlong-double-64. (DEC Alpha Options): Likewise. --- gcc/config/alpha/alpha.opt | 2 +- gcc/doc/invoke.texi | 22 +++++++++++++++++++++- 2 files changed, 22 insertions(+), 2 deletions(-) diff --git a/gcc/config/alpha/alpha.opt b/gcc/config/alpha/alpha.opt index 3c1320b5112d..31f4cb5ed61b 100644 --- a/gcc/config/alpha/alpha.opt +++ b/gcc/config/alpha/alpha.opt @@ -27,7 +27,7 @@ Target Mask(FPREGS) Use fp registers. mgas -Target Ignore +Target Ignore Undocumented Does nothing. Preserved for backward compatibility. mieee-conformant diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 02f2c9a6e933..ef6ca4cf6f2b 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -1073,7 +1073,9 @@ Objective-C and Objective-C++ Dialects}. -mfloat-vax -mfloat-ieee -mexplicit-relocs -msmall-data -mlarge-data -msmall-text -mlarge-text --mmemory-latency=@var{time}} +-mmemory-latency=@var{time} +-mtls-kernel -mtls-size=@var{bitsize} +-mlong-double-128 -mlong-double-64} @emph{eBPF Options} (@ref{eBPF Options}) @gccoptlist{-mbig-endian -mlittle-endian @@ -27540,6 +27542,24 @@ The compiler contains estimates of the number of clock cycles for Note that L3 is only valid for EV5. @end table + +@opindex mtls-kernel +@opindex mno-tls-kernel +@item -mtls-kernel +Emit @code{rdval} instead of @code{rduniq} for thread pointer. + +@opindex mtls-size +@item -mtls-size=@var{bitsize} +Specify bit size of immediate TLS offsets. Valid values for @var{bitsize} +are 16, 32, and 64; it defaults to 32. + +@opindex mlong-double-128 +@opindex mlong-double-64 +@item -mlong-double-128 +@itemx -mlong-double-64 +Specify the size of the @code{long double} type. Note that +@option{-mlong-double-128} is incompatible with VAX floating point. + @end table @node eBPF Options From bd360e9f247c325d9089fed6d90e426939573aec Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Wed, 5 Nov 2025 15:38:11 +0000 Subject: [PATCH 128/373] doc, bpf: Clean up eBPF option documentation [PR122243] gcc/ChangeLog PR other/122243 * doc/invoke.texi (Option Summary) : Fix formatting issues. Remove redundant entry for -mno-co-re. (eBPF Options): Add missing @opindex entries. Combine documentation for -mco-re and -mno-co-re. --- gcc/doc/invoke.texi | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index ef6ca4cf6f2b..222296519017 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -1078,10 +1078,10 @@ Objective-C and Objective-C++ Dialects}. -mlong-double-128 -mlong-double-64} @emph{eBPF Options} (@ref{eBPF Options}) -@gccoptlist{-mbig-endian -mlittle-endian --mframe-limit=@var{bytes} -mxbpf -mco-re -mno-co-re -mjmpext --mjmp32 -malu32 -mv3-atomics -mbswap -msdiv -msmov -mcpu=@var{version} --masm=@var{dialect} -minline-memops-threshold=@var{bytes}} +@gccoptlist{-mbig-endian -mlittle-endian +-mframe-limit=@var{bytes} -mxbpf -mco-re -mjmpext -mjmp32 +-malu32 -mv3-atomics -mbswap -msdiv -msmov -mcpu=@var{version} +-masm=@var{dialect} -minline-memops-threshold=@var{bytes}} @emph{FR30 Options} (@ref{FR30 Options}) @gccoptlist{-msmall-model -mno-lsim} @@ -27582,41 +27582,48 @@ Generate code for a big-endian target. Generate code for a little-endian target. This is the default. @opindex mjmpext +@opindex mno-jmpext @item -mjmpext @itemx -mno-jmpext Enable or disable generation of extra conditional-branch instructions. Enabled for CPU v2 and above. @opindex mjmp32 +@opindex mno-jmp32 @item -mjmp32 @itemx -mno-jmp32 Enable or disable generation of 32-bit jump instructions. Enabled for CPU v3 and above. @opindex malu32 +@opindex mno-alu32 @item -malu32 @itemx -mno-alu32 Enable or disable generation of 32-bit ALU instructions. Enabled for CPU v3 and above. @opindex mv3-atomics +@opindex mno-v3-atomics @item -mv3-atomics @itemx -mno-v3-atomics Enable or disable instructions for general atomic operations introduced in CPU v3. Enabled for CPU v3 and above. @opindex mbswap +@opindex mno-bswap @item -mbswap @itemx -mno-bswap Enable or disable byte swap instructions. Enabled for CPU v4 and above. @opindex msdiv +@opindex mno-sdiv @item -msdiv @itemx -mno-sdiv Enable or disable signed division and modulus instructions. Enabled for CPU v4 and above. @opindex msmov +@opindex mno-smov @item -msmov @itemx -mno-smov Enable or disable sign-extending move and memory load instructions. @@ -27654,16 +27661,15 @@ All features of v3, plus: @end table @opindex mco-re -@item -mco-re -Enable BPF Compile Once - Run Everywhere (CO-RE) support. Requires and -is implied by @option{-gbtf}. - @opindex mno-co-re -@item -mno-co-re -Disable BPF Compile Once - Run Everywhere (CO-RE) support. BPF CO-RE -support is enabled by default when generating BTF debug information for -the BPF target. +@item -mco-re +@itemx -mno-co-re +Enable or disable BPF Compile Once - Run Everywhere (CO-RE) support. +BPF CO-RE support is enabled by default when generating BTF debug +information for the BPF target (@option{-gbtf}). +@opindex mxbpf +@opindex mno-xbpf @item -mxbpf Generate code for an expanded version of BPF, which relaxes some of the restrictions imposed by the BPF architecture: From 6477814cb73ee12e6ae16b0f496a1072d45cec71 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Sun, 16 Nov 2025 23:11:33 +0000 Subject: [PATCH 129/373] doc, fr30: Clean up FR30 option documentation [PR122243] gcc/ChangeLog PR other/122243 * doc/invoke.texi (FR30 Options): Add @opindex for -mno-small-model. --- gcc/doc/invoke.texi | 1 + 1 file changed, 1 insertion(+) diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 222296519017..d3d5cc93772a 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -27714,6 +27714,7 @@ These options are defined specifically for the FR30 port. @table @gcctabopt @opindex msmall-model +@opindex mno-small-model @item -msmall-model Use the small address space model. This can produce smaller code, but it does assume that all symbolic values and addresses fit into a From 7ba5e0e4509dc0bfd4932137b8d89ce97c8a5425 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Mon, 17 Nov 2025 00:00:18 +0000 Subject: [PATCH 130/373] doc, ft32: Clean up FT32 options and documentation [PR122243] gcc/ChangeLog PR other/122243 * config/ft32/ft32.opt (mlra): Mark obsolete option as Undocumented. * doc/invoke.texi (Option Summary) : Remove -mlra. (FT32 Options): Likewise. Add @opindex entries for negative option forms. --- gcc/config/ft32/ft32.opt | 2 +- gcc/doc/invoke.texi | 13 +++++++------ 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/gcc/config/ft32/ft32.opt b/gcc/config/ft32/ft32.opt index 039ca29db3a7..def410d2af11 100644 --- a/gcc/config/ft32/ft32.opt +++ b/gcc/config/ft32/ft32.opt @@ -23,7 +23,7 @@ Target Mask(SIM) Target the software simulator. mlra -Target RejectNegative Ignore +Target RejectNegative Ignore Undocumented Ignored, but preserved for backward compatibility. mnodiv diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index d3d5cc93772a..fab22655d9a9 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -1087,7 +1087,7 @@ Objective-C and Objective-C++ Dialects}. @gccoptlist{-msmall-model -mno-lsim} @emph{FT32 Options} (@ref{FT32 Options}) -@gccoptlist{-msim -mlra -mnodiv -mft32b -mcompress -mnopm} +@gccoptlist{-msim -mnodiv -mft32b -mcompress -mnopm} @emph{FRV Options} (@ref{FRV Options}) @gccoptlist{-mgpr-32 -mgpr-64 -mfpr-32 -mfpr-64 @@ -27737,6 +27737,7 @@ These options are defined specifically for the FT32 port. @table @gcctabopt @opindex msim +@opindex mno-sim @item -msim Specifies that the program will be run on the simulator. This causes an alternate runtime startup and library to be linked. @@ -27744,23 +27745,23 @@ You must not use this option when generating programs that will run on real hardware; you must provide your own runtime library for whatever I/O functions are needed. -@opindex mlra -@item -mlra -Does nothing. Preserved for backward compatibility. - @opindex mnodiv +@opindex mno-nodiv @item -mnodiv Do not use div and mod instructions. @opindex mft32b +@opindex mno-ft32b @item -mft32b Enable use of the extended instructions of the FT32B processor. @opindex mcompress +@opindex mno-compress @item -mcompress Compress all code using the Ft32B code compression scheme. -@opindex mnopm +@opindex mnopm +@opindex mno-nopm @item -mnopm Do not generate code that reads program memory. From 8a57aabf339f4ea6d5b345fd8435fc948d518cc5 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Wed, 5 Nov 2025 15:39:14 +0000 Subject: [PATCH 131/373] doc, frv: Clean up FRV option documentation [PR122243] frv.opt has a few options that have never been documented in the manual. In the initial commit of the FRV port (prior to the adoption of .opt files) they were marked as "Internal debug switch" so I have explicitly made them "Undocumented", consistently with other options similarly marked in the original port. The documentation changes all straightforward here, to bring this section into conformance with conventions being applied through this chapter of the manual. gcc/ChangeLog PR other/122243 * config/frv/frv.opt (mbranch-cost=): Mark as Undocumented. (mcond-exec-insns=): Likewise. (mcond-exec-tempss=): Likewise. * doc/invoke.texi (Option Summary) : Remove duplicate positive/negative forms from the list. (FRV Options): Combine documentation of positive/negative forms where they were listed separately. Add @opindex entries for negative forms. --- gcc/config/frv/frv.opt | 6 +- gcc/doc/invoke.texi | 153 ++++++++++++++--------------------------- 2 files changed, 55 insertions(+), 104 deletions(-) diff --git a/gcc/config/frv/frv.opt b/gcc/config/frv/frv.opt index 1890f91e3336..19f41862d296 100644 --- a/gcc/config/frv/frv.opt +++ b/gcc/config/frv/frv.opt @@ -45,7 +45,7 @@ Dynamically allocate cc registers. ; generating SCC instructions and or/and-ing them together, and then doing the ; branch on the result, which collectively generate much worse code. mbranch-cost= -Target RejectNegative Joined UInteger Var(frv_branch_cost_int) Init(1) +Target RejectNegative Joined UInteger Var(frv_branch_cost_int) Init(1) Undocumented Set the cost of branches. mcond-exec @@ -53,11 +53,11 @@ Target Mask(COND_EXEC) Enable conditional execution other than moves/scc. mcond-exec-insns= -Target RejectNegative Joined UInteger Var(frv_condexec_insns) Init(8) +Target RejectNegative Joined UInteger Var(frv_condexec_insns) Init(8) Undocumented Change the maximum length of conditionally-executed sequences. mcond-exec-temps= -Target RejectNegative Joined UInteger Var(frv_condexec_temps) Init(4) +Target RejectNegative Joined UInteger Var(frv_condexec_temps) Init(4) Undocumented Change the number of temporary registers that are available to conditionally-executed sequences. mcond-move diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index fab22655d9a9..322d440c0d6b 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -1092,18 +1092,14 @@ Objective-C and Objective-C++ Dialects}. @emph{FRV Options} (@ref{FRV Options}) @gccoptlist{-mgpr-32 -mgpr-64 -mfpr-32 -mfpr-64 -mhard-float -msoft-float --malloc-cc -mfixed-cc -mdword -mno-dword --mdouble -mno-double --mmedia -mno-media -mmuladd -mno-muladd +-malloc-cc -mfixed-cc -mdword -mdouble -mmedia -mmuladd -mfdpic -minline-plt -mgprel-ro -multilib-library-pic -mlinked-fp -mlong-calls -malign-labels -mlibrary-pic -macc-4 -macc-8 --mpack -mno-pack -mno-eflags -mcond-move -mno-cond-move --moptimize-membar -mno-optimize-membar --mscc -mno-scc -mcond-exec -mno-cond-exec --mvliw-branch -mno-vliw-branch --mmulti-cond-exec -mno-multi-cond-exec -mnested-cond-exec --mno-nested-cond-exec -mtomcat-stats +-mpack -mno-eflags -mno-cond-move +-mno-optimize-membar -mno-scc -mno-cond-exec +-mno-vliw-branch -mno-multi-cond-exec -mno-nested-cond-exec +-mtomcat-stats -mTLS -mtls -mcpu=@var{cpu}} @@ -27814,47 +27810,35 @@ Do not try to dynamically allocate condition code registers, only use @code{icc0} and @code{fcc0}. @opindex mdword -@item -mdword - -Change ABI to use double word insns. - @opindex mno-dword -@opindex mdword -@item -mno-dword +@item -mdword +@itemx -mno-dword -Do not use double word instructions. +Control whether the ABI uses double-word instructions. @opindex mdouble -@item -mdouble - -Use floating-point double instructions. - @opindex mno-double -@item -mno-double +@item -mdouble +@itemx -mno-double -Do not use floating-point double instructions. +Enable or disable use of floating-point double instructions. @opindex mmedia -@item -mmedia - -Use media instructions. - @opindex mno-media -@item -mno-media +@item -mmedia +@itemx -mno-media -Do not use media instructions. +Enable or disable use of media instructions. @opindex mmuladd -@item -mmuladd - -Use multiply and add/subtract instructions. - @opindex mno-muladd -@item -mno-muladd +@item -mmuladd +@itemx -mno-muladd -Do not use multiply and add/subtract instructions. +Enable or disable use of multiply and add/subtract instructions. @opindex mfdpic +@opindex mno-fdpic @item -mfdpic Select the FDPIC ABI, which uses function descriptors to represent @@ -27866,6 +27850,7 @@ are computed with 32 bits. With a @samp{bfin-elf} target, this option implies @option{-msim}. @opindex minline-plt +@opindex mno-inline-plt @item -minline-plt Enable inlining of PLT entries in function calls to functions that are @@ -27886,6 +27871,7 @@ Assume a large TLS segment when generating thread-local code. Do not assume a large TLS segment when generating thread-local code. @opindex mgprel-ro +@opindex mno-gprel-ro @item -mgprel-ro Enable the use of @code{GPREL} relocations in the FDPIC ABI for data @@ -27906,6 +27892,7 @@ Link with the (library, not FD) pic libraries. It's implied by it explicitly. @opindex mlinked-fp +@opindex mno-linked-fp @item -mlinked-fp Follow the EABI requirement of always creating a frame pointer whenever @@ -27913,6 +27900,7 @@ a stack frame is allocated. This option is enabled by default and can be disabled with @option{-mno-linked-fp}. @opindex mlong-calls +@opindex mno-long-calls @item -mlong-calls Use indirect addressing to call functions outside the current @@ -27920,6 +27908,7 @@ compilation unit. This allows the functions to be placed anywhere within the 32-bit address space. @opindex malign-labels +@opindex mno-align-labels @item -malign-labels Try to align labels to an 8-byte boundary by inserting NOPs into the @@ -27928,6 +27917,7 @@ is enabled. It doesn't create new packets; it merely adds NOPs to existing ones. @opindex mlibrary-pic +@opindex mno-library-pic @item -mlibrary-pic Generate position-independent EABI code. @@ -27943,14 +27933,11 @@ Use only the first four media accumulator registers. Use all eight media accumulator registers. @opindex mpack -@item -mpack - -Pack VLIW instructions. - @opindex mno-pack +@item -mpack @item -mno-pack -Do not pack VLIW instructions. +Enable or disable packing VLIW instructions. @opindex mno-eflags @item -mno-eflags @@ -27958,116 +27945,80 @@ Do not pack VLIW instructions. Do not mark ABI switches in e_flags. @opindex mcond-move -@item -mcond-move - -Enable the use of conditional-move instructions (default). - -This switch is mainly for debugging the compiler and will likely be removed -in a future version. - @opindex mno-cond-move -@item -mno-cond-move +@item -mcond-move +@itemx -mno-cond-move -Disable the use of conditional-move instructions. +Enable or disable the use of conditional-move instructions; it is enabled +by default. This switch is mainly for debugging the compiler and will likely be removed in a future version. @opindex mscc -@item -mscc - -Enable the use of conditional set instructions (default). - -This switch is mainly for debugging the compiler and will likely be removed -in a future version. - @opindex mno-scc -@item -mno-scc +@item -mscc +@itemx -mno-scc -Disable the use of conditional set instructions. +Enable or disable the use of conditional set instructions; it is enabled +by default. This switch is mainly for debugging the compiler and will likely be removed in a future version. @opindex mcond-exec -@item -mcond-exec - -Enable the use of conditional execution (default). - -This switch is mainly for debugging the compiler and will likely be removed -in a future version. - @opindex mno-cond-exec -@item -mno-cond-exec +@item -mcond-exec +@itemx -mno-cond-exec -Disable the use of conditional execution. +Enable or disable the use of conditional execution; it is enabled by default. This switch is mainly for debugging the compiler and will likely be removed in a future version. @opindex mvliw-branch -@item -mvliw-branch - -Run a pass to pack branches into VLIW instructions (default). - -This switch is mainly for debugging the compiler and will likely be removed -in a future version. - @opindex mno-vliw-branch -@item -mno-vliw-branch +@item -mvliw-branch +@itemx -mno-vliw-branch -Do not run a pass to pack branches into VLIW instructions. +Enable or disable an optimization pass to pack branches into VLIW instructions; +it is enabled by default. This switch is mainly for debugging the compiler and will likely be removed in a future version. @opindex mmulti-cond-exec -@item -mmulti-cond-exec - -Enable optimization of @code{&&} and @code{||} in conditional execution -(default). - -This switch is mainly for debugging the compiler and will likely be removed -in a future version. - @opindex mno-multi-cond-exec -@item -mno-multi-cond-exec +@item -mmulti-cond-exec +@itemx -mno-multi-cond-exec -Disable optimization of @code{&&} and @code{||} in conditional execution. +Enable or disable optimization of @code{&&} and @code{||} in conditional +execution; it is enabled by default. This switch is mainly for debugging the compiler and will likely be removed in a future version. @opindex mnested-cond-exec -@item -mnested-cond-exec - -Enable nested conditional execution optimizations (default). - -This switch is mainly for debugging the compiler and will likely be removed -in a future version. - @opindex mno-nested-cond-exec -@item -mno-nested-cond-exec +@item -mnested-cond-exec +@itemx -mno-nested-cond-exec -Disable nested conditional execution optimizations. +Enable or disable nested conditional execution optimizations; it is enabled +by default. This switch is mainly for debugging the compiler and will likely be removed in a future version. @opindex moptimize-membar +@opindex mno-optimize-membar @item -moptimize-membar +@itemx -mno-optimize-membar This switch removes redundant @code{membar} instructions from the compiler-generated code. It is enabled by default. -@opindex mno-optimize-membar -@opindex moptimize-membar -@item -mno-optimize-membar - -This switch disables the automatic removal of redundant @code{membar} -instructions from the generated code. - @opindex mtomcat-stats +@opindex mno-tomcat-stats @item -mtomcat-stats Cause gas to print out tomcat statistics. From 1290b35c7e7da448177edc56421ea0d966c0aeaa Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Mon, 17 Nov 2025 15:30:15 +0000 Subject: [PATCH 132/373] doc, linux: Clean up GNU/Linux option documentation [PR122243] gcc/ChangeLog PR other/122243 * doc/invoke.texi: Document -mno-android. --- gcc/doc/invoke.texi | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 322d440c0d6b..8a5c554770d2 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -28060,7 +28060,9 @@ Use Bionic C library. This is the default on @samp{*-*-linux-*android*} targets. @opindex mandroid +@opindex mno-android @item -mandroid +@itemx -mno-android Compile code compatible with Android platform. This is the default on @samp{*-*-linux-*android*} targets. @@ -28070,6 +28072,8 @@ this option makes the GCC driver pass Android-specific options to the linker. Finally, this option causes the preprocessor macro @code{__ANDROID__} to be defined. +This option can be disabled completely with @option{-mno-android}. + @opindex tno-android-cc @item -tno-android-cc Disable compilation effects of @option{-mandroid}, i.e., do not enable From 64b61f9f5094fb42d0d4673614b339ec1f58a01c Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Sat, 29 Nov 2025 02:40:24 +0000 Subject: [PATCH 133/373] doc: Fix alphabetization of FRV/FT32 option documentation sections. The FRV and FT32 options were incorrectly alphabetized with respect to each other in the Options Summary, the menu for the Submodel Options section, and in the order of their respective subsections. Fixed thusly. gcc/ChangeLog * doc/invoke.texi (Options Summary): Switch ordering of FRV and FT32. (Submodel Options): Likewise in the menu and section ordering. --- gcc/doc/invoke.texi | 86 ++++++++++++++++++++++----------------------- 1 file changed, 43 insertions(+), 43 deletions(-) diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 8a5c554770d2..3be6635c70a3 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -1086,9 +1086,6 @@ Objective-C and Objective-C++ Dialects}. @emph{FR30 Options} (@ref{FR30 Options}) @gccoptlist{-msmall-model -mno-lsim} -@emph{FT32 Options} (@ref{FT32 Options}) -@gccoptlist{-msim -mnodiv -mft32b -mcompress -mnopm} - @emph{FRV Options} (@ref{FRV Options}) @gccoptlist{-mgpr-32 -mgpr-64 -mfpr-32 -mfpr-64 -mhard-float -msoft-float @@ -1103,6 +1100,9 @@ Objective-C and Objective-C++ Dialects}. -mTLS -mtls -mcpu=@var{cpu}} +@emph{FT32 Options} (@ref{FT32 Options}) +@gccoptlist{-msim -mnodiv -mft32b -mcompress -mnopm} + @emph{GNU/Linux Options} (@ref{GNU/Linux Options}) @gccoptlist{-mglibc -muclibc -mmusl -mbionic -mandroid -tno-android-cc -tno-android-ld} @@ -22385,8 +22385,8 @@ platform. * DEC Alpha Options:: * eBPF Options:: * FR30 Options:: -* FT32 Options:: * FRV Options:: +* FT32 Options:: * GNU/Linux Options:: * H8/300 Options:: * HPPA Options:: @@ -27724,45 +27724,6 @@ command line. @end table -@node FT32 Options -@subsection FT32 Options -@cindex FT32 Options - -These options are defined specifically for the FT32 port. - -@table @gcctabopt - -@opindex msim -@opindex mno-sim -@item -msim -Specifies that the program will be run on the simulator. This causes -an alternate runtime startup and library to be linked. -You must not use this option when generating programs that will run on -real hardware; you must provide your own runtime library for whatever -I/O functions are needed. - -@opindex mnodiv -@opindex mno-nodiv -@item -mnodiv -Do not use div and mod instructions. - -@opindex mft32b -@opindex mno-ft32b -@item -mft32b -Enable use of the extended instructions of the FT32B processor. - -@opindex mcompress -@opindex mno-compress -@item -mcompress -Compress all code using the Ft32B code compression scheme. - -@opindex mnopm -@opindex mno-nopm -@item -mnopm -Do not generate code that reads program memory. - -@end table - @node FRV Options @subsection FRV Options @cindex FRV Options @@ -28032,6 +27993,45 @@ Select the processor type for which to generate code. Possible values are @end table +@node FT32 Options +@subsection FT32 Options +@cindex FT32 Options + +These options are defined specifically for the FT32 port. + +@table @gcctabopt + +@opindex msim +@opindex mno-sim +@item -msim +Specifies that the program will be run on the simulator. This causes +an alternate runtime startup and library to be linked. +You must not use this option when generating programs that will run on +real hardware; you must provide your own runtime library for whatever +I/O functions are needed. + +@opindex mnodiv +@opindex mno-nodiv +@item -mnodiv +Do not use div and mod instructions. + +@opindex mft32b +@opindex mno-ft32b +@item -mft32b +Enable use of the extended instructions of the FT32B processor. + +@opindex mcompress +@opindex mno-compress +@item -mcompress +Compress all code using the Ft32B code compression scheme. + +@opindex mnopm +@opindex mno-nopm +@item -mnopm +Do not generate code that reads program memory. + +@end table + @node GNU/Linux Options @subsection GNU/Linux Options From 82d852b23e54a433a7475b27fcaa74a96d7ecf02 Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Sat, 29 Nov 2025 03:17:01 +0000 Subject: [PATCH 134/373] doc: make regenerate-opt-urls gcc/ChangeLog * common.opt.urls: Regenerated. * config/aarch64/aarch64.opt.urls: Regenerated. * config/alpha/alpha.opt.urls: Regenerated. * config/arm/arm.opt.urls: Regenerated. * config/avr/avr.opt.urls: Regenerated. * config/bpf/bpf.opt.urls: Regenerated. * config/c6x/c6x.opt.urls: Regenerated. * config/cris/cris.opt.urls: Regenerated. * config/cris/elf.opt.urls: Regenerated. * config/csky/csky.opt.urls: Regenerated. * config/darwin.opt.urls: Regenerated. * config/epiphany/epiphany.opt.urls: Regenerated. * config/frv/frv.opt.urls: Regenerated. * config/ft32/ft32.opt.urls: Regenerated. * config/gcn/gcn.opt.urls: Regenerated. * config/i386/i386.opt.urls: Regenerated. * config/ia64/ia64.opt.urls: Regenerated. * config/loongarch/loongarch.opt.urls: Regenerated. * config/m68k/m68k.opt.urls: Regenerated. * config/microblaze/microblaze.opt.urls: Regenerated. * config/mips/mips.opt.urls: Regenerated. * config/mmix/mmix.opt.urls: Regenerated. * config/or1k/or1k.opt.urls: Regenerated. * config/pa/pa.opt.urls: Regenerated. * config/pdp11/pdp11.opt.urls: Regenerated. * config/rs6000/rs6000.opt.urls: Regenerated. * config/s390/s390.opt.urls: Regenerated. * config/sparc/sparc.opt.urls: Regenerated. * config/v850/v850.opt.urls: Regenerated. * config/vax/vax.opt.urls: Regenerated. * config/visium/visium.opt.urls: Regenerated. --- gcc/common.opt.urls | 5 +- gcc/config/aarch64/aarch64.opt.urls | 14 +++- gcc/config/alpha/alpha.opt.urls | 14 +++- gcc/config/arm/arm.opt.urls | 12 --- gcc/config/avr/avr.opt.urls | 2 +- gcc/config/bpf/bpf.opt.urls | 3 + gcc/config/c6x/c6x.opt.urls | 6 +- gcc/config/cris/cris.opt.urls | 18 +++++ gcc/config/cris/elf.opt.urls | 3 +- gcc/config/csky/csky.opt.urls | 14 ++-- gcc/config/darwin.opt.urls | 90 +++++++++++------------ gcc/config/epiphany/epiphany.opt.urls | 15 +++- gcc/config/frv/frv.opt.urls | 6 +- gcc/config/ft32/ft32.opt.urls | 3 +- gcc/config/gcn/gcn.opt.urls | 6 +- gcc/config/i386/i386.opt.urls | 8 +- gcc/config/ia64/ia64.opt.urls | 2 +- gcc/config/loongarch/loongarch.opt.urls | 2 +- gcc/config/m68k/m68k.opt.urls | 4 +- gcc/config/microblaze/microblaze.opt.urls | 4 +- gcc/config/mips/mips.opt.urls | 10 +-- gcc/config/mmix/mmix.opt.urls | 2 +- gcc/config/or1k/or1k.opt.urls | 4 +- gcc/config/pa/pa.opt.urls | 4 +- gcc/config/pdp11/pdp11.opt.urls | 4 +- gcc/config/rs6000/rs6000.opt.urls | 4 +- gcc/config/s390/s390.opt.urls | 12 +-- gcc/config/sparc/sparc.opt.urls | 4 +- gcc/config/v850/v850.opt.urls | 6 +- gcc/config/vax/vax.opt.urls | 2 +- gcc/config/visium/visium.opt.urls | 4 +- 31 files changed, 160 insertions(+), 127 deletions(-) diff --git a/gcc/common.opt.urls b/gcc/common.opt.urls index d13af0a8e7c6..c42fba3157d7 100644 --- a/gcc/common.opt.urls +++ b/gcc/common.opt.urls @@ -1996,9 +1996,8 @@ UrlSuffix(gcc/Overall-Options.html#index-specs) specs= UrlSuffix(gcc/Overall-Options.html#index-specs) -; skipping UrlSuffix for 'static' due to multiple URLs: -; duplicate: 'gcc/Darwin-Options.html#index-static-1' -; duplicate: 'gcc/Link-Options.html#index-static' +static +UrlSuffix(gcc/Link-Options.html#index-static) static-libgcc UrlSuffix(gcc/Link-Options.html#index-static-libgcc) diff --git a/gcc/config/aarch64/aarch64.opt.urls b/gcc/config/aarch64/aarch64.opt.urls index 993e0fc9c4d7..f0087b280f7a 100644 --- a/gcc/config/aarch64/aarch64.opt.urls +++ b/gcc/config/aarch64/aarch64.opt.urls @@ -77,8 +77,14 @@ UrlSuffix(gcc/AArch64-Options.html#index-mearly-ra) msve-vector-bits= UrlSuffix(gcc/AArch64-Options.html#index-msve-vector-bits) -mverbose-cost-dump -UrlSuffix(gcc/AArch64-Options.html#index-mverbose-cost-dump) +mautovec-preference= +UrlSuffix(gcc/AArch64-Options.html#index-mautovec-preference) + +mmax-vectorization +UrlSuffix(gcc/AArch64-Options.html#index-mmax-vectorization) + +mtrack-speculation +UrlSuffix(gcc/AArch64-Options.html#index-mtrack-speculation) mearly-ldp-fusion UrlSuffix(gcc/AArch64-Options.html#index-mearly-ldp-fusion) @@ -95,6 +101,6 @@ UrlSuffix(gcc/AArch64-Options.html#index-mstack-protector-guard-reg) mstack-protector-guard-offset= UrlSuffix(gcc/AArch64-Options.html#index-mstack-protector-guard-offset) -Wexperimental-fmv-target -UrlSuffix(gcc/AArch64-Options.html#index-Wexperimental-fmv-target) +moutline-atomics +UrlSuffix(gcc/AArch64-Options.html#index-moutline-atomics) diff --git a/gcc/config/alpha/alpha.opt.urls b/gcc/config/alpha/alpha.opt.urls index 93615877ee3e..df814cd11c9c 100644 --- a/gcc/config/alpha/alpha.opt.urls +++ b/gcc/config/alpha/alpha.opt.urls @@ -1,7 +1,7 @@ ; Autogenerated by regenerate-opt-urls.py from gcc/config/alpha/alpha.opt and generated HTML msoft-float -UrlSuffix(gcc/DEC-Alpha-Options.html#index-msoft-float-2) +UrlSuffix(gcc/DEC-Alpha-Options.html#index-msoft-float-1) ; skipping UrlSuffix for 'mgas' due to finding no URLs @@ -56,9 +56,14 @@ UrlSuffix(gcc/DEC-Alpha-Options.html#index-msmall-text) mlarge-text UrlSuffix(gcc/DEC-Alpha-Options.html#index-mlarge-text) -; skipping UrlSuffix for 'mlong-double-128' due to finding no URLs +mtls-kernel +UrlSuffix(gcc/DEC-Alpha-Options.html#index-mtls-kernel) -; skipping UrlSuffix for 'mlong-double-64' due to finding no URLs +mlong-double-128 +UrlSuffix(gcc/DEC-Alpha-Options.html#index-mlong-double-128) + +mlong-double-64 +UrlSuffix(gcc/DEC-Alpha-Options.html#index-mlong-double-64) mcpu= UrlSuffix(gcc/DEC-Alpha-Options.html#index-mcpu-4) @@ -78,5 +83,6 @@ UrlSuffix(gcc/DEC-Alpha-Options.html#index-mtrap-precision) mmemory-latency= UrlSuffix(gcc/DEC-Alpha-Options.html#index-mmemory-latency) -; skipping UrlSuffix for 'mtls-size=' due to finding no URLs +mtls-size= +UrlSuffix(gcc/DEC-Alpha-Options.html#index-mtls-size-1) diff --git a/gcc/config/arm/arm.opt.urls b/gcc/config/arm/arm.opt.urls index b3696f78bc73..93c6fce197c3 100644 --- a/gcc/config/arm/arm.opt.urls +++ b/gcc/config/arm/arm.opt.urls @@ -36,9 +36,6 @@ UrlSuffix(gcc/ARM-Options.html#index-mfloat-abi) mcmse UrlSuffix(gcc/ARM-Options.html#index-mcmse) -mflip-thumb -UrlSuffix(gcc/ARM-Options.html#index-mflip-thumb) - mfp16-format= UrlSuffix(gcc/ARM-Options.html#index-mfp16-format) @@ -94,12 +91,6 @@ UrlSuffix(gcc/ARM-Options.html#index-mtpcs-leaf-frame) mtune= UrlSuffix(gcc/ARM-Options.html#index-mtune-4) -mprint-tune-info -UrlSuffix(gcc/ARM-Options.html#index-mprint-tune-info) - -mverbose-cost-dump -UrlSuffix(gcc/ARM-Options.html#index-mverbose-cost-dump-1) - mword-relocations UrlSuffix(gcc/ARM-Options.html#index-mword-relocations) @@ -115,9 +106,6 @@ UrlSuffix(gcc/ARM-Options.html#index-mfix-cmse-cve-2021-35465) munaligned-access UrlSuffix(gcc/ARM-Options.html#index-munaligned-access) -mneon-for-64bits -UrlSuffix(gcc/ARM-Options.html#index-mneon-for-64bits) - mslow-flash-data UrlSuffix(gcc/ARM-Options.html#index-mslow-flash-data) diff --git a/gcc/config/avr/avr.opt.urls b/gcc/config/avr/avr.opt.urls index fa560bc2a5a7..b46c9be9681f 100644 --- a/gcc/config/avr/avr.opt.urls +++ b/gcc/config/avr/avr.opt.urls @@ -28,7 +28,7 @@ muse-nonzero-bits UrlSuffix(gcc/AVR-Options.html#index-muse-nonzero-bits) mshort-calls -UrlSuffix(gcc/AVR-Options.html#index-mshort-calls) +UrlSuffix(gcc/AVR-Options.html#index-mshort-calls-1) mint8 UrlSuffix(gcc/AVR-Options.html#index-mint8) diff --git a/gcc/config/bpf/bpf.opt.urls b/gcc/config/bpf/bpf.opt.urls index 1e8873a899fd..afa5f6c69397 100644 --- a/gcc/config/bpf/bpf.opt.urls +++ b/gcc/config/bpf/bpf.opt.urls @@ -1,5 +1,8 @@ ; Autogenerated by regenerate-opt-urls.py from gcc/config/bpf/bpf.opt and generated HTML +mxbpf +UrlSuffix(gcc/eBPF-Options.html#index-mxbpf) + mbig-endian UrlSuffix(gcc/eBPF-Options.html#index-mbig-endian-5) diff --git a/gcc/config/c6x/c6x.opt.urls b/gcc/config/c6x/c6x.opt.urls index 5b1c103b43f2..7813a8024d91 100644 --- a/gcc/config/c6x/c6x.opt.urls +++ b/gcc/config/c6x/c6x.opt.urls @@ -11,7 +11,11 @@ UrlSuffix(gcc/C6X-Options.html#index-msim-1) ; skipping UrlSuffix for 'msdata=' due to finding no URLs -; skipping UrlSuffix for 'mlong-calls' due to finding no URLs +mdsbt +UrlSuffix(gcc/C6X-Options.html#index-mdsbt) + +mlong-calls +UrlSuffix(gcc/C6X-Options.html#index-mlong-calls-4) march= UrlSuffix(gcc/C6X-Options.html#index-march-3) diff --git a/gcc/config/cris/cris.opt.urls b/gcc/config/cris/cris.opt.urls index 56eeaa25da1c..20b31b3a5e1c 100644 --- a/gcc/config/cris/cris.opt.urls +++ b/gcc/config/cris/cris.opt.urls @@ -9,6 +9,9 @@ UrlSuffix(gcc/CRIS-Options.html#index-metrax4) metrax100 UrlSuffix(gcc/CRIS-Options.html#index-metrax100) +mno-etrax100 +UrlSuffix(gcc/CRIS-Options.html#index-mno-etrax100) + mpdebug UrlSuffix(gcc/CRIS-Options.html#index-mpdebug) @@ -54,6 +57,12 @@ UrlSuffix(gcc/CRIS-Options.html#index-mprologue-epilogue) mno-prologue-epilogue UrlSuffix(gcc/CRIS-Options.html#index-mno-prologue-epilogue) +mbest-lib-options +UrlSuffix(gcc/CRIS-Options.html#index-mbest-lib-options) + +moverride-best-lib-options +UrlSuffix(gcc/CRIS-Options.html#index-moverride-best-lib-options) + mcpu= UrlSuffix(gcc/CRIS-Options.html#index-mcpu-3) @@ -63,3 +72,12 @@ UrlSuffix(gcc/CRIS-Options.html#index-march-4) mtune= UrlSuffix(gcc/CRIS-Options.html#index-mtune-5) +mtrap-using-break8 +UrlSuffix(gcc/CRIS-Options.html#index-mtrap-using-break8) + +mtrap-unaligned-atomic +UrlSuffix(gcc/CRIS-Options.html#index-mtrap-unaligned-atomic) + +munaligned-atomic-may-use-library +UrlSuffix(gcc/CRIS-Options.html#index-munaligned-atomic-may-use-library) + diff --git a/gcc/config/cris/elf.opt.urls b/gcc/config/cris/elf.opt.urls index bdfa01e97a49..f7969fbd4e09 100644 --- a/gcc/config/cris/elf.opt.urls +++ b/gcc/config/cris/elf.opt.urls @@ -1,7 +1,6 @@ ; Autogenerated by regenerate-opt-urls.py from gcc/config/cris/elf.opt and generated HTML -melf -UrlSuffix(gcc/CRIS-Options.html#index-melf) +; skipping UrlSuffix for 'melf' due to finding no URLs sim UrlSuffix(gcc/CRIS-Options.html#index-sim) diff --git a/gcc/config/csky/csky.opt.urls b/gcc/config/csky/csky.opt.urls index 96b0b174f7c9..50f7b87f0374 100644 --- a/gcc/config/csky/csky.opt.urls +++ b/gcc/config/csky/csky.opt.urls @@ -9,20 +9,16 @@ UrlSuffix(gcc/C-SKY-Options.html#index-mcpu_003d-1) mbig-endian UrlSuffix(gcc/C-SKY-Options.html#index-mbig-endian-4) -EB -UrlSuffix(gcc/C-SKY-Options.html#index-EB-1) +; skipping UrlSuffix for 'EB' due to finding no URLs mlittle-endian UrlSuffix(gcc/C-SKY-Options.html#index-mlittle-endian-4) -EL -UrlSuffix(gcc/C-SKY-Options.html#index-EL-1) +; skipping UrlSuffix for 'EL' due to finding no URLs -mhard-float -UrlSuffix(gcc/C-SKY-Options.html#index-mhard-float) +; skipping UrlSuffix for 'mhard-float' due to finding no URLs -msoft-float -UrlSuffix(gcc/C-SKY-Options.html#index-msoft-float-1) +; skipping UrlSuffix for 'msoft-float' due to finding no URLs mfloat-abi= UrlSuffix(gcc/C-SKY-Options.html#index-mfloat-abi-1) @@ -88,7 +84,7 @@ mconstpool UrlSuffix(gcc/C-SKY-Options.html#index-mconstpool) mstack-size -UrlSuffix(gcc/C-SKY-Options.html#index-mstack-size-1) +UrlSuffix(gcc/C-SKY-Options.html#index-mstack-size) mccrt UrlSuffix(gcc/C-SKY-Options.html#index-mccrt) diff --git a/gcc/config/darwin.opt.urls b/gcc/config/darwin.opt.urls index e83d183ac161..a3da8d2cbc4e 100644 --- a/gcc/config/darwin.opt.urls +++ b/gcc/config/darwin.opt.urls @@ -3,6 +3,9 @@ dependency-file UrlSuffix(gcc/Darwin-Options.html#index-dependency-file) +fapple-kext +UrlSuffix(gcc/Darwin-Options.html#index-fapple-kext) + fconstant-cfstrings UrlSuffix(gcc/Darwin-Options.html#index-fconstant-cfstrings) @@ -12,7 +15,14 @@ UrlSuffix(gcc/Darwin-Options.html#index-iframework) mconstant-cfstrings UrlSuffix(gcc/Darwin-Options.html#index-mconstant-cfstrings) -; skipping UrlSuffix for 'mdynamic-no-pic' due to finding no URLs +Wnonportable-cfstrings +UrlSuffix(gcc/Darwin-Options.html#index-Wno-nonportable-cfstrings) + +matt-stubs +UrlSuffix(gcc/Darwin-Options.html#index-matt-stubs) + +mdynamic-no-pic +UrlSuffix(gcc/Darwin-Options.html#index-mdynamic-no-pic) mfix-and-continue UrlSuffix(gcc/Darwin-Options.html#index-mfix-and-continue) @@ -26,15 +36,30 @@ UrlSuffix(gcc/Darwin-Options.html#index-mmacosx-version-min) mone-byte-bool UrlSuffix(gcc/Darwin-Options.html#index-mone-byte-bool) +msymbol-stubs +UrlSuffix(gcc/Darwin-Options.html#index-msymbol-stubs) + +mtarget-linker= +UrlSuffix(gcc/Darwin-Options.html#index-mtarget-linker) + +mtarget-linker +UrlSuffix(gcc/Darwin-Options.html#index-mtarget-linker) + all_load UrlSuffix(gcc/Darwin-Options.html#index-all_005fload) allowable_client UrlSuffix(gcc/Darwin-Options.html#index-allowable_005fclient) +arch +UrlSuffix(gcc/Darwin-Options.html#index-arch) + arch_errors_fatal UrlSuffix(gcc/Darwin-Options.html#index-arch_005ferrors_005ffatal) +asm_macosx_version_min= +UrlSuffix(gcc/Darwin-Options.html#index-asm_005fmacosx_005fversion_005fmin) + bind_at_load UrlSuffix(gcc/Darwin-Options.html#index-bind_005fat_005fload) @@ -59,6 +84,9 @@ UrlSuffix(gcc/Darwin-Options.html#index-dead_005fstrip) dylib_file UrlSuffix(gcc/Darwin-Options.html#index-dylib_005ffile) +dylinker +UrlSuffix(gcc/Darwin-Options.html#index-dylinker) + dylinker_install_name UrlSuffix(gcc/Darwin-Options.html#index-dylinker_005finstall_005fname) @@ -83,6 +111,9 @@ UrlSuffix(gcc/Darwin-Options.html#index-force_005fcpusubtype_005fALL) force_flat_namespace UrlSuffix(gcc/Darwin-Options.html#index-force_005fflat_005fnamespace) +framework +UrlSuffix(gcc/Darwin-Options.html#index-framework) + gfull UrlSuffix(gcc/Darwin-Options.html#index-gfull) @@ -104,45 +135,21 @@ UrlSuffix(gcc/Darwin-Options.html#index-install_005fname) keep_private_externs UrlSuffix(gcc/Darwin-Options.html#index-keep_005fprivate_005fexterns) -multi_module -UrlSuffix(gcc/Darwin-Options.html#index-multi_005fmodule) - -multiply_defined -UrlSuffix(gcc/Darwin-Options.html#index-multiply_005fdefined) - -multiply_defined_unused -UrlSuffix(gcc/Darwin-Options.html#index-multiply_005fdefined_005funused) - -no_dead_strip_inits_and_terms -UrlSuffix(gcc/Darwin-Options.html#index-no_005fdead_005fstrip_005finits_005fand_005fterms) +nodefaultexport +UrlSuffix(gcc/Darwin-Options.html#index-nodefaultexport) nodefaultrpaths UrlSuffix(gcc/Darwin-Options.html#index-nodefaultrpaths) -nofixprebinding -UrlSuffix(gcc/Darwin-Options.html#index-nofixprebinding) +ObjC +UrlSuffix(gcc/Darwin-Options.html#index-ObjC) -nomultidefs -UrlSuffix(gcc/Darwin-Options.html#index-nomultidefs) - -noprebind -UrlSuffix(gcc/Darwin-Options.html#index-noprebind) - -noseglinkedit -UrlSuffix(gcc/Darwin-Options.html#index-noseglinkedit) +ObjC++ +UrlSuffix(gcc/Darwin-Options.html#index-ObjC_002b_002b) pagezero_size UrlSuffix(gcc/Darwin-Options.html#index-pagezero_005fsize) -prebind -UrlSuffix(gcc/Darwin-Options.html#index-prebind) - -prebind_all_twolevel_modules -UrlSuffix(gcc/Darwin-Options.html#index-prebind_005fall_005ftwolevel_005fmodules) - -private_bundle -UrlSuffix(gcc/Darwin-Options.html#index-private_005fbundle) - ; skipping UrlSuffix for 'pthread' due to multiple URLs: ; duplicate: 'gcc/Link-Options.html#index-pthread-1' ; duplicate: 'gcc/Preprocessor-Options.html#index-pthread' @@ -159,27 +166,15 @@ UrlSuffix(gcc/Darwin-Options.html#index-sectalign) sectcreate UrlSuffix(gcc/Darwin-Options.html#index-sectcreate) -sectobjectsymbols -UrlSuffix(gcc/Darwin-Options.html#index-sectobjectsymbols) - -sectorder -UrlSuffix(gcc/Darwin-Options.html#index-sectorder) - seg_addr_table UrlSuffix(gcc/Darwin-Options.html#index-seg_005faddr_005ftable) -seg_addr_table_filename -UrlSuffix(gcc/Darwin-Options.html#index-seg_005faddr_005ftable_005ffilename) - seg1addr UrlSuffix(gcc/Darwin-Options.html#index-seg1addr) segaddr UrlSuffix(gcc/Darwin-Options.html#index-segaddr) -seglinkedit -UrlSuffix(gcc/Darwin-Options.html#index-seglinkedit) - segprot UrlSuffix(gcc/Darwin-Options.html#index-segprot) @@ -189,9 +184,6 @@ UrlSuffix(gcc/Darwin-Options.html#index-segs_005fread_005fonly_005faddr) segs_read_write_addr UrlSuffix(gcc/Darwin-Options.html#index-segs_005fread_005fwrite_005faddr) -single_module -UrlSuffix(gcc/Darwin-Options.html#index-single_005fmodule) - sub_library UrlSuffix(gcc/Darwin-Options.html#index-sub_005flibrary) @@ -201,6 +193,9 @@ UrlSuffix(gcc/Darwin-Options.html#index-sub_005fumbrella) twolevel_namespace UrlSuffix(gcc/Darwin-Options.html#index-twolevel_005fnamespace) +twolevel_namespace_hints +UrlSuffix(gcc/Darwin-Options.html#index-twolevel_005fnamespace_005fhints) + umbrella UrlSuffix(gcc/Darwin-Options.html#index-umbrella) @@ -210,6 +205,9 @@ UrlSuffix(gcc/Darwin-Options.html#index-undefined) unexported_symbols_list UrlSuffix(gcc/Darwin-Options.html#index-unexported_005fsymbols_005flist) +weak_framework +UrlSuffix(gcc/Darwin-Options.html#index-weak_005fframework) + weak_reference_mismatches UrlSuffix(gcc/Darwin-Options.html#index-weak_005freference_005fmismatches) diff --git a/gcc/config/epiphany/epiphany.opt.urls b/gcc/config/epiphany/epiphany.opt.urls index a8e28c46d210..0037dd7b6545 100644 --- a/gcc/config/epiphany/epiphany.opt.urls +++ b/gcc/config/epiphany/epiphany.opt.urls @@ -21,6 +21,12 @@ UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-msoft-cmpsf) msplit-lohi UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-msplit-lohi) +mpost-inc +UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-mpost-inc) + +mpost-modify +UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-mpost-modify) + mstack-offset= UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-mstack-offset) @@ -30,7 +36,8 @@ UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-mround-nearest) mlong-calls UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-mlong-calls) -; skipping UrlSuffix for 'mshort-calls' due to finding no URLs +mshort-calls +UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-mshort-calls) msmall16 UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-msmall16) @@ -38,6 +45,9 @@ UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-msmall16) mfp-mode= UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-mfp-mode) +mmay-round-for-trunc +UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-mmay-round-for-trunc) + mvect-double UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-mvect-double) @@ -47,6 +57,9 @@ UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-max-vect-align) msplit-vecmove-early UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-msplit-vecmove-early) +mfp-iarith +UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-mfp-iarith) + m1reg- UrlSuffix(gcc/Adapteva-Epiphany-Options.html#index-m1reg-) diff --git a/gcc/config/frv/frv.opt.urls b/gcc/config/frv/frv.opt.urls index d3d3757bb289..f8e56cdd5fbf 100644 --- a/gcc/config/frv/frv.opt.urls +++ b/gcc/config/frv/frv.opt.urls @@ -53,7 +53,7 @@ mgprel-ro UrlSuffix(gcc/FRV-Options.html#index-mgprel-ro) mhard-float -UrlSuffix(gcc/FRV-Options.html#index-mhard-float-1) +UrlSuffix(gcc/FRV-Options.html#index-mhard-float) minline-plt UrlSuffix(gcc/FRV-Options.html#index-minline-plt-1) @@ -65,7 +65,7 @@ mlinked-fp UrlSuffix(gcc/FRV-Options.html#index-mlinked-fp) mlong-calls -UrlSuffix(gcc/FRV-Options.html#index-mlong-calls-4) +UrlSuffix(gcc/FRV-Options.html#index-mlong-calls-5) mmedia UrlSuffix(gcc/FRV-Options.html#index-mmedia) @@ -92,7 +92,7 @@ mscc UrlSuffix(gcc/FRV-Options.html#index-mscc) msoft-float -UrlSuffix(gcc/FRV-Options.html#index-msoft-float-3) +UrlSuffix(gcc/FRV-Options.html#index-msoft-float-2) mTLS UrlSuffix(gcc/FRV-Options.html#index-mTLS) diff --git a/gcc/config/ft32/ft32.opt.urls b/gcc/config/ft32/ft32.opt.urls index 707cb83010f0..27857da1fef4 100644 --- a/gcc/config/ft32/ft32.opt.urls +++ b/gcc/config/ft32/ft32.opt.urls @@ -3,8 +3,7 @@ msim UrlSuffix(gcc/FT32-Options.html#index-msim-3) -mlra -UrlSuffix(gcc/FT32-Options.html#index-mlra-1) +; skipping UrlSuffix for 'mlra' due to finding no URLs mnodiv UrlSuffix(gcc/FT32-Options.html#index-mnodiv) diff --git a/gcc/config/gcn/gcn.opt.urls b/gcc/config/gcn/gcn.opt.urls index bfa6deab7b74..2f9ce48d1b12 100644 --- a/gcc/config/gcn/gcn.opt.urls +++ b/gcc/config/gcn/gcn.opt.urls @@ -12,8 +12,10 @@ UrlSuffix(gcc/AMD-GCN-Options.html#index-mtune-1) ; skipping UrlSuffix for 'mgomp' due to finding no URLs -mstack-size= -UrlSuffix(gcc/AMD-GCN-Options.html#index-mstack-size) +; skipping UrlSuffix for 'mstack-size=' due to finding no URLs + +mgang-private-size= +UrlSuffix(gcc/AMD-GCN-Options.html#index-mgang-private-size) Wopenacc-dims UrlSuffix(gcc/AMD-GCN-Options.html#index-Wno-openacc-dims) diff --git a/gcc/config/i386/i386.opt.urls b/gcc/config/i386/i386.opt.urls index a89329b48449..129d91f0c287 100644 --- a/gcc/config/i386/i386.opt.urls +++ b/gcc/config/i386/i386.opt.urls @@ -13,10 +13,10 @@ mlong-double-80 UrlSuffix(gcc/x86-Options.html#index-mlong-double-80) mlong-double-64 -UrlSuffix(gcc/x86-Options.html#index-mlong-double-64-1) +UrlSuffix(gcc/x86-Options.html#index-mlong-double-64-2) mlong-double-128 -UrlSuffix(gcc/x86-Options.html#index-mlong-double-128-1) +UrlSuffix(gcc/x86-Options.html#index-mlong-double-128-2) maccumulate-outgoing-args UrlSuffix(gcc/x86-Options.html#index-maccumulate-outgoing-args-1) @@ -57,7 +57,7 @@ UrlSuffix(gcc/x86-Options.html#index-mfp-ret-in-387) ; duplicate: 'gcc/x86-Options.html#index-mfpmath-1' mhard-float -UrlSuffix(gcc/x86-Options.html#index-mhard-float-11) +UrlSuffix(gcc/x86-Options.html#index-mhard-float-10) mieee-fp UrlSuffix(gcc/x86-Options.html#index-mieee-fp) @@ -120,7 +120,7 @@ mrtd UrlSuffix(gcc/x86-Options.html#index-mrtd-1) msoft-float -UrlSuffix(gcc/x86-Options.html#index-msoft-float-16) +UrlSuffix(gcc/x86-Options.html#index-msoft-float-15) msseregparm UrlSuffix(gcc/x86-Options.html#index-msseregparm) diff --git a/gcc/config/ia64/ia64.opt.urls b/gcc/config/ia64/ia64.opt.urls index 1e1d0631550a..cc228d751ea5 100644 --- a/gcc/config/ia64/ia64.opt.urls +++ b/gcc/config/ia64/ia64.opt.urls @@ -70,7 +70,7 @@ mfixed-range= UrlSuffix(gcc/IA-64-Options.html#index-mfixed-range-1) mtls-size= -UrlSuffix(gcc/IA-64-Options.html#index-mtls-size-1) +UrlSuffix(gcc/IA-64-Options.html#index-mtls-size-2) mtune= UrlSuffix(gcc/IA-64-Options.html#index-mtune-7) diff --git a/gcc/config/loongarch/loongarch.opt.urls b/gcc/config/loongarch/loongarch.opt.urls index c93f04683e1c..a72075d458fe 100644 --- a/gcc/config/loongarch/loongarch.opt.urls +++ b/gcc/config/loongarch/loongarch.opt.urls @@ -4,7 +4,7 @@ mfpu= UrlSuffix(gcc/LoongArch-Options.html#index-mfpu-2) msoft-float -UrlSuffix(gcc/LoongArch-Options.html#index-msoft-float-5) +UrlSuffix(gcc/LoongArch-Options.html#index-msoft-float-4) msingle-float UrlSuffix(gcc/LoongArch-Options.html#index-msingle-float) diff --git a/gcc/config/m68k/m68k.opt.urls b/gcc/config/m68k/m68k.opt.urls index 1f1ac88bcb2e..bb5e1a0c0298 100644 --- a/gcc/config/m68k/m68k.opt.urls +++ b/gcc/config/m68k/m68k.opt.urls @@ -70,7 +70,7 @@ mdiv UrlSuffix(gcc/M680x0-Options.html#index-mdiv-1) mhard-float -UrlSuffix(gcc/M680x0-Options.html#index-mhard-float-2) +UrlSuffix(gcc/M680x0-Options.html#index-mhard-float-1) ; skipping UrlSuffix for 'mid-shared-library' due to finding no URLs @@ -96,7 +96,7 @@ mshort UrlSuffix(gcc/M680x0-Options.html#index-mshort) msoft-float -UrlSuffix(gcc/M680x0-Options.html#index-msoft-float-6) +UrlSuffix(gcc/M680x0-Options.html#index-msoft-float-5) mstrict-align UrlSuffix(gcc/M680x0-Options.html#index-mstrict-align-2) diff --git a/gcc/config/microblaze/microblaze.opt.urls b/gcc/config/microblaze/microblaze.opt.urls index 33b13b84e2c2..be4230504ada 100644 --- a/gcc/config/microblaze/microblaze.opt.urls +++ b/gcc/config/microblaze/microblaze.opt.urls @@ -1,10 +1,10 @@ ; Autogenerated by regenerate-opt-urls.py from gcc/config/microblaze/microblaze.opt and generated HTML msoft-float -UrlSuffix(gcc/MicroBlaze-Options.html#index-msoft-float-7) +UrlSuffix(gcc/MicroBlaze-Options.html#index-msoft-float-6) mhard-float -UrlSuffix(gcc/MicroBlaze-Options.html#index-mhard-float-3) +UrlSuffix(gcc/MicroBlaze-Options.html#index-mhard-float-2) msmall-divides UrlSuffix(gcc/MicroBlaze-Options.html#index-msmall-divides) diff --git a/gcc/config/mips/mips.opt.urls b/gcc/config/mips/mips.opt.urls index 5921d6929b28..a85ea0313a16 100644 --- a/gcc/config/mips/mips.opt.urls +++ b/gcc/config/mips/mips.opt.urls @@ -1,10 +1,10 @@ ; Autogenerated by regenerate-opt-urls.py from gcc/config/mips/mips.opt and generated HTML EB -UrlSuffix(gcc/MIPS-Options.html#index-EB-2) +UrlSuffix(gcc/MIPS-Options.html#index-EB-1) EL -UrlSuffix(gcc/MIPS-Options.html#index-EL-2) +UrlSuffix(gcc/MIPS-Options.html#index-EL-1) mabi= UrlSuffix(gcc/MIPS-Options.html#index-mabi-3) @@ -133,7 +133,7 @@ mplt UrlSuffix(gcc/MIPS-Options.html#index-mplt) mhard-float -UrlSuffix(gcc/MIPS-Options.html#index-mhard-float-4) +UrlSuffix(gcc/MIPS-Options.html#index-mhard-float-3) minterlink-compressed UrlSuffix(gcc/MIPS-Options.html#index-minterlink-compressed) @@ -154,7 +154,7 @@ mlocal-sdata UrlSuffix(gcc/MIPS-Options.html#index-mlocal-sdata) mlong-calls -UrlSuffix(gcc/MIPS-Options.html#index-mlong-calls-6) +UrlSuffix(gcc/MIPS-Options.html#index-mlong-calls-7) mlong32 UrlSuffix(gcc/MIPS-Options.html#index-mlong32) @@ -208,7 +208,7 @@ msmartmips UrlSuffix(gcc/MIPS-Options.html#index-msmartmips) msoft-float -UrlSuffix(gcc/MIPS-Options.html#index-msoft-float-8) +UrlSuffix(gcc/MIPS-Options.html#index-msoft-float-7) msplit-addresses UrlSuffix(gcc/MIPS-Options.html#index-msplit-addresses) diff --git a/gcc/config/mmix/mmix.opt.urls b/gcc/config/mmix/mmix.opt.urls index 6722f9e4e01d..dda41cadf8d3 100644 --- a/gcc/config/mmix/mmix.opt.urls +++ b/gcc/config/mmix/mmix.opt.urls @@ -22,7 +22,7 @@ mtoplevel-symbols UrlSuffix(gcc/MMIX-Options.html#index-mtoplevel-symbols) melf -UrlSuffix(gcc/MMIX-Options.html#index-melf-1) +UrlSuffix(gcc/MMIX-Options.html#index-melf) mbranch-predict UrlSuffix(gcc/MMIX-Options.html#index-mbranch-predict) diff --git a/gcc/config/or1k/or1k.opt.urls b/gcc/config/or1k/or1k.opt.urls index b3ba2df4ab7f..0927d6af1dbb 100644 --- a/gcc/config/or1k/or1k.opt.urls +++ b/gcc/config/or1k/or1k.opt.urls @@ -13,10 +13,10 @@ msoft-mul UrlSuffix(gcc/OpenRISC-Options.html#index-msoft-mul) msoft-float -UrlSuffix(gcc/OpenRISC-Options.html#index-msoft-float-9) +UrlSuffix(gcc/OpenRISC-Options.html#index-msoft-float-8) mhard-float -UrlSuffix(gcc/OpenRISC-Options.html#index-mhard-float-5) +UrlSuffix(gcc/OpenRISC-Options.html#index-mhard-float-4) mdouble-float UrlSuffix(gcc/OpenRISC-Options.html#index-mdouble-float-3) diff --git a/gcc/config/pa/pa.opt.urls b/gcc/config/pa/pa.opt.urls index 5516332ead13..29489f9b3bf0 100644 --- a/gcc/config/pa/pa.opt.urls +++ b/gcc/config/pa/pa.opt.urls @@ -34,7 +34,7 @@ mlinker-opt UrlSuffix(gcc/HPPA-Options.html#index-mlinker-opt) mlong-calls -UrlSuffix(gcc/HPPA-Options.html#index-mlong-calls-5) +UrlSuffix(gcc/HPPA-Options.html#index-mlong-calls-6) ; skipping UrlSuffix for 'mlra' due to finding no URLs @@ -63,7 +63,7 @@ mschedule= UrlSuffix(gcc/HPPA-Options.html#index-mschedule) msoft-float -UrlSuffix(gcc/HPPA-Options.html#index-msoft-float-4) +UrlSuffix(gcc/HPPA-Options.html#index-msoft-float-3) msoft-mult UrlSuffix(gcc/HPPA-Options.html#index-msoft-mult) diff --git a/gcc/config/pdp11/pdp11.opt.urls b/gcc/config/pdp11/pdp11.opt.urls index f0544ca84f69..2e8c7b1972f7 100644 --- a/gcc/config/pdp11/pdp11.opt.urls +++ b/gcc/config/pdp11/pdp11.opt.urls @@ -28,7 +28,7 @@ mint32 UrlSuffix(gcc/PDP-11-Options.html#index-mint32-1) msoft-float -UrlSuffix(gcc/PDP-11-Options.html#index-msoft-float-10) +UrlSuffix(gcc/PDP-11-Options.html#index-msoft-float-9) msplit UrlSuffix(gcc/PDP-11-Options.html#index-msplit) @@ -37,5 +37,5 @@ munix-asm UrlSuffix(gcc/PDP-11-Options.html#index-munix-asm) mlra -UrlSuffix(gcc/PDP-11-Options.html#index-mlra-2) +UrlSuffix(gcc/PDP-11-Options.html#index-mlra-1) diff --git a/gcc/config/rs6000/rs6000.opt.urls b/gcc/config/rs6000/rs6000.opt.urls index 0b418c09a083..ff2a53413098 100644 --- a/gcc/config/rs6000/rs6000.opt.urls +++ b/gcc/config/rs6000/rs6000.opt.urls @@ -37,10 +37,10 @@ mmultiple UrlSuffix(gcc/RS_002f6000-and-PowerPC-Options.html#index-mmultiple) msoft-float -UrlSuffix(gcc/RS_002f6000-and-PowerPC-Options.html#index-msoft-float-11) +UrlSuffix(gcc/RS_002f6000-and-PowerPC-Options.html#index-msoft-float-10) mhard-float -UrlSuffix(gcc/RS_002f6000-and-PowerPC-Options.html#index-mhard-float-6) +UrlSuffix(gcc/RS_002f6000-and-PowerPC-Options.html#index-mhard-float-5) mpopcntd UrlSuffix(gcc/RS_002f6000-and-PowerPC-Options.html#index-mpopcntd) diff --git a/gcc/config/s390/s390.opt.urls b/gcc/config/s390/s390.opt.urls index be0904ce1ced..021f2d790158 100644 --- a/gcc/config/s390/s390.opt.urls +++ b/gcc/config/s390/s390.opt.urls @@ -22,16 +22,16 @@ mhard-dfp UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-mhard-dfp-1) mhard-float -UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-mhard-float-7) +UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-mhard-float-6) mhotpatch= UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-mhotpatch) mlong-double-128 -UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-mlong-double-128) +UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-mlong-double-128-1) mlong-double-64 -UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-mlong-double-64) +UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-mlong-double-64-1) mhtm UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-mhtm-1) @@ -46,7 +46,7 @@ msmall-exec UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-msmall-exec) msoft-float -UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-msoft-float-12) +UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-msoft-float-11) mstack-guard= UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-mstack-guard) @@ -58,7 +58,9 @@ mstack-protector-guard-record UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-mstack-protector-guard-record) mstack-size= -UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-mstack-size-2) +UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-mstack-size-1) + +; skipping UrlSuffix for 'mno-stack-size' due to finding no URLs mtune= UrlSuffix(gcc/S_002f390-and-zSeries-Options.html#index-mtune-14) diff --git a/gcc/config/sparc/sparc.opt.urls b/gcc/config/sparc/sparc.opt.urls index 1188f88fdaab..a221b6b1ea24 100644 --- a/gcc/config/sparc/sparc.opt.urls +++ b/gcc/config/sparc/sparc.opt.urls @@ -4,10 +4,10 @@ mfpu UrlSuffix(gcc/SPARC-Options.html#index-mfpu-4) mhard-float -UrlSuffix(gcc/SPARC-Options.html#index-mhard-float-8) +UrlSuffix(gcc/SPARC-Options.html#index-mhard-float-7) msoft-float -UrlSuffix(gcc/SPARC-Options.html#index-msoft-float-13) +UrlSuffix(gcc/SPARC-Options.html#index-msoft-float-12) mflat UrlSuffix(gcc/SPARC-Options.html#index-mflat) diff --git a/gcc/config/v850/v850.opt.urls b/gcc/config/v850/v850.opt.urls index a06f4833f47c..6f8102f9996c 100644 --- a/gcc/config/v850/v850.opt.urls +++ b/gcc/config/v850/v850.opt.urls @@ -18,7 +18,7 @@ mghs UrlSuffix(gcc/V850-Options.html#index-mghs) mlong-calls -UrlSuffix(gcc/V850-Options.html#index-mlong-calls-7) +UrlSuffix(gcc/V850-Options.html#index-mlong-calls-8) mprolog-function UrlSuffix(gcc/V850-Options.html#index-mprolog-function) @@ -71,10 +71,10 @@ mlong-jumps UrlSuffix(gcc/V850-Options.html#index-mlong-jumps) msoft-float -UrlSuffix(gcc/V850-Options.html#index-msoft-float-14) +UrlSuffix(gcc/V850-Options.html#index-msoft-float-13) mhard-float -UrlSuffix(gcc/V850-Options.html#index-mhard-float-9) +UrlSuffix(gcc/V850-Options.html#index-mhard-float-8) mrh850-abi UrlSuffix(gcc/V850-Options.html#index-mrh850-abi) diff --git a/gcc/config/vax/vax.opt.urls b/gcc/config/vax/vax.opt.urls index 7813b886baa2..758a5a733e6c 100644 --- a/gcc/config/vax/vax.opt.urls +++ b/gcc/config/vax/vax.opt.urls @@ -19,5 +19,5 @@ munix UrlSuffix(gcc/VAX-Options.html#index-munix) mlra -UrlSuffix(gcc/VAX-Options.html#index-mlra-3) +UrlSuffix(gcc/VAX-Options.html#index-mlra-2) diff --git a/gcc/config/visium/visium.opt.urls b/gcc/config/visium/visium.opt.urls index 38ba88dfe612..16984e7f176f 100644 --- a/gcc/config/visium/visium.opt.urls +++ b/gcc/config/visium/visium.opt.urls @@ -10,10 +10,10 @@ mfpu UrlSuffix(gcc/Visium-Options.html#index-mfpu-5) mhard-float -UrlSuffix(gcc/Visium-Options.html#index-mhard-float-10) +UrlSuffix(gcc/Visium-Options.html#index-mhard-float-9) msoft-float -UrlSuffix(gcc/Visium-Options.html#index-msoft-float-15) +UrlSuffix(gcc/Visium-Options.html#index-msoft-float-14) mcpu= UrlSuffix(gcc/Visium-Options.html#index-mcpu-13) From bd098c34bea0afa3a487018e6760feb165b8c142 Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Fri, 28 Nov 2025 14:50:38 +0100 Subject: [PATCH 135/373] Bump libgcobol SONAME This bumps the libgcobol SONAME for GCC 16 since compared to GCC 15 there are removed symbols and key data structures have changed. PR cobol/122803 libgcobol/ * configure.ac (LIBGCOBOL_VERSION): Bump to 2:0:0. * configure: Re-generate. --- libgcobol/configure | 2 +- libgcobol/configure.ac | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libgcobol/configure b/libgcobol/configure index 4a57b0303507..410fc35e218b 100755 --- a/libgcobol/configure +++ b/libgcobol/configure @@ -17412,7 +17412,7 @@ fi # libgcobol soname version -LIBGCOBOL_VERSION=1:0:0 +LIBGCOBOL_VERSION=2:0:0 ## added, currently unused. diff --git a/libgcobol/configure.ac b/libgcobol/configure.ac index 8062601da716..9b6ea7ebbf35 100644 --- a/libgcobol/configure.ac +++ b/libgcobol/configure.ac @@ -184,7 +184,7 @@ AC_SEARCH_LIBS([malloc], [c]) AC_SEARCH_LIBS([clock_gettime], [c rt]) # libgcobol soname version -LIBGCOBOL_VERSION=1:0:0 +LIBGCOBOL_VERSION=2:0:0 AC_SUBST(LIBGCOBOL_VERSION) ## added, currently unused. From 55049da531f5246499ddd2bd882928b57ac97519 Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Fri, 28 Nov 2025 14:33:06 +0100 Subject: [PATCH 136/373] Bump libgo SONAME The following bumps the libgo SONAME to prevent PR119098 from re-appearing for GCC 15/16. For PR go/122802 --- libgo/configure | 2 +- libgo/configure.ac | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/libgo/configure b/libgo/configure index b1a2228fa1b4..bba3c7aa7804 100755 --- a/libgo/configure +++ b/libgo/configure @@ -2611,7 +2611,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_config_headers="$ac_config_headers config.h" -libtool_VERSION=24:0:0 +libtool_VERSION=25:0:0 # Default to --enable-multilib diff --git a/libgo/configure.ac b/libgo/configure.ac index 0b05551aacb2..f8fe5f2ed98f 100644 --- a/libgo/configure.ac +++ b/libgo/configure.ac @@ -10,7 +10,7 @@ AC_INIT(package-unused, version-unused,, libgo) AC_CONFIG_SRCDIR(Makefile.am) AC_CONFIG_HEADER(config.h) -libtool_VERSION=24:0:0 +libtool_VERSION=25:0:0 AC_SUBST(libtool_VERSION) AM_ENABLE_MULTILIB(, ..) From 54480d16b6cfdea3f0c45c7c97d937d99e59a1cd Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Sat, 29 Nov 2025 17:37:58 +0100 Subject: [PATCH 137/373] c++: Limit P2795R5 handling of jumps across vacuous inits to !processing_template_decl [PR122758] The extra handling of jumps across vacuous inits for -std=c++26 or -ftrivial-auto-var-init={zero,pattern} added for P2795R5 is undesirable when processing_template_decl, because it creates labels without DECL_NAME and GOTO_EXPRs to those and those can't be tsubsted. I was afraid the pop_labels and check_goto_1 and check_previous_goto_1 handling might not happen again during instantiation, but clearly it does happen fully (and has to, because whether some declaration has vacuous initialization or not can't be decided in some cases when parsing the template, if dependent types are involved). So, this patch just restricts the P2795R5 PR114457 r16-4212 changes to !processing_template_decl and adds 2 copies of the erroneous2.C testcase, one changing the function into a function template where nothing is dependent and another one where most of the declarations are dependent. 2025-11-29 Jakub Jelinek PR c++/122758 * decl.cc (pop_labels): Don't call adjust_backward_gotos if processing_template_decl. (decl_instrument_init_bypass_p): Always return false if processing_template_decl. (check_goto_1): Don't push anything to direct_goto vector if processing_template_decl. * g++.dg/cpp26/erroneous5.C: New test. * g++.dg/cpp26/erroneous6.C: New test. --- gcc/cp/decl.cc | 12 +- gcc/testsuite/g++.dg/cpp26/erroneous5.C | 241 ++++++++++++++++++++++++ gcc/testsuite/g++.dg/cpp26/erroneous6.C | 241 ++++++++++++++++++++++++ 3 files changed, 491 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/g++.dg/cpp26/erroneous5.C create mode 100644 gcc/testsuite/g++.dg/cpp26/erroneous6.C diff --git a/gcc/cp/decl.cc b/gcc/cp/decl.cc index c5066dfc60be..4482633d3a0d 100644 --- a/gcc/cp/decl.cc +++ b/gcc/cp/decl.cc @@ -517,7 +517,8 @@ pop_labels (tree block) auto_vec labels (named_labels->elements ()); hash_table::iterator end (named_labels->end ()); - if (flag_auto_var_init > AUTO_INIT_UNINITIALIZED) + if (flag_auto_var_init > AUTO_INIT_UNINITIALIZED + && !processing_template_decl) { for (decltype (end) iter (named_labels->begin ()); iter != end; ++iter) { @@ -3875,6 +3876,7 @@ decl_instrument_init_bypass_p (tree decl) tree type = TREE_TYPE (decl); return (flag_auto_var_init > AUTO_INIT_UNINITIALIZED + && !processing_template_decl && type != error_mark_node && VAR_P (decl) && !TREE_STATIC (decl) @@ -4357,7 +4359,9 @@ check_goto_1 (named_label_entry *ent, tree *declp) && ent->uses->binding_level == current_binding_level && ent->uses->names_in_scope == current_binding_level->names) { - if (declp && flag_auto_var_init > AUTO_INIT_UNINITIALIZED) + if (declp + && flag_auto_var_init > AUTO_INIT_UNINITIALIZED + && !processing_template_decl) vec_safe_push (ent->uses->direct_goto, named_label_fwd_direct_goto { declp }); return; @@ -4371,7 +4375,9 @@ check_goto_1 (named_label_entry *ent, tree *declp) new_use->in_omp_scope = false; new_use->computed_goto = computed ? make_tree_vector () : nullptr; new_use->direct_goto = nullptr; - if (declp && flag_auto_var_init > AUTO_INIT_UNINITIALIZED) + if (declp + && flag_auto_var_init > AUTO_INIT_UNINITIALIZED + && !processing_template_decl) vec_safe_push (new_use->direct_goto, named_label_fwd_direct_goto { declp }); diff --git a/gcc/testsuite/g++.dg/cpp26/erroneous5.C b/gcc/testsuite/g++.dg/cpp26/erroneous5.C new file mode 100644 index 000000000000..0ee624bda86b --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp26/erroneous5.C @@ -0,0 +1,241 @@ +// C++ 26 P2795R5 - Erroneous behaviour for uninitialized reads +// { dg-do compile } +// { dg-skip-if "" { *-*-* } { "-ftrivial-auto-var-init=*" } { "" } } +// { dg-options "-O2 -fdump-tree-gimple" } +// All the s1..s24 variables and i1 need .DEFERRED_INIT call on their +// declarations. +// Plus, forward gotos to l1 & l2 labels need up to s1-s4 and s6-s9 vars to +// be .DEFERRED_INITed (and backward gotos up to that minus the first two). +// switch to case 15 skips over s12, switch to case 16/17 skip +// over s12 and s13 but the adjacent l3 label needs to also skip over s3-s4 +// and s6-s9 and s11. switch to case 18 skips over s12-s14 and switch to +// default in the same switch skips over s12-s15. +// goto l4; skips over s19 initialization. +// goto l5; skips over s20-s22 initialization. +// switch to case 32/33 skips over s23 but goto to adjacent l6 skips also +// over s20-s22. switch to default in that switch skips over s23-s24. +// { dg-final { scan-tree-dump-times " s1 = \.DEFERRED_INIT \\\(" 2 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s2 = \.DEFERRED_INIT \\\(" 2 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s3 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s4 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s5 = \.DEFERRED_INIT \\\(" 1 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s6 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s7 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s8 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s9 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s10 = \.DEFERRED_INIT \\\(" 1 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s11 = \.DEFERRED_INIT \\\(" 2 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s12 = \.DEFERRED_INIT \\\(" 5 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s13 = \.DEFERRED_INIT \\\(" 4 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s14 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s15 = \.DEFERRED_INIT \\\(" 2 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s16 = \.DEFERRED_INIT \\\(" 1 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s17 = \.DEFERRED_INIT \\\(" 1 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s18 = \.DEFERRED_INIT \\\(" 1 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s19 = \.DEFERRED_INIT \\\(" 2 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s20 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s21 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s22 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s23 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s24 = \.DEFERRED_INIT \\\(" 2 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " i1 = \.DEFERRED_INIT \\\(" 1 "gimple" { target c++26 } } } + +struct S { int a, b, c; }; + +template +int +foo (int x) +{ + int r = 0; + if (x == 1) + goto l1; + S s1; + if (x == 2) + goto l1; + S s2; + { + S s10; + if (x == 12) + goto l1; + s10.a = 1; + r += s10.a; + int i1; + if (x == 13) + goto l1; + i1 = 2; + r += i1; + } + if (x == 3) + goto l2; + if (x == 4) + goto l1; + { + S s3; + if (x == 5) + goto l2; + S s4; + if (x == 6) + goto l1; + { + S s5; + if (x == 7) + goto l1; + s5.a = 5; + r += s5.a; + } + S s6; + { + S s7; + S s8; + if (x == 8) + goto l1; + S s9; + if (x == 9) + goto l2; + if (x == 10) + goto l2; + if (x == 11) + goto l2; + l1: + l2: + s1.a = 1; + s2.b = 2; + s3.c = 3; + s4.a = 4; + s6.b = 6; + s7.c = 7; + s8.a = 8; + s9.b = 9; + r += s1.a + s2.b + s3.c; + r += s4.a + s6.b + s7.c; + r += s8.a + s9.b; + if (x == 14) + goto l3; + S s11; + switch (x) + { + S s12; + case 15: + S s13; + // FALLTHRU + l3: + case 16: + case 17: + S s14; + s11.a = 1; + s12.b = 2; + s13.c = 3; + s14.a = 4; + r += s11.a + s12.b + s13.c; + r += s14.a; + return r; + case 18: + S s15; + s11.a = 1; + s12.b = 2; + s13.c = 3; + s14.a = 4; + s15.b = 5; + r += s11.a + s12.b + s13.c; + r += s14.a + s15.b; + return r; + default: + if (x != 19 && x != 20) + break; + S s16; + s11.a = 1; + s12.b = 2; + s13.c = 3; + s14.a = 4; + s15.b = 5; + s16.c = 6; + r += s11.a + s12.b + s13.c; + r += s14.a + s15.b + s16.c; + return r; + } + if (x == 21) + goto l3; + } + S s17; + if (x == 22) + goto l3; + if (x == 23) + goto l1; + if (x == 24) + goto l2; + s17.a = 1; + r += s17.a; + } + S s18; + if (x == 25) + { + S s19; + s19.c = 2; + r += s19.c; + if (x == 29) + l4:; + goto l3; + } + if (x == 26) + goto l1; + if (x == 27) + goto l2; + s18.b = 1; + r += s18.b; + if (x == 28) + goto l4; + { + S s20; + { + S s21; + if (x == 29) + goto l1; + S s22; + if (x == 30) + goto l2; + l5: + s20.a = 1; + s21.b = 2; + s22.c = 3; + r += s20.a + s21.b + s22.c; + switch (x) + { + case 31: + S s23; + // FALLTHRU + l6: + case 32: + case 33: + S s24; + s23.a = 1; + s24.b = 2; + r += s23.a + s24.b; + return r; + default: + if (x >= 34 && x <= 35) + return r; + break; + } + if (x == 34) + goto l5; + if (x == 35) + goto l6; + return r; + } + if (x == 36) + goto l5; + if (x == 37) + goto l6; + } + if (x == 38) + goto l5; + if (x == 39) + goto l6; + return r; +} + +int +bar (int x) +{ + return foo <42> (x); +} diff --git a/gcc/testsuite/g++.dg/cpp26/erroneous6.C b/gcc/testsuite/g++.dg/cpp26/erroneous6.C new file mode 100644 index 000000000000..e3ddf35b037a --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp26/erroneous6.C @@ -0,0 +1,241 @@ +// C++ 26 P2795R5 - Erroneous behaviour for uninitialized reads +// { dg-do compile } +// { dg-skip-if "" { *-*-* } { "-ftrivial-auto-var-init=*" } { "" } } +// { dg-options "-O2 -fdump-tree-gimple" } +// All the s1..s24 variables and i1 need .DEFERRED_INIT call on their +// declarations. +// Plus, forward gotos to l1 & l2 labels need up to s1-s4 and s6-s9 vars to +// be .DEFERRED_INITed (and backward gotos up to that minus the first two). +// switch to case 15 skips over s12, switch to case 16/17 skip +// over s12 and s13 but the adjacent l3 label needs to also skip over s3-s4 +// and s6-s9 and s11. switch to case 18 skips over s12-s14 and switch to +// default in the same switch skips over s12-s15. +// goto l4; skips over s19 initialization. +// goto l5; skips over s20-s22 initialization. +// switch to case 32/33 skips over s23 but goto to adjacent l6 skips also +// over s20-s22. switch to default in that switch skips over s23-s24. +// { dg-final { scan-tree-dump-times " s1 = \.DEFERRED_INIT \\\(" 2 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s2 = \.DEFERRED_INIT \\\(" 2 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s3 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s4 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s5 = \.DEFERRED_INIT \\\(" 1 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s6 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s7 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s8 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s9 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s10 = \.DEFERRED_INIT \\\(" 1 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s11 = \.DEFERRED_INIT \\\(" 2 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s12 = \.DEFERRED_INIT \\\(" 5 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s13 = \.DEFERRED_INIT \\\(" 4 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s14 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s15 = \.DEFERRED_INIT \\\(" 2 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s16 = \.DEFERRED_INIT \\\(" 1 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s17 = \.DEFERRED_INIT \\\(" 1 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s18 = \.DEFERRED_INIT \\\(" 1 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s19 = \.DEFERRED_INIT \\\(" 2 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s20 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s21 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s22 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s23 = \.DEFERRED_INIT \\\(" 3 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " s24 = \.DEFERRED_INIT \\\(" 2 "gimple" { target c++26 } } } +// { dg-final { scan-tree-dump-times " i1 = \.DEFERRED_INIT \\\(" 1 "gimple" { target c++26 } } } + +struct S { int a, b, c; }; + +template +int +foo (int x) +{ + int r = 0; + if (x == 1) + goto l1; + S s1; + if (x == 2) + goto l1; + S s2; + { + S s10; + if (x == 12) + goto l1; + s10.a = 1; + r += s10.a; + int i1; + if (x == 13) + goto l1; + i1 = 2; + r += i1; + } + if (x == 3) + goto l2; + if (x == 4) + goto l1; + { + S s3; + if (x == 5) + goto l2; + S s4; + if (x == 6) + goto l1; + { + S s5; + if (x == 7) + goto l1; + s5.a = 5; + r += s5.a; + } + S s6; + { + S s7; + S s8; + if (x == 8) + goto l1; + S s9; + if (x == 9) + goto l2; + if (x == 10) + goto l2; + if (x == 11) + goto l2; + l1: + l2: + s1.a = 1; + s2.b = 2; + s3.c = 3; + s4.a = 4; + s6.b = 6; + s7.c = 7; + s8.a = 8; + s9.b = 9; + r += s1.a + s2.b + s3.c; + r += s4.a + s6.b + s7.c; + r += s8.a + s9.b; + if (x == 14) + goto l3; + S s11; + switch (x) + { + S s12; + case 15: + S s13; + // FALLTHRU + l3: + case 16: + case 17: + S s14; + s11.a = 1; + s12.b = 2; + s13.c = 3; + s14.a = 4; + r += s11.a + s12.b + s13.c; + r += s14.a; + return r; + case 18: + S s15; + s11.a = 1; + s12.b = 2; + s13.c = 3; + s14.a = 4; + s15.b = 5; + r += s11.a + s12.b + s13.c; + r += s14.a + s15.b; + return r; + default: + if (x != 19 && x != 20) + break; + S s16; + s11.a = 1; + s12.b = 2; + s13.c = 3; + s14.a = 4; + s15.b = 5; + s16.c = 6; + r += s11.a + s12.b + s13.c; + r += s14.a + s15.b + s16.c; + return r; + } + if (x == 21) + goto l3; + } + S s17; + if (x == 22) + goto l3; + if (x == 23) + goto l1; + if (x == 24) + goto l2; + s17.a = 1; + r += s17.a; + } + S s18; + if (x == 25) + { + S s19; + s19.c = 2; + r += s19.c; + if (x == 29) + l4:; + goto l3; + } + if (x == 26) + goto l1; + if (x == 27) + goto l2; + s18.b = 1; + r += s18.b; + if (x == 28) + goto l4; + { + S s20; + { + S s21; + if (x == 29) + goto l1; + S s22; + if (x == 30) + goto l2; + l5: + s20.a = 1; + s21.b = 2; + s22.c = 3; + r += s20.a + s21.b + s22.c; + switch (x) + { + case 31: + S s23; + // FALLTHRU + l6: + case 32: + case 33: + S s24; + s23.a = 1; + s24.b = 2; + r += s23.a + s24.b; + return r; + default: + if (x >= 34 && x <= 35) + return r; + break; + } + if (x == 34) + goto l5; + if (x == 35) + goto l6; + return r; + } + if (x == 36) + goto l5; + if (x == 37) + goto l6; + } + if (x == 38) + goto l5; + if (x == 39) + goto l6; + return r; +} + +int +bar (int x) +{ + return foo (x); +} From ef4cd115ef67736b2af06fb7b47410961b73e7d6 Mon Sep 17 00:00:00 2001 From: Eczbek Date: Tue, 25 Nov 2025 00:26:50 -0500 Subject: [PATCH 138/373] c++: Allow lambda expressions in template type parameters [PR116952] PR c++/116952 gcc/cp/ChangeLog: * parser.cc (cp_parser_lambda_expression): Revert r11-8166-ge1666ebd9ad31d change prohibiting lambda in non-type parameter. gcc/testsuite/ChangeLog: * g++.dg/cpp2a/lambda-uneval14.C: Revise incorrect test. * g++.dg/cpp2a/lambda-uneval29.C: New test. Co-authored-by: Jason Merrill --- gcc/cp/parser.cc | 16 +--------------- gcc/testsuite/g++.dg/cpp2a/lambda-uneval14.C | 4 ++-- gcc/testsuite/g++.dg/cpp2a/lambda-uneval29.C | 5 +++++ 3 files changed, 8 insertions(+), 17 deletions(-) create mode 100644 gcc/testsuite/g++.dg/cpp2a/lambda-uneval29.C diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc index e0c8e0ec8ad2..de11798b8bdc 100644 --- a/gcc/cp/parser.cc +++ b/gcc/cp/parser.cc @@ -11964,21 +11964,7 @@ cp_parser_lambda_expression (cp_parser* parser, LAMBDA_EXPR_CONSTEVAL_BLOCK_P (lambda_expr) = consteval_block_p; if (cxx_dialect >= cxx20) - { - /* C++20 allows lambdas in unevaluated context, but one in the type of a - non-type parameter is nonsensical. - - Distinguish a lambda in the parameter type from a lambda in the - default argument by looking at local_variables_forbidden_p, which is - only set in default arguments. */ - if (processing_template_parmlist && !parser->local_variables_forbidden_p) - { - error_at (token->location, - "lambda-expression in template parameter type"); - token->error_reported = true; - ok = false; - } - } + /* C++20 allows lambdas in unevaluated context. */; else if (cp_unevaluated_operand) { if (!token->error_reported) diff --git a/gcc/testsuite/g++.dg/cpp2a/lambda-uneval14.C b/gcc/testsuite/g++.dg/cpp2a/lambda-uneval14.C index a18035954e16..d0e74e3c8057 100644 --- a/gcc/testsuite/g++.dg/cpp2a/lambda-uneval14.C +++ b/gcc/testsuite/g++.dg/cpp2a/lambda-uneval14.C @@ -1,6 +1,6 @@ // PR c++/99478 // { dg-do compile { target c++20 } } -template auto f() {} // { dg-error "lambda" } +template auto f() {} -int main() { f<{}>(); } // { dg-prune-output "no match" } +int main() { f<{}>(); } diff --git a/gcc/testsuite/g++.dg/cpp2a/lambda-uneval29.C b/gcc/testsuite/g++.dg/cpp2a/lambda-uneval29.C new file mode 100644 index 000000000000..76e743fedcef --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp2a/lambda-uneval29.C @@ -0,0 +1,5 @@ +// PR c++/116952 +// { dg-do compile { target c++20 } } + +template concept A = true; +template> int x; From 858f300727833740f74d90378a0f302d4254ef37 Mon Sep 17 00:00:00 2001 From: Nathaniel Shead Date: Sat, 15 Nov 2025 15:27:13 +1100 Subject: [PATCH 139/373] c++: Support template block-scope OpenMP user-defined reductions in modules [PR119864] There were two issues preventing OpenMP reductions of UDTs from working in modules. Firstly, we were failing a number of checking asserts in the streaming logic because the declaration is a DECL_LOCAL_DECL_P but was not correctly added to the BLOCK of the function template. This is because cp_parser_omp_declare_reduction only called pushdecl when !processing_template_decl; correcting this fixed this issue. The second issue is that modules saw this as a function definition and so attempted to call allocate_struct_function on it, which crashes. Given that these reduction functions don't really behave like real function definitions in any other way, I think the cleanest solution is to just skip all the function definition post-processing in modules; this seems to work to get the test functioning correctly, from what I can see. PR c++/119864 gcc/cp/ChangeLog: * module.cc (trees_in::read_function_def): Don't call post_process on OpenMP UDT reductions. * parser.cc (cp_parser_omp_declare_reduction): Call push_decl for block_scope, even when processing_template_decl. gcc/testsuite/ChangeLog: * g++.dg/modules/omp-4_a.C: New test. * g++.dg/modules/omp-4_b.C: New test. Signed-off-by: Nathaniel Shead Reviewed-by: Jakub Jelinek Reviewed-by: Jason Merrill --- gcc/cp/module.cc | 8 ++++++- gcc/cp/parser.cc | 5 +---- gcc/testsuite/g++.dg/modules/omp-4_a.C | 30 ++++++++++++++++++++++++++ gcc/testsuite/g++.dg/modules/omp-4_b.C | 11 ++++++++++ 4 files changed, 49 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/g++.dg/modules/omp-4_a.C create mode 100644 gcc/testsuite/g++.dg/modules/omp-4_b.C diff --git a/gcc/cp/module.cc b/gcc/cp/module.cc index 92449286a842..ea22cef24a5b 100644 --- a/gcc/cp/module.cc +++ b/gcc/cp/module.cc @@ -13015,7 +13015,13 @@ trees_in::read_function_def (tree decl, tree maybe_template) SET_DECL_FRIEND_CONTEXT (decl, context); if (cexpr.decl) register_constexpr_fundef (cexpr); - post_process (pdata); + + if (DECL_LOCAL_DECL_P (decl)) + /* Block-scope OMP UDRs aren't real functions, and don't need a + function structure to be allocated or to be expanded. */ + gcc_checking_assert (DECL_OMP_DECLARE_REDUCTION_P (decl)); + else + post_process (pdata); } else if (maybe_dup) { diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc index de11798b8bdc..786212713dbc 100644 --- a/gcc/cp/parser.cc +++ b/gcc/cp/parser.cc @@ -53737,10 +53737,7 @@ cp_parser_omp_declare_reduction (cp_parser *parser, cp_token *pragma_tok, fndecl = push_template_decl (fndecl); if (block_scope) - { - if (!processing_template_decl) - pushdecl (fndecl); - } + pushdecl (fndecl); else if (current_class_type) { if (cp == NULL) diff --git a/gcc/testsuite/g++.dg/modules/omp-4_a.C b/gcc/testsuite/g++.dg/modules/omp-4_a.C new file mode 100644 index 000000000000..948966e657f3 --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/omp-4_a.C @@ -0,0 +1,30 @@ +// PR c++/119864 +// { dg-additional-options "-fmodules -fopenmp" } +// { dg-module-cmi p1 } + +export module p1; + +export +template +struct T +{ + double d; + + T &operator +=(T const &x) { d += x.d; return *this; } +}; + +export +template +T sum(T const *p, unsigned N) +{ +T Sum = {}; + +#pragma omp declare reduction(Op: T: omp_out += omp_in) initializer(omp_priv = {}) +#pragma omp parallel for reduction(Op: Sum) +for (unsigned i = 0u; i < N; ++i) + { + Sum += *p; + ++p; + } +return Sum; +} diff --git a/gcc/testsuite/g++.dg/modules/omp-4_b.C b/gcc/testsuite/g++.dg/modules/omp-4_b.C new file mode 100644 index 000000000000..c1ca279a97e0 --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/omp-4_b.C @@ -0,0 +1,11 @@ +// PR c++/119864 +// { dg-additional-options "-fmodules -fopenmp" } + +import p1; + +int main() +{ + T<1u> v[3u] = {}; + + T s = sum(v, 3u); +} From 5d70604b748beb4f14e6fbcb2ae8fba225236db0 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Sun, 30 Nov 2025 00:16:27 +0000 Subject: [PATCH 140/373] Daily bump. --- gcc/ChangeLog | 231 ++++++++++++++++++++++++++++++++++++++++ gcc/DATESTAMP | 2 +- gcc/cp/ChangeLog | 26 +++++ gcc/testsuite/ChangeLog | 19 ++++ libgcobol/ChangeLog | 6 ++ 5 files changed, 283 insertions(+), 1 deletion(-) diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 584ac66ea036..9e78a81bef6f 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,234 @@ +2025-11-29 Sandra Loosemore + + * common.opt.urls: Regenerated. + * config/aarch64/aarch64.opt.urls: Regenerated. + * config/alpha/alpha.opt.urls: Regenerated. + * config/arm/arm.opt.urls: Regenerated. + * config/avr/avr.opt.urls: Regenerated. + * config/bpf/bpf.opt.urls: Regenerated. + * config/c6x/c6x.opt.urls: Regenerated. + * config/cris/cris.opt.urls: Regenerated. + * config/cris/elf.opt.urls: Regenerated. + * config/csky/csky.opt.urls: Regenerated. + * config/darwin.opt.urls: Regenerated. + * config/epiphany/epiphany.opt.urls: Regenerated. + * config/frv/frv.opt.urls: Regenerated. + * config/ft32/ft32.opt.urls: Regenerated. + * config/gcn/gcn.opt.urls: Regenerated. + * config/i386/i386.opt.urls: Regenerated. + * config/ia64/ia64.opt.urls: Regenerated. + * config/loongarch/loongarch.opt.urls: Regenerated. + * config/m68k/m68k.opt.urls: Regenerated. + * config/microblaze/microblaze.opt.urls: Regenerated. + * config/mips/mips.opt.urls: Regenerated. + * config/mmix/mmix.opt.urls: Regenerated. + * config/or1k/or1k.opt.urls: Regenerated. + * config/pa/pa.opt.urls: Regenerated. + * config/pdp11/pdp11.opt.urls: Regenerated. + * config/rs6000/rs6000.opt.urls: Regenerated. + * config/s390/s390.opt.urls: Regenerated. + * config/sparc/sparc.opt.urls: Regenerated. + * config/v850/v850.opt.urls: Regenerated. + * config/vax/vax.opt.urls: Regenerated. + * config/visium/visium.opt.urls: Regenerated. + +2025-11-29 Sandra Loosemore + + * doc/invoke.texi (Options Summary): Switch ordering of FRV + and FT32. + (Submodel Options): Likewise in the menu and section ordering. + +2025-11-29 Sandra Loosemore + + PR other/122243 + * doc/invoke.texi: Document -mno-android. + +2025-11-29 Sandra Loosemore + + PR other/122243 + * config/frv/frv.opt (mbranch-cost=): Mark as Undocumented. + (mcond-exec-insns=): Likewise. + (mcond-exec-tempss=): Likewise. + * doc/invoke.texi (Option Summary) : Remove duplicate + positive/negative forms from the list. + (FRV Options): Combine documentation of positive/negative forms + where they were listed separately. Add @opindex entries for + negative forms. + +2025-11-29 Sandra Loosemore + + PR other/122243 + * config/ft32/ft32.opt (mlra): Mark obsolete option as Undocumented. + * doc/invoke.texi (Option Summary) : Remove -mlra. + (FT32 Options): Likewise. Add @opindex entries for negative + option forms. + +2025-11-29 Sandra Loosemore + + PR other/122243 + * doc/invoke.texi (FR30 Options): Add @opindex for -mno-small-model. + +2025-11-29 Sandra Loosemore + + PR other/122243 + * doc/invoke.texi (Option Summary) : Fix formatting + issues. Remove redundant entry for -mno-co-re. + (eBPF Options): Add missing @opindex entries. Combine documentation + for -mco-re and -mno-co-re. + +2025-11-29 Sandra Loosemore + + PR other/122243 + * config/alpha/alpha.opt (mgas): Mark as Undocumented. + * doc/invoke.texi (Option Summary) : Add + -mtls-kernel, -mtls-size=, -mlong-double-128, and -mlong-double-64. + (DEC Alpha Options): Likewise. + +2025-11-29 Sandra Loosemore + + PR other/122243 + * config/darwin.opt (findirect-virtual-calls): Mark as Undocumented. + (fterminated-vtables): Likewise. + (multi_module): Likewise. + (multiply_defined): Likewise. + (multiply_defined_unused): Likewise. + (no_dead_strip_inits_and_terms): Likewise. + (noprefixbinding): Likewise. + (nomultidefs): Likewise. + (noprebind): Likewise. + (noseglinkedit): Likewise. + (ObjC, ObjC++): Add documentation strings. + (object): Mark as Undocumented. + (prebind): Likewise. + (prebind_all_twolevel_modules): Likewise. + (private_bundle): Likewise. + (sectobjectsymbols): Likewise. + (sectorder): Likewise. + (seg_addr_table_filename): Likewise. + (segcreate): Likewise. + (seglinkedit): Likewise. + (single_module): Likewise. + (X): Likewise. + (y): Likewise. + (Mach): Likewise. + * doc/invoke.texi (Option Summary) : Improve + alphabetization of the list. Remove obsolete/undocumented + options and add missing entries. + (Darwin Options): Add documentation for -arch, -dependency-file, + -fapple-kext, -matt-stubs, -fconstant-cfstrings, -mdynamic-no-pic, + -asm_macosx_version_min, -msymbol-stubs, -mtarget-linker, + -ObjC, -ObjC++, -Wnonportable-cfstrings. Update the list + of options passed to the linker to remove obsolete options + and add missing ones; also move the block of @opindex entries + before the list items instead of putting it in the middle. + +2025-11-29 Sandra Loosemore + + PR other/122243 + * doc/invoke.texi (Option Summary) : + Correct spelling of -mthreads and add missing options. + (Cygwin and MinGW Options): Add @opindex for negative forms. + +2025-11-29 Sandra Loosemore + + PR other/122243 + * doc/invoke.texi (Option Summary) : Remove + entries for "Undocumented" options -EB, -EL, -mhard-float, + -msoft-float, and nonexistent option -mcse-cc. + (C-SKY Options): Likewise. Also remove references to "Undocumented" + option -mstm and uniformly index/document the -mno- forms for + consistency with other options in this section that already do so. + +2025-11-29 Sandra Loosemore + + PR other/122243 + * config/cris/cris.opt (m32-bit, m16-bit, m8-bit): Remove + Undocumented property. + (m32bit, m8bit): Add Undocumented property. + * doc/invoke.texi (Option Summary) : Remove + obsolete -melf and -maout options from table, plus redundant + -mno-mul-bug-workaround. + (CRIS Options): Add @opindex for -mno- forms that didn't already + have one. Remove obsolete -melf documentation. Document + -mbest-lib-options, -moverride-best-lib-options, + -mtrap-using-break8, -mtrap-unaligned-atomic, and + -munaligned-atomic-may-use-library. + +2025-11-29 Sandra Loosemore + + PR other/122243 + * doc/invoke.texi (Option Summary) : Add -mdbst + and -mlong-calls. + (C6X Options): Likewise. + +2025-11-29 Sandra Loosemore + + PR other/122243 + * doc/invoke.texi (Option Summary) : + Remove redundant -mno- entries. + (Blackfin Options): Combine explicit -mno-* documentation + with that for the corresponding positive form of the option. + Add @opindex entries for the negative forms of options that + didn't already have one. + +2025-11-29 Sandra Loosemore + + PR other/122243 + * config/arm/arm.opt (mapcs-reentrant): Mark as "Undocumented", + updatehelp string for internal documentation. + (mapcs-stack-check): Likewise update help string. + (mprint-tune-info, mneon-for-64bits): Mark as "Undocumented". + * doc/invoke.texi (Option Summary) : Remove duplicate + entries for negative forms and entries for options that are + explicitly "Undocumented". Add missing entry for + -mpic-data-is-text-relative. Fix some formatting issues. + (ARM Options): Remove documentation for -mapcs-stack-check, + -mapcs-reentrant, -mflip-thumb, -mneon-for-64-bits, + -mprint-tune-info, and -mverbose-cost-dump. Add index entries + for -mno- option forms. Minor editing for clarity. + +2025-11-29 Sandra Loosemore + + PR other/122243 + PR target/122288 + * config/gcn/gcn.opt (m32, m64, mgomp): Mark "Undocumented" + since these options don't actually do anything useful. + (flag_bypass_init_error, stack_size_opt, gang_size_opt): Correct + opt file syntax. + (mstack-size=): Mark "Undocumented" since it's obsolete. + * doc/invoke.texi (Option Summary) : + Remove obsolete options, add missing entries for + -mgang-private-size=, -msram-ecc=, and -mxnack=. + (AMD GCN Options): Likewise. + +2025-11-29 Sandra Loosemore + + PR other/122243 + * config/epiphany/epiphany.opt (mlong-calls): Make it do something + useful. + (may-round-for-trunc): Make this undocumented option with a weird + name an alias for -mmay-round-for-trunc. + (mfp-iarith): Fix doc string. + * doc/invoke.texi (Option Summary) : + Add missing options. + (Adapteva Epiphany Options): Document negative forms also when + that is not the default, or where it's unclear. Document + -may-round-for-trunc and -mfp-iarith. Fix spelling of + -mpost-inc and -mpost-modify. + +2025-11-29 Sandra Loosemore + + PR other/122243 + * config/aarch64/aarch64.opt (Wexperimental-fmv-target): Mark + as "Undocumented". + * doc/invoke.texi (Option Summary) : Don't + list "Undocumented" aarch64 options -mverbose-cost-dump or + -Wexperimental-fmv-target, or both positive and negative forms + of other options. Add missing options. Fix whitespace problems. + (AArch64 Options): Light copy-editing. Add missing @opindex + entries to match the documented options. Undocument + -mverbose-cost-dump and -Wexperimental-fmv-target. + 2025-11-28 Jakub Jelinek * config/rs6000/rs6000.cc (complex_multiply_builtin_code): diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 159d5b496831..a06564385a85 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20251129 +20251130 diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 2294eaaef216..6790953f4158 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,29 @@ +2025-11-30 Nathaniel Shead + + PR c++/119864 + * module.cc (trees_in::read_function_def): Don't call + post_process on OpenMP UDT reductions. + * parser.cc (cp_parser_omp_declare_reduction): Call push_decl + for block_scope, even when processing_template_decl. + +2025-11-29 Eczbek + Jason Merrill + + PR c++/116952 + * parser.cc (cp_parser_lambda_expression): Revert + r11-8166-ge1666ebd9ad31d change prohibiting lambda in non-type + parameter. + +2025-11-29 Jakub Jelinek + + PR c++/122758 + * decl.cc (pop_labels): Don't call adjust_backward_gotos if + processing_template_decl. + (decl_instrument_init_bypass_p): Always return false if + processing_template_decl. + (check_goto_1): Don't push anything to direct_goto vector + if processing_template_decl. + 2025-11-28 Jakub Jelinek PR c++/119969 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 474547233d1c..391cde1b6954 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,22 @@ +2025-11-30 Nathaniel Shead + + PR c++/119864 + * g++.dg/modules/omp-4_a.C: New test. + * g++.dg/modules/omp-4_b.C: New test. + +2025-11-29 Eczbek + Jason Merrill + + PR c++/116952 + * g++.dg/cpp2a/lambda-uneval14.C: Revise incorrect test. + * g++.dg/cpp2a/lambda-uneval29.C: New test. + +2025-11-29 Jakub Jelinek + + PR c++/122758 + * g++.dg/cpp26/erroneous5.C: New test. + * g++.dg/cpp26/erroneous6.C: New test. + 2025-11-28 Richard Biener PR tree-optimization/122844 diff --git a/libgcobol/ChangeLog b/libgcobol/ChangeLog index a3752b3f4e65..5b005a0fc03b 100644 --- a/libgcobol/ChangeLog +++ b/libgcobol/ChangeLog @@ -1,3 +1,9 @@ +2025-11-29 Richard Biener + + PR cobol/122803 + * configure.ac (LIBGCOBOL_VERSION): Bump to 2:0:0. + * configure: Re-generate. + 2025-11-18 James K. Lowden PR cobol/122702 From 9ed1b0e964c8fd030b75a71ad5b589988e51cc1d Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:43:37 +0200 Subject: [PATCH 141/373] a68: gcc/algol68 misc files README contains a description of the front-end, and brief instructions for developers. At the moment the front-end doesn't define any custom tree node, as of yet. gcc/algol68/a68-tree.def is a placeholder where to have these node codes. a68-types.h and a68.h are the main header files used by the front-end. Together they provide data definitions and prototypes of functions defined in the .cc files. ga68.vw contains a revised-report like formal description of the language implemented by this compiler. This includes GNU extensions. Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/README: New file. * algol68/a68-tree.def: Likewise. * algol68/a68-types.h: Likewise. * algol68/a68.h: Likewise. * algol68/ga68.vw: Likewise. --- gcc/algol68/README | 130 +++ gcc/algol68/a68-tree.def | 24 + gcc/algol68/a68-types.h | 1166 ++++++++++++++++++++++++ gcc/algol68/a68.h | 1117 +++++++++++++++++++++++ gcc/algol68/ga68.vw | 1845 ++++++++++++++++++++++++++++++++++++++ 5 files changed, 4282 insertions(+) create mode 100644 gcc/algol68/README create mode 100644 gcc/algol68/a68-tree.def create mode 100644 gcc/algol68/a68-types.h create mode 100644 gcc/algol68/a68.h create mode 100644 gcc/algol68/ga68.vw diff --git a/gcc/algol68/README b/gcc/algol68/README new file mode 100644 index 000000000000..9d1595ad8d8c --- /dev/null +++ b/gcc/algol68/README @@ -0,0 +1,130 @@ +This is the GNU Algol 68 compiler. + +This compiler implements the Algol 68 programming language +(https://www.algol68-lang.org) as defined in the Revised Report, along +with several GNU extensions to the language which are oriented to +enhance its application in systems programming and to achieve a good +integration in POSIX systems. + +The parser component used in this front-end has been adapted from +Algol 68 Genie, an Algol 68 interpreter written by Marcel van der +Veer. It is worth noting that this parser is not your typical garden +variety parser, as it is capable of effectively parsing the two-level +grammar of Algol 68, which is no small task. Parsing Algol 68 is +notoriously difficult, and without Marcel's careful work of many years +this front-end would most probably not exist. It is also a beautiful +implementation that is a delight to both read and work with. + +The syntax tree built by the parser is lowered into a GENERIC tree by +a lowering pass, which then invokes the gimplifier and hands the +resulting gimple IR over to the rest of the compilation, down the +rabbit hole all the way to optimized assembly code. + +The compiler driver is called `ga68'. +The compiler proper is called `a681'. + +Programs built by this compiler make use of the libga68 run-time +library. + +Building +======== + +Configure and build GCC with: + + $ mkdir build-algol68 + $ cd build-algol68 + $ ../configure --enable-languages=algol68 + $ make + $ make install + +Alternatively you can configure and build a non-bootstrapped compiler, +which is much faster to build. But note that in this case you better +pass some flags so the compiler gets built optimized, or the resulting +compiler will be rather slow: + + $ mkdir build-algol68 + $ cd build-algol68 + $ ../configure --enable-languages=algol68 BOOT_CFLAGS="-O2 -g" \ + BOOT_CXXFLAGS="-O2 -g" \ + STAGE1_CFLAGS="-O2 -g" \ + STAGE1_CXXFLAGS="-O2 -g" + $ make + $ make install + +Debugging +========= + +A few front-end specific options useful for debugging are: + + '-fa68-dump-ast' + Emits a textual representation of the parse tree as produced by the parser. + + '-fa68-dump-modes' + Emits a list of all parsed modes. + +See the Developer Options section in the GNU Algol Compiler manual for +more hacking related options. + +Testing +======= + +Invoke the full testsuite from the build directory: + + $ make check-algol68 + +You can pass -jN to run tests in parallel: + + $ make -jN check-algol68 + +Invoke a subset of the testsuite. For example, to only run tests that +involve compilation but not running: + + $ make check-algol68 RUNTESTFLAGS="compile.exp" + +There are the following sets of tests: + + compile.exp - compilation tests + +Invoke only a specific test: + + $ make check-algol68 RUNTESTFLAGS="--all compile.exp=bad-coercion-1.a68" + +Test in both 32-bit and 64-bit in multilib arches: + + $ make check-algol68 RUNTESTFLAGS="--target_board=unix\{-m64,-m32\}" + +Test that integration with the GCC GC is correct: + + $ make check-algol68 RUNTESTFLAGS="CFLAGS_FOR_TARGET='--param=ggc-min-expand=0 --param=ggc-min-heapsize=0'" + +Logs (with corresponding commands) can be found in +BUILD/gcc/testsuite/algol68/algol68.log. + +See https://gcc.gnu.org/install/test.html for more details. + +Useful Resources +================ + +- An Emacs mode for editing Algol 68 programs can be found at + https://git.sr.ht/~jemarch/a68-mode. It supports automatic + indentation, pretty-printing of bold tags, an auto-stropping minor + mode and other features. + +- The Algol 68 Jargon File at https://jemarch.net/a68-jargon provides + a comprehensive list of definitions of many of the technical and + non-technical terms used in the context of Algol 68. + +- The very formal Revised Report on the Algorithmic Language ALGOL 68 + can be found at [1]. + +- The truly delightful Informal Introduction to ALGOL 68 by C.H + Lindsey and van der Meulen can be found at [2]. + +Community +========= + +mailing list: algol68@gcc.gnu.org +irc: irc.oftc.net - #gnualgol + +[1] https://www.softwarepreservation.org/projects/ALGOL/report/Algol68_revised_report-AB-600dpi.pdf +[2] https://inria.hal.science/hal-03027689/file/Lindsey_van_der_Meulen-IItA68-Revised.pdf diff --git a/gcc/algol68/a68-tree.def b/gcc/algol68/a68-tree.def new file mode 100644 index 000000000000..1d7c644988f7 --- /dev/null +++ b/gcc/algol68/a68-tree.def @@ -0,0 +1,24 @@ +/* This file contains the definitions and documentation for the + additional tree codes used in the GNU Algol 68 compiler (see + tree.def for the standard codes). + Copyright (C) 2025 Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it under the + terms of the GNU General Public License as published by the Free Software + Foundation; either version 3, or (at your option) any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + details. + + You should have received a copy of the GNU General Public License along with + GCC; see the file COPYING3. If not see . */ + +/* Tree nodes used in the Algol68 frontend only. */ + +/* +Local variables: +mode:c +End: +*/ diff --git a/gcc/algol68/a68-types.h b/gcc/algol68/a68-types.h new file mode 100644 index 000000000000..df9133fb12fe --- /dev/null +++ b/gcc/algol68/a68-types.h @@ -0,0 +1,1166 @@ +/* Type definitions for the ALGOL 68 parser. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#ifndef __A68_TYPES_H__ +#define __A68_TYPES_H__ + +#include "config.h" +#include "system.h" + +#include +#include "vec.h" + +/* Enumerations. */ + +enum a68_stropping +{ + UPPER_STROPPING, + SUPPER_STROPPING +}; + +enum a68_attribute +{ + STOP = 0, +#define A68_ATTR(ATTR,DESCR) ATTR, +#include "a68-parser-attrs.def" +#undef A68_ATTR +}; + +enum a68_tree_index +{ + /* Type trees. */ + ATI_VOID_TYPE, + ATI_BOOL_TYPE, + ATI_CHAR_TYPE, + ATI_SHORT_SHORT_BITS_TYPE, + ATI_SHORT_BITS_TYPE, + ATI_BITS_TYPE, + ATI_LONG_BITS_TYPE, + ATI_LONG_LONG_BITS_TYPE, + ATI_BYTES_TYPE, + ATI_LONG_BYTES_TYPE, + ATI_SHORT_SHORT_INT_TYPE, + ATI_SHORT_INT_TYPE, + ATI_INT_TYPE, + ATI_LONG_INT_TYPE, + ATI_LONG_LONG_INT_TYPE, + ATI_REAL_TYPE, + ATI_LONG_REAL_TYPE, + ATI_LONG_LONG_REAL_TYPE, + /* Sentinel. */ + ATI_MAX +}; + +/* + * Type definitions. + */ + +typedef char BUFFER[BUFFER_SIZE + 1]; + +typedef struct MODES_T MODES_T; +typedef struct NODE_T NODE_T; +typedef struct MODE_CACHE_T MODE_CACHE_T; +typedef struct MOID_T MOID_T; +typedef struct GINFO_T GINFO_T; +typedef struct KEYWORD_T KEYWORD_T; +typedef struct LINE_T LINE_T; +typedef struct NODE_INFO_T NODE_INFO_T; +typedef struct PACK_T PACK_T; +typedef struct SOID_T SOID_T; +typedef struct TABLE_T TABLE_T; +typedef struct TAG_T TAG_T; +typedef struct TOKEN_T TOKEN_T; +typedef struct ORIGIN_T ORIGIN_T; +typedef struct POSTULATE_T POSTULATE_T; +typedef struct OPTIONS_T OPTIONS_T; +typedef struct PARSER_T PARSER_T; +typedef struct MODULE_T MODULE_T; +typedef struct EXTRACT_T EXTRACT_T; +typedef struct MOIF_T MOIF_T; +typedef struct A68_T A68_T; + +#define NO_A68_REF ((A68_REF *) 0) +#define NO_ARRAY ((A68_ARRAY *) 0) +#define NO_BOOK ((BOOK_T *) 0) +#define NO_BOOL ((bool *) 0) +#define NO_BYTE ((BYTE_T *) 0) +#define NO_CONSTANT ((void *) 0) +#define NO_DEC ((DEC_T *) 0) +#define NO_EDLIN ((EDLIN_T *) 0) +#define NO_FILE ((FILE *) 0) +#define NO_FORMAT ((A68_FORMAT *) 0) +#define NO_GINFO ((GINFO_T *) 0) +#define NO_GPROC ((void (*) (NODE_T *)) 0) +#define NO_HANDLE ((A68_HANDLE *) 0) +#define NO_INT ((int *) 0) +#define NO_JMP_BUF ((jmp_buf *) 0) +#define NO_KEYWORD ((KEYWORD_T *) 0) +#define NO_NINFO ((NODE_INFO_T *) 0) +#define NO_NOTE ((void (*) (NODE_T *)) 0) +#define NO_OPTION_LIST ((OPTION_LIST_T *) 0) +#define NO_PACK ((PACK_T *) 0) +#define NO_PPROC ((PROP_T (*) (NODE_T *)) 0) +#define NO_PROCEDURE ((A68_PROCEDURE *) 0) +#define NO_REAL ((REAL_T *) 0) +#define NO_REFINEMENT ((REFINEMENT_T *) 0) +#define NO_REGMATCH ((regmatch_t *) 0) +#define NO_SCOPE ((SCOPE_T *) 0) +#define NO_SOID ((SOID_T *) 0) +#define NO_STREAM NO_FILE +#define NO_TEXT ((char *) 0) +#define NO_TICK ((bool *) 0) +#define NO_TOKEN ((TOKEN_T *) 0) +#define NO_TUPLE ((A68_TUPLE *) 0) +#define NO_VAR (0) + +/* A STATUS_MASK_T is a word of flags denoting states. + + Status masks are used in parse tree nodes (NODE_T) and in entries in the + symbol table (TAG_T). + + + SCOPE_ERROR_MASK is used by the static scope checker in order to avoid + emitting duplicated scope warnings. */ + +typedef uint32_t STATUS_MASK_T; + +#define STATUS_CLEAR(p, q) {STATUS (p) &= (~(q));} +#define STATUS_SET(p, q) {STATUS (p) |= (q);} +#define STATUS_TEST(p, q) ((STATUS (p) & (q)) != (uint32_t) 0) + +#define NULL_MASK ((STATUS_MASK_T) 0x00000000) +#define SCOPE_ERROR_MASK ((STATUS_MASK_T) 0x00000200) + +/* Structure containing the lowering context which is propagated while calling + the lowering handlers. */ + +struct LOW_CTX_T +{ + /* The common declarer in a declaration list. */ + NODE_T **declarer; + /* The defining identifier of the procedure declaration being processed, or + NO_NODE. This is set by a68_lower_procedure_declaration and used by + a68_lower_routine_text. */ + NODE_T *proc_decl_identifier; + /* If proc_decl_identifier is no NO_NODE, this denotes whether the + declaration being processed is of an operator. */ + bool proc_decl_operator; + /* Name of current module definition, or NULL. */ + const char *module_definition_name; + /* For debugging purposes. */ + int level; +}; + +typedef struct LOW_CTX_T LOW_CTX_T; + +/* Type of the lowerer routines defined in a68-low-prelude.cc. */ +typedef tree (*LOWERER_T) (struct NODE_T *, struct LOW_CTX_T); + +#define NO_LOWERER a68_lower_unimplemented + +struct GTY((chain_next ("%h.more"), chain_prev ("%h.less"))) KEYWORD_T +{ + enum a68_attribute attribute; + const char *text; + KEYWORD_T *less, *more; +}; + +/* A MOID_T represents a mode indicator. + + NUMBER is an unique number assigned to the moid when it gets created. A + renumber_moids function exists in a68-parser-modes.cc but it dosn't seem to + be used at all. + + ATTRIBUTE characterizes the kind of mode and is one of the values defined in + a68-parser-attrs.def. Valid values are: + + PROC_SYMBOL for procecure modes. + ROWS_SYMBOL for row modes. + REF_SYMBOL for reference modes. + FLEX_SYMBOL for flexible reference modes. + STRUCT_SYMBOL for struct modes. + UNION_SYMBOL for union modes. + IN_TYPE_MODE for XXX modes. + OUT_TYPE_MODE for XXX modes. + SERIES_MODE for XXX modes. + INDICANT for XXX modes. + MODULE_INDICANT for XXX modules. + STANDARD for standard modes. + + NODE is a parse tree node XXX. + + HAS_ROWS is true if the mode contains rows somewhere in its internal + structure. + + The interpretation of SUB depends on the kind of mode: + - For REF modes it is the referred mode. + - For FLEX modes it is the referred mode. + - For ROW modes it is the mode of the elements. + - For PROC modes it is the mode of the value yielded by the procedure. + + The interpretation of DIM depends on the kind of mode: + - In VOID_SYMBOL, STANDARD or INDICANT mode, if DIM is positive it + specifies the size of the longsety of the mode. If DIM is negative then + abs (DIM) is the size of hte shortsety of the mode. + - In ROW modes, DIM is the number of dimensions. + - In STRUCT modes, DIM is the number of fields. + - In UNION modes, DIM is the number of united modes. + - In PROC_SYMBOL modes, DIM is the number of arguments. + - In SERIES_MODE and STOWED_MODE modes, DIM is the number modes. + + SLICE is the mode resulting from slicing a value of this mode. For example, + slicing a M_ROW_INT yields a M_INT. + + EQUIVALENT_MODE (referred as EQUIVALENT), for INDICANTs it is its declarer + mode (in MODE FOO = BAR FOO is the indicant and BAR is its declarer) and for + STANDARD modes it may be a mode that reflects its structure. + + USE is used by the is_well_formed function, which detects whether a mode is + well formed, i.e. that the mode doesn't refer to itself nor it relates to + void. + + DEFLEXED_MODE is like the current mode, but without FLEX. Only defined for + modes that have a SUB, i.e. REF, FLEX, ROW and PROC. In other modes this is + NO_MODE. + + For refs to structs, rows or flex, NAME points to the corresponding name + mode. For example, for a mode REF STRUCT (INT i, REAL x), NAME points to a + mode STRUCT (REF INT i, REF REAL x). This is used for selections. + + For rows of structs, rows or flex, MULTIPLE points to the corresponding row + mode. For example, for a mode [] STRUCT (INT i, REAL x), MULTIPLE points to + a mode STRUCT ([]INT i, []REAL x). This is used for selections. + + PACK is a pack of moids. For a STOWED_MODE, it contains the modes of the + arguments of a procedure, or the modes of the units in a collateral clause. + For a SERIES_MODE, it contains the modes of the completing units in a serial + clause, the alternatives in a conformity clause, the alternatives in a + CONDITIONAL_CLAUSE, the alternatives in a CASE_CLAUSE, + + CTYPE is a GCC GENERIC tree corresponding to this mode. It is computed and + installed by a68_lower_moid. + + ASM_LABEL is an assembly label used by a68_asm_output_mode. */ + +#define NO_MOID ((MOID_T *) 0) + +struct GTY((chain_next ("%h.next"))) MOID_T +{ + int number; + int attribute; + int dim; + bool has_rows, use, portable, derivate; + NODE_T *node; + PACK_T *pack; + MOID_T *sub, *equivalent_mode, *slice, *deflexed_mode, *name, *multiple_mode, *next, *rowed, *trim; + tree ctype; + const char *asm_label; +}; + +/* A MODES_T struct contains a collection of particular pre-defined modes. + + These modes are initialized by either stand_moids or make_special_mode. + They are commonly referred using the corresponding M_* macros. + + ROWS is a mode to which any ROW mode can be strongly coerced. It is used as + the mode of the second operand of the ELEMS, LWB and UPB operators. + + HIP is the mode of NIL. */ + +struct MODES_T +{ + MOID_T *BITS, *BOOL, *BYTES, *CHANNEL, *CHAR, *COLLITEM, *COMPL, *COMPLEX, + *C_STRING, *ERROR, *FILE, *FORMAT, *HEX_NUMBER, *HIP, *INT, *LONG_BITS, *LONG_BYTES, + *LONG_COMPL, *LONG_COMPLEX, *LONG_INT, *LONG_LONG_BITS, *LONG_LONG_COMPL, + *LONG_LONG_COMPLEX, *LONG_LONG_INT, *LONG_LONG_REAL, *LONG_REAL, *NUMBER, + *PROC_REAL_REAL, *PROC_LONG_REAL_LONG_REAL, *PROC_REF_FILE_BOOL, *PROC_REF_FILE_VOID, *PROC_ROW_CHAR, + *PROC_STRING, *PROC_VOID, *REAL, *REF_BITS, *REF_BOOL, *REF_BYTES, + *REF_CHAR, *REF_COMPL, *REF_COMPLEX, *REF_FILE, *REF_INT, + *REF_LONG_BITS, *REF_LONG_BYTES, *REF_LONG_COMPL, *REF_LONG_COMPLEX, + *REF_LONG_INT, *REF_LONG_LONG_BITS, *REF_LONG_LONG_COMPL, + *REF_LONG_LONG_COMPLEX, *REF_LONG_LONG_INT, *REF_LONG_LONG_REAL, *REF_LONG_REAL, + *REF_REAL, *REF_REF_FILE, *REF_ROW_CHAR, *REF_ROW_COMPLEX, *REF_ROW_INT, + *REF_ROW_REAL, *REF_ROW_ROW_COMPLEX, *REF_ROW_ROW_REAL, + *REF_SHORT_BITS, *REF_SHORT_SHORT_BITS, *REF_SHORT_INT, + *REF_SHORT_SHORT_INT, *REF_STRING, + *ROW_BITS, *ROW_BOOL, *ROW_CHAR, *ROW_COMPLEX, *ROW_INT, *ROW_LONG_BITS, *ROW_LONG_LONG_BITS, + *ROW_REAL, *ROW_ROW_CHAR, *ROW_ROW_COMPLEX, *ROW_ROW_REAL, *ROWS, *ROW_SIMPLIN, *ROW_SIMPLOUT, + *ROW_STRING, *SEMA, *SHORT_BITS, *SHORT_SHORT_BITS, *SHORT_INT, *SHORT_SHORT_INT, + *SIMPLIN, *SIMPLOUT, *STRING, *FLEX_ROW_CHAR, + *FLEX_ROW_BOOL, *UNDEFINED, *VACUUM, *VOID; +}; + +/* The OPTIONS_T structure record which front-end options have been activated. + Each option OPTION has a corresponding GCC -f[no-]a68-OPTION command-line + switch that can be used to activate or deactivate it. + + STROPPING indicates the stropping regime in use. It can be UPPER_STROPPING + or SUPPER_STROPPING. + + BRACKETS indicates whether [ .. ] and { .. } are equivalent to ( .. ). + + STRICT indicates that no ALGOL 68 extension is allowed. + + ASSERT indicates whether to generate code for assertions. + + BOUNDS_CHECKING indicates whether to perform array bound checking at + run-time. + + NIL_CHECKING indicates whether to check for NIL when dereferencing at + run-time. */ + +struct GTY(()) OPTIONS_T +{ + enum a68_stropping stropping; + bool brackets; + bool strict; + bool assert; + bool bounds_checking; + bool nil_checking; +}; + +/* The access class static property of a stored value determines how the value + can be reached at run-time. It is used by the lowering pass in order to + minimize copies at run-time. + + CONSTANT is for constant literals. At run-time these literals will either + reside in operand instructions or in space allocated in CONSTAB%. + + DIRIDEN (direct identifier) means that the value is stored on IDST% at some + static address. This is the access class used for values ascribed to + identifiers as long as the block in hich they are declared has not been + left. It is also used for values resulting from actions such as the + selection from a value possessed by an identifier or the dereferencing fo a + name corespodning to a variable. + + VARIDEN (variable identifier) is used for values which are names/variables. + The name is stored on IDST%. The static elaboration of the dereferencing of + a variable with access VARIDEN results in a value with access DIRIDEN, not + requiring any run-time action. Same happens with selections of variables of + access VARIDEN. + + INDIDEN (indirect identifier) is used for values that are stored in a memory + location in IDST%. The static elaboration of a dereferencing applied to a + value of access DIRIDEN. + + DIRWOST (direct working stack) is very much like DIRIDEN, except that the + value is stored in WOST% rathern than in IDST%. This access is used for the + result of an action when this result does not preexist in memory and hence + has to be constructed in WOST%. + + INDWOST (indirect working stack) is very similar to INDIDEN. Such an access + can be obtained for example through the static elaboration of the + dereferencing of a name the access of which is DIRWOST. + + NIHIL is used to characterize the absence of value. This is used in the + static elaboration of a jump, a voiding and a call ith a void result. + + Note that in all these classes we assume as run-time the intermediate + language level we are lowering to, i.e. GENERIC. A DIRIDEN value, for + example, can very well stored in a register depending on further compiler + optimizations. */ + +#define ACCESS_NIHIL 0 +#define ACCESS_CONSTANT 1 +#define ACCESS_DIRIDEN 2 +#define ACCESS_INDIDEN 3 +#define ACCESS_DIRWOST 4 + +/* A NODE_T is a node in the A68 Syntax tree produced by the lexer-scanner and + later expanded by the Mailloux parser. + + NUMBER identifies the node uniquely in the syntax tree. + + ATTRIBUTE is a code that specifies the kind of entity denoted by the node. + Valid attributes are defined in the enumeration a68_attribute above in + this file. Examples of attributes are ELIF_PART, GOTO_SYMBOL or BOLD_TAG. + + ANNOTATION provides a way to annotate a node with a reference to another + node attribute. This is currently used by the mode checker to annotate + indexer nodes as slicer or as trimmers. + + TYPE (accessed as MOID) is either NO_MOID if the entity denoted by the node + doesn't have a mode, or a suitable MOID_T reflecting the mode of the entity. + This attribute is calculated and set in all the nodes of the tree by the + mode collection and checker pass implemented by make_moid_list. + + INFO contains additional attributes of the node. See NODE_INFO_T below. + + NEXT, PREVIOUS and SUB are links to other tree nodes. They are used to link + the syntax tree structure from the top: + + TOP <-> N <-> N <-> ... + | < is PREVIOUS + N <-> N <-> ... > is NEXT + | | is SUB + N <-> ... + + SEQUENCE is a link to another tree node. It is used by the tax collector + (symbol table builder) in order to handle DO .. OD ranges. + + NEST is a link to another tree node, which is the NEST for the current node. + It is set by the tax collector (symbol table builder) and it is used for + diagnostics. + + PACK (accessed as NODE_PACK) is either NO_PACK or an instance of the PACK_T + structure defined below. It is used by the modes checker. + + STATUS is a mask of flags, used by several passes that handle nodes. Valid status flags are: + + SYMBOL_TABLE (accessed as TABLE) is either NO_TABLE or a TABLE_T containing + a symbol table introduced by the entity denoted by the tree node. These + nodes are the ones introducing ranges: BEGIN, DO, etc. + + NON_LOCAL is either NO_TABLE, if the environ established by the node is + local, or a pointer to a TABLE_T identifying the non-local environment + associated with the tree node. It is set by the static scope checker. See + 3.2.2 and 5.2.3.2.b in the report for its application in the handling of + local generators in serial clauses. + + TAG (accessed as TAX) is either NO_TAG or a TAG_T used to bind identifier + nodes, routine texts and other indicants to their corresponding entry in a + symbol table. This is set by the taxes collector. + + The following fields are static properties managed an used in the lowering + pass. + + ORIGIN is a static property that describes the history of the entity denoted + by the node. This is only used in nodes denoting values. + + DYNAMIC_STACK_ALLOCS is a flag used in serial clause nodes. It determines + whether the elaboration of the phrases in the serial clause may involve + dynamic stack allocation. This is used by the lower pass, along with + NON_LOCAL above, in order to properly manage the stack pointer while + lowering these clauses. + + PUBLICIZED is true for DEFINING_OPERATOR, DEFINING_IDENTIFIER and + DEFINING_INDICANT nodes that appear in declarations marked with PUB. + + CDECL is a GCC GENERIC tree corresponding to a DECL_FIELD for FIELD + nodes. */ + +struct GTY((chain_next ("%h.next"), chain_prev ("%h.previous"))) NODE_T +{ + GINFO_T *genie; + int number; + enum a68_attribute attribute; + enum a68_attribute annotation; + MOID_T *type; + NODE_INFO_T *info; + NODE_T *next, *previous, *sub; + NODE_T *sequence, *nest; + PACK_T *pack; + STATUS_MASK_T status; + TABLE_T *symbol_table; + TABLE_T *non_local; + TAG_T *tag; + tree cdecl; + bool dynamic_stack_allocs; + bool publicized; +}; + +#define NO_NODE ((NODE_T *) 0) + +/* A NODE_INFO_T struct contains additional attributes of a NODE_T parse tree + node. + + PROCEDURE_LEVEL indicates how lexically deep the tree node is in terms of + routine texts. This attribute is set for all the nodes in the syntax tree + by the taxes collector and originally used by ALGOL 68 Genie's monitor. + Even if at the moment this is not used by GCC, this field and the + correponding machinery is still here in case it is useful in the future. + + PRIORITY (accessed as PRIO) is used by operator tree nodes and specifies the + priority of the operator denoted by the node. This is set tree wide by the + bottom-up parser. + + SYMBOL (accessed indirectly as NSYMBOL) contains the symbol value, a string, + corresponding to the tree node. This is used by tree nodes representing + tokens such as bold tags, keywords and identifiers. The symbols are set by + the parser-scanner. + + LINE is a pointer to the source line from which the tree node originates. + This is set for tree nodes representing tokens and is set by the + parser-scanner. */ + +struct GTY(()) NODE_INFO_T +{ + int procedure_level; + int priority; + char * GTY((skip)) char_in_line; + int comment_type; + char * GTY((skip)) comment; + LINE_T *comment_line; + char * GTY((skip)) comment_char_in_line; + int pragmat_type; + char * GTY((skip)) pragmat; + LINE_T *pragmat_line; + char * GTY((skip)) pragmat_char_in_line; + const char *symbol; + LINE_T *line; +}; + +struct GTY(()) GINFO_T +{ + MOID_T *partial_proc, *partial_locale; +}; + +struct GTY((chain_next ("%h.next"), chain_prev ("%h.previous"))) PACK_T +{ + MOID_T *type; + const char *text; + NODE_T *node; + PACK_T *next, *previous; +}; + +/* Postulates. */ + +struct GTY((chain_next ("%h.next"))) POSTULATE_T +{ + MOID_T *a, *b; + POSTULATE_T *next; +}; + +#define NO_POSTULATE ((POSTULATE_T *) 0) + +struct GTY((chain_next ("%h.next"))) SOID_T +{ + int attribute, sort, cast; + MOID_T *type; + NODE_T *node; + SOID_T *next; +}; + +struct GTY((chain_next ("%h.next"))) LINE_T +{ + char marker[6]; + char * GTY((skip)) string; + const char *filename; + int number; + LINE_T *next, *previous; +}; +#define NO_LINE ((LINE_T *) 0) + +/* Symbol table. + + PUBLIC_RANGE is true in ranges whose declarations may be made accessible to + other compilation units. decl trees lowered for declarations in public + ranges will be put in the top-level block. This is used for top-level + module declarations. */ + +struct GTY(()) TABLE_T +{ + int num, level, nest, attribute; + bool initialise_frame, initialise_anon, proc_ops, public_range; + TABLE_T *previous, *outer; + TAG_T *identifiers, *operators, *modules, *priority, *indicants, *labels, *anonymous; + NODE_T *jump_to, *sequence; +}; +#define NO_TABLE ((TABLE_T *) 0) + +/* A TAG_T structure denotes an entry in the symbol table. Each entry + corresponds to an identity. + + TAX: TAG; TAB; TAD; TAM; + + TYPE is the mode of the entry. + + NODE is the defining identifier associated to the declaration. + + SCOPE is the lexical depth of the tag. Zero corresponds to the primal + scope. It is set by the static scope checker. + + SCOPE_ASSIGNED determines whether a SCOPE has been actually assigned to the + tag. It is set by the static scope checker. The entities which get + assigned scopes are identities of format texts and routine texts. + + PORTABLE determines whether the construction associated with the tag is + Algol 68 or some extension. + + VARIABLE is set when the defining identifier in NODE is defined in a + variable declaration, as opposed to an identity declaration. This is set by + extract_variables and is used by the lowering pass. + + HEAP is used for defining identifier in NODE is defined in a variable + declaration. It is HEAP_SYMBOL or LOC_SYMBOL. + + IS_RECURSIVE is set for mode indicants whose definition is recursive, + i.e. they appear in actual declarers within its own definition. + + PUBLICIZED is set for tags that are marked as public and therefore shall be + exported as part of a module interface. + + EXPORTED is set for DEFINING_MODULEs whose module interface is to be + exported. + + ASCRIBED_ROUTINE_TEXT is set when the defining identifier is ascribed a + routine-text in an identity declaration. + + IN_PROC is set when the defining identifier has been set in a + proc-identity-declaration or in a brief-op-declaration. These declarations + are optimized in a similar way than variable declarations in order to avoid + indirect addressing. + + YOUNGEST_ENVIRON is used when NODE is either a ROUTINE_TEXT or a + FORMAT_TEXT, and contains the youngest (higher) lexical level of any object + directly declared in the routine or format body. This is filled in and used + by the scope checker. + + TREE_DECL is the GENERIC declaration for the definition of this symbol. + This is set and used by the lower pass. For mode indicants, it contains a + function that generates a pointer to the given mode, and is used by + a68_low_generator to handle recursive modes. + + MOIF is a list of module interfaces. This is used in ACCESS_CLAUSE nodes. + + EXTERN_SYMBOL is a string with the symbol that was obtained from an imported + module declaration. This is only used in entries where MOIF is not NO_MOIF. + + LOWERER is a lowering routine defined in a68-low-prelude.cc. These are used + in taxes that denote some pre-defined operator. */ + +struct GTY((chain_next ("%h.next"))) TAG_T +{ + TABLE_T *symbol_table; + MOID_T *type; + NODE_T *node, *unit; + const char *value; + bool scope_assigned, use, in_proc, loc_assigned, portable, variable; + bool ascribed_routine_text, is_recursive, publicized, exported; + int priority, heap, scope, youngest_environ, number; + STATUS_MASK_T status; + tree tree_decl; + MOIF_T *moif; + LOWERER_T lowerer; + TAG_T *next, *body; + const char *extern_symbol; +}; +#define NO_TAG ((TAG_T *) 0) + +struct GTY((chain_next ("%h.more"), chain_prev ("%h.less"))) TOKEN_T +{ + const char *text; + TOKEN_T *less, *more; +}; +#define NO_TOKEN ((TOKEN_T *) 0) + +struct GTY(()) MODULE_T +{ + bool tree_listing_safe, cross_reference_safe; + int error_count, warning_count, source_scan; + LINE_T *top_line; + MOID_T *top_moid, *standenv_moid; + NODE_T *top_node; + OPTIONS_T options; + FILE * GTY ((skip)) file_source_fd; + const char *file_source_name; + struct + { + LINE_T *save_l; + char * GTY((skip)) save_s, GTY((skip)) save_c; + } scan_state; +}; + +/* Module interface extracts. + + KIND is the kind of extract. One of the GA68_EXTRACT_* codes defined in + a68-exports.cc. + + SYMBOL is a string with the symbol name for the entity represented by the + extract. It is mangled. + + MODE applies to identifier, operator and indicatione extracts. + + PRIORITY is the priority number in a priority extract. + + VARIABLE applies to GA68_EXTRACT_IDEN and GA68_EXTRACT_OPER extracts, and + indicates whether the exported symbol was declared via a variable + declaration. These decls are optimized and don't require indirect + addressing. This is compiler-specific and part of mdextra. + + IN_PROC applies to GA68_EXTRACT_IDEN and GA68_EXTRACT_OPER extracts. If + set, the exported symbol shall not be indirected. This is compiler-specific + and part of mdextra. */ + +struct GTY(()) EXTRACT_T +{ + unsigned int kind; + const char *symbol; + MOID_T *mode; + int priority; + bool variable, in_proc; +}; + +/* Module interfaces. + + VERSION is the version of the exports format to report in the encoded data. + + NAME is the name of the module as it is accessed at the source level, which + corresponds to a bold word. + + PRELUDE and POSTLUDE are mangled symbols corresponding to the entry points + of the module's prelude and postlude. + + MODES is a vector of modes which conform the modes table of the module + interface. + + MODULES is a vector of TAGs for module extracts. + INDICANTS is a vector of TAGs for mode extracts. + IDENTIFIERS is a vector of TAGs for identifier extracts. + PRIOS is a vector of TAGs for operator priorities. */ + +#define NO_MOIF ((MOIF_T *) 0) + +struct GTY(()) MOIF_T +{ + unsigned int version; + const char *name; + const char *prelude; + const char *postlude; + vec *modes; + vec *modules; + vec *indicants; + vec *identifiers; + vec *prios; + vec *operators; +}; + +struct MODE_CACHE_T +{ + MOID_T *proc_bool; + MOID_T *proc_char; + MOID_T *proc_complex_complex; + MOID_T *proc_int; + MOID_T *proc_int_int; + MOID_T *proc_int_int_real; + MOID_T *proc_int_real; + MOID_T *proc_int_real_real; + MOID_T *proc_int_real_real_real; + MOID_T *proc_real; + MOID_T *proc_real_int_real; + MOID_T *proc_real_real; + MOID_T *proc_real_real_int_real; + MOID_T *proc_real_real_real; + MOID_T *proc_real_real_real_int; + MOID_T *proc_real_real_real_real; + MOID_T *proc_real_real_real_real_real; + MOID_T *proc_real_real_real_real_real_real; + MOID_T *proc_real_ref_real_ref_int_void; + MOID_T *proc_void; +}; + +/* A PARSER_T struct contains all the global state that is kept by the parser. + This information is managed and used exclusively by a68_parser. + + ERROR_TAG is a tag that signifies an error. It is initialized in + a68_parser. + + STOP_SCANNER is a control flag used exclusively by the main loop in + tokenise_source, which is recursive. + + SCAN_BUF is a scratch buffer used by the scanner for several purposes. This + buffer is known to be big enough to hold any substring from the source file. + It is initialized in read_source_file. + + MAX_SCAN_BUF_LENGTH is the useable size of SCAN_BUF. This is used by the + scanner to grow SCAN_BUF as it includes other files. + + TAG_NUMBER is a global counter used by the parser to assign an unique number + to each tag it creates. It is used in a68_new_tag. + + BOTTOM_UP_CRASH_EXIT and TOP_DOWN_CRASH_EXIT are used to longjmp from deeply + nested errors in the bottom-up and top-down parsers respectively. */ + +struct GTY(()) PARSER_T +{ + TAG_T *error_tag; + bool stop_scanner; + size_t max_scan_buf_length; + char * GTY((skip)) scan_buf; + int tag_number; + jmp_buf GTY((skip)) bottom_up_crash_exit; + jmp_buf GTY((skip)) top_down_crash_exit; +}; + +/* A A68_T struct contains the global state used by the ALGOL 68 front-end. + + OUTPUT_LINE is used by the diagnostics machinery in order to write out + message lines. + + EDIT_LINE is used as a scratch buffer for composing error messages and the + like. + + INPUT_LINE is used by the original ALGOL 68 Genie to read lines from the + tty. But in this parser it is used uninitialized (!) by the + a68_phrase_to_text routine in the top-down parser. XXX. + + NEW_NODES is a global counter that keeps the number of parse tree nodes + created. It is currently not used for anything, but still updated in + a68_new_node. + + NEW_MODES is a global counter that keeps the number of moids created. It is + currently not used for anything, but still updated in a68_new_moid. + + NEW_POSTULATES is a global counter that keeps the number of postulates + created by the front-end. It is currently not used for anything, but still + updated in a68_make_postulate. + + NEW_NODE_INFOS is a global counter that keeps the number of NODE_INFO_T + structures created by the front-end. It is currently not used for anything, + but still updated in a68_new_node_info. + + NEW_GENIE_INFOS is a global counter that keeps the number of GINFO_T + structures created by the front-end. It is currently no tused for anything, + but still updated in a68_new_genie_info. + + SYMBOL_TABLE_COUNT is a global counter used by the parser. XXX move to + parser global state when syntax tree finalisation is moved to a68_parser? + + MODE_COUNT is the number of modes registered in the global modes table. XXX + which table. + + TOP_KEYWORD is the top of the list of keywords known to the font-end. + + MODE_CACHE XXX. + + A68_MODES (accessed as MODE) is a collection of particular pre-defined + modes. These modes are initialized by stand_moids. + + JOB (accessed as A68_JOB) is the instance of MODULE_T with the global data + corresponding to the source file being compiled. + + OPTIONS is the set of options currently set for the front-end. + + TOP_POSTULATE and TOP_POSTULATE_LIST are lists of postulates maintained by + the front-end. + + POSTULATES is a collection of postulates used by the moid pretty printer. + + TOP_SOID_LIST is used by the moid machinery. + + STANDENV XXX. + + TOP_TOKEN XXX. + + INCLUDE_PATHS is the list of paths where we search for files to include. + Directories are added to the list at the option handling language hook. + The list is searched in FIFO order. + + IMPORT_PATHS is the list of paths where we search for module exports data. + Directories are added to the list at the option handling language hook. The + list is searched in FIFO order. + + GLOBAL_TREES is an array with global types like a68_void_type and + a68_long_int_type. It is indexed by an enum a68_tree_index. + + MODULE_DEFINITION_DECLS is the global list of the tree decls corresponding + to the module definition being compiled. Note that currently we only allow + top-level modules, so there is no nesting. This is part of the context of + the lowering pass, and these declarations are collected by the lowering + handlers and finally compiled down to assembler in lower_module_declaration. + It cannot go in LOW_CTX_T because the later is on the stack and is not + reachable by the GGC. + + PARSER_STATE contains the parser's global state. + + GLOBAL_CONTEXT is the context to be used for global declarations. Normally + the translation unit. + + GLOBAL_DECLARATIONS contains a array of global declarations to pass back to + the middle-end at the end of the compilation. +*/ + +struct GTY(()) A68_T +{ + BUFFER output_line; + BUFFER edit_line; + BUFFER input_line; + int new_nodes; + int new_modes; + int new_postulates; + int new_node_infos; + int new_genie_infos; + int symbol_table_count; + int mode_count; + KEYWORD_T *top_keyword; + MODE_CACHE_T mode_cache; + MODES_T a68_modes; + MODULE_T job; + OPTIONS_T *options; + POSTULATE_T *postulates, *top_postulate, *top_postulate_list; + SOID_T *top_soid_list; + TABLE_T *standenv; + TOKEN_T *top_token; + vec *include_paths; + vec *import_paths; + hash_map *module_files; + tree global_trees[ATI_MAX]; + PARSER_T parser_state; + vec *module_definition_decls; + tree global_context; + vec *global_declarations; +}; + +/* + * Access macros to fields in the struct types defined above. These are used * + * in order to achieve a nice ALGOL-like field OF struct style. + */ + +#define ASM_LABEL(m) ((m)->asm_label) +#define BACKWARD(p) (p = PREVIOUS (p)) +#define DEFLEX(p) (DEFLEXED (p) != NO_MOID ? DEFLEXED(p) : (p)) +#define FORWARD(p) ((p) = NEXT (p)) +#define A(p) ((p)->a) +#define ANNOTATION(p) ((p)->annotation) +#define ANONYMOUS(p) ((p)->anonymous) +#define ATTRIBUTE(p) ((p)->attribute) +#define ASCRIBED_ROUTINE_TEXT(p) ((p)->ascribed_routine_text) +#define B(p) ((p)->b) +#define BODY(p) ((p)->body) +#define CAST(p) ((p)->cast) +#define CHAR_IN_LINE(p) ((p)->char_in_line) +#define CROSS_REFERENCE_SAFE(p) ((p)->cross_reference_safe) +#define CDECL(p) ((p)->cdecl) +#define COMMENT(p) ((p)->comment) +#define COMMENT_CHAR_IN_LINE(p) ((p)->comment_char_in_line) +#define COMMENT_LINE(p) ((p)->comment_line) +#define COMMENT_TYPE(p) ((p)->comment_type) +#define CTYPE(p) ((p)->ctype) +#define DEFLEXED(p) ((p)->deflexed_mode) +#define DEREFO(p) ((p).derefo) +#define DERIVATE(p) ((p)->derivate) +#define DIM(p) ((p)->dim) +#define DYNAMIC_STACK_ALLOCS(p) ((p)->dynamic_stack_allocs) +#define EQUIVALENT(p) ((p)->equivalent_mode) +#define EQUIVALENT_MODE(p) ((p)->equivalent_mode) +#define ERROR_COUNT(p) ((p)->error_count) +#define EXPORTED(p) ((p)->exported) +#define EXTERN_SYMBOL(p) ((p)->extern_symbol) +#define EXTRACT_IN_PROC(p) ((p)->in_proc) +#define EXTRACT_KIND(p) ((p)->kind) +#define EXTRACT_MODE(p) ((p)->mode) +#define EXTRACT_PRIO(p) ((p)->priority) +#define EXTRACT_SYMBOL(p) ((p)->symbol) +#define EXTRACT_VARIABLE(p) ((p)->variable) +#define WARNING_COUNT(p) ((p)->warning_count) +#define F(p) ((p)->f) +#define FILENAME(p) ((p)->filename) +#define FILE_SOURCE_FD(p) ((p)->file_source_fd) +#define FILE_SOURCE_NAME(p) ((p)->file_source_name) +#define FLEXO(p) ((p).flexo) +#define FLEXO_KNOWN(p) ((p).flexo_known) +#define G(p) ((p)->g) +#define GINFO(p) ((p)->genie) +#define GENO(p) ((p).geno) +#define GET(p) ((p)->get) +#define GPARENT(p) (PARENT (GINFO (p))) +#define GREEN(p) ((p)->green) +#define H(p) ((p)->h) +#define HANDLE(p) ((p)->handle) +#define HAS_ROWS(p) ((p)->has_rows) +#define HEAP(p) ((p)->heap) +#define ID(p) ((p)->id) +#define IDENTIFICATION(p) ((p)->identification) +#define IDENTIFIERS(p) ((p)->identifiers) +#define IDF(p) ((p)->idf) +#define IM(z) (VALUE (&(z)[1])) +#define IN(p) ((p)->in) +#define INDEX(p) ((p)->index) +#define INDICANTS(p) ((p)->indicants) +#define INFO(p) ((p)->info) +#define INITIALISE_ANON(p) ((p)->initialise_anon) +#define INITIALISE_FRAME(p) ((p)->initialise_frame) +#define INI_PTR(p) ((p)->ini_ptr) +#define INS_MODE(p) ((p)->ins_mode) +#define IN_FORBIDDEN(p) ((p)->in_forbidden) +#define IN_PREFIX(p) ((p)->in_prefix) +#define IN_PROC(p) ((p)->in_proc) +#define IN_TEXT(p) ((p)->in_text) +#define IS_OPEN(p) ((p)->is_open) +#define IS_RECURSIVE(p) ((p)->is_recursive) +#define IS_TMP(p) ((p)->is_tmp) +#define JUMP_STAT(p) ((p)->jump_stat) +#define JUMP_TO(p) ((p)->jump_to) +#define K(q) ((q)->k) +#define LABELS(p) ((p)->labels) +#define LAST(p) ((p)->last) +#define LAST_LINE(p) ((p)->last_line) +#define LESS(p) ((p)->less) +#define LEVEL(p) ((p)->level) +#define LEX_LEVEL(p) (LEVEL (TABLE (p))) +#define LINBUF(p) ((p)->linbuf) +#define LINE(p) ((p)->line) +#define LINE_APPLIED(p) ((p)->line_applied) +#define LINE_DEFINED(p) ((p)->line_defined) +#define LINE_END_MENDED(p) ((p)->line_end_mended) +#define LINE_NUMBER(p) (NUMBER (LINE (INFO (p)))) +#define LINSIZ(p) ((p)->linsiz) +#define LIST(p) ((p)->list) +#define ln(x) (log (x)) +#define LOCALE(p) ((p)->locale) +#define LOC_ASSIGNED(p) ((p)->loc_assigned) +#define LOWERER(p) ((p)->lowerer) +#define LOWER_BOUND(p) ((p)->lower_bound) +#define LWB(p) ((p)->lower_bound) +#define MARKER(p) ((p)->marker) +#define MATCH(p) ((p)->match) +#define MODIFIED(p) ((p)->modified) +#define MODULES(p) ((p)->modules) +#define VERSION(p) ((p)->version) +#define MODES(p) ((p)->modes) +#define MOID(p) ((p)->type) +#define MOIF(p) ((p)->moif) +#define MORE(p) ((p)->more) +#define MSGS(p) ((p)->msgs) +#define MULTIPLE(p) ((p)->multiple_mode) +#define MULTIPLE_MODE(p) ((p)->multiple_mode) +#define NAME(p) ((p)->name) +#define NEST(p) ((p)->nest) +#define NEXT(p) ((p)->next) +#define NEXT_NEXT(p) (NEXT (NEXT (p))) +#define NEXT_NEXT_NEXT(p) (NEXT (NEXT_NEXT (p))) +#define NEXT_SUB(p) (NEXT (SUB (p))) +#define NF(p) ((p)->nf) +#define NILO(p) ((p).nilo) +#define NILO_KNOWN(p) ((p).nilo_known) +#define NODE(p) ((p)->node) +#define NODE_DEFINED(p) ((p)->node_defined) +#define NODE_PACK(p) ((p)->pack) +#define NON_LOCAL(p) ((p)->non_local) +#define NCHAR_IN_LINE(p) (CHAR_IN_LINE (INFO (p))) +#define NCOMMENT(p) (COMMENT (INFO (p))) +#define NCOMMENT_CHAR_IN_LINE(p) (COMMENT_CHAR_IN_LINE (INFO (p))) +#define NCOMMENT_LINE(p) (COMMENT_LINE (INFO (p))) +#define NCOMMENT_TYPE(p) (COMMENT_TYPE (INFO (p))) +#define NPRAGMAT(p) (PRAGMAT (INFO (p))) +#define NPRAGMAT_CHAR_IN_LINE(p) (PRAGMAT_CHAR_IN_LINE (INFO (p))) +#define NPRAGMAT_LINE(p) (PRAGMAT_LINE (INFO (p))) +#define NPRAGMAT_TYPE(p) (PRAGMAT_TYPE (INFO (p))) +#define NSYMBOL(p) (SYMBOL (INFO (p))) +#define NUM(p) ((p)->num) +#define NUMBER(p) ((p)->number) +#define OPER(p) ((p)->oper) +#define OPERATORS(p) ((p)->operators) +#define OPT(p) ((p)->opt) +#define OPTIONS(p) ((p)->options) +#define OPTION_ASSERT(p) (OPTIONS (p).assert) +#define OPTION_BOUNDS_CHECKING(p) (OPTIONS (p).bounds_checking) +#define OPTION_BRACKETS(p) (OPTIONS (p).brackets) +#define OPTION_NIL_CHECKING(p) (OPTIONS (p).nil_checking) +#define OPTION_STRICT(p) (OPTIONS (p).strict) +#define OPTION_STROPPING(p) (OPTIONS (p).stropping) +#define OPTION_LIST(p) (OPTIONS (p).list) +#define OPTION_LOCAL(p) (OPTIONS (p).local) +#define OPTION_NODEMASK(p) (OPTIONS (p).nodemask) +#define OUT(p) ((p)->out) +#define OUTER(p) ((p)->outer) +#define P(q) ((q)->p) +#define PACK(p) ((p)->pack) +#define PARTIAL_LOCALE(p) ((p)->partial_locale) +#define PARTIAL_PROC(p) ((p)->partial_proc) +#define PORTABLE(p) ((p)->portable) +#define POSTLUDE(p) ((p)->postlude) +#define PRAGMAT(p) ((p)->pragmat) +#define PRAGMAT_CHAR_IN_LINE(p) ((p)->pragmat_char_in_line) +#define PRAGMAT_LINE(p) ((p)->pragmat_line) +#define PRAGMAT_TYPE(p) ((p)->pragmat_type) +#define PRELUDE(p) ((p)->prelude) +#define PREVIOUS(p) ((p)->previous) +#define PRIO(p) ((p)->priority) +#define PRIOS(p) ((p)->prios) +#define PROCEDURE_LEVEL(p) ((p)->procedure_level) +#define PROC_OPS(p) ((p)->proc_ops) +#define PUBLICIZED(p) ((p)->publicized) +#define PUBLIC_RANGE(p) ((p)->public_range) +#define R(p) ((p)->r) +#define RE(z) (VALUE (&(z)[0])) +#define ROWED(p) ((p)->rowed) +#define SCAN_STATE_C(p) ((p)->scan_state.save_c) +#define SCAN_STATE_L(p) ((p)->scan_state.save_l) +#define SCAN_STATE_S(p) ((p)->scan_state.save_s) +#define SCOPE(p) ((p)->scope) +#define SCOPE_ASSIGNED(p) ((p)->scope_assigned) +#define SEQUENCE(p) ((p)->sequence) +#define SEVERITY(p) ((p)->severity) +#define SLICE(p) ((p)->slice) +#define SORT(p) ((p)->sort) +#define SOURCE_SCAN(p) ((p)->source_scan) +#define STANDENV_MOID(p) ((p)->standenv_moid) +#define STATUS(p) ((p)->status) +#define STRING(p) ((p)->string) +#define SUB(p) ((p)->sub) +#define SUB_MOID(p) (SUB (MOID (p))) +#define SUB_NEXT(p) (SUB (NEXT (p))) +#define SUB_SUB(p) (SUB (SUB (p))) +#define SYMBOL(p) ((p)->symbol) +#define TABLE(p) ((p)->symbol_table) +#define TAG_LEX_LEVEL(p) (LEVEL (TAG_TABLE (p))) +#define TAG_TABLE(p) ((p)->symbol_table) +#define TAX(p) ((p)->tag) +#define TAX_TREE_DECL(p) ((p)->tree_decl) +#define TEXT(p) ((p)->text) +#define TOP_LINE(p) ((p)->top_line) +#define TOP_MOID(p) ((p)->top_moid) +#define TOP_NODE(p) ((p)->top_node) +#define TRANSIENT(p) ((p)->transient) +#define TREE_LISTING_SAFE(p) ((p)->tree_listing_safe) +#define TRIM(p) ((p)->trim) +#define TUPLE(p) ((p)->tuple) +#define UNIT(p) ((p)->unit) +#define USE(p) ((p)->use) +#define VALUE(p) ((p)->value) +#define VARIABLE(p) ((p)->variable) +#define WHERE(p) ((p)->where) +#define IS_FLEXETY_ROW(m) (IS_FLEX (m) || IS_ROW (m) || m == M_STRING) +#define IS_FLEX(m) IS ((m), FLEX_SYMBOL) +#define IS_LITERALLY(p, s) (strcmp (NSYMBOL (p), s) == 0) +#define ISNT(p, s) (! IS (p, s)) +#define IS(p, s) (ATTRIBUTE (p) == (s)) +#define IS_REF_FLEX(m) (IS (m, REF_SYMBOL) && IS (SUB (m), FLEX_SYMBOL)) +#define IS_REF(m) IS ((m), REF_SYMBOL) +#define IS_INTEGRAL(m) \ + ((m) == M_INT \ + || (m) == M_LONG_INT \ + || (m) == M_LONG_LONG_INT \ + || (m) == M_SHORT_INT \ + || (m) == M_SHORT_SHORT_INT) +#define IS_BITS(m) \ + ((m) == M_BITS \ + || (m) == M_LONG_BITS \ + || (m) == M_LONG_LONG_BITS \ + || (m) == M_SHORT_BITS \ + || (m) == M_SHORT_SHORT_BITS) +#define IS_BYTES(m) \ + ((m) == M_BYTES || (m) == M_LONG_BYTES) +#define IS_COMPLEX(m) \ + ((m) == M_COMPLEX \ + || (m) == M_LONG_COMPLEX \ + || (m) == M_LONG_LONG_COMPLEX) +#define IS_REAL(m) \ + ((m) == M_REAL \ + || (m) == M_LONG_REAL \ + || (m) == M_LONG_LONG_REAL) +#define IS_ROW(m) IS ((m), ROW_SYMBOL) +#define IS_STRUCT(m) IS ((m), STRUCT_SYMBOL) +#define IS_UNION(m) IS ((m), UNION_SYMBOL) +#define YOUNGEST_ENVIRON(p) ((p)->youngest_environ) + +#endif /* ! __A68_TYPES_H */ diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h new file mode 100644 index 000000000000..92dc28e222f2 --- /dev/null +++ b/gcc/algol68/a68.h @@ -0,0 +1,1117 @@ +/* Definitions for the Algol 68 GCC front end. + Copyright (C) 2025 Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#ifndef __A68_H__ +#define __A68_H__ + +/* Some common definitions first. */ + +#define BUFFER_SIZE 1024 +#define SMALL_BUFFER_SIZE 128 +#define SNPRINTF_SIZE ((size_t) (BUFFER_SIZE - 1)) +#define BUFCLR(z) {memset ((z), 0, BUFFER_SIZE + 1);} +#define MOID_ERROR_WIDTH 80 + +#define MONADS "%^&+-~!?" +#define NOMADS ">= 4001) || GCC_VERSION == BUILDING_GCC_VERSION +#define ATTRIBUTE_A68_DIAG(m, n) __attribute__ ((__format__ (__gcc_tdiag__, m, n))) ATTRIBUTE_NONNULL(m) +#else +#define ATTRIBUTE_A68_DIAG(m, n) ATTRIBUTE_NONNULL(m) +#endif + +/* Maximum number of priorities supported for operators. The Algol 68 RR + specifies 9. */ + +#define MAX_PRIORITY 9 + +/* The primal scope is the top-level scope. */ + +#define PRIMAL_SCOPE 0 + +/* Deflexing strategy. See the moid checking routines in + a68-parser-moids-check for an explanation of these values. */ + +enum +{ + NO_DEFLEXING = 1, SAFE_DEFLEXING, ALIAS_DEFLEXING, FORCE_DEFLEXING, + SKIP_DEFLEXING +}; + +/* Magic number for the exports data. */ + +#define A68_EXPORT_MAGIC_LEN 2 + +#define A68_EXPORT_MAGIC1 0x0a +#define A68_EXPORT_MAGIC2 0x68 + +/* The segment name we pass to simple_object_start_read to find Algol 68 export + data. */ + +#ifndef A68_EXPORT_SEGMENT_NAME +#define A68_EXPORT_SEGMENT_NAME "__GNU_A68" +#endif + +/* The section name we use when reading and writing export data. */ + +#ifndef A68_EXPORT_SECTION_NAME +#define A68_EXPORT_SECTION_NAME ".a68_exports" +#endif + +/* ga68 export format definitions. See ga68-exports.pk. */ + +#define GA68_EXPORTS_VERSION 1 + +#define GA68_MODE_UNKNOWN 0 +#define GA68_MODE_VOID 1 +#define GA68_MODE_INT 2 +#define GA68_MODE_REAL 3 +#define GA68_MODE_BITS 4 +#define GA68_MODE_BYTES 5 +#define GA68_MODE_CHAR 6 +#define GA68_MODE_BOOL 7 +#define GA68_MODE_CMPL 8 +#define GA68_MODE_ROW 9 +#define GA68_MODE_STRUCT 10 +#define GA68_MODE_UNION 11 +#define GA68_MODE_NAME 12 +#define GA68_MODE_PROC 13 +#define GA68_MODE_STRING 14 +#define GA68_MODE_FLEX 15 + +#define GA68_EXTRACT_MODU 0 +#define GA68_EXTRACT_IDEN 1 +#define GA68_EXTRACT_MODE 2 +#define GA68_EXTRACT_PRIO 3 +#define GA68_EXTRACT_OPER 4 + +/* Then the types. */ + +#include "a68-types.h" + +/* Front-end global state. */ + +extern GTY(()) A68_T a68_common; +#define A68(z) (a68_common.z) +#define A68_JOB A68 (job) +#define A68_STANDENV A68 (standenv) +#define A68_MCACHE(z) A68 (mode_cache.z) +#define A68_INCLUDE_PATHS A68 (include_paths) +#define A68_IMPORT_PATHS A68 (import_paths) +#define A68_MODULE_FILES A68 (module_files) +#define A68_GLOBAL_TREES A68 (global_trees) +#define A68_PARSER(Z) (A68 (parser_state).Z) +#define A68_MODULE_DEFINITION_DECLS A68 (module_definition_decls) +#define A68_GLOBAL_CONTEXT A68 (global_context) +#define A68_GLOBAL_DECLARATIONS A68 (global_declarations) + +/* Particular pre-defined modes. */ + +#define MODE(p) A68 (a68_modes.p) +#define M_BITS (MODE (BITS)) +#define M_BOOL (MODE (BOOL)) +#define M_BYTES (MODE (BYTES)) +#define M_CHANNEL (MODE (CHANNEL)) +#define M_CHAR (MODE (CHAR)) +#define M_COLLITEM (MODE (COLLITEM)) +#define M_COMPLEX (MODE (COMPLEX)) +#define M_C_STRING (MODE (C_STRING)) +#define M_ERROR (MODE (ERROR)) +#define M_FILE (MODE (FILE)) +#define M_FLEX_ROW_BOOL (MODE (FLEX_ROW_BOOL)) +#define M_FLEX_ROW_CHAR (MODE (FLEX_ROW_CHAR)) +#define M_FORMAT (MODE (FORMAT)) +#define M_HIP (MODE (HIP)) +#define M_INT (MODE (INT)) +#define M_LONG_BITS (MODE (LONG_BITS)) +#define M_LONG_BYTES (MODE (LONG_BYTES)) +#define M_LONG_COMPLEX (MODE (LONG_COMPLEX)) +#define M_LONG_INT (MODE (LONG_INT)) +#define M_LONG_LONG_INT (MODE (LONG_LONG_INT)) +#define M_LONG_LONG_BITS (MODE (LONG_LONG_BITS)) +#define M_LONG_LONG_COMPLEX (MODE (LONG_LONG_COMPLEX)) +#define M_LONG_LONG_INT (MODE (LONG_LONG_INT)) +#define M_LONG_LONG_REAL (MODE (LONG_LONG_REAL)) +#define M_LONG_REAL (MODE (LONG_REAL)) +#define M_NIL (MODE (NIL)) +#define M_NUMBER (MODE (NUMBER)) +#define M_PROC_LONG_REAL_LONG_REAL (MODE (PROC_LONG_REAL_LONG_REAL)) +#define M_PROC_REAL_REAL (MODE (PROC_REAL_REAL)) +#define M_PROC_REF_FILE_BOOL (MODE (PROC_REF_FILE_BOOL)) +#define M_PROC_REF_FILE_VOID (MODE (PROC_REF_FILE_VOID)) +#define M_PROC_ROW_CHAR (MODE (PROC_ROW_CHAR)) +#define M_PROC_STRING (MODE (PROC_STRING)) +#define M_PROC_VOID (MODE (PROC_VOID)) +#define M_REAL (MODE (REAL)) +#define M_REF_BITS (MODE (REF_BITS)) +#define M_REF_BOOL (MODE (REF_BOOL)) +#define M_REF_BYTES (MODE (REF_BYTES)) +#define M_REF_CHAR (MODE (REF_CHAR)) +#define M_REF_COMPLEX (MODE (REF_COMPLEX)) +#define M_REF_FILE (MODE (REF_FILE)) +#define M_REF_INT (MODE (REF_INT)) +#define M_REF_LONG_BITS (MODE (REF_LONG_BITS)) +#define M_REF_LONG_BYTES (MODE (REF_LONG_BYTES)) +#define M_REF_LONG_COMPLEX (MODE (REF_LONG_COMPLEX)) +#define M_REF_LONG_INT (MODE (REF_LONG_INT)) +#define M_REF_LONG_LONG_BITS (MODE (REF_LONG_LONG_BITS)) +#define M_REF_LONG_LONG_COMPLEX (MODE (REF_LONG_LONG_COMPLEX)) +#define M_REF_LONG_LONG_INT (MODE (REF_LONG_LONG_INT)) +#define M_REF_LONG_LONG_REAL (MODE (REF_LONG_LONG_REAL)) +#define M_REF_LONG_REAL (MODE (REF_LONG_REAL)) +#define M_REF_REAL (MODE (REF_REAL)) +#define M_REF_REF_FILE (MODE (REF_REF_FILE)) +#define M_REF_SHORT_BITS (MODE (REF_SHORT_BITS)) +#define M_REF_SHORT_SHORT_BITS (MODE (REF_SHORT_SHORT_BITS)) +#define M_REF_ROW_CHAR (MODE (REF_ROW_CHAR)) +#define M_REF_ROW_COMPLEX (MODE (REF_ROW_COMPLEX)) +#define M_REF_ROW_INT (MODE (REF_ROW_INT)) +#define M_REF_ROW_REAL (MODE (REF_ROW_REAL)) +#define M_REF_ROW_ROW_COMPLEX (MODE (REF_ROW_ROW_COMPLEX)) +#define M_REF_ROW_ROW_REAL (MODE (REF_ROW_ROW_REAL)) +#define M_REF_SHORT_INT (MODE (REF_SHORT_INT)) +#define M_REF_SHORT_SHORT_INT (MODE (REF_SHORT_SHORT_INT)) +#define M_REF_STRING (MODE (REF_STRING)) +#define M_ROW_BITS (MODE (ROW_BITS)) +#define M_ROW_BOOL (MODE (ROW_BOOL)) +#define M_ROW_CHAR (MODE (ROW_CHAR)) +#define M_ROW_COMPLEX (MODE (ROW_COMPLEX)) +#define M_ROW_INT (MODE (ROW_INT)) +#define M_ROW_REAL (MODE (ROW_REAL)) +#define M_ROW_ROW_CHAR (MODE (ROW_ROW_CHAR)) +#define M_ROW_ROW_COMPLEX (MODE (ROW_ROW_COMPLEX)) +#define M_ROW_ROW_REAL (MODE (ROW_ROW_REAL)) +#define M_ROW_SIMPLIN (MODE (ROW_SIMPLIN)) +#define M_ROW_SIMPLOUT (MODE (ROW_SIMPLOUT)) +#define M_ROWS (MODE (ROWS)) +#define M_ROW_STRING (MODE (ROW_STRING)) +#define M_SEMA (MODE (SEMA)) +#define M_SHORT_BITS (MODE (SHORT_BITS)) +#define M_SHORT_SHORT_BITS (MODE (SHORT_SHORT_BITS)) +#define M_SHORT_INT (MODE (SHORT_INT)) +#define M_SHORT_SHORT_INT (MODE (SHORT_SHORT_INT)) +#define M_SIMPLIN (MODE (SIMPLIN)) +#define M_SIMPLOUT (MODE (SIMPLOUT)) +#define M_STRING (MODE (STRING)) +#define M_UNDEFINED (MODE (UNDEFINED)) +#define M_VACUUM (MODE (VACUUM)) +#define M_VOID (MODE (VOID)) + +/* Usage of TYPE_LANG_FLAG_* flags. */ + +#define A68_ROW_TYPE_P(NODE) TYPE_LANG_FLAG_0 (NODE) +#define A68_UNION_TYPE_P(NODE) TYPE_LANG_FLAG_1 (NODE) +#define A68_STRUCT_TYPE_P(NODE) TYPE_LANG_FLAG_2 (NODE) +#define A68_ROWS_TYPE_P(NODE) TYPE_LANG_FLAG_3 (NODE) +#define A68_TYPE_HAS_ROWS_P(NODE) TYPE_LANG_FLAG_4 (NODE) + +/* Language-specific tree checkers. */ + +#define STRUCT_OR_UNION_TYPE_CHECK(NODE) \ + TREE_CHECK2 (NODE, RECORD_TYPE, UNION_TYPE) + +/* Usage of TYPE_LANG_SLOT_* fields. */ + +#define TYPE_FORWARD_REFERENCES(NODE) \ + (TYPE_LANG_SLOT_1 (STRUCT_OR_UNION_TYPE_CHECK (NODE))) + +/* a68-unistr.cc */ + +int a68_u8_mbtouc (uint32_t *puc, const uint8_t *s, size_t n); +int a68_u8_uctomb (uint8_t *s, uint32_t uc, ptrdiff_t n); + +uint32_t *a68_u8_to_u32 (const uint8_t *s, size_t n, uint32_t *resultbuf, size_t *lengthp); + +/* a68-lang.cc */ + +/* Global types. These are built in a68_build_a68_type_nodes and used by the + lowering routines. */ + +#define a68_void_type A68_GLOBAL_TREES[ATI_VOID_TYPE] +#define a68_bool_type A68_GLOBAL_TREES[ATI_BOOL_TYPE] +#define a68_char_type A68_GLOBAL_TREES[ATI_CHAR_TYPE] +#define a68_short_short_bits_type A68_GLOBAL_TREES[ATI_SHORT_SHORT_BITS_TYPE] +#define a68_short_bits_type A68_GLOBAL_TREES[ATI_SHORT_BITS_TYPE] +#define a68_bits_type A68_GLOBAL_TREES[ATI_BITS_TYPE] +#define a68_long_bits_type A68_GLOBAL_TREES[ATI_LONG_BITS_TYPE] +#define a68_long_long_bits_type A68_GLOBAL_TREES[ATI_LONG_LONG_BITS_TYPE] +#define a68_bytes_type A68_GLOBAL_TREES[ATI_BYTES_TYPE] +#define a68_long_bytes_type A68_GLOBAL_TREES[ATI_LONG_BYTES_TYPE] +#define a68_short_short_int_type A68_GLOBAL_TREES[ATI_SHORT_SHORT_INT_TYPE] +#define a68_short_int_type A68_GLOBAL_TREES[ATI_SHORT_INT_TYPE] +#define a68_int_type A68_GLOBAL_TREES[ATI_INT_TYPE] +#define a68_long_int_type A68_GLOBAL_TREES[ATI_LONG_INT_TYPE] +#define a68_long_long_int_type A68_GLOBAL_TREES[ATI_LONG_LONG_INT_TYPE] +#define a68_real_type A68_GLOBAL_TREES[ATI_REAL_TYPE] +#define a68_long_real_type A68_GLOBAL_TREES[ATI_LONG_REAL_TYPE] +#define a68_long_long_real_type A68_GLOBAL_TREES[ATI_LONG_LONG_REAL_TYPE] + +struct lang_type *a68_build_lang_type (MOID_T *moid); +struct lang_decl *a68_build_lang_decl (NODE_T *node); +MOID_T *a68_type_moid (tree type); + +/* a68-diagnostics.cc */ + +void a68_error (NODE_T *p, const char *loc_str, ...); +void a68_error_in_pragmat (NODE_T *p, size_t off, + const char *loc_str, ...); +bool a68_warning (NODE_T *p, int opt, const char *loc_str, ...); +void a68_inform (NODE_T *p, const char *loc_str, ...); +void a68_fatal (NODE_T *p, const char *loc_str, ...); +void a68_scan_error (LINE_T *u, char *v, const char *txt, ...); + +/* a68-parser-scanner.cc */ + +bool a68_lexical_analyser (const char *filename); + +/* a68-parser.cc */ + +int a68_count_operands (NODE_T *p); +int a68_count_formal_bounds (NODE_T *p); +void a68_count_pictures (NODE_T *p, int *k); +bool a68_is_ref_refety_flex (MOID_T *m); +bool a68_is_semicolon_less (NODE_T *p); +bool a68_is_formal_bounds (NODE_T *p); +bool a68_is_unit_terminator (NODE_T *p); +bool a68_is_loop_keyword (NODE_T *p); +bool a68_is_new_lexical_level (NODE_T *p); +bool a68_dont_mark_here (NODE_T *p); +enum a68_attribute a68_get_good_attribute (NODE_T *p); +void a68_parser (const char *filename); +NODE_INFO_T *a68_new_node_info (void); +GINFO_T *a68_new_genie_info (void); +NODE_T *a68_new_node (void); +NODE_T *a68_some_node (const char *t); +TABLE_T *a68_new_symbol_table (TABLE_T *p); +MOID_T *a68_new_moid (void); +PACK_T *a68_new_pack (void); +TAG_T *a68_new_tag (void); +void a68_make_special_mode (MOID_T **, int m); +void a68_make_sub (NODE_T *p, NODE_T *, enum a68_attribute t); +bool a68_whether (NODE_T *, ...); +bool a68_is_one_of (NODE_T *p, ...); +void a68_bufcat (char *dst, const char *src, int len); +void a68_bufcpy (char *dst, const char *src, int len); +char *a68_new_string (const char *t, ...); +const char *a68_attribute_name (enum a68_attribute attr); +location_t a68_get_node_location (NODE_T *p); +location_t a68_get_line_location (LINE_T *line, const char *pos); + +/* a68-parser-top-down.cc */ + +void a68_substitute_brackets (NODE_T *p); +const char *a68_phrase_to_text (NODE_T *p, NODE_T **w); +void a68_top_down_parser (NODE_T *p); + +/* a68-parser-bottom-up.cc */ + +void a68_bottom_up_parser (NODE_T *p); +void a68_bottom_up_error_check (NODE_T *p); +void a68_rearrange_goto_less_jumps (NODE_T *p); +void a68_bottom_up_coalesce_pub (NODE_T *p); + +/* a68-parser-extract.cc */ + +void a68_extract_indicants (NODE_T *p); +void a68_extract_priorities (NODE_T *p); +void a68_extract_operators (NODE_T *p); +void a68_extract_labels (NODE_T *p, int expect); +void a68_extract_declarations (NODE_T *p); +void a68_elaborate_bold_tags (NODE_T *p); + +/* a68-parser-keywords.cc */ + +const char *a68_strop_keyword (const char *keyword); +void a68_set_up_tables (void); +TOKEN_T *a68_add_token (TOKEN_T **p, const char *t); +KEYWORD_T *a68_find_keyword (KEYWORD_T *p, const char *t); +KEYWORD_T *a68_find_keyword_from_attribute (KEYWORD_T *p, enum a68_attribute a); + +/* a68-postulates.cc */ + +void a68_init_postulates (void); +void a68_free_postulate_list (POSTULATE_T *, POSTULATE_T *); +void a68_make_postulate (POSTULATE_T **, MOID_T *, MOID_T *); +POSTULATE_T *a68_is_postulated (POSTULATE_T *, MOID_T *); +POSTULATE_T *a68_is_postulated_pair (POSTULATE_T *, MOID_T *, MOID_T *); + +/* a68-parser-moids-check.cc */ + +void a68_mode_checker (NODE_T *p); + +/* a68-parser-moids-coerce.cc */ + +void a68_coercion_inserter (NODE_T *p); + +/* a68-parser-moids-equivalence.cc */ + +bool a68_prove_moid_equivalence (MOID_T *, MOID_T *); + +/* a68-parser-brackets.cc */ + +void a68_check_parenthesis (NODE_T *top); + +/* a68-parser-prelude.cc */ + +void a68_make_standard_environ (void); + +/* a68-parser-taxes.cc */ + +void a68_set_proc_level (NODE_T *p, int n); +void a68_set_nest (NODE_T *p, NODE_T *s); +int a68_first_tag_global (TABLE_T * table, const char *name); +void a68_collect_taxes (NODE_T *p); +TAG_T *a68_add_tag (TABLE_T *s, int a, NODE_T *n, MOID_T *m, int p); +TAG_T *a68_find_tag_global (TABLE_T *table, int a, const char *name); +int a68_is_identifier_or_label_global (TABLE_T *table, const char *name); +void a68_reset_symbol_table_nest_count (NODE_T *p); +void a68_bind_routine_tags_to_tree (NODE_T *p); +void a68_fill_symbol_table_outer (NODE_T *p, TABLE_T *s); +void a68_finalise_symbol_table_setup (NODE_T *p, int l); +void a68_preliminary_symbol_table_setup (NODE_T *p); +void a68_mark_moids (NODE_T *p); +void a68_mark_auxilliary (NODE_T *p); +void a68_warn_for_unused_tags (NODE_T *p); +void a68_jumps_from_procs (NODE_T *p); + +/* a68-parser-victal.cc */ + +void a68_victal_checker (NODE_T *p); + +/* a68-parser-modes.cc */ + +int a68_count_pack_members (PACK_T *u); +MOID_T *a68_register_extra_mode (MOID_T **z, MOID_T *u); +MOID_T *a68_create_mode (int att, int dim, NODE_T *node, MOID_T *sub, PACK_T *pack); +MOID_T *a68_search_equivalent_mode (MOID_T *m); +MOID_T *a68_add_mode (MOID_T **z, int att, int dim, NODE_T *node, MOID_T *sub, PACK_T *pack); +void a68_contract_union (MOID_T *u); +PACK_T *a68_absorb_union_pack (PACK_T * u); +void a68_add_mode_to_pack (PACK_T **p, MOID_T *m, const char *text, NODE_T *node); +void a68_add_mode_to_pack_end (PACK_T **p, MOID_T *m, const char *text, NODE_T *node); +void a68_make_moid_list (MODULE_T *mod); + +void a68_renumber_moids (MOID_T *p, int n); + +/* a68-moids-to-string.cc */ + +const char *a68_moid_to_string (MOID_T *n, size_t w, NODE_T *idf, + bool indicant_value = false); + +/* a68-moids-misc.cc */ + +bool a68_basic_coercions (MOID_T *p, MOID_T *q, int c, int deflex); +bool a68_clause_allows_balancing (int att); +bool a68_is_balanced (NODE_T *n, SOID_T *y, int sort); +bool a68_is_coercible_in_context (SOID_T *p, SOID_T *q, int deflex); +bool a68_is_coercible (MOID_T *p, MOID_T *q, int c, int deflex); +bool a68_is_coercible_series (MOID_T *p, MOID_T *q, int c, int deflex); +bool a68_is_coercible_stowed (MOID_T *p, MOID_T *q, int c, int deflex); +bool a68_is_deprefable (MOID_T *p); +bool a68_is_equal_modes (MOID_T *p, MOID_T *q, int deflex); +bool a68_is_firmly_coercible (MOID_T *p, MOID_T *q, int deflex); +bool a68_is_firm (MOID_T *p, MOID_T *q); +bool a68_is_meekly_coercible (MOID_T *p, MOID_T *q, int deflex); +bool a68_is_mode_isnt_well (MOID_T *p); +bool a68_is_moid_in_pack (MOID_T *u, PACK_T *v, int deflex); +bool a68_is_name_struct (MOID_T *p); +bool a68_is_nonproc (MOID_T *p); +bool a68_is_printable_mode (MOID_T *p); +bool a68_is_proc_ref_file_void_or_format (MOID_T *p); +bool a68_is_readable_mode (MOID_T *p); +bool a68_is_ref_row (MOID_T *p); +bool a68_is_rows_type (MOID_T *p); +bool a68_is_softly_coercible (MOID_T *p, MOID_T *q, int deflex); +bool a68_is_strongly_coercible (MOID_T *p, MOID_T *q, int deflex); +bool a68_is_strong_name (MOID_T *p, MOID_T *q); +bool a68_is_strong_slice (MOID_T *p, MOID_T *q); +bool a68_is_subset (MOID_T *p, MOID_T *q, int deflex); +bool a68_is_transput_mode (MOID_T *p, char rw); +bool a68_is_unitable (MOID_T *p, MOID_T *q, int deflex); +bool a68_is_weakly_coercible (MOID_T * p, MOID_T * q, int deflex); +bool a68_is_widenable (MOID_T *p, MOID_T *q); +MOID_T *a68_absorb_related_subsets (MOID_T *m); +MOID_T *a68_depref_completely (MOID_T *p); +MOID_T *a68_depref_once (MOID_T *p); +MOID_T *a68_depref_rows (MOID_T *p, MOID_T *q); +MOID_T *a68_deproc_completely (MOID_T *p); +MOID_T *a68_derow (MOID_T *p); +MOID_T *a68_determine_unique_mode (SOID_T *z, int deflex); +MOID_T *a68_get_balanced_mode (MOID_T *m, int sort, bool return_depreffed, int deflex); +MOID_T *a68_get_balanced_mode_or_no_mode (MOID_T *m, int sort, bool return_depreffed, int deflex); +MOID_T *a68_make_series_from_moids (MOID_T *u, MOID_T *v); +MOID_T *a68_make_united_mode (MOID_T *m); +MOID_T *a68_pack_soids_in_moid (SOID_T *top_sl, int attribute); +MOID_T *a68_unites_to (MOID_T *m, MOID_T *u); +void a68_absorb_series_pack (MOID_T **p); +void a68_absorb_series_union_pack (MOID_T **p); +void a68_add_to_soid_list (SOID_T **root, NODE_T *where, SOID_T *soid); +void a68_free_soid_list (SOID_T *root); +void a68_investigate_firm_relations (PACK_T *u, PACK_T *v, bool *all, bool *some); +void a68_make_coercion (NODE_T *l, enum a68_attribute a, MOID_T *m); +void a68_make_depreffing_coercion (NODE_T *n, MOID_T *p, MOID_T *q); +void a68_make_ref_rowing_coercion (NODE_T *n, MOID_T *p, MOID_T *q); +void a68_make_rowing_coercion (NODE_T *n, MOID_T *p, MOID_T *q); +void a68_make_soid (SOID_T *s, int sort, MOID_T *type, int attribute); +void a68_make_strong (NODE_T *n, MOID_T *p, MOID_T *q); +void a68_make_uniting_coercion (NODE_T *n, MOID_T *q); +void a68_make_void (NODE_T *p, MOID_T *q); + +#define A68_DEPREF true +#define A68_NO_DEPREF false + +#define A68_IF_MODE_IS_WELL(n) (! ((n) == M_ERROR || (n) == M_UNDEFINED)) + +/* a68-parser-scope.cc */ + +void a68_scope_checker (NODE_T *p); + +/* a68-parser-serial-dsa.cc */ + +void a68_serial_dsa (NODE_T *p); + +/* a68-parser-pragmat.cc */ + +void a68_handle_pragmats (NODE_T *p); + +/* a68-moids-diagnostics.cc */ + +const char *a68_mode_error_text (NODE_T *n, MOID_T *p, MOID_T *q, int context, int deflex, int depth); +void a68_cannot_coerce (NODE_T *p, MOID_T *from, MOID_T *to, int context, int deflex, int att); +void a68_warn_for_voiding (NODE_T *p, SOID_T *x, SOID_T *y, int c); +void a68_semantic_pitfall (NODE_T *p, MOID_T *m, int c, int u); + +/* a68-low-misc.cc */ + +tree a68_lower_assertion (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_jump (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_parameter (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_parameter_list (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_parameter_pack (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_operator (NODE_T *p, LOW_CTX_T ctx); + +/* a68-low-moids.cc */ + +void a68_lower_moids (MOID_T *m); +void a68_set_type_moid (tree type, MOID_T *m); +tree a68_row_elements_pointer_type (tree type); +tree a68_row_elements_type (tree type); +tree a68_triplet_type (void); + +/* a68-low-bits.cc */ + +tree a68_get_bits_skip_tree (MOID_T *m); +tree a68_bits_width (tree type); +tree a68_bits_maxbits (tree type); +tree a68_bits_bin (MOID_T *m, tree val); +tree a68_bits_abs (MOID_T *m, tree bits); +tree a68_bits_leng (tree type, tree bits); +tree a68_bits_shorten (tree type, tree bits); +tree a68_bits_not (tree bits); +tree a68_bits_and (tree bits1, tree bits2); +tree a68_bits_ior (tree bits1, tree bits2); +tree a68_bits_xor (tree bits1, tree bits2); +tree a68_bits_elem (NODE_T *p, tree pos, tree bits); +tree a68_bits_subset (tree bits1, tree bits2); +tree a68_bits_shift (tree shift, tree bits); +tree a68_bits_eq (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_bits_ne (tree a, tree b, location_t loc = UNKNOWN_LOCATION); + +/* a68-low_bools.cc */ + +tree a68_get_bool_skip_tree (void); +tree a68_bool_abs (tree val); +tree a68_bool_eq (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_bool_ne (tree a, tree b, location_t loc = UNKNOWN_LOCATION); + +/* a68-low-ints.cc */ + +tree a68_get_int_skip_tree (MOID_T *m); +tree a68_int_maxval (tree type); +tree a68_int_minval (tree type); +tree a68_int_width (tree type); +tree a68_int_sign (tree val); +tree a68_int_abs (tree val); +tree a68_int_shorten (MOID_T *to_mode, MOID_T *from_mode, tree val); +tree a68_int_leng (MOID_T *to_mode, MOID_T *from_mode, tree val); + +tree a68_int_plus (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_int_minus (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_int_mult (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_int_div (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_int_mod (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_int_pow (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_int_eq (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_int_ne (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_int_lt (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_int_le (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_int_gt (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_int_ge (tree a, tree b, location_t loc = UNKNOWN_LOCATION); + +/* a68-low-complex.cc */ + +tree a68_complex_i (MOID_T *mode, tree re, tree im); +tree a68_complex_re (tree z); +tree a68_complex_im (tree z); +tree a68_complex_conj (MOID_T *mode, tree z); +tree a68_complex_widen_from_real (MOID_T *mode, tree r); + +/* a68-low-posix.cc */ + +tree a68_posix_setexitstatus (void); +tree a68_posix_argc (void); +tree a68_posix_argv (void); +tree a68_posix_getenv (void); +tree a68_posix_putchar (void); +tree a68_posix_puts (void); +tree a68_posix_fconnect (void); +tree a68_posix_fcreate (void); +tree a68_posix_fopen (void); +tree a68_posix_fclose (void); +tree a68_posix_fsize (void); +tree a68_posix_lseek (void); +tree a68_posix_errno (void); +tree a68_posix_perror (void); +tree a68_posix_strerror (void); +tree a68_posix_getchar (void); +tree a68_posix_fgetc (void); +tree a68_posix_fputc (void); +tree a68_posix_fputs (void); +tree a68_posix_gets (void); +tree a68_posix_fgets (void); + +/* a68-low-reals.cc */ + +tree a68_get_real_skip_tree (MOID_T *m); +tree a68_real_pi (tree type); +tree a68_real_maxval (tree type); +tree a68_real_minval (tree type); +tree a68_real_smallval (tree type); +tree a68_real_width (tree type); +tree a68_real_exp_width (tree type); +tree a68_real_sign (tree val); +tree a68_real_abs (tree val); +tree a68_real_sqrt (tree val); +tree a68_real_tan (tree type); +tree a68_real_sin (tree type); +tree a68_real_cos (tree type); +tree a68_real_acos (tree type); +tree a68_real_asin (tree type); +tree a68_real_atan (tree type); +tree a68_real_ln (tree type); +tree a68_real_log (tree type); +tree a68_real_exp (tree type); +tree a68_real_shorten (MOID_T *to_mode, MOID_T *from_mode, tree val); +tree a68_real_leng (MOID_T *to_mode, MOID_T *from_mode, tree val); +tree a68_real_entier (tree val, MOID_T *to_mode, MOID_T *from_mode); +tree a68_real_round (tree val, MOID_T *to_mode, MOID_T *from_mode); + +tree a68_real_plus (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_real_minus (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_real_mult (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_real_div (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_real_mod (MOID_T *m, tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_real_pow (MOID_T *m, MOID_T *a_mode, MOID_T *b_mode, + tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_real_eq (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_real_ne (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_real_lt (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_real_le (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_real_gt (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_real_ge (tree a, tree b, location_t loc = UNKNOWN_LOCATION); + + +/* a68-low-strings.cc */ + +tree a68_get_string_skip_tree (void); +tree a68_string_concat (tree str1, tree str2); +tree a68_string_mult (tree str1, tree str2); +tree a68_string_from_char (tree c); +tree a68_string_cmp (tree s1, tree s2); +char *a68_string_process_breaks (NODE_T *p, const char *str); + +/* a68-low-chars.cc */ + +tree a68_get_char_skip_tree (void); +tree a68_char_max (void); +tree a68_char_repr (NODE_T *p, tree val); +tree a68_char_abs (tree val); +tree a68_char_eq (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_char_ne (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_char_lt (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_char_le (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_char_gt (tree a, tree b, location_t loc = UNKNOWN_LOCATION); +tree a68_char_ge (tree a, tree b, location_t loc = UNKNOWN_LOCATION); + +/* a68-low-refs.cc */ + +tree a68_get_ref_skip_tree (MOID_T *m); + +/* a68-low-procs.cc */ + +tree a68_get_proc_skip_tree (MOID_T *m); + +/* a68-low-structs.cc */ + +tree a68_get_struct_skip_tree (MOID_T *m); + +/* a68-low-multiples.cc */ + +tree a68_get_multiple_skip_tree (MOID_T *m); +tree a68_multiple_dimensions (tree exp); +tree a68_multiple_num_elems (tree exp); +tree a68_multiple_lower_bound (tree exp, tree dim); +tree a68_multiple_upper_bound (tree exp, tree dim); +tree a68_multiple_stride (tree exp, tree dim); +tree a68_multiple_triplets (tree exp); +tree a68_multiple_elements (tree exp); +tree a68_multiple_elements_size (tree exp); +tree a68_multiple_set_elements (tree exp, tree elements); +tree a68_multiple_set_elements_size (tree exp, tree elements_size); +void a68_multiple_compute_strides (tree type, size_t dim, + tree *lower_bounds, tree *upper_bounds, + tree *strides); +tree a68_multiple_set_lower_bound (tree exp, tree dim, tree bound); +tree a68_multiple_set_upper_bound (tree exp, tree dim, tree bound); +tree a68_multiple_set_stride (tree exp, tree dim, tree stride); +tree a68_row_value (tree type, size_t dim, + tree elements, tree elements_size, + tree *lower_bound, tree *upper_bound); +tree a68_row_value_raw (tree type, tree descriptor, + tree elements, tree elements_size); +tree a68_row_malloc (tree type, int dim, + tree elements, tree elements_size, + tree *lower_bound, tree *upper_bound); +tree a68_multiple_slice (NODE_T *p, tree multiple, bool slicing_name, + int num_indexes, tree *indexes); +tree a68_multiple_copy_elems (MOID_T *to_mode, tree to, tree from); +tree a68_rows_dim (tree exp); +tree a68_rows_value (tree multiple); +tree a68_rows_lower_bound (tree rows, tree dim); +tree a68_rows_upper_bound (tree rows, tree dim); +tree a68_rows_dim_check (NODE_T *p, tree rows, tree dim); +tree a68_multiple_dim_check (NODE_T *p, tree multiple, tree dim); +tree a68_multiple_single_bound_check (NODE_T *p, tree dim, tree multiple, + tree index, bool upper_bound); +tree a68_multiple_bounds_check (NODE_T *p, tree dim, tree multiple, + tree index); +tree a68_multiple_bounds_check_equal (NODE_T *p, tree m1, tree m2); + +/* a68-low-ranges.cc */ + +bool a68_in_global_range (void); +void a68_init_ranges (void); +void a68_push_range (MOID_T *mode); +tree a68_pop_range (void); +tree a68_pop_range_with_finalizer (tree *finalizer); +void a68_push_stmt_list (MOID_T *mode); +tree a68_pop_stmt_list (void); +void a68_push_function_range (tree fndel, tree result_type, + bool top_level = false); +void a68_pop_function_range (tree body); +void a68_push_serial_clause_range (MOID_T *clause_mode, + bool save_restore_stack = false); +tree a68_pop_serial_clause_range (void); +void a68_add_stmt (tree exp); +void a68_add_decl (tree decl); +void a68_add_decl_expr (tree decl_expr); +void a68_add_completer (void); +tree a68_range_context (void); +tree a68_range_names (void); +tree a68_range_stmt_list (void); + +/* a68-low-runtime.cc */ + +enum a68_libcall_fn +{ +#define DEF_A68_RUNTIME(CODE, N, T, P, F) A68_LIBCALL_ ## CODE, +#include "a68-low-runtime.def" +#undef DEF_A68_RUNTIME + A68_LIBCALL_LAST +}; + +tree a68_get_libcall (a68_libcall_fn libcall); +tree a68_build_libcall (a68_libcall_fn libcall, tree type, int nargs, ...); + +/* a68-low-clauses.cc */ + +void a68_begin_serial_clause (LOW_CTX_T *ctx, MOID_T *clause_mode); +tree a68_finish_serial_clause (LOW_CTX_T ctx, MOID_T *clause_mode, tree parent_block); +tree a68_lower_label (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_labeled_unit (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_completer (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_initialiser_series (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_serial_clause (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_loop_clause (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_conformity_clause (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_case_clause (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_enquiry_clause (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_conditional_clause (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_unit_list (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_access_clause (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_collateral_clause (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_parallel_clause (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_closed_clause (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_enclosed_clause (NODE_T *p, LOW_CTX_T ctx); + +/* a68-low-coercions.cc */ + +tree a68_lower_dereferencing (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_rowing (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_widening (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_deproceduring (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_proceduring (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_voiding (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_uniting (NODE_T *p, LOW_CTX_T ctx); + +/* a68-low-decls.cc */ + +tree a68_lower_mode_declaration (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_variable_declaration (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_identity_declaration (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_procedure_declaration (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_procedure_variable_declaration (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_declarer (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_declaration_list (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_priority_declaration (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_brief_operator_declaration (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_operator_declaration (NODE_T *p, LOW_CTX_T ctx); + +/* a68-low.cc */ + +tree a68_lower_top_tree (NODE_T *p); +tree a68_lower_tree (NODE_T *p, LOW_CTX_T ctx); +tree a68_make_identity_declaration_decl (NODE_T *identifier, const char *module_name = NULL, + bool indicant = false, bool external = false, + const char *extern_symbol = NULL); +tree a68_make_variable_declaration_decl (NODE_T *identifier, const char *module_name = NULL, + bool external = false, + const char *extern_symbol = NULL); +tree a68_make_proc_identity_declaration_decl (NODE_T *identifier, const char *module_name = NULL, + bool indicant = false, bool external = false, + const char *extern_symbol = NULL); +tree a68_make_anonymous_routine_decl (MOID_T *mode); +tree a68_get_skip_tree (MOID_T *m); +tree a68_get_empty (void); +void a68_ref_counts (tree exp, MOID_T *m, int *num_refs, int *num_pointers); +tree a68_consolidate_ref (MOID_T *m, tree expr); +tree a68_lower_alloca (tree type, tree size); +tree a68_lower_malloc (tree type, tree size); +tree a68_checked_indirect_ref (NODE_T *p, tree exp, MOID_T *exp_mode); +tree a68_low_deref (tree exp, NODE_T *p); +tree a68_low_dup (tree exp, bool use_heap = false); +tree a68_low_ascription (MOID_T *mode, tree lhs, tree rhs); +tree a68_low_assignation (NODE_T *p, tree lhs, MOID_T *lhs_mode, tree rhs, MOID_T *rhs_mode); +tree a68_lower_memcpy (tree dst, tree src, tree size); +tree a68_lower_tmpvar (const char *name, tree type, tree init); +tree a68_get_mangled_identifier (const char *name, + const char *mname = NULL, bool internal = false, + bool numbered = false); +tree a68_get_mangled_indicant (const char *name, + const char *mname = NULL, bool internal = false, + bool numbered = false); +char *a68_demangle_symbol (const char *mname, const char *symbol, + bool is_operator = false); +tree a68_low_toplevel_func_decl (const char *name, tree fntype); +tree a68_low_func_param (tree fndecl, const char *name, tree type); + +/* a68-low-builtins.cc */ + +void a68_install_builtins (); + +/* a68-low-unions.c */ + +int a68_united_mode_index (MOID_T *p, MOID_T *q); +tree a68_get_union_skip_tree (MOID_T *m); +tree a68_union_overhead (tree exp); +tree a68_union_set_overhead (tree exp, tree overhead); +tree a68_union_cunion (tree exp); +tree a68_union_alternative (tree exp, int index); +tree a68_union_value (MOID_T *mode, tree exp, MOID_T *exp_mode); +tree a68_union_translate_overhead (MOID_T *from, tree from_overhead, MOID_T *to); +bool a68_union_contains_mode (MOID_T *p, MOID_T *q); + +/* a68-low-units.cc */ + +tree a68_lower_identifier (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_denotation (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_string_denotation (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_skip (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_nihil (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_empty (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_identity_relation (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_logic_function (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_primary (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_cast (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_secondary (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_slice (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_selection (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_formula (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_monadic_formula (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_tertiary (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_assignation (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_routine_text (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_generator (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_call (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_unit (NODE_T *p, LOW_CTX_T ctx); + +/* a68-low-generator.c */ + +tree a68_low_generator (NODE_T *declarer, MOID_T *mode, + bool heap, LOW_CTX_T ctx); +tree a68_low_gen (MOID_T *m, size_t nbuonds, tree *bounds, + bool use_heap); + +/* a68-low-prelude.c */ + +tree a68_lower_unimplemented (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_assert (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_intabs2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_realabs2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_boolabs2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_charabs2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_not2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_and3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_or3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_xor3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_confirm2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_negate2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_sign2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_realsign2 (NODE_T *p, LOW_CTX_T ctx); + +tree a68_lower_plus_int (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_plus_real (NODE_T *p, LOW_CTX_T ctx); + +tree a68_lower_minus_int (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_minus_real (NODE_T *p, LOW_CTX_T ctx); + +tree a68_lower_mult_int (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_mult_real (NODE_T *p, LOW_CTX_T ctx); + +tree a68_lower_multab3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_div3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_divab3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_rdiv3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_over3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_mod3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_int_eq3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_int_ne3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_int_lt3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_int_le3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_int_gt3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_int_ge3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_real_eq3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_real_ne3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_real_lt3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_real_le3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_real_gt3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_real_ge3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_char_eq3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_char_ne3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_char_lt3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_char_le3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_char_gt3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_char_ge3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bool_eq3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bool_ne3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_plusab3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_minusab3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_overab3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_modab3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_upb2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_upb3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_lwb2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_lwb3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_elems2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_elems3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_entier2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_round2 (NODE_T *p, LOW_CTX_T ctx); + +tree a68_lower_pow_int (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_pow_real (NODE_T *p, LOW_CTX_T ctx); + +tree a68_lower_odd2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_string_eq3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_string_ne3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_string_lt3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_string_le3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_string_gt3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_string_ge3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_string_plus3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_char_plus3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_string_plusab3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_string_mult3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_char_mult3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_string_multab3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_string_plusto3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_repr2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bitelem3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bin2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bitabs2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bitleng2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bitshorten2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bit_eq3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bit_ne3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bitnot2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bitand3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bitior3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bitxor3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_shl3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_shr3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bit_eq3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bit_ne3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bit_le3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bit_ge3 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_maxint (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_minint (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_maxbits (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_maxreal (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_minreal (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_smallreal (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bitswidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_longbitswidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_longlongbitswidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_shortbitswidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_shortshortbitswidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_intwidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_longintwidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_longlongintwidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_shortintwidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_shortshortintwidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_realwidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_longrealwidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_longlongrealwidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_expwidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_longexpwidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_longlongexpwidth (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_pi (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_nullcharacter (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_flip (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_flop (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_errorchar (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_blank (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_eofchar (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_replacementchar (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_intlengths (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_intshorths (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bitslengths (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_bitsshorths (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_reallengths (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_realshorths (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_infinity (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_minusinfinity (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_maxabschar (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_sqrt (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_sqrt (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_long_sqrt (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_tan (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_tan (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_long_tan (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_sin (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_sin (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_long_sin (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_cos (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_cos (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_long_cos (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_acos (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_acos (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_long_acos (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_asin (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_asin (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_long_asin (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_atan (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_atan (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_long_atan (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_ln (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_ln (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_long_ln (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_log (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_log (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_long_log (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_exp (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_exp (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_long_long_exp (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_reali (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_longreali (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_longlongreali (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_inti (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_longinti (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_longlonginti (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_re2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_im2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_conj2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_shortenint2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_lengint2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_lengreal2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_shortenreal2 (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_random (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_longrandom (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_longlongrandom (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_setexitstatus (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixargc (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixargv (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixputchar (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixputs (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixfputc (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixfputs (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixgetenv (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixfconnect (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixfopen (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixfcreate (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixfclose (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixfsize (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixlseek (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixseekcur (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixseekend (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixseekset (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixstdinfiledes (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixstdoutfiledes (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixstderrfiledes (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixfileodefault (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixfileordwr (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixfileordonly (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixfileowronly (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixfileotrunc (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixerrno (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixperror (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixstrerror (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixgetchar (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixfgetc (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixgets (NODE_T *p, LOW_CTX_T ctx); +tree a68_lower_posixfgets (NODE_T *p, LOW_CTX_T ctx); + +/* a68-exports.cc */ + +MOIF_T *a68_moif_new (const char *module_name); +void a68_moif_free (MOIF_T *moif); +void a68_do_exports (NODE_T *p); + +/* a68-imports.cc */ + +MOIF_T *a68_open_packet (const char *module); + +/* a68-parser-debug.cc */ + +void a68_dump_parse_tree (NODE_T *p, bool tables = false, bool levels = false); +void a68_dump_modes (MOID_T *m); +void a68_dump_moif (MOIF_T *moif); + +#endif /* ! __A68_H__ */ diff --git a/gcc/algol68/ga68.vw b/gcc/algol68/ga68.vw new file mode 100644 index 000000000000..54511c927fbe --- /dev/null +++ b/gcc/algol68/ga68.vw @@ -0,0 +1,1845 @@ +{ ga68.vw - The GNU Algol 68 strict language -*- vw -*- + + Copyright (C) 2025 Jose E. Marchesi + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + General Public License for more details. } + +{ This file contains an annotated description of the syntax of the GNU + Algol 68 strict language. GNU Algol 68 aims to be a super-language + of Algol 68. + + Extension to the strict Revised Report incorporated into GNU Algol + 68 are: + + [US] This is the GNU68-2025-001-unsafe GNU extension. It adds an + unsafe clause that marks a controlled clause as containing + unsafe constructs which are known by the programmer, and makes + the compiler to avoid certain diagnostics. See the GNU Algol + 68 Compiler manual for more information. + + [SC] This is the GNU68-2025-003-andth-orel GNU extension. It adds + two units that act as pseudo-operators providing logical AND + and OR functions with short-circuited elaboration. See the GNU + Algol 68 Compiler manual for more information. + + [MR] A modules and separated compilation system based on the modules + system recomended by IFIP Working Group 2.1 Standing + Subcommittee on Algol 68 Support, described in: + + A Modules and Separate Compilation Facility for Algol 68 by + Lindsey and Boom. + + [NC] This is the GNU68-2025-005-nestable-comments GNU extension. It + adds support for nestable block comments. + + The metaproduction rules, hyper-rules and hyper-alternatives + introduced by each extension are clearly marked in the sections + below. You can easily search for them using the extensions tags in + the list above. For example, to look for the extensions introduced + by the modules and separated compilation system, search for [MR]. + + The few deviations to the RR Algol 68 are clearly marked as well in + this specification. + + A complete description of the semantics of the Algol 68 subset of + the described language and the extensions is not included in this + file. The reader is referred to the Revised Report and other + documentation corresponding to the extensions, like the GNU Algol 68 + compiler manual. + + The sectioning and the enumeration of metaproduction rules and of + hyper-rules, including cross-references, are the same than in the + Report. The annotations and pragmatics added between curly brackets + explain the meaning of the rules and how they describe the syntax of + the language. Note that thanks to the expressive power of VW + grammars the syntax expressed by this description covers much more + than what is usually expressed by context-free grammars in the + descriptions of other languages that typically use some variant of + the BNF notation. + + Sample code in examples and pragmatics is expressed using the UPPER + stropping regime. + + This file is better browsed using the Emacs vw-mode, which provides + automatic indentation, font-lock, and other facilities like the + hiding of annotations an the following of cross-references. See the + vw-mode manual for more information, including a primer on VW + grammars and the formal description used in both the original Report + and this file. } + +1 Language and metalanguage + +1.2 General metaproduction rules + +1.2.1 Metaproduction rules of modes + +A) MODE :: PLAIN ; STOWED ; REF to MODE ; PROCEDURE ; + UNITED ; MU definition of MODE ; MU application. +B) PLAIN :: INTREAL ; boolean ; character. +C) INTREAL :: SIZETY integral ; SIZETY real. +D) SIZETY :: long LONGSETY ; short SHORTSETY ; EMPTY. +E) LONGSETY :: long LONGSETY ; EMPTY. +F) SHORTSETY :: short SHORTSETY ; EMPTY. +G) EMPTY :: . +H) STOWED :: structured with FIELDS mode ; + FLEXETY ROWS of MODE. +I) FIELDS :: FIELD ; FIELDS FIELD. +J) FIELD :: MODE field TAG{942A}. +K) FLEXETY :: flexible ; EMPTY. +L) ROWS :: row ; ROWS row. +M) REF :: reference ; transient reference. +N) PROCEDURE :: procedure PARAMETY yielding MOID. +O) PARAMETY :: with PARAMETERS ; EMPTY. +P) PARAMETERS :: PARAMETER ; PARAMETERS PARAMETER. +Q) PARAMETER :: MODE parameter. +R) MOID :: MODE ; void. +S) UNITED :: union of MOODS mode. +T) MOODS :: MOOD ; MOODS MOOD. +U) MOOD :: PLAIN ; STOWED ; reference to MODE ; PROCEDURE ; void. +V) MU :: muTALLY. +W) TALLY :: i ; TALLY i. + +1.2.2 Metaproduction rules associated with phrases and coercion + +{ Extensions: + [MR] access + [US] unsafe } + +A) ENCLOSED :: closed ; collateral ; parallel ; CHOICE{34A} ; + loop ; access ; unsafe. +B) SOME :: SORT MOID NEST. +C) SORT :: strong ; firm ; meek ; weak ; soft. + +{ Modules are activated by means of access-clauses. } + +1.2.3 Metaproduction rules associated with nests + +{ Extensions: + [MR] MODSETY, MOD, MODS, REVSETY, REVS, REV, + TAU, INKSETY, INKS, INK } + +A) NEST :: LAYER ; NEST LAYER. +B) LAYER :: new DECSETY LABSETY INKSETY. +C) DECSETY :: DECS ; EMPTY. +D) DECS :: DEC ; DECS DEC. +E) DEC :: MODE TAG{942A} ; priority PRIO TAD{942F} ; + MOID TALLY TAB{942D} ; DUO TAD{942F} MONO TAM{492K} ; + MOD. +F) PRIO :: i ; ii ; iii ; + iii i ; iii ii ; iii iii ; + iii iii i ; iii iii ii ; iii iii iii. +G) MONO :: procedure with PARAMETER yielding MOID. +H) DUO :: procedure with PARAMETER1 PARAMETER2 yielding MOID. +I) LABSETY :: LABS ; EMPTY. +J) LABS :: LAB ; LABS LAB. +K) LAB :: label TAG{942A}. +L) MODSETY :: MODS ; EMPTY. +M) MODS :: MOD ; MODS MOD. +N) MOD :: module REVS TAB. +O) REVSETY :: REVS ; EMPTY. +P) REVS :: REV ; REVS REV. +Q) REV :: TAU reveals DECSETY INKS. +R) TAU :: MU. +S) INKSETY :: INKS ; EMPTY. +T) INKS :: INK ; INKS INK. +U) INK :: invoked TAU. + +{ The primal environment is just 'new'. } + +1.3 General hyper-rules + +1.3.1 Syntax of general predicates + +A) NOTION :: ALPHA ; NOTION ALPHA. +B) ALPHA :: a ; b ; c ; d ; e ; f ; g ; h ; i ; j; + k ; l ; m ; n ; o ; p ; q ; r ; s ; t; + u ; v ; w ; x ; y ; z. +C) NOTETY :: NOTION ; EMPTY. +D) THING :: NOTION ; + (NOTETY1) NOTETY2 ; + THING (NOTETY1) NOTETY2. +E) WHETHER :: where ; unless. + +a) where true : EMPTY. +b) unless false : EMPTY. +c) where THING1 and THING2 : where THING1, where THING2. +d) where THING1 or THING2 : where THING1 ; where THING2. +e) unless THING1 and THING2 : unless THING1; unless THING2. +f) unless THING1 or THING2 : unless THING1, unless THING2. +g) WHETHER (NOTETY1) is (NOTETY2) : + WHETHER (NOTETY1) begins with (NOTETY2){h,i,j} + and (NOTETY2) begins with (NOTETY1){h,i,j}. +h) WHETHER (EMPTY) begins with (NOTION){g,j} : + WHETHER false{b,-}. +i) WHETHER (NOTETY1) begins with (EMPTY){g,j} : + WHETHER true{a,-}. +j) WHETHER (ALPHA1 NOTETY1) begins with + (ALPHA2 NOTETY2){g,j,m} : + WHETHER (ALPHA1) coincides with (ALPHA2) in + (abcdefghijklmnopqrstuvwxyz){k,l,-} + and (NOTETY1) begins with (NOTETY2){h,i,j}. +k) where (ALPHA) coincides with (ALPHA) in (NOTION){j} : + where true{a}. +l) unless (ALPHA1) coincides with (ALPHA2) in (NOTION){j} : + where (NOTION) contains (ALPHA1 NOTETY ALPHA2){m} + or (NOTION) contains (ALPHA2 NOTETY ALPHA1){m}. +m) WHETHER (ALPHA NOTETY) contains (NOTION){l,m} : + WHETHER (ALPHA NOTETY) begins with (NOTION){j} + or (NOTETY) contains (NOTION){m,n}. +n) WHETHER (EMPTY) contains (NOTION){m} : WHETHER false{b,-}. + +1.3.3 Syntax of general constructions + +A) STYLE :: brief ; bold ; style TALLY. + +a) NOTION option : NOTION ; EMPTY. +b) NOTION sequence{b} : NOTION ; NOTION, NOTION sequence{b}. +c) NOTION list{c} : + NOTION ; NOTION, and also{94f} token, NOTION list{c}. +d) NOTETY STYLE pack : + STYLE begin{94f,-} token, NOTETY, STYLE end{94f,-} token. +e) NOTION STYLE bracket : + STYLE sub{94f,-} token, NOTION, STYLE bus{94f,-} token. +f) THING1 or alternatively THING2 : THING1 ; THING2. + +2 The computer and the program + +2.2 The program + +2.2.1 Syntax + +a) program : program token, strong integral new closed clause{31a}. + +{ The value yielded by the elaboration of the program is the exit + status returned by the process to the operating system upon + termination. This is a slight deviation from the Report, which + instead specifies: + + a) program : strong void new closed clause. + + and mandates that the production tree of a particular program should + be akin to the production of the program in the strict language. } + +3 Clauses + +3.0.1 Syntax + +{ Extensions: + [MR] "NEST module text publishing REVS defining LAYER", + "NEST LAYER1 LAYER2 module series with DECSETY + without DECSETY", + "SOID NEST access clause" } + +a) *phrase : SOME unit{32d} ; NEST declaration of DECS{41a}. +b) *SORT MODE expression : SORT MODE NEST UNIT{5A}. +c) *statement : strong void NEST UNIT{5A}. +d) *MOID constant : MOID NEST DEFIED identifier with TAG{48a,b} ; + MOID NEST denoter{80a}. +e) *MODE variable : + reference to MODE NEST DEFIED identifier with TAG{48a,b}. +f) *NEST range : + SOID NEST serial clause defining LAYER{32a} ; + SOID NEST chooser CHOICE STYLE clause{34b} ; + SOID NEST case part of choice using UNITED{34i} ; + NEST STYLE repeating part with DEC{35e} ; + NEST STYLE while do part{35f} ; + PROCEDURE NEST routine text{541a,b} ; + NEST module text publishing REVS defining LAYER{49c,-} ; + NEST LAYER1 LAYER2 module series + with DECSETY without DECSETY1{49d} ; + SOID NEST access clause{36a}. + +{ The rules b and c establish a precise definition of "expressions" + and "statements". The former are units yielding values of a mode + other than VOID in any context. The later are units in a strong + context with a-posteriori mode of VOID, that get voided. } + +{ The rules d and e establish a precise definition of "constants" and + "variables". The former are either a denotation or an identifier of + some mode. The second are identifiers of a "reference to" mode. } + +{ The rule f introduces a paranotion for all the constructs that + introduce new ranges. } + +3.1 Closed clauses + +3.1.1 Syntax + +A) SOID :: SORT MOID. +B) PACK :: STYLE pack. + +a) SOID NEST closed clause{22a,5D,551a,A341h,A349a} : + SOID NEST serial clause defining LAYER{32a} PACK. + +{ Examples: + a) BEGIN x := 1; y := 2 END } + +3.2 Serial clauses + +3.2.1 Syntax + +{ Extensions: + [MR] "establishing clause" } + +a) SOID NEST serial clause defining new PROPSETY{31a,34f,1,35h} : + SOID NEST new PROPSETY series with PROPSETY{b}. +b) SOID NEST series with PROPSETY{a,b,35c} : + strong void NEST unit{d}, go on{94f} token, + SOID NEST series with PROPSETY{b} ; + where (PROPSETY) is (DECS DECSETY LABSETY), + NEST declaration of DECS{41a}, go on{94f} token, + SOID NEST series with DECSETY LABSETY{b} ; + where (PROPSETY) is (LAB LABSETY), + NEST label definition of LAB{c}, + SOID NEST series with LABSETY{b} ; + where (PROPSETY) is (LAB LABSETY) + and SOID balances SOID1 and SOID2{3}, SOID1 NEST unit{d}, + completion{94f} token, NEST label definition of LAB{c}, + SOID2 NEST series with LABSETY{b} ; + where (PROPSETY) is (EMPTY), + SOID NEST unit{d}. +c) NEST label definition of label TAG{b} : + label NEST defining identifier with TAG{48a}, label{94f} token. +d) SOME unit{b,33b,g,34i,35d,46m,n,521c,532e,541a,b,543c,A34Ab,c,d} : + SOME UNIT{5A,-}. +e) WHETHER SORT MOID balances + SORT1 MOID1 an SORT2 MOID2{b,33b,34d,h} : + WHETHER SORT balances SORT1 and SORT2{f} + and MOID balances MOID1 and MOID2{g}. +f) WHETHER SORT balances SORT1 and SORT2{e,522a} : + where (SORT1) is (strong), WHETHER (SORT2) is (SORT) ; + where (SORT2) is (strong), WHETHER (SORT1) is (SORT). +g) WHETHER MOID balances MOID1 and MOID2{3} : + where (MOID1) is (MOID2), WHETHER (MOID) is (MOID1) ; + where (MOID1) is (transient MOID2), + WHETHER (MOID) is (MOID1) ; + where (MOID2) is (transient MOID1), + WHETHER (MOID) is (MOID2). + +h) *SOID unitary clause : SOID NEST unit{d}. +i) *establishing clause : + SOID NEST serial clause defining LAYER{32a} ; + MODE NEST enquiry clause defining LAYER{34c}. + +{ The paranotion establishing-clause encompasses both module-texts and + revelations. } + +{ Examples: + b) read (x1); REAL s:= 0; + sum: FOR i TO n DO (x1[i] > 0 | s :+= x1[i] | nonpos) OD EXIT + nonpos: print (s) + + REAL s := 0; + sum: FOR i TO n DO (x1[i] > 0 | s :+= x1[i] | nonpos) OD EXIT + nonpos: print (s) + + sum: FOR i TO n DO (x1[i] > 0 | s :+= x1[i] | nonpos) OD EXIT + nonpos: print (s) + + FOR i TO n DO (x1[i] > 0 | s :+= x1[i] | nonpos) OD EXIT + nonpos: print (s) + c) sum: + d) print (s) } + +3.3 Collateral and parallel clauses + +3.3.1 Syntax + +a) strong void NEST collateral clause{5D,551a} : + strong void NEST joined portrait{b} PACK. +b) SOID NEST joined portrait{a,b,c,d,34g} : + were SOID balances SOID1 and SOID2{32e}, + SOID1 NEST unit{32d}, and also{94f} token, + SOID2 NEST unit{32d} + or alternatively SOID2 NEST joined portrait{b}. +c) strong void NEST parallel clause{5D,551a} : + parallel{94f} token, strong void NEST joined portrait{b} PACK. +d) strong ROWS of MODE NEST collateral clause{5D,551a} : + where (ROWS) is (row), + strong MODE NEST joined portrait{b} PACK ; + where (ROWS) is (row ROWS1), + strong ROWS1 of MODE NEST joined portrait{b} PACK ; + EMPTY PACK. +e) strong structured with + FIELDS FIELD mode NEST collateral clause{5D,551a} : + NEST FIELDS FIELD portrait{f} PACK. +f) NEST FIELDS FIELD portrait{3,f} : + NEST FIELDS portrait{f,g}, an also{94f} token, + NEST FIELD portrait{g}. +g) NEST MODE field TAG portrait{f} : strong MODE NEST unit{32d}. + +h) *structure display : + strong structured with FIELDS FIELD mode NEST collateral clause{e}. +i) *row display : + strong ROWS of MODE NEST collateral clause{d}. +j) *display : strong STOWED NEST collateral clause{d,e}. +k) *vacuum : EMPTY PACK. + +3.4 Choice clauses + +3.4.1 Syntax + +A) CHOICE :: choice using boolean ; CASE. +B) CASE :: choice using intgral ; choice using UNITED. + +a) SOID NEST1 CHOICE clause{5D,551a,A341h,A349a} : + CHOICE STYLE start{91a,-}, + SOID NEST1 chooser CHOICE STYLE clause{b}, + CHOICE STYLE finish{91e,-}. +b) SOID NEST1 chooser choice using MODE STYLE clause{a,l} : + MODE NEST1 enquiry clause defining LAYER2{c,-}, + SOID NEST1 LAYER2 alternate choice using MODE STYLE clause{d}. +c) MODE NEST1 enquiry clause defining new DECSETY2{b,35g} : + meek MODE NEST1 new DESETY2 series with DECSETY2{32b}. +d) SOID NEST2 alternate CHOICE STYLE clause{b} : + SOID NEST2 in CHOICE STYLE clause{e} ; + where SOID balances SOID1 and SOID2{32e}, + SOID1 NEST2 in CHOICE STYLE clause{3}, + SOID2 NEST2 out CHOICE STYLE clause{l}. +e) SOID NEST2 in CHOICE STYLE clause{d} : + CHOICE STYLE in{91b,-}, SOID NEST2 in part of CHOICE{f,g,h}. +f) SOID NEST2 in part of choice using boolean{e} : + SOID NEST2 serial clause defining LAYER3{32a}. +g) SOID NEST2 in part of choice using integral{e} : + SOID NEST2 joined portrait{33b}. +h) SOID NEST2 in part of choice using UNITED{e,h} : + SOID NEST2 case part of choice using UNITED{i} ; + where SOID balances SOID1 and SOID2{32e}, + SOID1 NEST2 case part of choice using UNITED{i}, + and also{94f} token, + SOID2 NEST2 in part of choice using UNITED{h}. +i) SOID NEST2 case part of choice using UNITED{h} : + MOID NEST2 LAYER3 specification defining LAYER3{jk,-}, + where MOID unites to UNITED{64b}, + SOID NEST2 LAYER3 unit{32d}. +j) MODE NEST3 specification defining new MODE TAG3{i} : + NEST3 declarative defining new MODE TAG3{541e} brief pack, + colon{94f} token. +k) MOID NEST3 specification defining new EMPTY{i} : + formal MOID NEST3 declarer{46b} brief pack, colon{94f} token. +l) SOID NEST2 out CHOICE STYLE clause{d} : + CHOICE STYLE out{91d,-}, + SOID NEST2 serial lause defining LAYER3{32a} ; + CHOICE STYLE again{91c,-}, + SOID NEST2 chooser CHOICE2 STYLE clause{b}, + where CHOICE2 may follow CHOICE{m}. +m) WHETHER choice using MODE2 may follow choice using MODE1{l} : + where (MODE1) is (MOOD), WHETHER (MODE2) is (MODE1) ; + where (MODE1) begins with (union of), + WHETHER (MODE2) begins with (union of). + +n) *SOME choice clause : SOME CHOICE clause{a}. +o) *SOME conditional clause : SOME choice using boolean clause{a}. +p) *SOME case clause : SOME choice using integral clause{a}. +q) *SOME conformity clause : SOME choice using UNITED clause{a}. + +3.5 Loop clauses + +3.5.1 Syntax + +A) FROBYT :: from ; by ; to. + +a) strong void NEST1 loop clause{5D,551a} : + NEST1 STYLE for part defining new integral TAG2{b}, + NEST1 STYLE intervals{c}, + NEST1 STYLE repeating part with integral TAG2{e}. +b) NEST1 STYLE for part defining new integral TAG2{a} : + STYLE for{94g,-} token, + integral NEST1 new integral TAG2 defining identifier + with TAG2{48a} ; + where (TAG2) is (letter aleph), EMPTY. +c) NEST1 STYLE intervals{a} : + NEST1 STYLE from part{d} option, + NEST1 STYLE by part{d} option, + NEST1 STYLE to part{d} option. +d) NEST1 STYLE FROBYT part{c} : + STYLE FROBYT{94g,-} token, meek integral NEST1 unit{32d}. +e) NEST1 STYLE repeating part with DEC2{a} : + NEST1 new DEC2 STYLE while do part{f} ; + NEST1 new DEC2 STYLE do part{h}. +f) NEST2 STYLE while do part{e} : + NEST2 STYLE while part defining LAYER3{g}, + NEST2 LAYER3 STYLE do part{h}. +g) NEST2 STYLE while part defining LAYER3{f} : + STYLE while{94g,-} token, + boolean NEST2 enquiry clause defining LAYER3{34c,-}. +h) NEST3 STYLE do part{3,f} : + STYLE do{94g,-} token, + strong void NEST3 serial clause defining LAYER4{32a}, + STYLE od{94g,-} token. + +3.6 Access clauses + +{ Extensions: + [MR] GMR } + +{ Access clauses contain a controlled-clause, which is an + enclosed-clause. } + +3.6.1 Syntax + +a) SOID NEST access clause{5D,551a,A341h,A349a} : + NEST revelation publishing EMPTY defining LAYER{b}, + SOID NEST LAYER ENCLOSED clause{a,31a,33a,c,d,e,34a,35a,-}. +b) NEST revelation publishing REVSETY + defining new DECSETY INKSETY{a,49c} : + access{94d} token, + NEST joined module call publishing REVSETY revealing REVS{c}, + where DECSETY INKS revealed by REVS{e,f} + and NEST filters INKSETY out of INKS{h}. +c) NEST joined module call publishing REVSETY revealing RES{b,c} : + NEST moule call publishing REVSETY revealing REVS{d,-} ; + where (REVSETY) is (REVSETY1 REVSETY2) + an (REVS) is (REVS1 REVS2), + NEST module call publishing REVSETY1 revealing REVS1{d,-}, + and also{94f} token, + NEST joined module call publishing REVSETY2 revealing REVS2{c}. +d) NEST module call publishing REVSETY revealing REVS{c} : + where (REVSETY) is (EMPTY), + module REVS NEST applied module indication with TAB{48b} ; + where (REVSETY) is (REVS), + public{94d} token, + module REVS NEST applied module indication with TAB{48b}. +e) WHETHER DECSETY1 DECSETY2 INKS1 INKSETY2 revealed by + TAU reveals DECSETY1 INKS1 REVSETY3 + TAU reveals DECSETY1 INKS1 REVSETY4{b,e,f} : + WHETHER DECSETY DECSETY2 INKS1 INKSETY2 revealed by + TAU reveals DECSETY1 INKS1 REVSETY3 REVSETY4{e,f}. +f) WHETHER DECSETY1 DECSETY2 INKS1 INKSETY2 revealed by + TAU reveals DECSETY1 INKS1 REVSETY2{b,e,f} : + WHETHER DECSETY2 INKSETY2 revealed by REVSETY2 + and DECSETY1 independent DECSETY2{71a,b,c}. +g) WHETHER EMPTY revealed by EmPTY{e,f} : WHETHER true. +h) WHETHER NEST filters INKSETY1 out of INKSETY INK{b} : + unless INK ientified in NEST{72a}, + WHETHER (INKSETY) is (INKSETY2 INK) + and NEST INK filers INKSETY2 out of INKSETY{h,i} ; + where INK identified in NEST{72a}, + WHETHER NEST filters INKSETY1 out of INKSETY{h,i}. +i) WHETHER NEST filters EMPTY out of EMPTY{h} : WHETHER true. + +{ Examples: + a) ACCESS A, B (gets (f, a); puts (a)) + b) ACCESS A, B + c) A, B + d) A + PUB B } + +{ In rule b, the 'invoke TAU's enveloped by 'INKS' represent those + modules which might need to be invoked at any module-call whose + applied-module-indication identified a particular + defining-module-indication, whereas those enveloped by 'INKSETY' + represent only those which need invocation in the particular + context, the remainder having already being elaborated, as can be + determined statically from the 'NEST'. The presence of 'INKSETY' in + the nest of all descendent constructs of the access-clause ensures + that all modules now invoked will never be invoked again within + those descendents. } + +{ Rule f ensures the independence of declarations revealed by one + revelation; thus + + MODULE A = DEF PUB REAL x FED, B = DEF PUB REAL x FED; + ACCESS A, B (x) + + is not produced. However, rule e allows a given declaration to be + revealed by two public accesses of the same module, as in + + MODULE A = DEF PUB REAL x FED; + MODULE B = ACCESS PUB A DEF REAL y FED, + C = ACCESS PUB A DEF REAL z FED; + ACCESS B C (x + y + z) + + in which the module-definitions for both B and C reveal x, by virtue + of the PUB A in their constituent revelations. } + +{ Note that a particular-program may now consist of a + joined-label-definition followed by an access-clause. The + defining-module- indications identified thereby would be in the + library-prelude or the user-prelude. } + +3.7 Unsafe clauses + +{ Extensions: [US] } + +{ Unsafe clauses contain a controlled-clause, which is an enclosed-clause. } + +3.7.1 Syntax + +a) SOID NEST unsafe clause : + unsafe{94f} token, SOID NEST ENCLOSED clause{a,31a,33a,c,d,e,34a,35a,-}. + +{ Examples: + a) UNSAFE (ptr := dst) } + +4 Declarations, declarers and indicators + +4.1 Declarations + +4.1.1 Syntax + +{ Extensions: + [MR] module + "declaration with DECSETY without DECSETY1" } + +A) COMMON :: mode ; priority ; MODINE identity ; + reference to MODINE variable ; MODINE operation ; + PARAMETER ; MODE FIELDS ; module. + { MODINE :: MODE ; routine. } + +a) NEST declaration of DECS{a,32b} : + NEST COMMON declaration of DECS{42a,43a,44a,e,45a,-} ; + where (DECS) is (DECS1 DECS2), + NEST COMMON declaration of DECS1{42a,43a,44a,e,45a,-}, + and also{94f} token, NEST declaration of DECS2{a}. +b) NEST COMMON joined definition of PROPS PROP{b,42a,43a,44a,e,45a,46e,541e} : + NEST COMON joined definition of PROPS{b,c}, + and also{94f} token, + NEST COMMON joined definition of PROP{c}. +c) NEST COMMON joined definition of PROP{b,42a,43a,44a,e,45a,46e,541e} : + NEST COMMON definition of PROP{42b,43b,44c,f,45c,46f,541f,-}. + +d) *definition of PROP : + NEST COMMON definition of PROP{42b,43b,44c,f,45c,46f,541f} ; + NEST label definition of PROP{32}. +e) NEST declaration with DECSETY without DECSETY1{49e} : + where (DECSETY without DECSETY1) is (EMPTY without DECS1), + NEST COMMON declaration of DECS1{42a,43a,44a,e,45a,49a,-} ; + where (DECSETY without DECSETY1) is (DECS without EMPTY), + public{94d} token, + NEST COMMON declaration of DECS{42a,43a,44a,e,45a,49a,-} ; + where (DECSETY without DECSETY1) is + (DECSETY without DECS1 DECSETY2), + NEST COMMON declaration of DECS1{42a,43a,44a,e,45a,49a,-}, + and also{94f} token, + NEST declaration with DECSETY without DECSETY2{e} ; + where (DECSETY without DECSETY1) is + (DECS DECSETY3 without DECSETY1), + public{94d} token, + NEST COMMON declaration of DECS{42a,43a,44a,e,45a,49a,-}, + and also{94f} token, + NEST declaration with DECSETY3 without DECSETY1{e}. + +{ Rule e determines how a "NEST declaration with DECSETY without + DECSETY1" results into two groups of declarations. The declarations + in 'DECSETY' are public and syntactically preceded by PUB. The + declarations in 'DECSETY1 are non-public and are not marked by + PUB. } + +4.2 Mode declarations + +4.2.1 Syntax + +a) NEST mode declaration of DECS{41a} : + mode{94d} token, NEST mode joined definition of DECS{41b,c}. +b) NEST mode definition of MOID TALLY TAB{41c} : + where (TAB) is (bold TAG) or (NEST) is (new LAYER), + MOID TALLY NEST defining mode indication with TAB{48a}, + is defined as{94d} token, + actual MOI TALLY NEST declarer{c}. +c) actual MOID TALLY1 NEST declarer{b} : + where (TALLY1) is (i), + actual MOID NEST declarator{46c,d,g,h,o,s,-} ; + where (TALLY1) is (TALLY2 i), + MOID TALLY2 NEST applied mode indication with TAB2{48b}. + +{ The use of TALLY excludes circular chains of mode-definitions such + as `mode a = b, b = a'. } + +4.3 Priority declarations + +4.3.1 Syntax + +a) NEST priority declaration of DECS{41a} : + priority{94d} token, NEST priority joined definition of DECS{41b,c}. +b) NEST priority definition of priority PRIO TAD{41c} : + priority PRIO NEST definining operator with TAD{48a}, + is defined as{94d} token, DIGIT{94b} token, + where DIGIT counts DIGIT{94b} token, + where DIGIT counts PRIO{c,d}. + {DIGIT :: digit zero ; digit one ; digit two ; digit three ; + digit four ; digit five ; digit six ; digit seven ; + digit eight ; digit nine.} +c) WHETHER DIGIT1 counts PRIO i{b,c} : + WHETHER DIGIT2 counts PRIO{c,d}, + where (digit one igit two digit three digit four + digit five digit six digit seven digit eight digit nine) + contains (DIGIT2 DIGIT1). +d) WHETHER digit one counts i{b,c} : WHETHER true. + +4.4 Identifier declarations + +4.4.1 Syntax + +A) MODINE :: MODE ; routine. +B) LEAP :: local ; heap ; primal. + +a) NEST MODINE identity declaration of DECS{41a} : + formal MODINE NEST declarer{b,46b}, + NEST MODINE identity joined definition of DECS{41b,c}. +b) VICTAL routine NEST declarer{a,523b} : procedure{94d} token. +c) NEST MODINE identity definition of MODE TAG{41c} : + MODE NEST defining identifier with TAG{48a}, + is defined as{94d} token, MODE NEST source for MODINE{d}. +d) MODE NEST source for MODINE{c,f,45c} : + where (MODINE) is (MODE), MODE NEST source{521c} ; + where (MODINE) is (routine), MODE NEST routine text{541a,b,-}. +e) NEST reference to MODINE variable declaration of DECS{41a} : + reference to MODINE NEST LEAP sample generator{523b}, + NEST reference to MODINE variable joined definition of DECS{41b,c}. +f) NEST reference to MODINE variable definition + of reference to MODE TAG{41c} : + reference to MODE NEST defining identifier with TAG{48a}, + becomes{94c} token, MODE NEST soure for MODINE{d} ; + where (MODINE) is (MODE), + reference to MODE NEST defining identifier with TAG{48a}. + +g) *identifier declaration : + NEST MODINE identity declaration of DECS{a} ; + NEST reference to MODINE variable declaration of DECS{e}. + +4.5 Operation declarations + +4.5.1 Syntax + +A) PRAM :: DUO ; MONO. +B) TAO :: TAD ; TAM. + +a) NEST MODINE operation delarations of DECS{41a} : + operator{94d} token, formal MODINE NEST plan{b,46p,-}, + NEST MODINE operation joined definition of DECS{41b,c}. +b) formal routine NEST plan{a} : EMPTY. +c) NEST MODINE operation definition of PRAM TAO{41c} : + PRAM NEST defining operator with TAO{48a}, + is defined as{94d} token, PRAM NEST source for MODINE{44d}. + +4.6 Declarers + +4.6.1 Syntax + +A) VICTAL :: VIRACT ; formal. +B) VIRACT :: virtual ; actual. +C) MOIDS :: MOID ; MOIDS MOID. + +a) VIRACT MOID NEST declarer{c,e,g,h,523a,b} : + VIRACT MOID NEST declarator{c,d,g,h,o,s,-} ; + MOID TALLY NEST applied mode indication with TAB{48b,-}. +b) formal MOID NEST declarer{e,h,p,r,u,34k,44a,541a,b,e,551a} : + where MOID deflexes to MOID{47a,b,c,-}, + formal MOID NEST declarator{c,d,h,o,s,-} ; + MOID1 TALLY NEST applied mode indication with TAB{48b,-}, + where MOID1 deflexes to MOID{47a,b,c,-}. +c) VICTAL reference to MODE NEST declarator{a,b,42c} : + reference to{94d} token, virtual MODE NEST declarer{a}. +d) VICTAL structured with FIELDS mode NEST declarator{a,b,42c} : + structure{94d} token, + VICTAL FIELDS NEST portrayer of FIELDS{e} brief pack. +e) VICTAL FIELDS NEST portrayer of FIELDS1{d,e} : + VICTAL MODE NEST declarer{a,b}, + NEST MODE FIELDS joined definition of FIELDS1{41b,c} ; + where (FIELDS1) is (FIELDS2 FIELDS3), + VICTAL MODE NEST declarer{a,b}, + NEST MODE FIELDS joined definition of FIELDS2{41b,c}, + and also{94f} token, + VICTAL FIELDS NEST portrayer of FIELDS3{e}. +f) NEST MODE FIELDS definition of MODE field TAG{41c} : + MODE field FIELDS defining field selector with TAG{48c}. +g) VIRACT flexible ROWS of MODE NEST declarator{a,42c} : + flexible{94d} token, VIRACT ROWS of MODE NEST declarer{a}. +h) VICTAL ROWS of MODE NEST declarator{a,b,42c} : + VICTAL ROWS NEST rower{i,j,k,l} STYLE bracket, + VICTAL MODE NEST declarer{a,b,}. +i) VICTAL row ROWS NEST rower{h,i} : + VICTAL row NEST rower{j,k,l}, and also{94f} token, + VICTAL ROWS NEST rower{i,j,k,l}. +j) actual row NEST rower{h,i} : + NEST lower bound{m}, up to{94f} token, NEST upper bound{n} ; + NEST upper bound{n}. +k) virtual row NEST rower{h,i} : up to{94f} token option. +l) formal row NEST rower{h,i} : up to{94f} token option. +m) NEST lower bound{j,532f,g} : meek integral NEST unit{32d}. +n) NEST upper bound{j,532f} : meek integral NEST unit{32d}. +o) VICTAL PROCEDURE NEST declarator{a,b,42c} : + procedure{94d} token, formal PROCEDURE NEST plan{p}. +p) formal procedure PARAMETY yieling MOID NEST plan{o,45a} : + where (PARAMETY) is (EMPTY), formal MOID NEST declarer{b} ; + PARAMETERS NEST joined declarer{q,r} brief pack, + formal MOID NEST declarer{b}. +q) PARAMETERS PARAMETER NEST joined declarer{p,q} : + PARAMETERS NEST joined declarer{q,r}, and also{94f} token, + PARAMETER NEST joined declarer{r}. +r) MODE parameter NEST joined declarer{p,q} : + formal MODE NEST declarer{b}. +s) VICTAL union of MOODS1 MOOD1 mode NEST declarator{a,b,42c} : + unless EMPTY with MOODS1 MOOD1 incestuous{47f}, + union of{94d} token, + MOIDS NEST joined declarer{t,u} brief pack, + where MOIDS ravels to MOODS2{47g} + and safe MOODS1 MOOD1 subset of safe MOODS2{73l} + and safe MOODS2 subset of safe MOODS1 MOOD1{731,m}. +t) MOIDS MOID NEST joined declarer{s,t} : + MOIDS NEST joined declarer{t,u}, an also{94f} token, + MOID NEST joined declarer{u}. +u) MOID NEST joined declarer{s,t} : formal MOID NEST declarer{b}. + +4.7 Relationships between modes + +4.7.1 Syntax + +A) NONSTOWED :: PLAIN ; REF to MODE ; PROCEDURE ; UNITED ; void. +B) MOODSETY :: MOODS ; EMPTY. +C) MOIDSETY :: MOIDS ; EMPTY. + +a) WHETHER NONSTOWED deflexes to NONSTOWED{b,e,46b,521c,62a,71n} : + WHETHER true. +b) WHETHER FLEXETY ROWS of MODE1 deflexes to ROWS of MODE2{b,e,46b,521c,62a,71n} : + WHETHER MODE1 deflexes to MODE2{a,b,c,-}. +c) WHETHER structured with FIELDS1 mode deflexes to + structured with FIELDS2 mode{b,e,46b,521c,62a,71n} : + WHETHER FIELDS1 deflexes to FIELDS2{d,e,-}. +d) WHETHER FIELDS1 FIELD1 deflexes to FIELDS2 FIELD2{c,d} : + WHETHER FIELDS1 deflexes to FIELDS2{d,e,-} + and FIELD1 deflexes to FIELD2{e,-}. +e) WHETHER MODE1 field TAG deflexes to MODE2 field TAG{c,d} : + WHETHER MODE1 deflexes to MODE2{a,b,c,-}. + +f) WHETHER MOODSETY1 with MOODSETY2 inestuous{f,46s} : + where (MOODSETY2) is (MOOD MOODSETY3), + WHETHER MOODSETY1 MOOD with MOODSETY3 incestuous{f} + or MOOD is firm union of MOODSETY1 MOODSETY3 mode{71m} ; + where (MOODSETY2) is (EMPTY), WHETHER false. + +g) WHETHER MOIDS ravels to MOODS{g,46s} : + where (MOIDS) is (MOODS), WHETHER true ; + where (MOIDS) is + (MOODSETY union of MOODS1 mode MOIDSETY), + WHETHER MOODSETY MOODS1 MOIDSETY ravels to MOODS{g}. + +{ The hyperrules from a) to e) implement a predicate deflexes-to that + determines whether a given mode deflexes to another mode. Any + non-stowed mode deflexes to any other non-stowed mode. A row mode + deflexes to another row mode if the ranks of the modes are the same + and the mode of the former's elements deflexes to the mode of the + later's elements. A structured mode deflexes to another structured + mode if they have the same number of fields with the same tags and + their modes deflex. } + +{ The hyperrule f) implements a predicate that determines whether two + provided sets of moods are incestuous, i.e. whether they contain + modes which are firmly related. } + +{ The hyperrule g) determines whether a set of moods and + united modes may be ravelled. } + +4.8 Indicators and field selectors + +4.8.1 Syntax + +{ Extensions: + [MR] INK, "module indication", "module REVS", "invoked", TAU } + +A) INDICATOR :: identifier ; mode indication ; operator ; + module indication. +B) DEFIED :: defining ; applied. +C) PROPSETY :: PROPS ; EMPTY. +D) PROPS :: PROP ; PROPS PROP. +E) PROP :: DEC ; LAB ; FIELD ; INK. +F) QUALITY :: MODE ; MOID TALLY ; DYADIC ; label ; MODE field ; + module REVS ; invoked. +G) TAX :: TAG ; TAB ; TAD ; TAM ; TAU. + +a) QUALITY NEST new PROPSETY1 QUALITY TAX PROPSETY2 + defining INDICATOR with TAX{32c,35b,42b,43b,44c,f,45c,541f} : + where QUALITY TAX independent PROPSETY1 PROPSETY2{71a,b,c}, + TAX{942A,D,F,K} token. +b) QUALITY NEST applied INDICATOR with TAX{42c,46a,b,5D,542a,b,544a} : + where QUALITY TAX identified in NEST{72a}, + TAX{942A,D,F,K} token. +c) MODE field PROPSETY1 MODE field TAG PROPSETY2 defining + field selector with TAG{46f} : + where MODE field TAG independent PROPSETY1 PrOPSETY2{71a,b,c}, + TAX{942A} token. +d) MODE field FIELDS applied field selector with TAG{531a} : + where MODE field TAG resides in FIELDS{72b,c,-}, + TAG{942A} token. + +e) *QUALITY NEST DEFIED indicator with TAX : + QUALITY NEST DEFIED INDICATOR with TAX{a,b}. +f) *MODE DEFIED field seletor with TAG : + MODE field FIELDS DEFIED field selector with TAG{c,d}. + +{ MODs are introduced into a nest by module-declarations. + INKs are introduced into a nest by module-calls. } + +{ Modules are ascribed to module-indications by means of + module-declarations. } + +4.9 Module declarations + +4.9.1 Syntax + +a) NEST1 module declaration of MODS{41a,e} : + module{94d} token, + NEST1 module joined definition of MODS{41b,c}. +b) NEST1 module definition of module RESETY REV TAB{41c} : + where (REV) is (TAU reveals DECSETY invoked TAU) + and (TAB) is (bold TAG), + where (NEST1) is (NOTION1 invoked TAU NOTETY2), + unless (NOTION1 NOTETY2) contains (invoked TAU), + module REVSETY REV NEST1 defining module indication with TAB{48a}, + is defined as{94d} token, + NEST1 module text publishing REVSETY REV defining LAYER{c,-}. +c) NEST1 module text + publishing REVSETY TAU reveals DECSETY INKSETY INK + defining new DECSETY1 DECSETY INK{b} : + where (INKSETY) is (EMPTY) and (REVSETY) is (EMPTY), + def{94d} token, + NEST1 new new DECSETY1 DECSETY INK module series + with DECSETY without DECSETY1{d}, + fed{94d} token ; + NEST1 revelation publishing REVSETY defining LAYER{36b}, + def{94d} token, + NEST1 LAYER new DECSETY1 DECSETY INK module series + with DECSETY without DECSETY1{d}, + fed{94d} token, + where (LAYER) is (new DECSETY2 INKSETY). +d) NEST3 module series with DECSETY without DECSETY1{c} : + NEST3 module prelude with DECSETY without DECSETY1{e}, + NEST3 module postlude{f} option. +e) NEST3 module prelude with DECSETY1 without DECSETY2{d,e} : + strong void NEST3 unit{32d}, go on{94f} token, + NEST3 module prelude with DECSETY1 without DECSETY2{e} ; + where (DECSETY1 without DECSETY2) is + (DECSETY3 DECSETY4 without DECSETY5 DECSETY6>, + NEST3 declaration with DECSETY3 without DECSETY5{41e}, + go on{94f} token, + NEST3 module prelude with DECSETY4 without DECSETY6{e} ; + where (DECSETY1 without DECSETY2) is (EMPTY without EMPTY), + strong void NEST3 unit{32d} ; + NEST3 declaration with DECSETY1 without DECSETY2{41e}. +f) NEST3 module postlude{d} : + postlude{94d} token, strong void NEST3 series with EMPTY{32b}. + +g) *module text : + NEST module text publishing REVS defining LAYER{c}. + +{ Examples: + a) MODULE A = DEF STRING s; gets (s); + PUB STRING t = "file"+s, PUB REAL a FED, + B = ACCESS A DEF PUB INT fd; + fopen (fd, file o rdonly) + POSTLUDE close (f) FED + + b) A = DEF STRING s; gets (s); + PUB STRING t = "file"+s, PUB REAL a FED + + B = ACCESS A DEF PUB FILE f; + fopen (fd, file o rdonly) + POSTLUDE close (f) FED + + c) DEF STRING s; gets (s); + PUB STRING t = "file"+s, PUB REAL a FED + + ACCESS A DEF PUB FILE f; + fopen (fd, file o rdonly) + POSTLUDE close (f) FED + + d) STRING s; gets (s); PUB STRING t = "file"+s, PUB real a + + PUB FILE f; fopen (fd, file o rdonly) POSTLUDE close (f) + + e) STRING s; gets (s); PUB STRING t = "file"+s, PUB real a + + PUB FILE f; fopen (fd, file o rdonly) + + f) POSTLUDE close (f) } + +{ Note that the EMPTY (for PROPSETY) in rule f enforces that a module + postlude cannot contain declarations, labels or module accesses. + Only units are allowed. } + +{ Rule b ensures that a unique 'TAU' is associated with each + module-text accessible from any given point in the program. This is + used to ensure that an invoke ATU' can be identified in the nest of + all descendent constructs of any access-clause or module-text which + invokes that module-text. + + In general, a module-text-publishing-REVS-defining-LAYER T makes + 'LAYER' visible within itself, and makes the properties revealed by + 'REVS' visible wherever T is accessed. 'LAYER' includes both a + 'DECSETY' corresponding to its public declarations and an INK' which + links T to its unique associated 'TAU' and signifies in the nest + that T is now known to be invoked. REVS' always reveals 'DECSETY + INKSETY INK' (but not 'DECSETY1'), where INKSETY' signifies the + invocation of any other modules accessed by T. 'REVS' may also + reveal the publications of the other modules accessed by T if their + module-calls within T contained a public-token. } + +5 Units + +5.1 Syntax + +{ Extensions: + [MR] formal hole, virtual hole } + +A) UNIT{32d} :: + assignation{521a} coercee ; identity relation{522a} coercee ; + routine text{541a,b} coercee ; jump{544a} ; skip{552a} ; + and function{57a} ; or function{57b} ; + formal hole{561b} ; virtual hole{561a} ; + TERTIARY{B}. +B) TERTIARY{A,521b,522a} :: + ADIC formula{542a,b} coercee ; nihil ; + SECONDARY{C}. +C) SECONDARY{B,531a,542c} :: + LEAP generator{523a} coercee ; selection{531a} coercee ; + PRIMARY{D}. +D) PRIMARY{C,532a,543a} :: + slice{532a} coercee ; call{543a} coercee ; + format text{A341a} coercee ; + applied identifier with TAG{48b} coercee ; + ENCLOSED clause{31a,33a,c,d,e,34a,35a}. + +a) *SOME hip : + SOME jump{544a} : SOME skip{552a} ; SOME nihil{524a}. + +5.2 Units associated with names + +5.2.1 Assignations + +5.2.1.1 Syntax + +a) REF to MODE NEST assignation{5A} : + REF to MODE NEST destination{b}, becomes{94c} token, + MODE NEST source{c}. +b) REF to MODE NEST destination{a} : + soft REF to MODE NEST TERTIARY{5B}. +c) MODE1 NEST source{a,44d} : + strong MODE2 NEST unit{32d}, + where MODE1 deflexes to MODE2{47a,b,c,-}. + +5.2.2 Identity relations + +5.2.2.1 Syntax + +a) boolean NEST identity relation{5A} : + where soft balances SORT1 and SORT2{32f}, + SORT1 reference to MODE NEST TERTIARY1{5B}, + identity relator{b}, + SORT2 reference to MODE NEST TERTIARY2{5B}. +b) identity relator{a} : is{94f} token ; is not{94f} token. + +5.2.3 Generators + +5.2.3.1 Syntax + +a) reference to MODE NEST LEAP generator{5C} : + LEAP{94d,-} token, actual MODE NEST declarer{46a}. +b) reference to MODINE NEST LEAP sample generator{44e} : + LEAP{94d,-} token, actual MODINE NEST declarer{44b,46a} ; + where (LEAP) is (local), actual MODINE NEST declarer{44b,46a}. + +5.2.4 Nihils + +5.2.4.1 Syntax + +a) strong reference to MODE NEST nihil{5B} : + nil{94f} token. + +5.3 Units associated with stowed values + +5.3.1 Selections + +5.3.1.1 Syntax + +A) REFETY :: REF to ; EMPTY. +B) REFLEXETY :: REF to ; REF to flexible ; EMPTY. + +a) REFETY MODE1 NEST selection{5C} : + MODE1 field FIELDS applied field selector with TAG{48d}, + of{94f} token, weak REFLEXETY ROWS of structured with + FIELDS mode NEST SECONDARY{5C}, + where (REFETY) is derived from (REFLEXETY){b,c,-}. +b) WHETHER (transient reference to) is derived from + (REF to flexible){a,532,66a} : + WHETHER true. +c) WHETHER (REFETY) is derived from (REFETY){a,532a,66a} : + WHETHER true. + +5.3.2 Slices + +5.3.2.1 Syntax + +A) ROWSETY :: ROWS ; EMPTY. + +a) REFETY MODE1 NEST slice{5D} : + weak REFLEXETY ROWS1 of MODE1 NEST PRIMARY{5D}, + ROWS1 leaving EMPTY NEST indexer{b,c,-} STYLE bracket, + where (REFETY) is derived from (REFLEXETY){531b,c,-} ; + where (MODE1) is (ROWS2 of MODE2), + weak REFLEXETY ROWS1 of MODE2 NEST PRIMARY{5D}, + ROWS1 leaving ROWS2 NEST indexer{b,d,-} STYLE bracket, + where (REFETY) is derived from (REFLEXETY){531b,c,-}. +b) row ROWS leaving ROWSETY1 ROWSETY2 NEST indexer{a,b} : + row leaing ROWSETY1 NEST indexer{c,d,-}, and also{94f} token, + ROWS leaving ROWSETY2 NEST indexer{b,c,d,-}. +c) row leaving EMPTY NEST indexer{a,b} : NEST subscript{3}. +d) row leaving row NEST indexer{a,b} : + NEST trimmer{f} ; NEST revised lower bound{g} option. +e) NEST subscript{c} : meek integral NEST unit{32d}. +f) NEST trimmer{d} : + NEST lower bound{46m} option, up to{94f} token, + NEST upper bound{46n} option, + NEST revised lower bound{g} option. +g) NEST revised lower bound{d,f} : + at{94f} token, NEST lower bound{46m}. + +h) *trimscript : + NEST subscript{e} ; NEST trimmer{f}; + NEST revised lower bound{g} option. +i) *indexer : + ROWS leaving ROWSETY NEST indexer{b,c,d}. +j) *boundscript : + NEST subscript{e} ; NEST lower bound{46m} ; + NEST upper bound{46n} ; NEST revised lowe bound{g}. + +5.4 Units associated with routines + +5.4.1 Routine texts + +5.4.1.1 Syntax + +a) procedure yielding MOID NEST1 routine text{44d,5A} : + formal MOID NEST1 declarer{46b}, routine{94f} token, + strong MOID NEST1 unit{32d}. +b) procedure with PARAMETERS yielding + MOID NEST1 routine text{44d,5A} : + NEST1 new DECS2 declarative defining + new DECS2{e} brief pack, + where DECS2 like PARAMETERS{c,d,-}, + formal MOID NEST1 declarer{46b}, routine{94f} token, + strong MOID NEST1 new DECS2 unit{32d}. +c) WHETHER DECS DEC like PARAMETERS PARAMETER{b,c} : + WHETHER DECS like PARAMETERS{c,d-} + and DEC like PARAMETER{d,-}. +d) WHETHER MODE TAG like MODE parameters{b,c} : + WHETHER true. +e) NEST2 declarative defining new DECS2{b,e,34j} : + formal MODE NEST2 declarer{46b}, + NEST2 MODE parameter joined definition of DECS2{41b,c} ; + where (DECS2) is (DECS3 DECS4), + formal MODE NEST2 declarer{46b}, + NEST2 MODE parameter joind definition of DECS3{41b,c}, + and also{94f} token, NEST2 declarative defining new DECS4{3}. +f) NEST2 MODE parameter efinition of MODE TAG2{41c} : + MDOE NEST2 defining identifier with TAG2{48a}. + +g) *formal MODE parameter : + NEST MODE parameter definition of MODE TAG{f}. + +5.4.2 Formulas + +5.4.2.1 Syntax + +A) DYADIC :: priority PRIO. +B) MONADIC :: priority iii iii iii i. +C) ADIC :: DYADIC ; MONADIC. +D) TALLETY :: TALLY ; EMPTY. + +a) MOID NEST DYADIC formula{c,5B} : + MODE1 NEST DYADIC TALLETY operand{c,-}, + procedure with MODE1 parameter MODE2 parameter + yielding MOID NEST applied operator with TAD{48b}, + where DYADIC TAD identified in NEST{72a}, + MODE2 NEST DYADIC TALLY operand{c,-}. +b) MOID NEST MONADIC formula{c,5B} : + procedure with MODE parameter yielding MOID + NEST applied operator ith TAM{48b}, + MODE NEST MONADIC operand{c}. +c) MODE NEST ADIC operand{a,b} : + firm MODE NEST ADIC formula{a,b} coercee{61b} ; + where (ADIC) is (MONADIC), firm MODE NEST SECONDARY{5C}. + +d) *MOID formula : MOID NEST ADIC formula{a,b}. +e) *DUO dyadic operator with TAD : + DUO NEST DEFIED operator with TAD{48a,b}. +f) *MONO monadic operator with TAM : + MONO NEST DEFIED operator with TAM{48a,b}. +g) *MODE operand : MODE NEST ADIC operand{c}. + +5.4.3 Calls + +5.4.3.1 Syntax + +a) MOID NEST call{5D} : + meek procedure with PARAMETERS yielding MOID NEST PRIMARY{5D}, + actual NEST PARAMETERS{b,c} brief pack. +b) actual NEST PARAMETERS PARAMETER{a,b} : + actual NEST PARAMETERS{b,c}, and also{94f} token, + actual NEST PARAMETER{c}. +c) actual NEST MODE parameter{a,b} : strong MODE NEST unit{32d}. + +5.4.4 Jumps + +5.4.4.1 Syntax + +a) strong MOID NEST jump{5A} : + go to{b} option, + label NEST applied identifier with TAG{48b}. +b) go to{a} : STYLE go to{94f,-} token ; + STYLE go{94f,-} token, STYLE to symbol{94g,-}. + +5.5 Units associated with values of any mode + +5.5.1 Casts + +5.5.1.1 Syntax + +a) MOID NEST cast{5D} : + formal MOID NEST declarer{46b}, + strong MOID NEST ENCLOSED clause{31a,33c,d,e,34a,35a,-}. + +5.5.2 Skips + +5.5.2.1 Syntax + +a) strong MOID NEST skip{5A} : skip{94f} token. + +5.6 Holes + +5.6.1 Syntax + +A) LANGUAGE :: algol sixty eight ; fortran ; c language ; cpp language. +B) ALGOL68 :: algol sixty eight. +C) FORTRAM :: fortran. +D) CLANG :: c language. +E) CPPLANG :: cpp language. +F) DLANG :: d language. + +a) strong MOID NEST virtual hole{5A} : + virtual nest symbol, strong MOID NEST closed clause{31a}. +b) strong MOID NEST formal hole{5A} : + formal nest{94d} token, MOID LANGUAGE indication{e,f,-}, + hole indication{d}. +c) MOID NEST actual hole{A6a} : + strong MOID NEST ENCLOSED clause{31a,33a,c,34a,35a,36a,-}. +d) hole indication{b} : + character denotation{814a} ; row of character denotation{83a}. +e) MOID ALGOL68 indication{b} : EMPTY. +f) MOID FORTRAN indication{b} : bold letter f letter o letter r letter t + letter r letter a letter n token. +g) MOID CLANG indication{b} : bold letter c letter l letter a letter n + letter g. +e) MOID CPPLANG indication{b} : bold letter c letter p letter p letter l + letter a letter n letter g. +f) MOID DLANG indication{b} : bold letter d letter l letter a letter n + letter g. + +{ Since no representation is provided for the virtual-nest-symbol, the + user is unable to construct virtual-holes for himself, but a + mechanism is provided (10.6.2.a) for constructing them out of + formal- and actual-holes. } + +5.7 Short-circuit logical functions + +{ Extensions: [SC] } + +{ The short-circuit logical functions are pseudo-operators providing + logical AND and OR functions with short-circuited elaboration. } + +5.7.1 Syntax + +a) boolean NEST and function{5A} : + meek boolean NEST TERTIARY1, andth{94c} token, meek boolean NEST TERTIARY2. + +b) boolean NEST or function{5A} : + meek boolean NEST TERTIARY1, orel{94c} token, meek boolean NEST TERTIARY2. + +c) *boolean NEST short circuit function : + boolean NEST and function{a} ; boolean NEST or function{b}. + +{ Examples: + a) UPB str > 2 ANDTH str[3] /= "x" + b) error = 0 OREL (print ("error"); stop; SKIP) } + +6 Coercion + +6.1 Coercees + +6.1.1 Syntax + +A) STRONG{a,66a} :: + FIRM{B} ; widened to{65a,b,c,d} ; rowed to{66a} ; + voided for{67a,b}. +B) FIRM{A,b} :: MEEK{C} ; united to{64a}. +C) MEEK{B,c,d,64a,63a,64a,65a,b,c,d} :: + unchanged from{f} ; dereferenced to{62a} ; deprocedured to{63a}. +D) SOFT{e,63b} :: + unchanged from{f} ; softly deprocedured to{63b}. +E) FORM :: MORF ; COMORF. +F) MORF :: + NEST selection ; NEST slice ; NEST routine text ; + NEST ADIC formula ; NEST call ; + NEST applied identifier with TAG. +G) COMORF :: + NEST assignation ; NEST identity relation ; + NEST LEAP generator ; NEST cast ; NEST denoter ; + NEST format text. + +a) strong MOID FORM coercee{5A,B,C,D,A341i} : + where (FORM) is (MORF), STRONG{A} MOID MORF ; + where (FORM) is (COMORF), STRONG{A} MOID COMORF, + unless (STRONG MOID) is (deprocedured to void). +b) firm MODE FORM coercee{5A,B,C,D,542c} : FIRM{B} MODE FORM. +c) meek MODE FORM coercee{5A,B,C,D} : MEEK{C} MOID FORM. +d) weak REFETY STOWED FORM coercee{5A,B,C,D} : + MEEK{C} REFETY STOWED FORM, + unless (MEEK) is (dereferenced to) + and (REFETY) is (EMPTY). +e) soft MODE FORM coercee{5A,B,C,D} : SOFT{D} MODE FORM. +f) unchanged from MOID FORM{C,D,67a,b} : MOID FORM. + +g) *SORT MOID coercee : SORT MOID FORM coercee{a,b,c,d,e}. +h) *MOID coercend : MOID FORM. + +{ Examples: + a) 3.14 (in x := 3.14) + b) 3.14 (in x + 3.14) + c) sin (in sin (x)) + d) x1 (in x1[2] := 3.14) + e) x (in x := 3.14) } + +6.2 Dereferencing + +6.2.1 Syntax + +a) dereferenced to{61C} MODE1 FORM : + MEEK{61C} REF to MODE2 FORM, + where MODE2 deflexes to MODE1{47a,b,c,-}. + +{ Examples: + a) x in (real (x)) } + +6.3 Deproceduring + +6.3.1 Syntax + +a) deprocedured to{61C,67a} MOID FORM : + MEEK{61C} procedure yielding MOID FORM. +b) softly deprocedured to{61D} MODE FORM : + SOFT{61D} procedure yielding MODE FORM. + +{ Examples: + a) random (in real (random)) + b) x or y (in x or y := 3.14, given + PROC x or y = REF REAL: (random < .5 | x | y)) } + +6.4 Uniting + +6.4.1 Syntax + +a) united to{64B} UNITED FORM : + MEEK{61C} MOID FORM, + where MOID unites to UNITED{b}. +b) WHETHER MOID1 unites to MOID2{a,34i,71m} : + where MOID1 equivalent MOID2{73a}, WHETHER false ; + unless MOID1 equivalent MOID2{73a}, + WHETHER safe MOODS1 subset of safe MOODS2{73l,m,n}, + where (MOODS1) is (MOID1) + or (union of MOODS1 mode) is (MOID1), + where (MOODS2) is (MOIDS2) + or (union of MOODS2 mode) is (MOIDS2). + +{ Examples: + a) x (in uir := x) + u (in UNION(CHAR,INT,VOID)(u), in a reach containing + UNION(INt,VOID) u := EMPTY) } + +6.5 Widening + +6.5.1 Syntax + +A) BITS :: structured with + row of boolean field SITHETY letter aleph mode. +B) BYTES :: structured with + row of character field SITHETY letter aleph mode. +C) SITHETY :: LENGTH LENGTHETY ; SHORT SHORTHETY ; EMPTY. +D) LENGTH :: letter l letter o letter n letter g. +E) SHORT :: letter s letter h letter o letter r letter t. +F) LENGTHETY :: LENGTH LENGTHETY ; EMPTY. +G) SHORTHETY :: SHORT SHORTHETY ; EMPTY. + +a) widened to{b,61A} SIZETY real FORM : + MEEK{61C} SIZETY integral FORM. +b) widened to{61A} structured with SIZETY real field letter r letter e + SIZETY real field letter i letter m mode FORM : + MEEK{61C} SIZETY real FORM ; + widened to{a} SIZETY real FORM. +c) widened to{61A} row of boolean FORM : MEEK{61C} BIT FORM. +d) widened to{61A} row of character FORM : MEEK{61C} BYTES FORM. + +{ Examples: + a) 1 (in x := 1) + b) 1.0 (in z := 1.0) + 1 (in z := 1) + c) 2r101 (in []BOOL(2r101)) + d) r (in []CHAR(r)) } + +6.6 Rowing + +6.6.1 Syntax + +a) rowed to{61A} REFETY ROWS1 of MODE FORM : + where (ROWS1) is (row), + STRONG{61A} REFLEXETY MODE FORM, + where (REFETY) is derived from (REFLEXETY){531b,c,-} ; + where (ROWS1) is (row ROWS2), + STRONG{61A} REFLEXETY ROWS2 of MODE FORM, + where (REFETY) is derived from (REFLEXETY){531b,c,-}. + +{ Examples: + a) 4.13 (in [1:1]REAL b1 := 4.13) + x1 (in [1:1,1:n]REAL b2 := x1) } + +6.7 Voiding + +6.7.1 Syntax + +A) NONPROC :: PLAIN ; STOWED ; REF to NONPROC ; + procedure with PARAMETERS yielding MOID ; UNITED. + +a) voided to{61A} void MORF : + deprocedured to{63a} NONPROC MORF ; + unchanged from{61f} NONPROC MORF. +b) voided to{61A} void COMORF : + unchanged from{61f} MODE COMORF. + +{ Examples: + a) random (in SKIP; random;) + next random (last random) + (in SKIP; next random (lat random);) + b) PROC VOID (pp) (in PROC PROC VOID pp = PROC VOID : (print (1); + VOID : print (2)); PROC VOID (pp);) } + +8 Denotations + +8.1 Plain denotations + +8.1.0.1 Syntax + +A) SIZE:: long ; short. +B) *NUMERAL :: fixed point numeral ; variable point numeral ; + floating point numeral. + +a) SIZE INTREAL denotation{a,80a} : + SIZE symbol{94d}, INTREAL, denotation{a,811a,812a}. + +b) *plain denotation : + PLAIN denotation{a,811a,812a,813a,814a} ; void denotation{815a}. + +{ Example: + a) LONG 0 } + +8.1.1 Integral denotations + +8.1.1.1 Syntax + +a) integral denotation{80a,810a} : fixed point numeral{b}. +b) fixed point numeral{a,812c,d,f,i,A341h} : digit cypher{c} sequence. +c) digit cypher{b} : DIGIT symbol{94b}. + +{ Examples: + a) 4096 + b) 4096 + c) 4 } + +8.1.2 Real denotations + +8.1.2.1 Syntax + +a) real denotation{80a,810a} : + variable point numeral{b} ; floating point numeral{e}. +b) variable point numeral{a,f} : + integral part{c} option, fractional part{d}. +c) integral part{b} : fixed point numeral{811b}. +d) fractional part{b} : point symbol{94b}, fixed point numeral{811b}. +e) floating point numeral{a} : stagnant part{f}, exponent part{g}. +f) stagnant part{e} : + fixed point numeral{811b} : variable point numeral{b}. +g) exponent part{e} : + times ten to the power choice{h}, power of then{i}. +h) times ten to the power choice{g} : + times ten to the power symbol{94b} ; letter e symbol{94a}. +i) power of ten{g}: plusminus{j} option, fixed point numeral{811b}. +j) plusminus{i} : plus symbol{94c} ; mius symbol{94c}. + +{ Examples: + a) 0.00123 + 1.23e-3 + b) 0.00123 + c) 0 + d) .00123 + e) 1.23e-3 + f) 123 + 1.23 + g) E-3 + h) E + i) -3 + j) + + - } + +8.1.3 Boolean denotations + +8.1.3.1 Syntax + +a) boolean denotation{80a} : true{94b} symbol ; false{94b} smbol. + +{ Examples: + a) TRUE + FALSE } + +8.1.4 Character denotations + +8.1.4.1 Syntax + +a) character denotation{80a} : + quote{94b} symbol, string item{b}, quote sybol{94b}. +b) string item{a,83b} : + character glyph{c} ; quote image symbol{94f} ; other string item{d}. +c) character glyph{b,92c} : + LETTER symbol{94a} ; DIGIT symbol{94b} ; + point sybol{94b} ; open symbol{94f} ; close symbol{94f} ; + comma symbol{94b} ; space symbol{94b} ; + plus symbol{94c} ; minus symbol{94c}. + +{ A production rule may be added for the notion 'other string item' + each of whose alternatives is a symbol 1.1.3.1.f which is different + from any terminal production of 'character glyph' and which is not + 'quote symbol' } + +{ Examples: + a) "a" + b) a + "" + ? + c) a 1 . ( ) , . space + - } + +8.1.5 Void denotation + +5.1.5.1 Syntax + +a) void denotation{80a} : empty{94b} symbol. + +{ Example: + a) EMPTY } + +8.2 Bits denotations + +8.2.1 Syntax + +A) RADIX :: radix two ; radix four ; radix eight ; radix sixteen. + +a) structured with row of boolean field + LENGTH LENGTHETY letter aleph mode denotation{a,80a} : + long{94d} symbol, structured with row of boolean field + LENGTHETY letter aleph mode denotation{a,c}. +b) structured with row of boolean field + SHORT SHORTHTETY letter aleph mode denotation{b,80a} : + short{94d} symbol, + structured with row of boolean field SHORTHETY letter aleph mode denotation{b,c}. +c) structured wih row of boolean field + letter aleph mode denotation{a,b,80a} : + RADIX{d,e,f,g}, letter r symbol{94a}, RADIX digit{h,i,j,k} sequence. +d) radix two{c,A347b} : digit two{94b} symbol. +e) radix four{c,A347b} : digit four{94b} symbol. +f) radix eight{c,A347b} : digit eight{94b} symbol. +g) radix sixteen{c,A347b} : digit one symbol{94b}, digit six symbol{94b}. +h) radix two digit{c,i} : digit zero symbol{94b} ; digit one symbol{94b}. +i) radix four digit{c,j} : + radix two digit{h} ; digit two symbol{94b} ; + digit three symbol{94b}. +j) raidx eight digit{c,k} : + radix four digit{i} ; digit four symbol{94b} ; + digit five symbol{94b} ; digit six symbol{94b} ; + digit seven symbol{94b}. +k) radix sixteen digit{c} : + radix eight digit{j} ; digit eight symbol{94b} ; + digit nine symbol{94b} ; letter a symbol{94a} ; + letter b symbol{94a} ; letter e symbol{94a} ; letter d symbol{94a} ; + letter e symbol{94a} ; letter f symbol{94a}. + +l) *bits denotation : BITS denotation{a,b,c}. +m) *radix digit : RADIX digit{h,i,j,k}. + +{ Examples: + a) LONG 2r101 + b) SHORT 16rffff + c) 8r231 } + +8.3 String denotations + +8.3.1 Syntax + +a) row of character denotation{80a} : + quote{94b} symbol, string{b} option, quote symbol{94b}. +b) string{a} : string item{814b}, string item{814b} sequence. + +c) *string denotation : row of charater denotation{a}. + +{ Examples: + a) "abc" + b) abc } + +9 Tokens and symbols + +9.1 Tokens + +{ Tokens are symbols possibly preceded by pragments. } + +9.1.1 Syntax + +a) CHOICE STYLE start{34a} : + where (CHOICE) is (choice using boolean), + STYLE if{94f,-} token ; + where (CHOICE) is (CASE), STYLE case{94f,-} token. +b) CHOICE STYLE in{34e} : + where (CHOICE) is (choice using boolean), + STYLE then{94f,-} token ; + where (CHOICE) is (CASE), STYLE in{94f,-} token. +c) CHOICE STYLE again{34l} : + where (CHOICE) is (choice using boolean), + STYLE else if{94f,-} token ; + where (CHOICE) is (CASE), STYLE ouse{94f,-} token. +d) CHOICE STYLE out{34l} : + where (CHOICE) is (choice using boolean), + STYLE else{94f,-} token ; + where (CHOICE) is (CASE), STYLE out{94f,-} token. +e) CHOICE STYLE finish{34a} : + whre (CHOICE) is (choice using boolean), + STYLE fi{94f,-} token ; + where (CHOICE) is (CASE), STYLE esac{94f,-} token. +f) NOTION token : + pragment{92a} sequence option, + NOTION symbol{94a,b,c,d,e,f,g,h}. + +g) *token : NOTION token{f}. +h) *symbol : NOTION symbol{94a,b,c,d,e,f,g,h}. + +9.2 Comments and pragmats + +9.2.1 Syntax + +{ Extensions: + [NC] nestable comments. } + +A) PRAGMENT :: pragmat ; comment. + +a) pragment{80a,91f,A341b,h,A348a,b,c,A349a,A34Ab} : PRAGMENT{b}. +b) PRAGMENT{a} : + STYLE PRAGMENT symbol{94h,-}, + STYLE PRAGMENT item{c} sequence option, + STYLE PRAGMENT symbol{94h,-} ; + STYLE nestable comment{d}. +c) STYLE PRAGMENT item{b} : + character glyph{814c} ; STYLE other PRAGMENT item{d}. +d) STYLE nestable comment{b} : + STYLE comment begin symbol{94h,-}, + STYLE nestable comment contents{e} sequence, + STYLE comment end symbol{94h,-}. +e) STYLE nestable comment contents{d} : + STYLE nestable comment item{c} sequence option, + STYLE nestable comment{d} option. +f) STYLE nestable comment item{e} : + character glyph{814c} ; STYLE other nestable comment item{d}. + +{ A production rule may be added for each notion designated by 'STYLE + other PRAGMENT item' each of whose alternatives is a symbol + different from any terminal production of 'character glyph', and + such that no terminal production of any 'STYLE other PRAGMENT item' + is the corresponding 'STYLE PRAGMENT symbol'. This allows to nest + different comment or pragmat for example. } + +9.4 The reference language + +9.4.1 Representations of symbols + +{ Extensions: + [CS] andth symbol, orel symbol + [MR] access symbol, module symbol, def symbol, public symbol, + postlude symbol, formal nest symbol, egg symbol + [US] unsafe symbol } + +{ This section of the Report doesn't describe syntax, but lists all + the different symbols along with their representation in the + reference language. We only include here symbols corresponding to + the GNU extensions implemented by this compiler. } + + symbol representation + +c) andth symbol{57a} ANDTH + orel symbol{57b} OREL +d) module symbol{49a} MODULE + access symbol{36b} ACCESS + def symbol{49c} DEF + fed symbol{49c} FED + public symbol{36d,41e} PUB + postlude symbol{49f} POSTLUDE + formal nest symbol{56b} NEST + egg symbol{A6a,c} EGG +f) unsafe symbol{37a} UNSAFE +h) bold comment begin symbol{92a} NOTE + bold comment end symbol{92a} ETON + brief comment begin symbol{92a} { + brief comment end symbol{92a} } + +10.1.1 Syntax + +{ Extensions: + [MR] user, user task } + +A) EXTERNAL :: user. + +f) NEST1 user task{d} : + NEST2 particular prelude with DECS{c}, + NEST2 user prelude with MODSETY{c}, + NEST2 particular program{g} PACK, go on{94f} token, + NEST2 particualr poslude{i}, + where (NEST2) is (NEST1 new DECS MODSETY STOP). + +10.6 Packets + +10.6.1 Syntax + +a) MOID NEST new MODSETY ALGOL68 stuffing packet{A7a} : + egg{94d} token, hole indication{56d}, is defined as{94d} token, + MOID NEST new MODSETY actual hole{56c}. + +{ b) Note that the rules for "MOID NEST new MODSETY LANGUAGE stuffing + packets" for other languages are not explicitly included in the + syntax. These rules conceptually transform all such + LANGUAGE-stuffing-packets into ALGOL68-stuffing-packets with the + same meaning. } + +c) NEST new MODSETY1 MODS definition module packet of MODS{A7a} : + egg{94d} token, hole indication{56d}, is defined as{94d} token, + NEST new MODSETY1 MODS module declaration of MODS{49a}, + where MODS absent from NEST{e}. +d) new LAYER1 new DECS MODSETY1 MODS STOP + prelude packet of MODS{A7a} : + new LAYER1 new DECS MODSETY1 MODS STOP + module declaration of MODS{4a}, + where MODS absent from new LAYER1{e}. +e) WHETHER MODSETY MOD absent from NEST{c,d} : + WHETEHR MODSETY absent from NEST{e,f} + and MOD independent PROPSETY{71a,b,c}, + where PROPSETY collected properties from NEST{g,h}. +f) WHETHER EMPTY absent from NEST{e} : + WHETHER true. +g) WHETHER PROPSETY1 PROPSETY2 collected properties from + NEST new PROPSETY2{e,g} : + WHETHER PROPSETY1 collected properties from NEST {g,h}. +h) WHETHER EMPTY collected properties from new EMPTY{e,g} : + WHETHER true. + +i) *NEST new PROPSETY packet : + MOID NEST new PROPSETY LANGUAGE stuffing packet{a,b} ; + NEST new PROPSETY definition module packet of MODS{c} ; + NEST new PROPSETY particular program{A1g} ; + NEST new PROPSETY prelude packet of MODS{d}. +j) *letter symbol : LETTER symbol{94a}. +k) *digit symbol : DIGIT symbol{94b}. + +{ Examples: + + a) EGG "abc" = ACCESS A,B (x := 1; y := 2; print (x+y)) + c) EGG "abc" = MODULE A = DEF PUB REAL x FED + d) MODULE B = DEF PUB REAL y FED + + The thre examples above would form a compatible collection of + packets when taken in conjunction with the particular-program BEGIN + NEST "abc" END } + +{ In rule a above, 'MODSETY' envelops the 'MOD's defined by al the + definition-module-packets that are being stuffed along with the + stuffing-packet. + + In rules c and d, 'MODSETY1' need only envelop the 'MOD's for those + modules actually accessed from within that packet. + + The semantics related to packets are only defined if, for a + collection of packets being stuffed together, all the 'MOD's + enveloped by the various 'MODSETY1's are enveloped by 'MODSETY'. } + +{ A stuffing packet contains the definition of an actual-hole. For + Algol 68 this consists on an enclosed-clause. For other values of + the metanotion 'LANGUAGE' it is different, and it is expected to be + translated somehow to an equivalent Algol 68 definition, + conceptually naturally. + + A definition module packet contains the definition of an actual-hole + which consists in one or more joined module declarations, with the + restriction that none of the declared modules shall exist in the + static environment at the formal-hole. + + A prelude packet contains one or more joined module declarations. } + +10.7 Compilation systems + +{ An implementtion of Algol 68 in which packets of a collection are + compiled into a collection of object-modules should conform to the + provisions of this section. } + +10.7.1 Syntax + +{ Note that we use the notion "compilation unit" rather than the + original "compilation input" used in the IFIP modules definition. } + +A) *LAYERS :: LAYER ; LAYERS LAYER. + +a) compilation unit : + MOID NEST new MODSETY LANGUAGE stuffing packet{A6a,b}, + MOID NEST hole interface{d}, + joined module interface with MODSETY{b,c} ; + NEST new MODSETY1 MODS definition module packet of MODS{A6c}, + MOID NEST hole interface{d}, + joined module interface with MODSETY1{b,c}, + module interface with MODS{d} option ; + new LAYER1 new DECS MODSETY STOP particular program{A1g}, + { void new LAYER1 new DECS STOP hole interface,} + unless (DECS) contains (MODULE), + joined module interface with MODSETY{b,c} ; + new LAYER1 new DECS MODSETY1 MODS STOP + prelude packet of MODS{A6d}, + { void new LAYER1 new DECS STOP hole interface,} + unless (DECS) contains (module), + joined module interface with MODSETY1{b,c}, + module interface with MODS{d} option. +b) joined module interface with MODS MODSETY{a,b} : + module interface with MODS{d}, + joined module interface with MODSETY{b,c}. +c) joined module inteface with EMPTY{a,b} : EMPTY. + +{ A compilation-unit is either a stuffing packet, a definition module + packet, a particular program, or a prelude packet. The packets + shall be accompanied by the required hole and module interface + information. } + +{ d) Hyper-rules for "MOID NEST hole interface", "module interface + with MODS" and "MOID NEST object module". The terminal + productions will most likely be in some cryptic notation + understood only by the compiler, i.e. the interface data. } + +{ The inclusion of the hypernotions "void new LAYER1 new DECS STOP + hole interface" within pragmatic remarks in rule a is intended to + signify that this information (which describes the standard + environment) must clearly be available to the compiler, but that it + may well not be provided in the form of an explicit + hole-interface. } From df160b3addd2e7a32dc15879f6fe47a3b098f606 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:44:39 +0200 Subject: [PATCH 142/373] a68: ga68 compiler driver This commit adds the main sources for the ga68 compiler driver. Signed-off-by: Jose E. Marchesi gcc/ChangeLog: * algol68/a68spec.cc: New file. * algol68/lang-specs.h: Likewise. --- gcc/algol68/a68spec.cc | 222 +++++++++++++++++++++++++++++++++++++++ gcc/algol68/lang-specs.h | 24 +++++ 2 files changed, 246 insertions(+) create mode 100644 gcc/algol68/a68spec.cc create mode 100644 gcc/algol68/lang-specs.h diff --git a/gcc/algol68/a68spec.cc b/gcc/algol68/a68spec.cc new file mode 100644 index 000000000000..bc11abde76e9 --- /dev/null +++ b/gcc/algol68/a68spec.cc @@ -0,0 +1,222 @@ +/* a68spec.c -- Specific flags and argument handling of the Algol 68 front end. + Copyright (C) 2025 Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it under the + terms of the GNU General Public License as published by the Free Software + Foundation; either version 3, or (at your option) any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + details. + + You should have received a copy of the GNU General Public License along with + GCC; see the file COPYING3. If not see . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "opt-suggestions.h" +#include "gcc.h" +#include "tm.h" +#include "opts.h" + +/* satisfy intellisense */ +#include "options.h" + +/* How to link with libga68. */ +enum libga68_link_mode +{ + LIBGA68_NOLINK, + LIBGA68_STATIC, + LIBGA68_DYNAMIC +}; + +static enum libga68_link_mode libga68_link = LIBGA68_STATIC; + +/* This bit is set if we saw a `-xfoo' language specification. */ +#define LANGSPEC (1 << 1) +/* This bit is set if they did `-lc'. */ +#define WITHLIBC (1 << 2) +/* Skip this option. */ +#define SKIPOPT (1 << 3) + +void +lang_specific_driver (struct cl_decoded_option **in_decoded_options, + unsigned int *in_decoded_options_count, + int *in_added_libraries) +{ + unsigned int i, j; + + /* The new argument list will be contained in this. */ + struct cl_decoded_option *new_decoded_options; + + /* "-lc" if it appears on the command line. */ + const struct cl_decoded_option *saw_libc = 0; + + /* An array used to flag each argument that needs a bit set for + LANGSPEC or WITHLIBC. */ + int *args; + + /* True if we saw -static. */ + int static_link = 0; + + /* True if we should add -shared-libgcc to the command-line. */ + int shared_libgcc = 1; + + /* The total number of arguments with the new stuff. */ + unsigned int argc; + + /* The argument list. */ + struct cl_decoded_option *decoded_options; + + /* The number of libraries added in. */ + int added_libraries; + + /* The total number of arguments with the new stuff. */ + int num_args = 1; + + /* Whether the -o option was used. */ + // bool saw_opt_o = false; + + argc = *in_decoded_options_count; + decoded_options = *in_decoded_options; + added_libraries = *in_added_libraries; + + args = XCNEWVEC (int, argc); + + for (i = 1; i < argc; i++) + { + const char *arg = decoded_options[i].arg; + + switch (decoded_options[i].opt_index) + { + case OPT__help: + case OPT__help_: + /* Let gcc.cc handle this. */ + *in_added_libraries = 0; + return; + case OPT_c: + case OPT_E: + case OPT_M: + case OPT_MM: + case OPT_fsyntax_only: + case OPT_S: + libga68_link = LIBGA68_NOLINK; + break; + + case OPT_l: + if (strcmp (arg, "c") == 0) + args[i] |= WITHLIBC; + break; + + case OPT_o: + //saw_opt_o = true; + break; + + case OPT_static: + static_link = 1; + break; + + case OPT_static_libgcc: + shared_libgcc = 0; + break; + + case OPT_static_libga68: + libga68_link = LIBGA68_STATIC; +#ifdef HAVE_LD_STATIC_DYNAMIC + /* Remove -static-libga68 from the command only if target supports + LD_STATIC_DYNAMIC. When not supported, it is left in so that a + back-end target can use outfile substitution. */ + args[i] |= SKIPOPT; +#endif + break; + + case OPT_shared_libga68: + libga68_link = LIBGA68_DYNAMIC; + args[i] |= SKIPOPT; + break; + + case OPT_SPECIAL_input_file: + break; + } + } + + /* There's no point adding -shared-libgcc if we don't have a shared + libgcc. */ +#ifndef ENABLE_SHARED_LIBGCC + shared_libgcc = 0; +#endif + + /* Make sure to have room for the trailing NULL argument. + - libga68 adds `-Bstatic -lga68 -Bdynamic' */ + num_args = argc + shared_libgcc + 1 * 5 + 10; + new_decoded_options = XNEWVEC (struct cl_decoded_option, num_args); + + i = 0; + j = 0; + + /* Copy the 0th argument, i.e., the name of the program itself. */ + new_decoded_options[j++] = decoded_options[i++]; + + /* NOTE: We start at 1 now, not 0. */ + while (i < argc) + { + new_decoded_options[j] = decoded_options[i]; + + if (!saw_libc && (args[i] & WITHLIBC)) + { + --j; + saw_libc = &decoded_options[i]; + } + + if ((args[i] & SKIPOPT) != 0) + --j; + + i++; + j++; + } + + if (saw_libc) + new_decoded_options[j++] = *saw_libc; + if (shared_libgcc && !static_link) + generate_option (OPT_shared_libgcc, NULL, 1, CL_DRIVER, + &new_decoded_options[j++]); + + /* Add `-lga68 -lm' if we haven't already done so. */ +#ifdef HAVE_LD_STATIC_DYNAMIC + if (libga68_link == LIBGA68_STATIC && !static_link) + { + generate_option (OPT_Wl_, LD_STATIC_OPTION, 1, CL_DRIVER, + &new_decoded_options[j++]); + added_libraries++; /* The driver calls add_infile while handling -Wl */ + } +#endif + generate_option (OPT_l, + "ga68", 1, + CL_DRIVER, &new_decoded_options[j++]); + added_libraries++; +#ifdef HAVE_LD_STATIC_DYNAMIC + if (libga68_link == LIBGA68_STATIC && !static_link) + { + generate_option (OPT_Wl_, LD_DYNAMIC_OPTION, 1, CL_DRIVER, + &new_decoded_options[j++]); + added_libraries++; /* The driver calls add_infile while handling -Wl */ + } +#endif + *in_decoded_options_count = j; + *in_decoded_options = new_decoded_options; + *in_added_libraries = added_libraries; +} + +/* Called before linking. Returns 0 on success and -1 on failure. */ +int +lang_specific_pre_link (void) +{ + if (libga68_link != LIBGA68_NOLINK) + do_spec ("%:include(libga68.spec)"); + return 0; +} + +/* Number of extra output files that lang_specific_pre_link may generate. */ +int lang_specific_extra_outfiles = 0; /* Not used for Algol68. */ diff --git a/gcc/algol68/lang-specs.h b/gcc/algol68/lang-specs.h new file mode 100644 index 000000000000..737270c41f7a --- /dev/null +++ b/gcc/algol68/lang-specs.h @@ -0,0 +1,24 @@ +/* lang-specs.h -- gcc driver specs for Algol 68 frontend. + Copyright (C) 2025 Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it under + the terms of the GNU General Public License as published by the Free + Software Foundation; either version 3, or (at your option) any later + version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or + FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License + for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +/* This is the contribution to the `default_compilers' array in gcc.cc for the + Algol 68 language. */ + +{".a68", "@algol68", 0, 1, 0}, + {"@algol68", + "a681 %i %(cc1_options) %{I*} %{L*} %D %{!fsyntax-only:%(invoke_as)}", 0, 1, + 0}, From 58c3f0fb3d4d78cd3e75eeba6ae8102e31298743 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:45:09 +0200 Subject: [PATCH 143/373] a68: a681 compiler proper This commit adds the language hooks and the target hooks for the Algol 68 front-end, which implement the a681 compiler proper. Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-lang.cc: New file. --- gcc/algol68/a68-lang.cc | 755 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 755 insertions(+) create mode 100644 gcc/algol68/a68-lang.cc diff --git a/gcc/algol68/a68-lang.cc b/gcc/algol68/a68-lang.cc new file mode 100644 index 000000000000..8ba0259ce29d --- /dev/null +++ b/gcc/algol68/a68-lang.cc @@ -0,0 +1,755 @@ +/* Language-dependent hooks for Algol 68. + Copyright (C) 2025 Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "tree.h" +#include "toplev.h" +#include "langhooks.h" +#include "langhooks-def.h" +#include "target.h" +#include "stringpool.h" +#include "debug.h" +#include "diagnostic.h" +#include "opts.h" +#include "machmode.h" +#include "stor-layout.h" /* For layout_type */ +#include "vec.h" + +#include "a68.h" + +/* Global state for the Algol 68 front end. */ + +A68_T a68_common; + +/* Types expected by gcc's garbage collector. + These types exist to allow language front-ends to + add extra information in gcc's parse tree data structure. */ + +struct GTY(()) lang_type +{ + MOID_T * moid; +}; + +struct GTY(()) lang_decl +{ + NODE_T * node; +}; + +/* Language-specific identifier information. This must include a + tree_identifier. */ +struct GTY(()) lang_identifier +{ + struct tree_identifier common; +}; + + +struct GTY(()) language_function +{ + int dummy; +}; + +/* The Algol68 frontend Type AST for GCC type NODE. */ +#define TYPE_LANG_FRONTEND(NODE) \ + (TYPE_LANG_SPECIFIC (NODE) \ + ? TYPE_LANG_SPECIFIC (NODE)->type : NULL) + +/* The resulting tree type. */ + +union GTY((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"), + chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), " + "TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN " + "(&%h.generic)) : NULL"))) lang_tree_node +{ + union tree_node GTY((tag ("0"), + desc ("tree_node_structure (&%h)"))) generic; + struct lang_identifier GTY ((tag ("1"))) identifier; +}; + +/* Allocate and return a lang specific structure for type tree nodes. */ + +struct lang_type * +a68_build_lang_type (MOID_T *moid) +{ + tree ctype = CTYPE (moid); + struct lang_type *lt = ctype ? TYPE_LANG_SPECIFIC (ctype) : NULL; + + if (lt == NULL) + lt = (struct lang_type *) ggc_cleared_alloc (); + if (lt->moid == NULL) + lt->moid = moid; + return lt; +} + +/* Allocate and return a lang specific structure for decl tree nodes. */ + +struct lang_decl * +a68_build_lang_decl (NODE_T *node) +{ + tree cdecl = CDECL (node); + struct lang_decl *ld = cdecl ? DECL_LANG_SPECIFIC (cdecl) : NULL; + + if (ld == NULL) + ld = (struct lang_decl *) ggc_cleared_alloc (); + if (ld->node == NULL) + ld->node = node; + return ld; +} + +/* Get the front-end mode associated with the given TYPE. If no mode is + associated then this function returns NO_MODE. */ + +MOID_T * +a68_type_moid (tree type) +{ + gcc_assert (TYPE_LANG_SPECIFIC (type) != NULL + && TYPE_LANG_SPECIFIC (type)->moid != NO_MOID); + return TYPE_LANG_SPECIFIC (type)->moid; +} + +/* Build the type trees in a68_global_trees. */ + +static void +a68_build_a68_type_nodes (void) +{ + /* VOID */ + a68_void_type = make_node (RECORD_TYPE); + TYPE_NAME (a68_void_type) = get_identifier ("void%"); + TYPE_FIELDS (a68_void_type) = NULL_TREE; + TYPE_READONLY (a68_void_type) = 1; + TYPE_CXX_ODR_P (a68_void_type) = 1; + layout_type (a68_void_type); + + /* BOOL */ + a68_bool_type = boolean_type_node; + + /* CHAR */ + a68_char_type = uint32_type_node; + + /* SHORT SHORT INT + SHORT INT + INT */ + a68_short_short_int_type = signed_char_type_node; + a68_short_int_type = short_integer_type_node; + a68_int_type = integer_type_node; + + /* LONG INT */ + if (int_size_in_bytes (long_integer_type_node) + > int_size_in_bytes (a68_int_type)) + a68_long_int_type = long_integer_type_node; + else if (int_size_in_bytes (long_long_integer_type_node) + > int_size_in_bytes (a68_int_type)) + a68_long_int_type = long_long_integer_type_node; + else + a68_long_int_type = a68_int_type; + + /* LONG LONG INT */ + if (int_size_in_bytes (long_integer_type_node) + > int_size_in_bytes (a68_long_int_type)) + a68_long_long_int_type = long_integer_type_node; + else if (int_size_in_bytes (long_long_integer_type_node) + > int_size_in_bytes (a68_long_int_type)) + a68_long_long_int_type = long_long_integer_type_node; + else + a68_long_long_int_type = a68_long_int_type; + + /* SHORT SHORT BITS + SHORT BITS + BITS */ + a68_short_short_bits_type = unsigned_char_type_node; + a68_short_bits_type = short_unsigned_type_node; + a68_bits_type = unsigned_type_node; + + /* LONG BITS */ + if (int_size_in_bytes (long_unsigned_type_node) + > int_size_in_bytes (a68_bits_type)) + a68_long_bits_type = long_unsigned_type_node; + else if (int_size_in_bytes (long_long_unsigned_type_node) + > int_size_in_bytes (a68_bits_type)) + a68_long_bits_type = long_long_unsigned_type_node; + else + a68_long_bits_type = a68_bits_type; + + /* LONG LONG BITS */ + if (int_size_in_bytes (long_unsigned_type_node) + > int_size_in_bytes (a68_long_bits_type)) + a68_long_long_bits_type = long_unsigned_type_node; + else if (int_size_in_bytes (long_long_unsigned_type_node) + > int_size_in_bytes (a68_long_bits_type)) + a68_long_long_bits_type = long_long_unsigned_type_node; + else + a68_long_long_bits_type = a68_long_bits_type; + + /* BYTES + LONG BYTES */ + a68_bytes_type = unsigned_type_node; + a68_long_bytes_type = long_unsigned_type_node; + + /* REAL + LONG REAL + LONG LONG REAL */ + a68_real_type = float_type_node; + a68_long_real_type = double_type_node; + a68_long_long_real_type = long_double_type_node; +} + +/* Language hooks data structures. This is the main interface between + the GCC front-end and the GCC middle-end/back-end. A list of + language hooks can be found in langhooks.h. */ + +#undef LANG_HOOKS_NAME +#define LANG_HOOKS_NAME "GNU Algol 68" + +/* LANG_HOOKS_INIT gets called to initialize the front-end. + Invoked after option handling. */ + +static bool +a68_init (void) +{ + build_common_tree_nodes (false); + targetm.init_builtins (); + a68_build_a68_type_nodes (); + build_common_builtin_nodes (); + a68_install_builtins (); + + /* Initialize binding contexts. */ + a68_init_ranges (); + + /* Set the type of size_t. */ + if (TYPE_MODE (long_unsigned_type_node) == ptr_mode) + size_type_node = long_unsigned_type_node; + else if (TYPE_MODE (long_long_unsigned_type_node) == ptr_mode) + size_type_node = long_long_unsigned_type_node; + else + size_type_node = long_unsigned_type_node; + + /* Create an empty module files map. */ + A68_MODULE_FILES = hash_map::create_ggc (16); + A68_MODULE_FILES->empty (); + + return true; +} + +#undef LANG_HOOKS_INIT +#define LANG_HOOKS_INIT a68_init + +/* LANG_HOOKS_OPTION_LANG_MASK */ + +static unsigned int +a68_option_lang_mask (void) +{ + return CL_Algol68; +} + +#undef LANG_HOOKS_OPTION_LANG_MASK +#define LANG_HOOKS_OPTION_LANG_MASK a68_option_lang_mask + + +/* Return a data type that has machine mode MODE. If the mode is an + integer, then UNSIGNEDP selects between signed and unsigned types. */ + +static tree +a68_type_for_mode (enum machine_mode mode, int unsignedp) +{ + if (mode == QImode) + return unsignedp ? a68_short_short_bits_type :a68_short_short_int_type; + + if (mode == HImode) + return unsignedp ? a68_short_bits_type : a68_short_int_type; + + if (mode == SImode) + return unsignedp ? a68_bits_type : a68_int_type; + + if (mode == DImode) + return unsignedp ? a68_long_bits_type : a68_long_int_type; + + if (mode == TYPE_MODE (a68_long_long_bits_type)) + return unsignedp ? a68_long_long_bits_type : a68_long_long_int_type; + + if (mode == TYPE_MODE (a68_real_type)) + return a68_real_type; + + if (mode == TYPE_MODE (a68_long_real_type)) + return a68_long_real_type; + + if (mode == TYPE_MODE (a68_long_long_real_type)) + return a68_long_long_real_type; + + if (mode == TYPE_MODE (build_pointer_type (char_type_node))) + return build_pointer_type (char_type_node); + + if (mode == TYPE_MODE (build_pointer_type (integer_type_node))) + return build_pointer_type (integer_type_node); + + for (int i = 0; i < NUM_INT_N_ENTS; i ++) + { + if (int_n_enabled_p[i] && mode == int_n_data[i].m) + { + if (unsignedp) + return int_n_trees[i].unsigned_type; + else + return int_n_trees[i].signed_type; + } + } + + return 0; +} + +#undef LANG_HOOKS_TYPE_FOR_MODE +#define LANG_HOOKS_TYPE_FOR_MODE a68_type_for_mode + + +/* Return an integer type with BITS bits of precision, + that is unsigned if UNSIGNEDP is nonzero, otherwise signed. */ + +static tree +a68_type_for_size (unsigned int bits, int unsignedp) +{ + if (unsignedp) + { + if (bits <= TYPE_PRECISION (a68_short_short_bits_type)) + return a68_short_short_bits_type; + if (bits <= TYPE_PRECISION (a68_short_bits_type)) + return a68_short_bits_type; + if (bits <= TYPE_PRECISION (a68_bits_type)) + return a68_bits_type; + if (bits <= TYPE_PRECISION (a68_long_bits_type)) + return a68_long_bits_type; + if (bits <= TYPE_PRECISION (a68_long_long_bits_type)) + return a68_long_long_bits_type; + } + else + { + if (bits <= TYPE_PRECISION (a68_short_short_int_type)) + return a68_short_short_int_type; + if (bits <= TYPE_PRECISION (a68_short_int_type)) + return a68_short_int_type; + if (bits <= TYPE_PRECISION (a68_int_type)) + return a68_int_type; + if (bits <= TYPE_PRECISION (a68_long_int_type)) + return a68_long_int_type; + if (bits <= TYPE_PRECISION (a68_long_long_int_type)) + return a68_long_long_int_type; + } + + for (int i = 0; i < NUM_INT_N_ENTS; ++i) + { + if (int_n_enabled_p[i] && bits == int_n_data[i].bitsize) + { + if (unsignedp) + return int_n_trees[i].unsigned_type; + else + return int_n_trees[i].signed_type; + } + } + + return 0; +} + +#undef LANG_HOOKS_TYPE_FOR_SIZE +#define LANG_HOOKS_TYPE_FOR_SIZE a68_type_for_size + + +/* Implements the lang_hooks.decls.global_bindings_p routine for Algol 68. + Return true if we are in the global binding level. */ + +static bool +a68_global_bindings_p (void) +{ + return (current_function_decl == NULL_TREE); +} + +#undef LANG_HOOKS_GLOBAL_BINDINGS_P +#define LANG_HOOKS_GLOBAL_BINDINGS_P a68_global_bindings_p + +/* Implements the lang_hooks.decls.getdecls routine. + Return the list of declarations of the current level. */ + +static tree +a68_getdecls (void) +{ + return a68_range_names (); +} + +#undef LANG_HOOKS_GETDECLS +#define LANG_HOOKS_GETDECLS a68_getdecls + +/* Return A68_GLOBAL_CONTEXT, but create it first if need be. */ + +static tree +get_global_context (void) +{ + if (!A68_GLOBAL_CONTEXT) + { + A68_GLOBAL_CONTEXT = build_translation_unit_decl (NULL_TREE); + debug_hooks->register_main_translation_unit (A68_GLOBAL_CONTEXT); + } + + return A68_GLOBAL_CONTEXT; +} + +/* Implements the lang_hooks.decls.pushdecl routine. + Record DECL as belonging to the current lexical scope. */ + +static tree +pushdecl (tree decl) +{ + /* Set the context of the decl. If current_function_decl did not help in + determining the context, use global scope. */ + if (!DECL_CONTEXT (decl)) + { + if (current_function_decl) + DECL_CONTEXT (decl) = current_function_decl; + else + DECL_CONTEXT (decl) = get_global_context (); + } + + /* Put decls on list in reverse order. */ + if (TREE_STATIC (decl) || a68_global_bindings_p ()) + vec_safe_push (A68_GLOBAL_DECLARATIONS, decl); + else + a68_add_decl (decl); + + return decl; +} + +#undef LANG_HOOKS_PUSHDECL +#define LANG_HOOKS_PUSHDECL pushdecl + +/* Implements the lang_hooks.init_options routine for language Algol 68. This + initializes the global state for the frontend before calling the option + handlers. */ + +static void +a68_init_options (unsigned int argc ATTRIBUTE_UNUSED, + cl_decoded_option *decoded_options ATTRIBUTE_UNUSED) +{ + /* Nothing to do here for now. */ +} + +#undef LANG_HOOKS_INIT_OPTIONS +#define LANG_HOOKS_INIT_OPTIONS a68_init_options + + +/* Handle -fcheck= option. */ + +static void +a68_handle_runtime_check_option (const char *arg) +{ + int pos = 0; + + while (*arg) + { + /* We accept entries like -fcheck=nil,,bounds and -fcheck=,all. */ + while (*arg == ',') + arg++; + + while (arg[pos] && arg[pos] != ',') + pos++; + + /* Process an option flag in the -fcheck= specification. + + "all" means enable all run-time checks. + "none" means disable all run-time checks. + + Options are processed from left to right, with increase + precedende. */ + + if (strncmp (arg, "all", pos) == 0) + { + OPTION_NIL_CHECKING (&A68_JOB) = true; + OPTION_BOUNDS_CHECKING (&A68_JOB) = true; + } + else if (strncmp (arg, "none", pos) == 0) + { + OPTION_NIL_CHECKING (&A68_JOB) = false; + OPTION_BOUNDS_CHECKING (&A68_JOB) = false; + } + else if (strncmp (arg, "nil", pos) == 0) + OPTION_NIL_CHECKING (&A68_JOB) = true; + else if (strncmp (arg, "no-nil", pos) == 0) + OPTION_NIL_CHECKING (&A68_JOB) = false; + else if (strncmp (arg, "bounds", pos) == 0) + OPTION_BOUNDS_CHECKING (&A68_JOB) = true; + else if (strncmp (arg, "no-bounds", pos) == 0) + OPTION_BOUNDS_CHECKING (&A68_JOB) = false; + else + fatal_error (UNKNOWN_LOCATION, + "Argument to %<-fcheck%> is not valid: %s", arg); + + /* Process next flag. */ + arg += pos; + pos = 0; + } +} + +/* Handle Algol 68 specific options. Return false if we didn't do + anything. */ + +static bool +a68_handle_option (size_t scode, + const char *arg, + HOST_WIDE_INT value ATTRIBUTE_UNUSED, + int kind ATTRIBUTE_UNUSED, + location_t loc ATTRIBUTE_UNUSED, + const cl_option_handlers *handlers ATTRIBUTE_UNUSED) +{ + opt_code code = (opt_code) scode; + + switch (code) + { + case OPT_std_algol68: + OPTION_STRICT (&A68_JOB) = 1; + break; + case OPT_fbrackets: + OPTION_BRACKETS (&A68_JOB) = flag_brackets; + break; + case OPT_fassert: + OPTION_ASSERT (&A68_JOB) = flag_assert; + break; + case OPT_fcheck_: + a68_handle_runtime_check_option (arg); + break; + case OPT_fstropping_: + if (value == 0) + OPTION_STROPPING (&A68_JOB) = UPPER_STROPPING; + else + OPTION_STROPPING (&A68_JOB) = SUPPER_STROPPING; + break; + case OPT_I: + vec_safe_push (A68_INCLUDE_PATHS, arg); + vec_safe_push (A68_IMPORT_PATHS, arg); + break; + case OPT_L: + vec_safe_push (A68_IMPORT_PATHS, arg); + break; + default: + break; + } + + return true; +} + +#undef LANG_HOOKS_HANDLE_OPTION +#define LANG_HOOKS_HANDLE_OPTION a68_handle_option + +/* LANG_HOOKS_INIT_OPTIONS_STRUCT is called so the front-end can + change some default values in the compiler's option structure. */ + +static void +a68_init_options_struct (struct gcc_options *opts) +{ + /* Operations are always wrapping in algol68, even on signed + integer. */ + opts->x_flag_wrapv = 1; + /* Do not warn for voiding by default. */ + opts->x_warn_algol68_voiding = 0; + /* Do not warn for usage of Algol 68 extensions by default. */ + opts->x_warn_algol68_extensions = 0; + /* Do not warn for potential scope violations by default. */ + opts->x_warn_algol68_scope = 0; + /* Do not warn for hidden declarations by default. */ + opts->x_warn_algol68_hidden_declarations = 0; + /* Enable assertions by default. */ + OPTION_ASSERT (&A68_JOB) = 1; + /* Disable run-time nil checking by default. */ + OPTION_NIL_CHECKING (&A68_JOB) = 0; + /* Enable run-time bounds checking by default. */ + OPTION_BOUNDS_CHECKING (&A68_JOB) = 1; + opts->x_flag_assert = 1; + /* Allow GNU extensions by default. */ + OPTION_STRICT (&A68_JOB) = 0; + /* The default stropping regime is SUPPER. */ + OPTION_STROPPING (&A68_JOB) = SUPPER_STROPPING; +} + +#undef LANG_HOOKS_INIT_OPTIONS_STRUCT +#define LANG_HOOKS_INIT_OPTIONS_STRUCT a68_init_options_struct + +/* Deal with any options that imply the turning on/off of features. FILENAME + is the main input file passed on the command line. */ + +static bool +a68_post_options (const char **filename ATTRIBUTE_UNUSED) +{ + /* -fbounds-check is equivalent to -fcheck=bounds */ + if (flag_bounds_check) + OPTION_BOUNDS_CHECKING (&A68_JOB) = true; + + return false; +} + +#undef LANG_HOOKS_POST_OPTIONS +#define LANG_HOOKS_POST_OPTIONS a68_post_options + +/* LANG_HOOKS_PARSE_FILE is called to parse the input files. + + The input file names are available in the global variables + in_fnames and num_in_fnames, and this function is required to + create a complete parse tree from them in a global var, then + return. */ + +MOIF_T *moif; + +static void +a68_parse_file (void) +{ + if (num_in_fnames != 1) + fatal_error (UNKNOWN_LOCATION, + "exactly one source file must be specified on the command line"); + + /* Run the Mailloux parser. */ + a68_parser (in_fnames[0]); + + if (ERROR_COUNT (&A68_JOB) > 0) + goto had_errors; + + /* Generate dumps if so requested. */ + if (flag_a68_dump_modes) + a68_dump_modes (TOP_MOID (&A68_JOB)); + if (flag_a68_dump_ast) + a68_dump_parse_tree (TOP_NODE (&A68_JOB)); + + /* Lower modes to GENERIC. */ + a68_lower_moids (TOP_MOID (&A68_JOB)); + /* Lower the particular program. */ + a68_lower_top_tree (TOP_NODE (&A68_JOB)); + + if (ERROR_COUNT (&A68_JOB) > 0) + goto had_errors; + + /* Emit exports information for any compiled module in this packet. Note + this must be done after the low pass. */ + a68_do_exports (TOP_NODE (&A68_JOB)); + + /* Process all file scopes in this compilation, and the external_scope, + through wrapup_global_declarations. */ + for (unsigned int i = 0; i < vec_safe_length (A68_GLOBAL_DECLARATIONS); i++) + { + tree decl = vec_safe_address (A68_GLOBAL_DECLARATIONS)[i]; + wrapup_global_declarations (&decl, 1); + } + + had_errors: + errorcount += ERROR_COUNT (&A68_JOB); +} + +#undef LANG_HOOKS_PARSE_FILE +#define LANG_HOOKS_PARSE_FILE a68_parse_file + +/* This hook is called for every GENERIC tree that gets gimplified. + Its purpose is to gimplify language specific trees. + + At the moment we are not supporting any Algol 68 specific tree, so + we just return FALSE. */ + +static int +a68_gimplify_expr (tree *expr_p ATTRIBUTE_UNUSED, + gimple_seq *pre_p ATTRIBUTE_UNUSED, + gimple_seq *post_p ATTRIBUTE_UNUSED) +{ + return false; +} + +#undef LANG_HOOKS_GIMPLIFY_EXPR +#define LANG_HOOKS_GIMPLIFY_EXPR a68_gimplify_expr + +/* This function shall return the printable name of the language. */ + +static const char * +a68_printable_name (tree decl, int kind ATTRIBUTE_UNUSED) +{ + tree decl_name = DECL_NAME (decl); + + if (decl_name == NULL_TREE) + return ""; + else + return IDENTIFIER_POINTER (decl_name); +} + +#undef LANG_HOOKS_DECL_PRINTABLE_NAME +#define LANG_HOOKS_DECL_PRINTABLE_NAME a68_printable_name + + +/* Return true if a warning should be given about option OPTION, which is for + the wrong language, false if it should be quietly ignored. */ + +static bool +a68_complain_wrong_lang_p (const struct cl_option *option ATTRIBUTE_UNUSED) +{ + return false; +} + +#undef LANG_HOOKS_COMPLAIN_WRONG_LANG_P +#define LANG_HOOKS_COMPLAIN_WRONG_LANG_P a68_complain_wrong_lang_p + +/* Create an expression whose value is that of EXPR, + converted to type TYPE. The TREE_TYPE of the value + is always TYPE. This function implements all reasonable + conversions; callers should filter out those that are + not permitted by the language being compiled. + + Note that this function is not used outside the front-end. This front-end + doesn't currently use it at all. */ + +tree convert (tree type ATTRIBUTE_UNUSED, + tree expr ATTRIBUTE_UNUSED) +{ + gcc_unreachable (); +} + +/* Implements the lang_hooks.types_compatible_p routine for Algol 68. + Compares two types for equivalence in Algol 68. + This routine should only return 1 if it is sure, even though the frontend + should have already ensured that all types are compatible before handing + over the parsed ASTs to the code generator. */ + +static int +a68_types_compatible_p (tree x, tree y) +{ + MOID_T *mode_x = a68_type_moid (x); + MOID_T *mode_y = a68_type_moid (y); + + if (mode_x != NO_MOID && mode_y != NO_MOID) + return a68_is_equal_modes (mode_x, mode_y, SAFE_DEFLEXING); + + return false; +} + +#undef LANG_HOOKS_TYPES_COMPATIBLE_P +#define LANG_HOOKS_TYPES_COMPATIBLE_P a68_types_compatible_p + +/* Get a value for the SARIF v2.1.0 "artifact.sourceLanguage" property. Algol + 68 is not yet listed in SARIF v2.1.0 Appendix J, but if/when it does, it + will likely use this string. */ + +const char * +a68_get_sarif_source_language (const char *) +{ + return "algol68"; +} + +#undef LANG_HOOKS_GET_SARIF_SOURCE_LANGUAGE +#define LANG_HOOKS_GET_SARIF_SOURCE_LANGUAGE a68_get_sarif_source_language + +/* Expands all LANG_HOOKS_x o GCC. */ +struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; + +#include "gt-algol68-a68-lang.h" +#include "gtype-algol68.h" From c92ad59aa2d1acc3d1c12ae484ada707fa1fcaa1 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:45:27 +0200 Subject: [PATCH 144/373] a68: unicode support routines This commit adds several utility functions to deal with Unicode strings. These functions have been adapted from the libunistring gnulib module. gcc/ChangeLog * algol68/a68-unistr.c: New file. --- gcc/algol68/a68-unistr.c | 453 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 453 insertions(+) create mode 100644 gcc/algol68/a68-unistr.c diff --git a/gcc/algol68/a68-unistr.c b/gcc/algol68/a68-unistr.c new file mode 100644 index 000000000000..ee7a6d7831f6 --- /dev/null +++ b/gcc/algol68/a68-unistr.c @@ -0,0 +1,453 @@ +/* Character conversion functions for the Algol 68 front-end. + Copyright (C) 1999-2002, 2006-2007, 2009-2024 Free Software Foundation, Inc. + Copyright (C) 2025 Jose E. Marchesi. + + The code in this file has been adapted from the unistr gnulib module, + written by Bruno Haible. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "a68.h" + +static int +u8_mbtoucr (uint32_t *puc, const uint8_t *s, size_t n) +{ + uint8_t c = *s; + + if (c < 0x80) + { + *puc = c; + return 1; + } + else if (c >= 0xc2) + { + if (c < 0xe0) + { + if (n >= 2) + { + if ((s[1] ^ 0x80) < 0x40) + { + *puc = ((unsigned int) (c & 0x1f) << 6) + | (unsigned int) (s[1] ^ 0x80); + return 2; + } + /* invalid multibyte character */ + } + else + { + /* incomplete multibyte character */ + *puc = 0xfffd; + return -2; + } + } + else if (c < 0xf0) + { + if (n >= 2) + { + if ((s[1] ^ 0x80) < 0x40 + && (c >= 0xe1 || s[1] >= 0xa0) + && (c != 0xed || s[1] < 0xa0)) + { + if (n >= 3) + { + if ((s[2] ^ 0x80) < 0x40) + { + *puc = ((unsigned int) (c & 0x0f) << 12) + | ((unsigned int) (s[1] ^ 0x80) << 6) + | (unsigned int) (s[2] ^ 0x80); + return 3; + } + /* invalid multibyte character */ + } + else + { + /* incomplete multibyte character */ + *puc = 0xfffd; + return -2; + } + } + /* invalid multibyte character */ + } + else + { + /* incomplete multibyte character */ + *puc = 0xfffd; + return -2; + } + } + else if (c <= 0xf4) + { + if (n >= 2) + { + if ((s[1] ^ 0x80) < 0x40 + && (c >= 0xf1 || s[1] >= 0x90) + && (c < 0xf4 || (/* c == 0xf4 && */ s[1] < 0x90))) + { + if (n >= 3) + { + if ((s[2] ^ 0x80) < 0x40) + { + if (n >= 4) + { + if ((s[3] ^ 0x80) < 0x40) + { + *puc = ((unsigned int) (c & 0x07) << 18) + | ((unsigned int) (s[1] ^ 0x80) << 12) + | ((unsigned int) (s[2] ^ 0x80) << 6) + | (unsigned int) (s[3] ^ 0x80); + return 4; + } + /* invalid multibyte character */ + } + else + { + /* incomplete multibyte character */ + *puc = 0xfffd; + return -2; + } + } + /* invalid multibyte character */ + } + else + { + /* incomplete multibyte character */ + *puc = 0xfffd; + return -2; + } + } + /* invalid multibyte character */ + } + else + { + /* incomplete multibyte character */ + *puc = 0xfffd; + return -2; + } + } + } + /* invalid multibyte character */ + *puc = 0xfffd; + return -1; +} + +/* Get the UCS code for the first character of a given UTF-8 string. */ + +int +a68_u8_mbtouc (uint32_t *puc, const uint8_t *s, size_t n) +{ + uint8_t c = *s; + + if (c < 0x80) + { + *puc = c; + return 1; + } + else if (c >= 0xc2) + { + if (c < 0xe0) + { + if (n >= 2) + { + if ((s[1] ^ 0x80) < 0x40) + { + *puc = ((unsigned int) (c & 0x1f) << 6) + | (unsigned int) (s[1] ^ 0x80); + return 2; + } + /* invalid multibyte character */ + } + else + { + /* incomplete multibyte character */ + *puc = 0xfffd; + return 1; + } + } + else if (c < 0xf0) + { + if (n >= 3) + { + if ((s[1] ^ 0x80) < 0x40 + && (c >= 0xe1 || s[1] >= 0xa0) + && (c != 0xed || s[1] < 0xa0)) + { + if ((s[2] ^ 0x80) < 0x40) + { + *puc = ((unsigned int) (c & 0x0f) << 12) + | ((unsigned int) (s[1] ^ 0x80) << 6) + | (unsigned int) (s[2] ^ 0x80); + return 3; + } + /* invalid multibyte character */ + *puc = 0xfffd; + return 2; + } + /* invalid multibyte character */ + *puc = 0xfffd; + return 1; + } + else + { + *puc = 0xfffd; + if (n == 1) + { + /* incomplete multibyte character */ + return 1; + } + else + { + if ((s[1] ^ 0x80) < 0x40 + && (c >= 0xe1 || s[1] >= 0xa0) + && (c != 0xed || s[1] < 0xa0)) + { + /* incomplete multibyte character */ + return 2; + } + else + { + /* invalid multibyte character */ + return 1; + } + } + } + } + else if (c <= 0xf4) + { + if (n >= 4) + { + if ((s[1] ^ 0x80) < 0x40 + && (c >= 0xf1 || s[1] >= 0x90) + && (c < 0xf4 || (/* c == 0xf4 && */ s[1] < 0x90))) + { + if ((s[2] ^ 0x80) < 0x40) + { + if ((s[3] ^ 0x80) < 0x40) + { + *puc = ((unsigned int) (c & 0x07) << 18) + | ((unsigned int) (s[1] ^ 0x80) << 12) + | ((unsigned int) (s[2] ^ 0x80) << 6) + | (unsigned int) (s[3] ^ 0x80); + return 4; + } + /* invalid multibyte character */ + *puc = 0xfffd; + return 3; + } + /* invalid multibyte character */ + *puc = 0xfffd; + return 2; + } + /* invalid multibyte character */ + *puc = 0xfffd; + return 1; + } + else + { + *puc = 0xfffd; + if (n == 1) + { + /* incomplete multibyte character */ + return 1; + } + else + { + if ((s[1] ^ 0x80) < 0x40 + && (c >= 0xf1 || s[1] >= 0x90) + && (c < 0xf4 || (/* c == 0xf4 && */ s[1] < 0x90))) + { + if (n == 2) + { + /* incomplete multibyte character */ + return 2; + } + else + { + if ((s[2] ^ 0x80) < 0x40) + { + /* incomplete multibyte character */ + return 3; + } + else + { + /* invalid multibyte character */ + return 2; + } + } + } + else + { + /* invalid multibyte character */ + return 1; + } + } + } + } + } + /* invalid multibyte character */ + *puc = 0xfffd; + return 1; +} + +/* Encode a given UCS code in UTF-8. */ + +int +a68_u8_uctomb (uint8_t *s, uint32_t uc, ptrdiff_t n) +{ + if (uc < 0x80) + { + if (n > 0) + { + s[0] = uc; + return 1; + } + /* else return -2, below. */ + } + else + { + int count; + + if (uc < 0x800) + count = 2; + else if (uc < 0x10000) + { + if (uc < 0xd800 || uc >= 0xe000) + count = 3; + else + return -1; + } + else if (uc < 0x110000) + count = 4; + else + return -1; + + if (n >= count) + { + switch (count) /* note: code falls through cases! */ + { + case 4: s[3] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x10000; + gcc_fallthrough (); + case 3: s[2] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x800; + gcc_fallthrough (); + case 2: s[1] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0xc0; + /*case 1:*/ s[0] = uc; + } + return count; + } + } + return -2; +} + +/* Convert UTF-8 to UTF-32/UCS-4 */ + +uint32_t * +a68_u8_to_u32 (const uint8_t *s, size_t n, uint32_t *resultbuf, size_t *lengthp) +{ + const uint8_t *s_end = s + n; + /* Output string accumulator. */ + uint32_t *result; + size_t allocated; + size_t length; + + if (resultbuf != NULL) + { + result = resultbuf; + allocated = *lengthp; + } + else + { + result = NULL; + allocated = 0; + } + length = 0; + /* Invariants: + result is either == resultbuf or == NULL or malloc-allocated. + If length > 0, then result != NULL. */ + + while (s < s_end) + { + uint32_t uc; + int count; + + /* Fetch a Unicode character from the input string. */ + count = u8_mbtoucr (&uc, s, s_end - s); + if (count < 0) + { + if (!(result == resultbuf || result == NULL)) + free (result); + errno = EILSEQ; + return NULL; + } + s += count; + + /* Store it in the output string. */ + if (length + 1 > allocated) + { + uint32_t *memory; + + allocated = (allocated > 0 ? 2 * allocated : 12); + if (length + 1 > allocated) + allocated = length + 1; + if (result == resultbuf || result == NULL) + memory = (uint32_t *) xmalloc (allocated * sizeof (uint32_t)); + else + memory = + (uint32_t *) xrealloc (result, allocated * sizeof (uint32_t)); + + if (memory == NULL) + { + if (!(result == resultbuf || result == NULL)) + free (result); + errno = ENOMEM; + return NULL; + } + if (result == resultbuf && length > 0) + memcpy ((char *) memory, (char *) result, + length * sizeof (uint32_t)); + result = memory; + } + result[length++] = uc; + } + + if (length == 0) + { + if (result == NULL) + { + /* Return a non-NULL value. NULL means error. */ + result = (uint32_t *) xmalloc (sizeof (uint32_t)); + if (result == NULL) + { + errno = ENOMEM; + return NULL; + } + } + } + else if (result != resultbuf && length < allocated) + { + /* Shrink the allocated memory if possible. */ + uint32_t *memory; + + memory = (uint32_t *) xrealloc (result, length * sizeof (uint32_t)); + if (memory != NULL) + result = memory; + } + + *lengthp = length; + return result; +} From 54d11abf262b5a6c1786fe4b78c7a3fd39cc4412 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:45:45 +0200 Subject: [PATCH 145/373] a68: front-end diagnostics This commit adds the diagnostics infrastructure for the Algol 68 front-end. Signed-off-by: Jose E. Marchesi Co-authored-by: Marcel van der Veer gcc/ChangeLog * algol68/a68-diagnostics.cc: New file. --- gcc/algol68/a68-diagnostics.cc | 381 +++++++++++++++++++++++++++++++++ 1 file changed, 381 insertions(+) create mode 100644 gcc/algol68/a68-diagnostics.cc diff --git a/gcc/algol68/a68-diagnostics.cc b/gcc/algol68/a68-diagnostics.cc new file mode 100644 index 000000000000..0c25da2a21f3 --- /dev/null +++ b/gcc/algol68/a68-diagnostics.cc @@ -0,0 +1,381 @@ +/* Error and warning routines. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted and expanded for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "diagnostic.h" + +#include "a68.h" + +/* + * Error handling routines. + */ + +#define TABULATE(n) (8 * (n / 8 + 1) - n) + +/* Severities handled by the DIAGNOSTIC function defined below. */ + +#define A68_ERROR 0 +#define A68_WARNING 1 +#define A68_FATAL 2 +#define A68_SCAN_ERROR 3 +#define A68_INFORM 4 + +/* Give a diagnostic message. */ + +#if __GNUC__ >= 10 +#pragma GCC diagnostic ignored "-Wsuggest-attribute=format" +#endif + +static bool +diagnostic (int sev, int opt, + NODE_T *p, + LINE_T *line, + char *pos, + const char *loc_str, va_list args) +{ + int res = 0; + MOID_T *moid = NO_MOID; + const char *t = loc_str; + obstack b; + + /* + * Synthesize diagnostic message. + * + * Legend for special symbols: + * * as first character, copy rest of string literally + * @ AST node + * A AST node attribute + * B keyword + * C context + * L line number + * M moid - if error mode return without giving a message + * O moid - operand + * S quoted symbol, when possible with typographical display features + * X expected attribute + * Y string literal. + * Z quoted string. */ + + static va_list argp; /* Note this is empty. */ + gcc_obstack_init (&b); + + if (t[0] == '*') + obstack_grow (&b, t + 1, strlen (t + 1)); + else + while (t[0] != '\0') + { + if (t[0] == '@') + { + const char *nt = a68_attribute_name (ATTRIBUTE (p)); + if (t != NO_TEXT) + obstack_grow (&b, nt, strlen (nt)); + else + obstack_grow (&b, "construct", strlen ("construct")); + } + else if (t[0] == 'A') + { + enum a68_attribute att = (enum a68_attribute) va_arg (args, int); + const char *nt = a68_attribute_name (att); + if (nt != NO_TEXT) + obstack_grow (&b, nt, strlen (nt)); + else + obstack_grow (&b, "construct", strlen ("construct")); + } + else if (t[0] == 'B') + { + enum a68_attribute att = (enum a68_attribute) va_arg (args, int); + KEYWORD_T *nt = a68_find_keyword_from_attribute (A68 (top_keyword), att); + if (nt != NO_KEYWORD) + { + const char *strop_keyword = a68_strop_keyword (TEXT (nt)); + + obstack_grow (&b, "%<", 2); + obstack_grow (&b, strop_keyword, strlen (strop_keyword)); + obstack_grow (&b, "%>", 2); + } + else + obstack_grow (&b, "keyword", strlen ("keyword")); + } + else if (t[0] == 'C') + { + int att = va_arg (args, int); + const char *sort = NULL; + + switch (att) + { + case NO_SORT: sort = "this"; break; + case SOFT: sort = "a soft"; break; + case WEAK: sort = "a weak"; break; + case MEEK: sort = "a meek"; break; + case FIRM: sort = "a meek"; break; + case STRONG: sort = "a strong"; break; + default: + gcc_unreachable (); + } + + obstack_grow (&b, sort, strlen (sort)); + } + else if (t[0] == 'L') + { + LINE_T *a = va_arg (args, LINE_T *); + gcc_assert (a != NO_LINE); + if (NUMBER (a) == 0) + obstack_grow (&b, "in standard environment", + strlen ("in standard environment")); + else if (p != NO_NODE && NUMBER (a) == LINE_NUMBER (p)) + obstack_grow (&b, "in this line", strlen ("in this line")); + else + { + char d[10]; + if (snprintf (d, 10, "in line %d", NUMBER (a)) < 0) + gcc_unreachable (); + obstack_grow (&b, d, strlen (d)); + } + } + else if (t[0] == 'M') + { + const char *moidstr = NULL; + + moid = va_arg (args, MOID_T *); + if (moid == NO_MOID || moid == M_ERROR) + moid = M_UNDEFINED; + + if (IS (moid, SERIES_MODE)) + { + if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK) + moidstr = a68_moid_to_string (MOID (PACK (moid)), + MOID_ERROR_WIDTH, p); + else + moidstr = a68_moid_to_string (moid, MOID_ERROR_WIDTH, p); + } + else + moidstr = a68_moid_to_string (moid, MOID_ERROR_WIDTH, p); + + obstack_grow (&b, "%<", 2); + obstack_grow (&b, moidstr, strlen (moidstr)); + obstack_grow (&b, "%>", 2); + } + else if (t[0] == 'O') + { + moid = va_arg (args, MOID_T *); + if (moid == NO_MOID || moid == M_ERROR) + moid = M_UNDEFINED; + if (moid == M_VOID) + obstack_grow (&b, "UNION (VOID, ..)", strlen ("UNION (VOID, ..)")); + else if (IS (moid, SERIES_MODE)) + { + const char *moidstr = NULL; + + if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK) + moidstr = a68_moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p); + else + moidstr = a68_moid_to_string (moid, MOID_ERROR_WIDTH, p); + obstack_grow (&b, moidstr, strlen (moidstr)); + } + else + { + const char *moidstr = a68_moid_to_string (moid, MOID_ERROR_WIDTH, p); + obstack_grow (&b, moidstr, strlen (moidstr)); + } + } + else if (t[0] == 'S') + { + if (p != NO_NODE && NSYMBOL (p) != NO_TEXT) + { + const char *txt = NSYMBOL (p); + char *sym = NCHAR_IN_LINE (p); + int n = 0, size = (int) strlen (txt); + + obstack_grow (&b, "%<", 2); + if (txt[0] != sym[0] || (int) strlen (sym) < size) + obstack_grow (&b, txt, strlen (txt)); + else + { + while (n < size) + { + if (ISPRINT (sym[0])) + obstack_1grow (&b, sym[0]); + if (TOLOWER (txt[0]) == TOLOWER (sym[0])) + { + txt++; + n++; + } + sym++; + } + } + obstack_grow (&b, "%>", 2); + } + else + obstack_grow (&b, "symbol", strlen ("symbol")); + } + else if (t[0] == 'X') + { + enum a68_attribute att = (enum a68_attribute) (va_arg (args, int)); + const char *att_name = a68_attribute_name (att); + obstack_grow (&b, att_name, strlen (att_name)); + } + else if (t[0] == 'Y') + { + char *loc_string = va_arg (args, char *); + obstack_grow (&b, loc_string, strlen (loc_string)); + } + else if (t[0] == 'Z') + { + char *str = va_arg (args, char *); + obstack_grow (&b, "%<", 2); + obstack_grow (&b, str, strlen (str)); + obstack_grow (&b, "%>", 2); + } + else + obstack_1grow (&b, t[0]); + + t++; + } + + obstack_1grow (&b, '\0'); + char *format = (char *) obstack_finish (&b); + + /* Construct a diagnostic message. */ + if (sev == A68_WARNING) + WARNING_COUNT (&A68_JOB)++; + else if (sev != A68_INFORM) + ERROR_COUNT (&A68_JOB)++; + + /* Emit the corresponding GCC diagnostic at the proper location. */ + location_t loc = UNKNOWN_LOCATION; + + if (p != NO_NODE) + loc = a68_get_node_location (p); + else if (line != NO_LINE) + { + if (pos == NO_TEXT) + pos = STRING (line); + loc = a68_get_line_location (line, pos); + } + + /* Prepare rich location and diagnostics. */ + rich_location rich_loc (line_table, loc); + diagnostics::diagnostic_info diagnostic; + enum diagnostics::kind kind; + + switch (sev) + { + case A68_FATAL: + kind = diagnostics::kind::fatal; + break; + case A68_INFORM: + kind = diagnostics::kind::note; + break; + case A68_WARNING: + kind = diagnostics::kind::warning; + break; + case A68_SCAN_ERROR: + case A68_ERROR: + kind = diagnostics::kind::error; + break; + default: + gcc_unreachable (); + } + + diagnostic_set_info (&diagnostic, format, + &argp, + &rich_loc, kind); + if (opt != 0) + diagnostic.m_option_id = opt; + res = diagnostic_report_diagnostic (global_dc, &diagnostic); + + if (sev == A68_SCAN_ERROR) + exit (FATAL_EXIT_CODE); + return res; +} + +/* Give an intelligible error and exit. A line is provided rather than a + node so this can be used at scanning time. */ + +void +a68_scan_error (LINE_T * u, char *v, const char *txt, ...) +{ + va_list args; + + va_start (args, txt); + diagnostic (A68_SCAN_ERROR, 0, NO_NODE, u, v, txt, args); + va_end (args); +} + +/* Report a compilation error. */ + +void +a68_error (NODE_T *p, const char *loc_str, ...) +{ + va_list args; + + va_start (args, loc_str); + diagnostic (A68_ERROR, 0, p, NO_LINE, NO_TEXT, loc_str, args); + va_end (args); +} + +/* Report a compilation error in a node's pragmat. */ + +void +a68_error_in_pragmat (NODE_T *p, size_t off, + const char *loc_str, ...) +{ + va_list args; + + LINE_T *line = NPRAGMAT_LINE (p); + char *pos = NPRAGMAT_CHAR_IN_LINE (p) + off; + + va_start (args, loc_str); + diagnostic (A68_ERROR, 0, NO_NODE, line, pos, loc_str, args); + va_end (args); + a68_inform (p, "pragmat applies to this construct"); +} + +/* Report a compilation warning. + This function returns a boolean indicating whether a warning was + emitted. */ + +bool +a68_warning (NODE_T *p, int opt, + const char *loc_str, ...) +{ + bool res; + va_list args; + + va_start (args, loc_str); + res = diagnostic (A68_WARNING, opt, p, NO_LINE, NO_TEXT, loc_str, args); + va_end (args); + return res; +} + +/* Report a compilation note. */ + +void +a68_inform (NODE_T *p, const char *loc_str, ...) +{ + va_list args; + + va_start (args, loc_str); + diagnostic (A68_INFORM, 0, p, NO_LINE, NO_TEXT, loc_str, args); + va_end (args); +} From 51b5a394d93348d1ef85de394604bb35bacf7aed Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 22 Nov 2025 02:19:13 +0100 Subject: [PATCH 146/373] a68: modules exports This commit adds the code that handles the exports information for the module definitions in prelude packets. The exports info is generated in a section in the output object file. A precise description of the binary format in which the exports are encoded is expressed in an included GNU poke pickle ga68-exports.pk. Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-exports.cc: New file. * algol68/ga68-exports.pk: Likewise. --- gcc/algol68/a68-exports.cc | 598 ++++++++++++++++++++++++++++++++++++ gcc/algol68/ga68-exports.pk | 297 ++++++++++++++++++ 2 files changed, 895 insertions(+) create mode 100644 gcc/algol68/a68-exports.cc create mode 100644 gcc/algol68/ga68-exports.pk diff --git a/gcc/algol68/a68-exports.cc b/gcc/algol68/a68-exports.cc new file mode 100644 index 000000000000..58d04d5842bc --- /dev/null +++ b/gcc/algol68/a68-exports.cc @@ -0,0 +1,598 @@ +/* Exporting Algol 68 module interfaces. + Copyright (C) 2025 Jose E. Marchesi. + Copyright (C) 2010-2025 Free Software Foundation, Inc. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "tree.h" +#include "target.h" +#include "tm_p.h" +#include "simple-object.h" +#include "varasm.h" +#include "intl.h" +#include "output.h" /* for assemble_string */ +#include "common/common-target.h" +#include "dwarf2asm.h" + +#include + +#include "a68.h" + +#ifndef TARGET_AIX_OS +#define TARGET_AIX_OS 0 +#endif + +/* The size of the target's pointer type. */ +#ifndef PTR_SIZE +#define PTR_SIZE (POINTER_SIZE / BITS_PER_UNIT) +#endif + +/* Create a new module interface, initially with no modes and no + extracts. MODULE_NAME is the name of the module as it is accessed at the + source level, which corresponds to a bold word. */ + +MOIF_T * +a68_moif_new (const char *module_name) +{ + MOIF_T *moif = ggc_cleared_alloc (); + + VERSION (moif) = GA68_EXPORTS_VERSION; + NAME (moif) = (module_name == NULL ? NULL : ggc_strdup (module_name)); + PRELUDE (moif) = NULL; + POSTLUDE (moif) = NULL; + vec_alloc (MODES (moif), 16); + vec_alloc (MODULES (moif), 16); + vec_alloc (IDENTIFIERS (moif), 16); + vec_alloc (INDICANTS (moif), 16); + vec_alloc (PRIOS (moif), 16); + vec_alloc (OPERATORS (moif), 16); + return moif; +} + +/* Add a new mode to a module interface. */ + +static void +a68_add_moid_to_moif (MOIF_T *moif, MOID_T *m) +{ + if (! MODES(moif)->contains (m)) + vec_safe_push (MODES (moif), m); +} + +/* Add a new identifier extract to a module interface. */ + +void +a68_add_identifier_to_moif (MOIF_T *moif, TAG_T *tag) +{ + EXTRACT_T *e = ggc_alloc (); + const char *tag_symbol = IDENTIFIER_POINTER (DECL_NAME (TAX_TREE_DECL (tag))); + + EXTRACT_KIND (e) = GA68_EXTRACT_IDEN; + EXTRACT_SYMBOL (e) = ggc_strdup (tag_symbol); + EXTRACT_MODE (e) = MOID (tag); + EXTRACT_PRIO (e) = 0; + EXTRACT_VARIABLE (e) = VARIABLE (tag); + EXTRACT_IN_PROC (e) = IN_PROC (tag); + + if (! IDENTIFIERS (moif)->contains (e)) + { + a68_add_moid_to_moif (moif, MOID (tag)); + vec_safe_push (IDENTIFIERS (moif), e); + } +} + +/* Add a new mode indicant extract to a module interface. */ + +static void +a68_add_indicant_to_moif (MOIF_T *moif, TAG_T *tag) +{ + EXTRACT_T *e = ggc_alloc (); + /* Mode tags are not associated with declarations, so we have to do the + mangling here. */ + tree id = a68_get_mangled_indicant (NSYMBOL (NODE (tag)), NAME (moif)); + const char *tag_symbol = IDENTIFIER_POINTER (id); + + EXTRACT_KIND (e) = GA68_EXTRACT_MODE; + EXTRACT_SYMBOL (e) = ggc_strdup (tag_symbol); + EXTRACT_MODE (e) = MOID (tag); + EXTRACT_PRIO (e) = 0; + EXTRACT_VARIABLE (e) = false; + EXTRACT_IN_PROC (e) = false; + + if (! INDICANTS (moif)->contains (e)) + { + a68_add_moid_to_moif (moif, MOID (tag)); + vec_safe_push (INDICANTS (moif), e); + } +} + +/* Add a new module extract to a module interface. */ + +static void +a68_add_module_to_moif (MOIF_T *moif, TAG_T *tag) +{ + EXTRACT_T *e = ggc_alloc (); + /* Module tags are not associated with declarations, so we have to do the + mangling here. */ + tree id = a68_get_mangled_indicant (NSYMBOL (NODE (tag)), NAME (moif)); + const char *tag_symbol = IDENTIFIER_POINTER (id); + + EXTRACT_KIND (e) = GA68_EXTRACT_MODU; + EXTRACT_SYMBOL (e) = ggc_strdup (tag_symbol); + EXTRACT_MODE (e) = NO_MOID; + EXTRACT_PRIO (e) = 0; + EXTRACT_VARIABLE (e) = false; + EXTRACT_IN_PROC (e) = false; + + if (! MODULES (moif)->contains (e)) + vec_safe_push (MODULES (moif), e); +} + +/* Add a new priority extract to a module interface. */ + +static void +a68_add_prio_to_moif (MOIF_T *moif, TAG_T *tag) +{ + EXTRACT_T *e = ggc_alloc (); + /* Priority tags are not associated with declarations, so we have to do the + mangling here. */ + tree id = a68_get_mangled_indicant (NSYMBOL (NODE (tag)), NAME (moif)); + const char *tag_symbol = IDENTIFIER_POINTER (id); + + EXTRACT_KIND (e) = GA68_EXTRACT_PRIO; + EXTRACT_SYMBOL (e) = ggc_strdup (tag_symbol); + EXTRACT_MODE (e) = NO_MOID; + EXTRACT_PRIO (e) = PRIO (tag); + EXTRACT_VARIABLE (e) = false; + EXTRACT_IN_PROC (e) = false; + + if (! PRIOS (moif)->contains (e)) + vec_safe_push (PRIOS (moif), e); +} + +/* Add a new operator extract to a module interface. */ + +static void +a68_add_operator_to_moif (MOIF_T *moif, TAG_T *tag) +{ + EXTRACT_T *e = ggc_alloc (); + const char *tag_symbol = IDENTIFIER_POINTER (DECL_NAME (TAX_TREE_DECL (tag))); + + EXTRACT_KIND (e) = GA68_EXTRACT_OPER; + EXTRACT_SYMBOL (e) = ggc_strdup (tag_symbol); + EXTRACT_MODE (e) = MOID (tag); + EXTRACT_PRIO (e) = 0; + EXTRACT_VARIABLE (e) = EXTRACT_VARIABLE (tag); + /* There are no operatorvariable-declarations */ + gcc_assert (EXTRACT_VARIABLE (e) == false); + EXTRACT_IN_PROC (e) = IN_PROC (tag); + + if (! OPERATORS (moif)->contains (e)) + { + a68_add_moid_to_moif (moif, MOID (tag)); + vec_safe_push (OPERATORS (moif), e); + } +} + +/* Make the exports section the asm_out_file's new current section. */ + +static void +a68_switch_to_export_section (void) +{ + static section *exports_sec; + + if (exports_sec == NULL) + { + gcc_assert (targetm_common.have_named_sections); +#ifdef OBJECT_FORMAT_MACHO + exports_sec + = get_section (A68_EXPORT_SEGMENT_NAME "," A68_EXPORT_SECTION_NAME, + SECTION_DEBUG, NULL); +#else + exports_sec = get_section (A68_EXPORT_SECTION_NAME, + TARGET_AIX_OS ? SECTION_EXCLUDE : SECTION_DEBUG, + NULL); +#endif + } + + switch_to_section (exports_sec); +} + +/* Output a sized string. */ + +static void +a68_asm_output_string (const char *s, const char *comment) +{ + dw2_asm_output_data (2, strlen (s) + 1, comment); + assemble_string (s, strlen (s) + 1); +} + +/* Output a mode to the exports section if it hasn't been emitted already. */ + +static void +a68_asm_output_mode (MOID_T *m, const char *module_label) +{ + /* Do nothing if the mode has been already emitted and therefore there is + already a label to access it. */ + if (ASM_LABEL (m) != NULL) + return; + + /* Mode indicants are not emitted in the mode table, but as mode extracts in + the extracts table. Still we have to emit the named mode. */ + if (IS (m, INDICANT)) + m = MOID (NODE (m)); + + /* Collection of modes. */ + if (IS (m, SERIES_MODE) || IS (m, STOWED_MODE)) + { + for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p)) + a68_asm_output_mode (MOID (p), module_label); + return; + } + + /* Ok we got a mode to output. */ + + /* First emit referred modes and sub-modes. Note how we have to create a + label for the mode and install it in the NODE_T in order to avoid infinite + recursion in case of ref-induced recursive mode definitions. */ + + static long int cnt; + static char label[100]; + ASM_GENERATE_INTERNAL_LABEL (label, "LM", cnt++); + ASM_LABEL (m) = ggc_strdup (label); + + if (IS_REF(m) || IS_FLEX (m)) + a68_asm_output_mode (SUB (m), module_label); + else if (m != M_STRING && IS_FLEXETY_ROW (m)) + a68_asm_output_mode (SUB (m), module_label); + else if (!IS_COMPLEX (m) && (IS_STRUCT (m) || IS_UNION (m))) + { + for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p)) + a68_asm_output_mode (MOID (p), module_label); + } + else if (IS (m, PROC_SYMBOL)) + { + a68_asm_output_mode (SUB (m), module_label); + for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p)) + a68_asm_output_mode (MOID (p), module_label); + } + + /* No recursion below this point pls. */ + + /* Emit a label for this mode. */ + ASM_OUTPUT_LABEL (asm_out_file, ASM_LABEL (m)); + + /* Now emit assembly for the mode entry. */ + if (m == M_VOID) + dw2_asm_output_data (1, GA68_MODE_VOID, "void"); + else if (m == M_CHAR) + dw2_asm_output_data (1, GA68_MODE_CHAR, "char"); + else if (m == M_BOOL) + dw2_asm_output_data (1, GA68_MODE_BOOL, "bool"); + else if (m == M_STRING) + dw2_asm_output_data (1, GA68_MODE_STRING, "string"); + else if (IS_INTEGRAL (m)) + { + dw2_asm_output_data (1, GA68_MODE_INT, "int"); + dw2_asm_output_data (1, DIM (m), "sizety"); + } + else if (IS_REAL (m)) + { + dw2_asm_output_data (1, GA68_MODE_REAL, "real"); + dw2_asm_output_data (1, DIM (m), "sizety"); + } + else if (IS_BITS (m)) + { + dw2_asm_output_data (1, GA68_MODE_BITS, "bits"); + dw2_asm_output_data (1, DIM (m), "sizety"); + } + else if (IS_BYTES (m)) + { + dw2_asm_output_data (1, GA68_MODE_BYTES, "bytes"); + dw2_asm_output_data (1, DIM (m), "sizety"); + } + else if (IS_COMPLEX (m)) + { + /* Complex is a struct of two reals of the right sizety. */ + int dim = DIM (MOID (PACK (m))); + dw2_asm_output_data (1, GA68_MODE_CMPL, "compl"); + dw2_asm_output_data (1, dim, "sizety"); + } + else if (IS_REF (m)) + { + dw2_asm_output_data (1, GA68_MODE_NAME, "ref"); + dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (SUB (m)), module_label, "referred mode"); + } + else if (IS_FLEX (m)) + { + dw2_asm_output_data (1, GA68_MODE_FLEX, "flex"); + dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (SUB (m)), module_label, "flexible row mode"); + } + else if (IS_ROW (m)) + { + dw2_asm_output_data (1, GA68_MODE_ROW, "row"); + dw2_asm_output_data (1, DIM (m), "dim"); + /* XXX for now emit zeroes as triplets. */ + for (int i = 0; i < DIM (m); ++i) + { + dw2_asm_output_data (PTR_SIZE, 0, "lb"); + dw2_asm_output_data (PTR_SIZE, 0, "ub"); + } + dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (SUB (m)), module_label, "row of"); + } + else if (IS_STRUCT (m)) + { + dw2_asm_output_data (1, GA68_MODE_STRUCT, "struct"); + dw2_asm_output_data (2, DIM (m), "nfields"); + for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p)) + { + dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (MOID (p)), module_label, "field mode"); + if (TEXT (p) != NO_TEXT) + a68_asm_output_string (TEXT (p), "field name"); + else + a68_asm_output_string ("", "field name"); + } + } + else if (IS_UNION (m)) + { + dw2_asm_output_data (1, GA68_MODE_UNION, "union"); + dw2_asm_output_data (2, DIM (m), "nmodes"); + for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p)) + dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (MOID (p)), module_label, "united mode"); + } + else if (IS (m, PROC_SYMBOL)) + { + dw2_asm_output_data (1, GA68_MODE_PROC, "proc"); + dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (SUB (m)), module_label, "ret mode"); + dw2_asm_output_data (1, DIM (m), "nargs"); + for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p)) + { + dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (MOID (p)), module_label, "arg mode"); + if (TEXT (p) != NO_TEXT) + a68_asm_output_string (TEXT (p), "arg name"); + else + a68_asm_output_string ("", "arg name"); + } + } + else + dw2_asm_output_data (1, GA68_MODE_UNKNOWN, "unknown mode %s", + a68_moid_to_string (m, 80, NO_NODE, false)); +} + +/* Output an extract for a given tag to the extracts section. */ + +static void +a68_asm_output_extract (const char *module_label, int kind, + const char *symbol, MOID_T *mode, int prio, + bool variable, bool in_proc) +{ + static char begin_label[100]; + static char end_label[100]; + static long int cnt; + + ASM_GENERATE_INTERNAL_LABEL (begin_label, "LEBL", cnt); + ASM_GENERATE_INTERNAL_LABEL (end_label, "LEEL", cnt); + cnt++; + + dw2_asm_output_delta (PTR_SIZE, end_label, begin_label, "extract size"); + ASM_OUTPUT_LABEL (asm_out_file, begin_label); + + bool encode_mdextra = false; + switch (kind) + { + case GA68_EXTRACT_MODU: + dw2_asm_output_data (1, GA68_EXTRACT_MODU, "module extract %s", symbol); + a68_asm_output_string (symbol, "module indication"); + break; + case GA68_EXTRACT_MODE: + dw2_asm_output_data (1, GA68_EXTRACT_MODE, "mode extract %s", symbol); + a68_asm_output_string (symbol, "mode indication"); + dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (mode), module_label, "mode"); + break; + case GA68_EXTRACT_IDEN: + dw2_asm_output_data (1, GA68_EXTRACT_IDEN, "identifier extract %s", symbol); + a68_asm_output_string (symbol, "name"); + dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (mode), module_label, "mode"); + encode_mdextra = true; + break; + case GA68_EXTRACT_PRIO: + dw2_asm_output_data (1, GA68_EXTRACT_PRIO, "prio extract %s", symbol); + a68_asm_output_string (symbol, "opname"); + dw2_asm_output_data (1, prio, "priority"); + break; + case GA68_EXTRACT_OPER: + dw2_asm_output_data (1, GA68_EXTRACT_OPER, "operator extract %s", symbol); + a68_asm_output_string (symbol, "opname"); + dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (mode), module_label, "mode"); + encode_mdextra = true; + break; + default: + gcc_unreachable (); + } + + if (encode_mdextra) + { + dw2_asm_output_data (PTR_SIZE, 2, "mdextra size"); + dw2_asm_output_data (1, variable, "variable"); + dw2_asm_output_data (1, in_proc, "in_proc"); + } + else + dw2_asm_output_data (PTR_SIZE, 0, "mdextra size"); + + ASM_OUTPUT_LABEL (asm_out_file, end_label); +} + +/* Output a module interface. */ + +static void +a68_asm_output_moif (MOIF_T *moif) +{ + a68_switch_to_export_section (); + + static char module_label[100]; + static long int moifcnt; + ASM_GENERATE_INTERNAL_LABEL (module_label, "LMOIF", moifcnt++); + ASM_OUTPUT_LABEL (asm_out_file, module_label); + + if (flag_debug_asm) + { + fputs (ASM_COMMENT_START " MODIF START ", asm_out_file); + fputs (NAME (moif), asm_out_file); + fputc ('\n', asm_out_file); + } + + dw2_asm_output_data (1, A68_EXPORT_MAGIC1, "magic1"); + dw2_asm_output_data (1, A68_EXPORT_MAGIC2, "magic2"); + dw2_asm_output_data (2, VERSION (moif), "exports version"); + a68_asm_output_string (NAME (moif), "module name"); + a68_asm_output_string (PRELUDE (moif) ? PRELUDE (moif) : "", "prelude symbol"); + a68_asm_output_string (POSTLUDE (moif) ? POSTLUDE (moif) : "", "postlude symbol"); + + /* Modes table. */ + static char modes_begin_label[100]; + static char modes_end_label[100]; + static long int modescnt; + ASM_GENERATE_INTERNAL_LABEL (modes_begin_label, "LMTL", modescnt++); + ASM_GENERATE_INTERNAL_LABEL (modes_end_label, "LMTL", modescnt++); + + if (flag_debug_asm) + fputs ("\t" ASM_COMMENT_START " modes table\n", asm_out_file); + dw2_asm_output_delta (PTR_SIZE, modes_end_label, modes_begin_label, + "modes size"); + ASM_OUTPUT_LABEL (asm_out_file, modes_begin_label); + for (MOID_T *m : MODES (moif)) + a68_asm_output_mode (m, module_label); + ASM_OUTPUT_LABEL (asm_out_file, modes_end_label); + + /* Extracts table. */ + static char extracts_begin_label[100]; + static char extracts_end_label[100]; + static long int extractscnt; + ASM_GENERATE_INTERNAL_LABEL (extracts_begin_label, "LETL", extractscnt++); + ASM_GENERATE_INTERNAL_LABEL (extracts_end_label, "LETL", extractscnt++); + + if (flag_debug_asm) + fputs ("\t" ASM_COMMENT_START " extracts table\n", asm_out_file); + dw2_asm_output_delta (PTR_SIZE, extracts_end_label, extracts_begin_label, + "extracts size"); + ASM_OUTPUT_LABEL (asm_out_file, extracts_begin_label); + for (EXTRACT_T *e : MODULES (moif)) + a68_asm_output_extract (module_label, GA68_EXTRACT_MODU, + EXTRACT_SYMBOL (e), EXTRACT_MODE (e), EXTRACT_PRIO (e), + EXTRACT_VARIABLE (e), EXTRACT_IN_PROC (e)); + for (EXTRACT_T *e : INDICANTS (moif)) + a68_asm_output_extract (module_label, GA68_EXTRACT_MODE, + EXTRACT_SYMBOL (e), EXTRACT_MODE (e), EXTRACT_PRIO (e), + EXTRACT_VARIABLE (e), EXTRACT_IN_PROC (e)); + for (EXTRACT_T *e : IDENTIFIERS (moif)) + a68_asm_output_extract (module_label, GA68_EXTRACT_IDEN, + EXTRACT_SYMBOL (e), EXTRACT_MODE (e), EXTRACT_PRIO (e), + EXTRACT_VARIABLE (e), EXTRACT_IN_PROC (e)); + for (EXTRACT_T *e : PRIOS (moif)) + a68_asm_output_extract (module_label, GA68_EXTRACT_PRIO, + EXTRACT_SYMBOL (e), EXTRACT_MODE (e), EXTRACT_PRIO (e), + EXTRACT_VARIABLE (e), EXTRACT_IN_PROC (e)); + for (EXTRACT_T *e : OPERATORS (moif)) + a68_asm_output_extract (module_label, GA68_EXTRACT_OPER, + EXTRACT_SYMBOL (e), EXTRACT_MODE (e), EXTRACT_PRIO (e), + EXTRACT_VARIABLE (e), EXTRACT_IN_PROC (e)); + ASM_OUTPUT_LABEL (asm_out_file, extracts_end_label); + + if (flag_debug_asm) + { + fputs (ASM_COMMENT_START " MODIF END ", asm_out_file); + fputs (NAME (moif), asm_out_file); + fputc ('\n', asm_out_file); + } +} + +/* Emit export information for the module definition in the parse tree P. */ + +void +a68_do_exports (NODE_T *p) +{ + for (;p != NO_NODE; FORWARD (p)) + { + if (IS (p, DEFINING_MODULE_INDICANT)) + { + // XXX only do this if the defining module is to be + // exported. Accessed modules without PUB are not exported. */ + TAG_T *tag = a68_find_tag_global (TABLE (p), MODULE_SYMBOL, NSYMBOL (p)); + gcc_assert (tag != NO_TAG); + + if (EXPORTED (tag)) + { + tree module_id = a68_get_mangled_indicant (NSYMBOL (p)); + MOIF_T *moif = a68_moif_new (IDENTIFIER_POINTER (module_id)); + char *prelude = xasprintf ("%s__prelude", IDENTIFIER_POINTER (module_id)); + char *postlude = xasprintf ("%s__postlude", IDENTIFIER_POINTER (module_id)); + PRELUDE (moif) = ggc_strdup (prelude); + POSTLUDE (moif) = ggc_strdup (postlude); + free (prelude); + free (postlude); + + NODE_T *module_text = NEXT (NEXT (p)); + gcc_assert (IS (module_text, MODULE_TEXT)); + NODE_T *def_part = (IS (SUB (module_text), REVELATION_PART) + ? NEXT_SUB (module_text) + : SUB (module_text)); + gcc_assert (IS (def_part, DEF_PART)); + TABLE_T *table = TABLE (SUB (def_part)); + gcc_assert (PUBLIC_RANGE (table)); + + for (TAG_T *t = MODULES (table); t != NO_TAG; FORWARD (t)) + { + if (PUBLICIZED (t)) + a68_add_module_to_moif (moif, t); + } + + for (TAG_T *t = INDICANTS (table); t != NO_TAG; FORWARD (t)) + { + if (PUBLICIZED (t)) + a68_add_indicant_to_moif (moif, t); + } + + for (TAG_T *t = IDENTIFIERS (table); t != NO_TAG; FORWARD (t)) + { + if (PUBLICIZED (t)) + a68_add_identifier_to_moif (moif, t); + } + + for (TAG_T *t = PRIO (table); t != NO_TAG; FORWARD (t)) + { + if (PUBLICIZED (t)) + a68_add_prio_to_moif (moif, t); + } + + for (TAG_T *t = OPERATORS (table); t != NO_TAG; FORWARD (t)) + { + if (PUBLICIZED (t)) + a68_add_operator_to_moif (moif, t); + } + + a68_asm_output_moif (moif); + if (flag_a68_dump_moif) + a68_dump_moif (moif); + } + } + else + a68_do_exports (SUB (p)); + } +} diff --git a/gcc/algol68/ga68-exports.pk b/gcc/algol68/ga68-exports.pk new file mode 100644 index 000000000000..86484b8d8893 --- /dev/null +++ b/gcc/algol68/ga68-exports.pk @@ -0,0 +1,297 @@ +/* ga68-exports.pk - GCC Algol 68 exports format. + + Copyright (C) 2025 Jose E. Marchesi + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +/* GNU Algol 68 source files (compilation units, or "packets") may + contain either a single particular-program or a set of one or more + module definitions. + + When compiling a compilation unit containing module definitions, + the ga68 compiler emits an ELF section called .a68_exports along + with the usual compiled object code. This section contains + information that reflects the PUBlicized identifiers exported by + module definitions: modes, operators, procedures, identifiers, + other module definitions, etc. This interface is complete enough + to allow other compilation units to access these declarations. + + The information that is in a module interface is defined in the MR + document using a sort of grammar. It is: + + module interface : + unique code & external symbol & hole description option & + mode table & definition summary. + + definition summary : + set of definition groups. + + definition group : + module identity & set of definition extracts. + + definition extract : + mode extract ; + operation extract ; + priority extract ; + identifier extract ; + definition module extract ; + invocation extract. + + mode extract : + mode marker & mode indication & mode & mdextra. + + operation extract : + operation marker & operator & mode & mdextra. + + priority extract : + priority marker & operator & integer priority & mdextra. + + identifier extract : + identifier marker & identifier & mode & mdextra. + + definition module extract : + definition module marker & definition module indication & + definition summary & mdextra. + + invocation extract : + module identity. + + mdextra : + extra machine-dependent information. + + This pickle precisely describes how the module interfaces are + encoded in the .a68_exports ELF section, which are of type PROGBITS + and thus are concatenated by ELF linkers. This works well because + each compilation unit may contain several module definitions, but a + module definition cannot be splitted among several compilation + units. */ + +/* The exports format is versioned. A bump in the format version + number indicates the presence of a backward incompatibility. This + is important because .ga68_exports section may contain module + definition interfaces having different versions, so compilers and + tools designed to operate on version "n" must ignore, or error on, + modules definition interfaces with later versions. */ + +var ga68_exports_ver = 1; + +/* References other sections and the .ga68_export section itself are + realized via link-time relocations: + + References to code addresses are relative to some text section. + References to data in .ga68_export are relative to the start of the + section. */ + +load elf; + +type ga68_text_reloc = Elf64_Addr; +type ga68_data_reloc = Elf64_Addr; + +/* Strings are encoded in-place and are both pre-sized and + NULL-terminated. This is to ease reading them quickly and + efficiently. Note that the size includes the final NULL + character. */ + +type ga68_str = + struct + { + offset,B> len; + string s: s'size == len; + }; + +/* Each module definition interface includes a table of modes, that + contains not only the modes for which mode extracts exist, but also + the indirectly referred modes: since Algol 68 used structural + equivalence of modes, each mode has to be defined fully. The + encoding therefore tries to be as compact as possible while + allowing being read with a reasonable level of performance and + convenience. */ + +var GA68_MODE_UNKNOWN = 0UB, + GA68_MODE_VOID = 1UB, + GA68_MODE_INT = 2UB, + GA68_MODE_REAL = 3UB, + GA68_MODE_BITS = 4UB, + GA68_MODE_BYTES = 5UB, + GA68_MODE_CHAR = 6UB, + GA68_MODE_BOOL = 7UB, + GA68_MODE_CMPL = 8UB, + GA68_MODE_ROW = 9UB, + GA68_MODE_STRUCT = 10UB, + GA68_MODE_UNION = 11UB, + GA68_MODE_NAME = 12UB, + GA68_MODE_PROC = 13UB, + GA68_MODE_STRING = 14UB, + GA68_MODE_FLEX = 15UB; + +type ga68_mode = + struct + { + uint<8> kind : kind in [GA68_MODE_VOID, GA68_MODE_INT, + GA68_MODE_REAL, GA68_MODE_BITS, + GA68_MODE_BYTES, GA68_MODE_CHAR, + GA68_MODE_CMPL, GA68_MODE_ROW, + GA68_MODE_STRUCT, GA68_MODE_UNION, + GA68_MODE_NAME, GA68_MODE_PROC, + GA68_MODE_FLEX]; + + union + { + int<8> sizety : kind in [GA68_MODE_INT, GA68_MODE_REAL, + GA68_MODE_CMPL, GA68_MODE_BITS, + GA68_MODE_BYTES]; + struct + { + ga68_data_reloc mode; + } name : kind == GA68_MODE_NAME || kind == GA68_MODE_FLEX; + + struct + { + type triplet = struct { ga68_text_reloc lb; ga68_text_reloc ub; }; + + uint<8> ndims; + triplet[ndims] dims; + ga68_data_reloc row_of; + } row : kind == GA68_MODE_ROW; + + struct + { + type field = struct { ga68_data_reloc mode; ga68_str name; }; + + uint<16> nfields; + field[nfields] fields; + } sct : kind == GA68_MODE_STRUCT; + + struct + { + uint<8> nmodes; + ga68_data_reloc[nmodes] modes; + } uni : kind == GA68_MODE_UNION; + + struct + { + type arg = struct { ga68_data_reloc mode; ga68_str name; }; + + ga68_data_reloc ret_mode; + uint<8> nargs; + arg[nargs] args; + } routine : kind == GA68_MODE_PROC; + + struct { } _ : kind in [GA68_MODE_UNKNOWN, GA68_MODE_VOID, + GA68_MODE_CHAR, GA68_MODE_BOOL, + GA68_MODE_STRING]; + + } data; + }; + +/* Each module definition interface includes a table of "extracts", + one per identifier PUBlicized by the module definition. + + Mode extracts represent declarations of mode indications, like for + example `mode Foo = struct (int i, real r)'. + + Identifier extracts represent declarations of constans, variables, + procedures and operators. Examples are `real pi = 3.14', `int + counter', `proc double = (int a) int : a * 2' and `op // = (int a, + b) int: a % b'. + + Priority extracts represent declarations of priorities for dyadic + operators, like for example `prio // = 9'. + + Finally, module extracts represent the PUBlication of some other + module definition. For example, the module definition `mode Foo = + access A, B def ... fed' will include module extracts for both "A" + and "B" in its interface. + + Some of the extracts may need some additional compiler-specific or + machine-specific information, whose contents are not specified + here. */ + +var GA68_EXTRACT_MODU = 0UB, + GA68_EXTRACT_IDEN = 1UB, + GA68_EXTRACT_MODE = 2UB, + GA68_EXTRACT_PRIO = 3UB, + GA68_EXTRACT_OPER = 4UB; + +type ga68_extract = + struct + { + Elf64_Off extract_size; + union + { + struct + { + uint<8> mark : mark == GA68_EXTRACT_MODU; + ga68_str module_indication; + } module; + + struct + { + uint<8> mark : mark == GA68_EXTRACT_IDEN; + ga68_str name; + ga68_data_reloc mode; + } identifier; + + struct + { + uint<8> mark : mark == GA68_EXTRACT_MODE; + ga68_str mode_indication; + ga68_data_reloc mode; + } mode; + + struct + { + uint<8> mark : mark == GA68_EXTRACT_PRIO; + ga68_str opname; + uint<8> prio; + } prio; + + struct + { + uint<8> mark : mark == GA68_EXTRACT_OPER; + ga68_str opname; + ga68_mode mode; + } oper; + + } extract : extract'size == extract_size; + + Elf64_Off mdextra_size; + uint<8>[mdextra_size] data; + }; + +/* The contents of the .ga68_exports section can be mapped as a + ga68_module[sec.sh_size] */ + +type ga68_module = + struct + { + uint<8>[2] magic : magic == [0x0aUB, 0xadUB]; + uint<16> version : version == ga68_exports_ver; + + /* Module identification. + Add a hash or UUID? */ + ga68_str name; + + /* Entry points. */ + ga68_str prelude; + ga68_str poslude; + + /* Table of modes. */ + Elf64_Off modes_size; + ga68_mode[modes_size] modes; + + /* Table of extracts. */ + Elf64_Off extracts_size; + ga68_extract[extracts_size] extracts; + }; From 4e61dc57497c38960c0850b5f1733eaecebc7731 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 22 Nov 2025 02:19:31 +0100 Subject: [PATCH 147/373] a68: modules imports This patch adds support for importing module interfaces, read from object files, shared objects, archives or stand-alone files. Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-imports.cc: New file. --- gcc/algol68/a68-imports.cc | 1263 ++++++++++++++++++++++++++++++++++++ 1 file changed, 1263 insertions(+) create mode 100644 gcc/algol68/a68-imports.cc diff --git a/gcc/algol68/a68-imports.cc b/gcc/algol68/a68-imports.cc new file mode 100644 index 000000000000..a5c66bcb4cc8 --- /dev/null +++ b/gcc/algol68/a68-imports.cc @@ -0,0 +1,1263 @@ +/* Importing Algol 68 module interfaces. + Copyright (C) 2025 Jose E. Marchesi. + Copyright (C) 2010-2025 Free Software Foundation, Inc. + + Written by Jose E. Marchesi. + + The following utility functions have been adapted from the Go front-end: + + a68_open_packet + a68_try_packet_in_directory + a68_try_suffixes + a68_find_export_data + a68_find_object_export_data + a68_read_export_data + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "tree.h" +#include "target.h" +#include "tm_p.h" +#include "simple-object.h" +#include "varasm.h" +#include "intl.h" +#include "common/common-target.h" +#include "dwarf2asm.h" + +#include + +#include "a68.h" + +/* Read exports from an object file. + + FD is a file descriptor open for reading. + + OFFSET is the offset within the file where the object file starts; this will + be 0 except when reading an archive. + + On success this returns NULL and sets *PBUF to a buffer allocated using + malloc, of size *PLEN, holding the export data. + + If the data is not found this returns NULL and sets *PBUF to NULL and *PLEN + to 0. + + If some error occurs, this returns an error message and sets *PERR to an + errno value or 0 if there is no relevant errno. */ + +static const char * +a68_read_export_data (int fd, uint64_t offset, char **pbuf, size_t *plen, + int *perr) +{ + simple_object_read *sobj; + const char *errmsg; + off_t sec_offset; + off_t sec_length; + int found; + char *buf; + ssize_t c; + + *pbuf = NULL; + *plen = 0; + + sobj = simple_object_start_read (fd, offset, A68_EXPORT_SEGMENT_NAME, + &errmsg, perr); + if (sobj == NULL) + { + /* If we get an error here, just pretend that we didn't find any + export data. This is the right thing to do if the error is + that the file was not recognized as an object file. This + will ignore file I/O errors, but it's not too big a deal + because we will wind up giving some other error later. */ + return NULL; + } + + found = simple_object_find_section (sobj, A68_EXPORT_SECTION_NAME, + &sec_offset, &sec_length, + &errmsg, perr); + simple_object_release_read (sobj); + if (!found) + return errmsg; + + if (lseek (fd, offset + sec_offset, SEEK_SET) < 0) + { + *perr = errno; + return _("lseek failed while reading export data"); + } + + buf = XNEWVEC (char, sec_length); + if (buf == NULL) + { + *perr = errno; + return _("memory allocation failed while reading export data"); + } + + c = read (fd, buf, sec_length); + if (c < 0) + { + *perr = errno; + free (buf); + return _("read failed while reading export data"); + } + + if (c < sec_length) + { + free (buf); + return _("short read while reading export data"); + } + + *pbuf = buf; + *plen = sec_length; + return NULL; +} + +/* Look for export data in an object file. */ + +static char * +a68_find_object_export_data (const std::string& filename, + int fd, uint64_t offset, size_t *psize) +{ + char *buf; + size_t len; + int err; + + const char *errmsg = a68_read_export_data (fd, offset, &buf, &len, &err); + if (errmsg != NULL) + { + if (err == 0) + a68_error (NO_NODE, "Z: Z", filename.c_str (), errmsg); + else + a68_error (NO_NODE, "Z: Z: Z", filename.c_str(), errmsg, + xstrerror(err)); + return NULL; + } + + *psize = len; + return buf; +} + +/* Look for export data in the file descriptor FD. */ + +static char * +a68_find_export_data (const std::string &filename, int fd, size_t *psize) +{ + /* See if we can read this as an object file. */ + char *exports = a68_find_object_export_data (filename, fd, 0, psize); + if (exports != NULL) + return exports; + + if (lseek (fd, 0, SEEK_SET) < 0) + { + a68_error (NO_NODE, "lseek Z failed", filename.c_str ()); + return NULL; + } + + char buf[A68_EXPORT_MAGIC_LEN]; + ssize_t c = ::read(fd, buf, A68_EXPORT_MAGIC_LEN); + if (c < A68_EXPORT_MAGIC_LEN) + return NULL; + + /* Check for a file containing nothing but Algol 68 export data. */ + if (buf[0] == '\x0a' && buf[1] == '\xad') + { + /* XXX read whole file. */ + return exports; + } + +#if 0 + /* See if we can read this as an archive. */ + if (Import::is_archive_magic(buf)) + return Import::find_archive_export_data(filename, fd, location); +#endif + + return NULL; + +} + +/* Given *PFILENAME, where *PFILENAME does not exist, try various suffixes. If + we find one, set *FILENAME to the one we found. Return the open file + descriptor. */ + +static int +a68_try_suffixes (std::string *pfilename) +{ + std::string filename = *pfilename + ".m68"; + int fd = open (filename.c_str(), O_RDONLY | O_BINARY); + if (fd >= 0) + { + *pfilename = filename; + return fd; + } + + const char* basename = lbasename (pfilename->c_str()); + size_t basename_pos = basename - pfilename->c_str (); + filename = pfilename->substr (0, basename_pos) + "lib" + basename + ".so"; + fd = open (filename.c_str (), O_RDONLY | O_BINARY); + if (fd >= 0) + { + *pfilename = filename; + return fd; + } + + filename = pfilename->substr (0, basename_pos) + "lib" + basename + ".a"; + fd = open (filename.c_str (), O_RDONLY | O_BINARY); + if (fd >= 0) + { + *pfilename = filename; + return fd; + } + + filename = *pfilename + ".o"; + fd = open (filename.c_str(), O_RDONLY | O_BINARY); + if (fd >= 0) + { + *pfilename = filename; + return fd; + } + + return -1; +} + +/* Try to find the export data for FILENAME. */ + +static char * +a68_try_packet_in_directory (const std::string &filename, size_t *psize) +{ + std::string found_filename = filename; + int fd = open (found_filename.c_str(), O_RDONLY | O_BINARY); + + if (fd >= 0) + { + struct stat s; + if (fstat (fd, &s) >= 0 && S_ISDIR (s.st_mode)) + { + close (fd); + fd = -1; + errno = EISDIR; + } + } + + if (fd < 0) + { + if (errno != ENOENT && errno != EISDIR) + a68_warning (NO_NODE, 0, "cannot open file Z for imports", + filename.c_str ()); + + fd = a68_try_suffixes (&found_filename); + if (fd < 0) + return NULL; + } + + /* The export data may not be in this file. */ + char *exports = a68_find_export_data (found_filename, fd, psize); + if (exports != NULL) + return exports; + + close (fd); + + a68_error (NO_NODE, "file Z exists but does not contain any export data", + found_filename.c_str ()); + + return NULL; +} + +/* Find import data in FILENAME. + + This searches the file system for FILENAME, reads exports information from + it, and returns a pointer to the beginning of an allocated buffer with the + exports data, its size in *psize. It is up to the caller of this function + to release the buffer when it is no longer necessary. If the file is not + found, this function returns NULL. + + When FILENAME is not an absolute path and does not start with ./ or ../, we + use the search path provided by -I and -L options. + + When FILENAME does start with ./ or ../, we use RELATIVE_IMPORT_PATH as a + prefix. + + When FILENAME does not exist, we try modifying FILENAME to find the file. + We use the first of these which exists: + + - We append ".m68". + - We turn the base of FILENAME info libFILENAME.so. + - We turn the base of FILENAME into libFILENAME.a. + - We append ".o". + + When using a search path, we apply each of these transformations at each + entry on the search path before moving on to the next entry. If the file + exists, but does not contain Algol 68 export data, we stop; we do not keep + looking for another file with the same name later in the search path. */ + +static char * +a68_get_packet_exports (const std::string &filename, + const std::string &relative_import_path, + size_t *psize) +{ + char *exports; + + bool is_local; + if (IS_ABSOLUTE_PATH (filename)) + is_local = true; + else if (filename[0] == '.' + && (filename[1] == '\0' || IS_DIR_SEPARATOR (filename[1]))) + is_local = true; + else if (filename[0] == '.' + && filename[1] == '.' + && (filename[2] == '\0' || IS_DIR_SEPARATOR (filename[2]))) + is_local = true; + else + is_local = false; + + std::string fn = filename; + if (is_local && !IS_ABSOLUTE_PATH (filename) + && !relative_import_path.empty ()) + { + if (fn == ".") + /* A special case. */ + fn = relative_import_path; + else if (fn[0] == '.' && fn[1] == '.' + && (fn[2] == '\0' || IS_DIR_SEPARATOR (fn[2]))) + { + /* We are going to join relative_import_path and fn, and it will look + like DIR/../PATH. BUt DIR does not necessarily exist in this + case, and if it doesn't the use of .. will fail although it + shouldn't. */ + size_t index; + for (index = relative_import_path.length () - 1; + index > 0 && !IS_DIR_SEPARATOR (relative_import_path[index]); + index--) + ; + if (index > 0) + fn = relative_import_path.substr (0, index) + fn.substr (2); + else + fn = relative_import_path + '/' + fn; + } + else + fn = relative_import_path + '/' + fn; + is_local = false; + } + + if (!is_local) + { + for (std::string path : A68_IMPORT_PATHS) + { + if (path.empty () && path[path.size () - 1] != '/') + path += '/'; + path += fn; + exports = a68_try_packet_in_directory (path, psize); + if (exports != NULL) + return exports; + } + } + + return a68_try_packet_in_directory (fn, psize); +} + +/* The size of the target's pointer type, in bytes. */ +#ifndef PTR_SIZE +#define PTR_SIZE ((int)(POINTER_SIZE / BITS_PER_UNIT)) +#endif + +/* Collection of decoding helper macros, to be exclusively used in the + a68_decode_* functions below. */ + +#define DINT8(V) \ + do \ + { \ + if (pos + 1 > size) \ + goto decode_error; \ + (V) = (int8_t)data[pos++]; \ + } \ + while (0) + +#define DUINT8(V) \ + do \ + { \ + if (pos + 1 > size) \ + goto decode_error; \ + (V) = (uint8_t)data[pos++]; \ + } \ + while (0) + +#define DUINT16(V) \ + do \ + { \ + if (pos + 2 > size) \ + goto decode_error; \ + if (BYTES_BIG_ENDIAN) \ + (V) = ((uint8_t) data[pos] << 8) | (uint8_t) data[pos + 1]; \ + else \ + (V) = ((uint8_t) data[pos + 1] << 8) | (uint8_t) data[pos]; \ + pos += 2; \ + } \ + while (0) + +#define DOFFSET(V) \ + do \ + { \ + if (pos + PTR_SIZE > size) \ + goto decode_error; \ + (V) = 0; \ + uint64_t ptr_bit_size = 8 * PTR_SIZE; \ + if (BYTES_BIG_ENDIAN) \ + { \ + for (int i = 0; i < PTR_SIZE; i++) \ + (V) = ((V) | ((uint8_t) data[pos + i] << (ptr_bit_size - (i * 8)))); \ + } \ + else \ + { \ + for (int i = 0; i < PTR_SIZE; i++) \ + (V) = ((V) | ((uint8_t) data[pos + i] << (i * 8))); \ + } \ + pos += PTR_SIZE; \ + } \ + while (0) + +#define DSTR(V) \ + do \ + { \ + uint16_t len; \ + char *str = NULL; \ + DUINT16 (len); \ + if (pos + len > size) \ + goto decode_error; \ + if (len > 0) \ + { \ + str = (char *) xmalloc (len); \ + memcpy (str, data + pos, len); \ + pos += len; \ + } \ + (V) = str; \ + } \ + while (0) + +/* Types to denote encoded modes. */ + +struct encoded_triplet +{ + uint64_t lb; + uint64_t ub; +}; + +struct encoded_field +{ + uint64_t mode_offset; + char *name; +}; + +struct encoded_arg +{ + uint64_t arg_mode_offset; + char *arg_name; +}; + +struct encoded_mode +{ + MOID_T *moid; + uint64_t offset; + uint8_t kind; + int8_t sizety; + union + { + struct + { + uint64_t sub_offset; + } name; + + struct + { + uint8_t sub_offset; + } flex; + + struct + { + uint8_t ndims; + struct encoded_triplet *triplets; + uint64_t sub_offset; + } row; + + struct + { + uint16_t nfields; + struct encoded_field *fields; + } sct; + + struct + { + uint8_t nmodes; + uint64_t *modes; + } union_; + + struct + { + uint64_t ret_mode_offset; + uint8_t nargs; + struct encoded_arg *args; + } proc; + + } data; +}; + +/* Free the memory used by an encoded mode. */ + +static void +encoded_mode_free (struct encoded_mode *em) +{ + switch (em->kind) + { + case GA68_MODE_ROW: + free (em->data.row.triplets); + break; + case GA68_MODE_STRUCT: + /* Note that the field names are installed in moids in + encoded_mode_to_moid, so we shoud not free them. */ + free (em->data.sct.fields); + break; + case GA68_MODE_UNION: + free (em->data.union_.modes); + break; + case GA68_MODE_PROC: + for (uint8_t i = 0; i < em->data.proc.nargs; i++) + free (em->data.proc.args[i].arg_name); + free (em->data.proc.args); + break; + default: + break; + } + free (em); +} + +/* A collection of encoded modes indexed by offsets. */ + +#define NO_OFFSET ((uint64_t) -1) + +typedef hash_map, + struct encoded_mode *> encoded_modes_map_t; + +/* Complete a encoded mode. */ + +static MOID_T * +complete_encoded_mode (encoded_modes_map_t &encoded_modes, uint64_t offset) +{ + struct encoded_mode *em = *(encoded_modes.get (offset)); + MOID_T *sub; + PACK_T *pack; + + if (em->moid != NO_MOID) + return em->moid; + + switch (em->kind) + { + case GA68_MODE_VOID: em->moid = M_VOID; break; + case GA68_MODE_CHAR: em->moid = M_CHAR; break; + case GA68_MODE_BOOL: em->moid = M_BOOL; break; + case GA68_MODE_STRING: em->moid = M_FLEX_ROW_CHAR; break; + case GA68_MODE_INT: + switch (em->sizety) + { + case 0: em->moid = M_INT; break; + case 1: em->moid = M_LONG_INT; break; + case 2: em->moid = M_LONG_LONG_INT; break; + case -1: em->moid = M_SHORT_INT; break; + case -2: em->moid = M_SHORT_SHORT_INT; break; + default: + gcc_unreachable (); + } + break; + case GA68_MODE_BITS: + switch (em->sizety) + { + case 0: em->moid = M_BITS; break; + case 1: em->moid = M_LONG_BITS; break; + case 2: em->moid = M_LONG_LONG_BITS; break; + case -1: em->moid = M_SHORT_BITS; break; + case -2: em->moid = M_SHORT_SHORT_BITS; break; + default: + gcc_unreachable (); + } + break; + case GA68_MODE_BYTES: + switch (em->sizety) + { + case 0: em->moid = M_BYTES; break; + case 1: em->moid = M_LONG_BYTES; break; + default: + gcc_unreachable (); + } + break; + case GA68_MODE_REAL: + switch (em->sizety) + { + case 0: em->moid = M_REAL; break; + case 1: em->moid = M_LONG_REAL; break; + case 2: em->moid = M_LONG_LONG_REAL; break; + default: + gcc_unreachable (); + } + break; + case GA68_MODE_CMPL: + switch (em->sizety) + { + case 0: em->moid = M_COMPLEX; break; + case 1: em->moid = M_LONG_COMPLEX; break; + case 2: em->moid = M_LONG_LONG_COMPLEX; break; + default: + gcc_unreachable (); + } + break; + case GA68_MODE_NAME: + case GA68_MODE_FLEX: + /* For recursive declarations. */ + em->moid = a68_create_mode (em->kind == GA68_MODE_NAME ? REF_SYMBOL : FLEX_SYMBOL, + 0, NO_NODE, M_ERROR, NO_PACK); + sub = complete_encoded_mode (encoded_modes, em->data.name.sub_offset); + if (sub == NO_MOID) + { + /* Free em->moid */ + return NO_MOID; + } + SUB (em->moid) = sub; + break; + case GA68_MODE_ROW: + /* XXX how to convey actual bounds. */ + /* For recursive declarations. */ + em->moid = a68_create_mode (ROW_SYMBOL, 0, NO_NODE, M_ERROR, NO_PACK); + sub = complete_encoded_mode (encoded_modes, em->data.row.sub_offset); + if (sub == NO_MOID) + { + /* Free em->moid */ + return NO_MOID; + } + SUB (em->moid) = sub; + DIM (em->moid) = em->data.row.ndims; + break; + case GA68_MODE_STRUCT: + /* For recursive declarations. */ + em->moid = a68_create_mode (STRUCT_SYMBOL, 0, NO_NODE, NO_MOID, NO_PACK); + pack = NO_PACK; + for (uint16_t i = 0; i < em->data.sct.nfields; i++) + { + /* Note we have to do this from last field to first field, because + a68_add_mode_to_pack prepends to the list. */ + uint16_t index = em->data.sct.nfields - 1 - i; + char *field_name = em->data.sct.fields[index].name; + MOID_T *field_moid = complete_encoded_mode (encoded_modes, + em->data.sct.fields[index].mode_offset); + if (field_moid == NO_MOID) + { + /* XXX free em->moid */ + em->moid = NO_MOID; + return NO_MOID; + } + (void) a68_add_mode_to_pack (&pack, field_moid, field_name, NO_NODE); + } + DIM (em->moid) = a68_count_pack_members (pack); + PACK (em->moid) = pack; + break; + case GA68_MODE_UNION: + /* For recursive declarations. */ + em->moid = a68_create_mode (UNION_SYMBOL, 0, NO_NODE, NO_MOID, NO_PACK); + pack = NO_PACK; + for (uint8_t i = 0; i < em->data.union_.nmodes; i++) + { + /* Union alternatives are internally stored in reverse order in the + pack. */ + uint16_t index = i; + MOID_T *united_moid = complete_encoded_mode (encoded_modes, + em->data.union_.modes[index]); + if (united_moid == NO_MOID) + { + /* XXX free em->moid */ + em->moid = NO_MOID; + return NO_MOID; + } + (void) a68_add_mode_to_pack (&pack, united_moid, NO_TEXT, NO_NODE); + } + DIM (em->moid) = a68_count_pack_members (pack); + PACK (em->moid) = pack; + break; + case GA68_MODE_PROC: + /* For recursive declarations. */ + em->moid = a68_create_mode (PROC_SYMBOL, 0, NO_NODE, NO_MOID, NO_PACK); + pack = NO_PACK; + for (uint8_t i = 0; i < em->data.proc.nargs; i++) + { + /* Note we have to do this from last argument mode to first argument + mode, because a68_add_mode_to_pack prepends to the list. */ + uint16_t index = em->data.proc.nargs - 1 - i; + char *arg_name = em->data.proc.args[index].arg_name; + MOID_T *arg_moid = complete_encoded_mode (encoded_modes, + em->data.proc.args[index].arg_mode_offset); + if (arg_moid == NO_MOID) + { + /* XXX free em->moid */ + em->moid = NO_MOID; + return NO_MOID; + } + (void) a68_add_mode_to_pack (&pack, arg_moid, arg_name, NO_NODE); + } + SUB (em->moid) = complete_encoded_mode (encoded_modes, + em->data.proc.ret_mode_offset); + if (SUB (em->moid) == NO_MOID) + { + /* Free em->moid */ + em->moid = NO_MOID; + return NO_MOID; + } + DIM (em->moid) = a68_count_pack_members (pack); + PACK (em->moid) = pack; + break; + default: + gcc_unreachable (); + } + + return em->moid; +} + +/* Dump the contents of an encoded_mode, for debugging purposes. */ + +ATTRIBUTE_UNUSED static void +dump_encoded_mode (struct encoded_mode *em) +{ + printf ("[%" PRIu64 "] kind: %" PRIu8, em->offset, em->kind); + switch (em->kind) + { + case GA68_MODE_VOID: + printf (" void\n"); + break; + case GA68_MODE_CHAR: + printf (" char\n"); + break; + case GA68_MODE_BOOL: + printf (" bool\n"); + break; + case GA68_MODE_STRING: + printf (" basic\n"); + break; + case GA68_MODE_NAME: + printf (" name\n"); + printf (" sub: %" PRIu64 "\n", em->data.name.sub_offset); + break; + case GA68_MODE_STRUCT: + printf (" struct\n"); + printf (" nfields: %" PRIu16 "\n", em->data.sct.nfields); + for (uint16_t i = 0; i < em->data.sct.nfields; i++) + printf (" %s : [%" PRIu64 "]\n", + em->data.sct.fields[i].name, em->data.sct.fields[i].mode_offset); + break; + case GA68_MODE_FLEX: + printf (" flex\n"); + printf (" sub: %" PRIu64 "\n", em->data.name.sub_offset); + break; + case GA68_MODE_UNION: + printf (" union\n"); + printf (" nmodes: %" PRIu8 "\n", em->data.union_.nmodes); + printf (" "); + for (uint8_t i = 0; i < em->data.union_.nmodes; i++) + printf (" [%" PRIu64 "]", em->data.union_.modes[i]); + printf ("\n"); + break; + case GA68_MODE_PROC: + printf (" proc\n"); + printf (" retmode: [%" PRIu64 "]\n", em->data.proc.ret_mode_offset); + printf (" nargs: %" PRIu8 "\n", em->data.proc.nargs); + for (uint8_t i = 0; i < em->data.proc.nargs; i++) + printf (" %s : [%" PRIu64 "]\n", + em->data.proc.args[i].arg_name, + em->data.proc.args[i].arg_mode_offset); + break; + case GA68_MODE_ROW: + printf (" row\n"); + printf (" ndims: %" PRIu8 "\n", em->data.row.ndims); + for (uint8_t i = 0; i < em->data.row.ndims; i++) + { + printf (" lb: %" PRIu64 "\n", em->data.row.triplets[i].lb); + printf (" ub: %" PRIu64 "\n", em->data.row.triplets[i].ub); + } + printf (" sub: [%" PRIu64 "]\n", em->data.row.sub_offset); + break; + default: + break; + } +} + +/* Substitute any reference to mode M in T to R. */ + +static void +a68_replace_submode (MOID_T *t, MOID_T *m, MOID_T *r) +{ + if (SUB (t) == m) + SUB (t) = r; + + for (PACK_T *p = PACK (t); p != NO_PACK; FORWARD (p)) + { + if (MOID (p) == m) + MOID (p) = r; + } +} + +/* Substitute mode M with mode R in all modes in MODES_LIST. + The entry for M in MODES_LIST is set to NO_MOID. */ + +static void +a68_replace_equivalent_mode (vec *mode_list, + MOID_T *m, MOID_T *r) +{ + for (size_t i = 0; i < mode_list->length (); ++i) + { + if ((*mode_list)[i] == m) + (*mode_list)[i] = NO_MOID; + else if ((*mode_list)[i] != NO_MOID) + a68_replace_submode ((*mode_list)[i], m, r); + } +} + +/* Decode a modes table at DATA + POS. */ + +static bool +a68_decode_modes (MOIF_T *moif, encoded_modes_map_t &encoded_modes, + const char *data, size_t size, size_t pos, + size_t *ppos, const char **errstr) +{ + bool siga; + uint8_t kind; + uint64_t mode_table_size, mode_table_end; + + /* Get the size of the modes table. */ + DOFFSET (mode_table_size); + mode_table_end = pos + mode_table_size; + + /* Decode all the mode entries and fill in encoded_modes. */ + while (pos < mode_table_end) + { + int8_t sizety; + uint8_t ndims, nmodes, nargs; + uint16_t nfields; + uint64_t mode_offset = pos; + uint64_t sub, ret_mode_offset; + struct encoded_mode *encoded_mode; + + DUINT8 (kind); + encoded_mode = (struct encoded_mode *) xmalloc (sizeof (struct encoded_mode)); + encoded_mode->moid = NO_MOID; + encoded_mode->offset = mode_offset; + encoded_mode->kind = kind; + encoded_mode->sizety = 0; + switch (kind) + { + case GA68_MODE_VOID: + case GA68_MODE_CHAR: + case GA68_MODE_BOOL: + case GA68_MODE_STRING: + break; + case GA68_MODE_INT: + case GA68_MODE_REAL: + case GA68_MODE_BITS: + case GA68_MODE_BYTES: + case GA68_MODE_CMPL: + DINT8 (sizety); + encoded_mode->sizety = sizety; + break; + case GA68_MODE_NAME: + DOFFSET (sub); + encoded_mode->data.name.sub_offset = sub; + break; + case GA68_MODE_FLEX: + DOFFSET (sub); + encoded_mode->data.flex.sub_offset = sub; + break; + case GA68_MODE_ROW: + DUINT8 (ndims); + encoded_mode->data.row.triplets + = (struct encoded_triplet *) xmalloc (sizeof (struct encoded_triplet) * ndims); + for (uint8_t i = 0; i < ndims; i++) + { + uint64_t lb, ub; + DOFFSET (lb); + DOFFSET (ub); + encoded_mode->data.row.triplets[i].lb = lb; + encoded_mode->data.row.triplets[i].ub = ub; + } + DOFFSET (sub); + encoded_mode->data.row.ndims = ndims; + encoded_mode->data.row.sub_offset = sub; + break; + case GA68_MODE_UNION: + DUINT16 (nmodes); + encoded_mode->data.union_.nmodes = nmodes; + encoded_mode->data.union_.modes + = (uint64_t *) xmalloc (sizeof (uint64_t) * nmodes); + for (uint8_t i = 0; i < nmodes; i++) + { + uint64_t mode; + DOFFSET (mode); + encoded_mode->data.union_.modes[i] = mode; + } + break; + case GA68_MODE_PROC: + DOFFSET (ret_mode_offset); + DUINT8 (nargs); + encoded_mode->data.proc.ret_mode_offset = ret_mode_offset; + encoded_mode->data.proc.nargs = nargs; + encoded_mode->data.proc.args + = (struct encoded_arg *) xmalloc (sizeof (struct encoded_arg) * nargs); + for (uint8_t i = 0; i < nargs; i++) + { + uint64_t arg_mode_offset; + char *arg_name; + DOFFSET (arg_mode_offset); + DSTR (arg_name); + encoded_mode->data.proc.args[i].arg_mode_offset = arg_mode_offset; + encoded_mode->data.proc.args[i].arg_name = arg_name; + } + break; + case GA68_MODE_STRUCT: + DUINT16 (nfields); + encoded_mode->data.sct.nfields = nfields; + encoded_mode->data.sct.fields + = (struct encoded_field *) xmalloc (sizeof (struct encoded_field) * nfields); + for (uint16_t i = 0; i < nfields; i++) + { + uint64_t mode_offset; + char *field_name; + DOFFSET (mode_offset); + DSTR (field_name); + encoded_mode->data.sct.fields[i].mode_offset = mode_offset; + encoded_mode->data.sct.fields[i].name = field_name; + } + break; + case GA68_MODE_UNKNOWN: + default: + *errstr = "invalid kind in mode"; + goto decode_error; + break; + } + + encoded_modes.put (mode_offset, encoded_mode); + } + + /* Sanity check. */ + if (pos != mode_table_end) + { + *errstr = "invalid mode table size"; + goto decode_error; + } + + /* Complete all encoded modes. + This operation must conform a transitive closure. */ + siga = true; + while (siga) + { + siga = false; + for (auto entry : encoded_modes) + { + uint64_t offset = entry.first; + struct encoded_mode *em = entry.second; + + if (em->moid == NO_MOID + && complete_encoded_mode (encoded_modes, offset) != NO_MOID) + siga = true; + } + } + + /* At this point all the encoded modes are complete and they are all + associated with moids. Put them in the moif. */ + for (auto entry : encoded_modes) + { + struct encoded_mode *em = entry.second; + vec_safe_push (MODES (moif), em->moid); + } + + /* Next step is to see if equivalent modes the any of the modes in the moif + DIM already exist in the compiler's mode list. In that case, replace the + DIM moif's mode with the existing mode anywhere in the moif. */ + for (MOID_T *m : MODES (moif)) + { + MOID_T *r = a68_search_equivalent_mode (m); + if (r != NO_MOID) + { + a68_replace_equivalent_mode (MODES (moif), m, r); + + /* Update encoded_modes to reflect the replacement. */ + for (auto entry : encoded_modes) + { + struct encoded_mode *em = entry.second; + if (em->moid == m) + em->moid = r; + } + } + } + + *errstr = NULL; + *ppos = pos; + return true; + decode_error: + if (*errstr == NULL) + *errstr = "error decoding mode"; + return false; +} + +/* Decode an extracts table at DATA + POS. */ + +static bool +a68_decode_extracts (MOIF_T *moif, encoded_modes_map_t &encoded_modes, + const char *data, size_t size, size_t pos, + size_t *ppos, const char **errstr) +{ + uint64_t extracts_table_size, extracts_table_end; + + /* Get the size of the extracts table. */ + DOFFSET (extracts_table_size); + extracts_table_end = pos + extracts_table_size; + + /* Decode all the extracts entries, adding them to MOIF as we go. */ + while (pos < extracts_table_end) + { + uint8_t marker, prio, variable, in_proc; + uint64_t extract_size, extract_end, mode_offset; + uint64_t mdextra_size; + char *name; + + EXTRACT_T *e = (EXTRACT_T *) ggc_cleared_alloc (); + + DOFFSET (extract_size); + extract_end = pos + extract_size; + + DUINT8 (marker); + switch (marker) + { + case GA68_EXTRACT_MODU: + DSTR (name); + DOFFSET (mdextra_size); + if (mdextra_size != 0) + { + *errstr = "non-empty mdextra in module extract"; + goto decode_error; + } + EXTRACT_KIND (e) = GA68_EXTRACT_MODU; + EXTRACT_SYMBOL (e) = ggc_strdup (name); + EXTRACT_MODE (e) = NO_MOID; + EXTRACT_PRIO (e) = 0; + EXTRACT_VARIABLE (e) = false; + EXTRACT_IN_PROC (e) = false; + vec_safe_push (MODULES (moif), e); + break; + case GA68_EXTRACT_IDEN: + DSTR (name); + DOFFSET (mode_offset); + DOFFSET (mdextra_size); + if (mdextra_size != 2) + { + *errstr = "mdextra size should be 2 in iden extract"; + goto decode_error; + } + DUINT8 (variable); + DUINT8 (in_proc); + EXTRACT_KIND (e) = GA68_EXTRACT_IDEN; + EXTRACT_SYMBOL (e) = ggc_strdup (name); + EXTRACT_MODE (e) = (*(encoded_modes.get (mode_offset)))->moid; + EXTRACT_PRIO (e) = 0; + EXTRACT_VARIABLE (e) = variable; + EXTRACT_IN_PROC (e) = in_proc; + vec_safe_push (IDENTIFIERS (moif), e); + break; + case GA68_EXTRACT_MODE: + DSTR (name); + DOFFSET (mode_offset); + DOFFSET (mdextra_size); + if (mdextra_size != 0) + { + *errstr = "non-empty mdextra in indicant extract"; + goto decode_error; + } + EXTRACT_KIND (e) = GA68_EXTRACT_MODE; + EXTRACT_SYMBOL (e) = ggc_strdup (name); + EXTRACT_MODE (e) = (*(encoded_modes.get (mode_offset)))->moid; + EXTRACT_PRIO (e) = 0; + EXTRACT_VARIABLE (e) = false; + EXTRACT_IN_PROC (e) = false; + vec_safe_push (INDICANTS (moif), e); + break; + case GA68_EXTRACT_PRIO: + DSTR (name); + DUINT8 (prio); + DOFFSET (mdextra_size); + if (mdextra_size != 0) + { + *errstr = "non-empty mdextra in prio extract"; + goto decode_error; + } + EXTRACT_KIND (e) = GA68_EXTRACT_PRIO; + EXTRACT_SYMBOL (e) = ggc_strdup (name); + EXTRACT_MODE (e) = NO_MOID; + EXTRACT_PRIO (e) = prio; + EXTRACT_VARIABLE (e) = false; + EXTRACT_IN_PROC (e) = false; + vec_safe_push (PRIOS (moif), e); + break; + case GA68_EXTRACT_OPER: + DSTR (name); + DOFFSET (mode_offset); + DOFFSET (mdextra_size); + if (mdextra_size != 2) + { + *errstr = "mdextra size should be 2 in oper extract"; + goto decode_error; + } + DUINT8 (variable); + DUINT8 (in_proc); + EXTRACT_KIND (e) = GA68_EXTRACT_OPER; + EXTRACT_SYMBOL (e) = ggc_strdup (name); + EXTRACT_MODE (e) = (*(encoded_modes.get (mode_offset)))->moid; + EXTRACT_PRIO (e) = 0; + EXTRACT_VARIABLE (e) = variable; + EXTRACT_IN_PROC (e) = in_proc; + vec_safe_push (OPERATORS (moif), e); + break; + default: + *errstr = "invalid marker in extract"; + goto decode_error; + break; + } + + /* Sanity check. */ + if (pos != extract_end) + { + *errstr = "invalid extract size"; + goto decode_error; + } + } + + /* Sanity check. */ + if (pos != extracts_table_end) + { + *errstr = "invalid extracts table size"; + goto decode_error; + } + + *errstr = NULL; + *ppos = pos; + return true; + decode_error: + if (*errstr == NULL) + *errstr = "error decoding extract"; + return false; +} + +/* Decode the given exports data into a moif. If there is a decoding error + then put an explicative mssage in *ERRSTR and return NULL. */ + +static MOIF_T * +a68_decode_moif (const char *data, size_t size, const char **errstr) +{ + size_t pos = 0; + MOIF_T *moif = a68_moif_new (NULL /* name */); + encoded_modes_map_t encoded_modes (16); + + uint8_t magic1, magic2; + uint16_t version; + char *name, *prelude, *postlude; + + DUINT8 (magic1); + DUINT8 (magic2); + if (magic1 != A68_EXPORT_MAGIC1 || magic2 != A68_EXPORT_MAGIC2) + { + *errstr = "invalid magic number"; + goto decode_error; + } + + DUINT16 (version); + if (version != 1) + { + *errstr = "invalid a68 exports version"; + goto decode_error; + } + + DSTR (name); + DSTR (prelude); + DSTR (postlude); + NAME (moif) = name; + PRELUDE (moif) = prelude; + POSTLUDE (moif) = postlude; + + /* Decode the modes table. + This installs the resulting moids in MOIF. */ + if (!a68_decode_modes (moif, encoded_modes, data, size, pos, &pos, errstr)) + goto decode_error; + + /* Decode the extracts table. + This installs the resulting tags in MOIF. */ + if (!a68_decode_extracts (moif, encoded_modes, data, size, pos, &pos, errstr)) + goto decode_error; + + /* We don't need the encoded modes anymore. */ + for (auto entry : encoded_modes) + { + struct encoded_mode *em = entry.second; + encoded_mode_free (em); + } + + /* Got some juicy exports for youuuuuu... */ + return moif; + decode_error: + if (*errstr == NULL) + *errstr = "premature end of data"; + return NULL; +} + +/* Get a moif with the exports for module named MODULE. If no exports can be + found then return NULL. */ + +MOIF_T * +a68_open_packet (const char *module) +{ + /* Look in the modules location maps to see if there is an entry for MODULE. + If there is one, use the specified filename. Otherwise canonicalize the + module name to a file name. */ + char *filename; + const char **pfilename = A68_MODULE_FILES->get (module); + if (pfilename == NULL) + { + /* Turn the module indicant in MODULE to lower-case. */ + filename = (char *) alloca (strlen (module) + 1); + size_t i = 0; + for (; i < strlen (module); i++) + filename[i] = TOLOWER (module[i]); + filename[i] = '\0'; + } + else + { + size_t len = strlen (*pfilename) + 1; + filename = (char *) alloca (len); + memcpy (filename, *pfilename, len); + } + + /* Try to read exports data in a buffer. */ + char *exports_data; + size_t exports_data_size; + exports_data = a68_get_packet_exports (std::string (filename), + std::string ("."), + &exports_data_size); + if (exports_data == NULL) + return NULL; + + /* Got some data. Parse it into a moif. */ + const char *errstr = NULL; + MOIF_T *moif = a68_decode_moif (exports_data, exports_data_size, &errstr); + return moif; +} From bffb702400a18d60a05e3ca123dde2b334bc6dc8 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:46:09 +0200 Subject: [PATCH 148/373] a68: parser: entry point This commit adds the parsing support code and the entry point to the parser. Signed-off-by: Jose E. Marchesi Co-authored-by: Marcel van der Veer --- gcc/algol68/a68-parser.cc | 1181 +++++++++++++++++++++++++++++++++++++ 1 file changed, 1181 insertions(+) create mode 100644 gcc/algol68/a68-parser.cc diff --git a/gcc/algol68/a68-parser.cc b/gcc/algol68/a68-parser.cc new file mode 100644 index 000000000000..f01ecbee434b --- /dev/null +++ b/gcc/algol68/a68-parser.cc @@ -0,0 +1,1181 @@ +/* ALGOL 68 parser. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +/* + This is a Mailloux-type parser driver. + + The Algol 68 grammar is a two level (Van Wijngaarden, "VW") grammar + that incorporates, as syntactical rules, the semantical rules in + other languages. Examples are correct use of symbols, modes and + scope. + + This code constitutes an effective "VW Algol 68 parser". A + pragmatic approach was chosen since in the early days of Algol 68, + many "ab initio" implementations failed, probably because + techniques to parse a language like Algol 68 had yet to be + invented. + + This is a Mailloux-type parser, in the sense that it scans a + "phrase" for definitions needed for parsing. Algol 68 allows for + tags to be used before they are defined, which gives freedom in + top-down programming. + + B. J. Mailloux. On the implementation of Algol 68. + Thesis, Universiteit van Amsterdam (Mathematisch Centrum) [1968]. + + Technically, Mailloux's approach renders the two-level grammar + LALR. + + First part of the parser is the scanner. The source file is read, is + tokenised. The result is a linear list of tokens that is input for the + parser, that will transform the linear list into a syntax tree. + + This front-end tokenises all symbols before the bottom-up parser is invoked. + This means that scanning does not use information from the parser. The + scanner does of course some rudimentary parsing. + + The scanner supports two stropping regimes: "bold" (or "upper") and + "quote". Examples of both: + + bold stropping: BEGIN INT i = 1, j = 1; print (i + j) END + + quote stropping: 'BEGIN' 'INT' I = 1, J = 1; PRINT (I + J) 'END' + + Quote stropping was used frequently in the (excusez-le-mot) + punch-card age. Hence, bold stropping is the default. There also + existed point stropping, but that has not been implemented here. + + Next part of the parser is a recursive-descent type to check + parenthesis. Also a first set-up is made of symbol tables, needed + by the bottom-up parser. Next part is the bottom-up parser, that + parses without knowing modes while parsing and reducing. It can + therefore not exchange "[]" with "()" as was blessed by the Revised + Report. This is solved by treating CALL and SLICE as equivalent for + the moment and letting the mode checker sort it out later. + + Parsing progresses in various phases to avoid spurious diagnostics + from a recovering parser. Every phase "tightens" the grammar more. + An error in any phase makes the parser quit when that phase ends. + The parser is forgiving in case of superfluous semicolons. + + These are the parser phases: + + (1) Parenthesis are checked to see whether they match. Then, a top-down + parser determines the basic-block structure of the program + so symbol tables can be set up that the bottom-up parser will consult + as you can define things before they are applied. + + (2) A bottom-up parser resolves the structure of the program. + + (3) After the symbol tables have been finalised, a small rearrangement of the + tree may be required where JUMPs have no GOTO. This leads to the + non-standard situation that JUMPs without GOTO can have the syntactic + position of a PRIMARY, SECONDARY or TERTIARY. The bottom-up parser also + does not check VICTAL correctness of declarers. This is done separately. + + The parser sets up symbol tables and populates them as far as needed to parse + the source. After the bottom-up parser terminates succesfully, the symbol tables + are completed. + + (4) Next, modes are collected and rules for well-formedness and structural + equivalence are applied. Then the symbol-table is completed now moids are + all known. + + (5) Next phases are the mode checker and coercion inserter. The syntax tree is + traversed to determine and check all modes, and to select operators. Then + the tree is traversed again to insert coercions. + + (6) A static scope checker detects where objects are transported out of scope. + At run time, a dynamic scope checker will check that what the static scope + checker cannot see. + + (7) A serial-clause dynamic stack allocation (DSA) phase annotates the + serial clauses that contain phrases whose elaboration may result in + dynamic stack adjustments. +*/ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "diagnostic.h" +#include "tree.h" + +#include "a68.h" + +/* Global state kept by the parser. */ + +PARSER_T a68_parser_state; + +/* A few forward declarations of functions defined below. */ + +static void make_special_mode (MOID_T ** n, int m); +static void tie_label_to_serial (NODE_T *p); +static void tie_label_to_unit (NODE_T *p); + +/* Is_ref_refety_flex. */ + +bool +a68_is_ref_refety_flex (MOID_T *m) +{ + if (IS_REF_FLEX (m)) + return true; + else if (IS_REF (m)) + return a68_is_ref_refety_flex (SUB (m)); + else + return false; +} + +/* Count number of operands in operator parameter list. */ + +int +a68_count_operands (NODE_T *p) +{ + if (p != NO_NODE) + { + if (IS (p, DECLARER)) + return a68_count_operands (NEXT (p)); + else if (IS (p, COMMA_SYMBOL)) + return 1 + a68_count_operands (NEXT (p)); + else + return a68_count_operands (NEXT (p)) + a68_count_operands (SUB (p)); + } + else + return 0; +} + +/* Count formal bounds in declarer in tree. */ + +int +a68_count_formal_bounds (NODE_T * p) +{ + if (p == NO_NODE) + return 0; + else + { + if (IS (p, COMMA_SYMBOL)) + return 1; + else + return a68_count_formal_bounds (NEXT (p)) + a68_count_formal_bounds (SUB (p)); + } +} + +/* Count pictures. */ + +void +a68_count_pictures (NODE_T *p, int *k) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, PICTURE)) + (*k)++; + a68_count_pictures (SUB (p), k); + } +} + +/* Whether token cannot follow semicolon or EXIT. */ + +bool +a68_is_semicolon_less (NODE_T *p) +{ + switch (ATTRIBUTE (p)) + { + case BUS_SYMBOL: + case CLOSE_SYMBOL: + case END_SYMBOL: + case SEMI_SYMBOL: + case EXIT_SYMBOL: + case THEN_BAR_SYMBOL: + case ELSE_BAR_SYMBOL: + case THEN_SYMBOL: + case ELIF_SYMBOL: + case ELSE_SYMBOL: + case FI_SYMBOL: + case IN_SYMBOL: + case OUT_SYMBOL: + case OUSE_SYMBOL: + case ESAC_SYMBOL: + case OD_SYMBOL: + case FED_SYMBOL: + case POSTLUDE_SYMBOL: + return true; + default: + return false; + } +} + +/* Whether formal bounds. */ + +bool +a68_is_formal_bounds (NODE_T *p) +{ + if (p == NO_NODE) + return true; + + switch (ATTRIBUTE (p)) + { + case OPEN_SYMBOL: + case CLOSE_SYMBOL: + case SUB_SYMBOL: + case BUS_SYMBOL: + case COMMA_SYMBOL: + case COLON_SYMBOL: + case INT_DENOTATION: + case IDENTIFIER: + case OPERATOR: + return (a68_is_formal_bounds (SUB (p)) + && a68_is_formal_bounds (NEXT (p))); + default: + return false; + } +} + +/* Whether token terminates a unit. */ + +bool +a68_is_unit_terminator (NODE_T *p) +{ + switch (ATTRIBUTE (p)) + { + case BUS_SYMBOL: + case CLOSE_SYMBOL: + case END_SYMBOL: + case SEMI_SYMBOL: + case EXIT_SYMBOL: + case COMMA_SYMBOL: + case THEN_BAR_SYMBOL: + case ELSE_BAR_SYMBOL: + case THEN_SYMBOL: + case ELIF_SYMBOL: + case ELSE_SYMBOL: + case FI_SYMBOL: + case IN_SYMBOL: + case OUT_SYMBOL: + case OUSE_SYMBOL: + case ESAC_SYMBOL: + case FED_SYMBOL: + case POSTLUDE_SYMBOL: + return true; + default: + return false; + } +} + +/* Whether token is a unit-terminator in a loop clause. */ + +bool +a68_is_loop_keyword (NODE_T *p) +{ + switch (ATTRIBUTE (p)) + { + case FOR_SYMBOL: + case FROM_SYMBOL: + case BY_SYMBOL: + case TO_SYMBOL: + case WHILE_SYMBOL: + case DO_SYMBOL: + return true; + default: + return false; + } +} + +/* Get good attribute. */ + +enum a68_attribute +a68_get_good_attribute (NODE_T *p) +{ + switch (ATTRIBUTE (p)) + { + case UNIT: + case TERTIARY: + case SECONDARY: + case PRIMARY: + return a68_get_good_attribute (SUB (p)); + default: + return ATTRIBUTE (p); + } +} + +/* Preferably don't put intelligible diagnostic here. */ + +bool +a68_dont_mark_here (NODE_T *p) +{ + switch (ATTRIBUTE (p)) + { + case ALT_DO_SYMBOL: + case ALT_EQUALS_SYMBOL: + case ANDF_SYMBOL: + case ASSERT_SYMBOL: + case ASSIGN_SYMBOL: + case ASSIGN_TO_SYMBOL: + case AT_SYMBOL: + case BEGIN_SYMBOL: + case BITS_SYMBOL: + case BOLD_COMMENT_SYMBOL: + case BOLD_PRAGMAT_SYMBOL: + case BOLD_COMMENT_BEGIN_SYMBOL: + case BOLD_COMMENT_END_SYMBOL: + case BOOL_SYMBOL: + case BUS_SYMBOL: + case BY_SYMBOL: + case BYTES_SYMBOL: + case CASE_SYMBOL: + case CHANNEL_SYMBOL: + case CHAR_SYMBOL: + case CLOSE_SYMBOL: + case COLON_SYMBOL: + case COMMA_SYMBOL: + case COMPLEX_SYMBOL: + case COMPL_SYMBOL: + case DO_SYMBOL: + case ELIF_SYMBOL: + case ELSE_BAR_SYMBOL: + case ELSE_SYMBOL: + case EMPTY_SYMBOL: + case END_SYMBOL: + case EQUALS_SYMBOL: + case ESAC_SYMBOL: + case EXIT_SYMBOL: + case FALSE_SYMBOL: + case FILE_SYMBOL: + case FI_SYMBOL: + case FLEX_SYMBOL: + case FOR_SYMBOL: + case FROM_SYMBOL: + case GO_SYMBOL: + case GOTO_SYMBOL: + case HEAP_SYMBOL: + case IF_SYMBOL: + case IN_SYMBOL: + case INT_SYMBOL: + case ISNT_SYMBOL: + case IS_SYMBOL: + case LOC_SYMBOL: + case LONG_SYMBOL: + case MAIN_SYMBOL: + case MODE_SYMBOL: + case NIL_SYMBOL: + case OD_SYMBOL: + case OF_SYMBOL: + case OPEN_SYMBOL: + case OP_SYMBOL: + case ORF_SYMBOL: + case OUSE_SYMBOL: + case OUT_SYMBOL: + case PAR_SYMBOL: + case POINT_SYMBOL: + case PRIO_SYMBOL: + case PROC_SYMBOL: + case REAL_SYMBOL: + case REF_SYMBOL: + case ROWS_SYMBOL: + case ROW_SYMBOL: + case SEMA_SYMBOL: + case SEMI_SYMBOL: + case SHORT_SYMBOL: + case SKIP_SYMBOL: + case STRING_SYMBOL: + case STRUCT_SYMBOL: + case STYLE_I_COMMENT_SYMBOL: + case STYLE_II_COMMENT_SYMBOL: + case STYLE_I_PRAGMAT_SYMBOL: + case SUB_SYMBOL: + case THEN_BAR_SYMBOL: + case THEN_SYMBOL: + case TO_SYMBOL: + case TRUE_SYMBOL: + case UNION_SYMBOL: + case VOID_SYMBOL: + case WHILE_SYMBOL: + case SERIAL_CLAUSE: + case ENQUIRY_CLAUSE: + case INITIALISER_SERIES: + case DECLARATION_LIST: + case DEF_SYMBOL: + case FED_SYMBOL: + case POSTLUDE_SYMBOL: + case ACCESS_SYMBOL: + return true; + default: + return false; + } +} + +/* Renumber nodes in the given subtree P, starting with number N. */ + +static void +renumber_nodes (NODE_T *p, int *n) +{ + for (; p != NO_NODE; FORWARD (p)) + { + NUMBER (p) = (*n)++; + renumber_nodes (SUB (p), n); + } +} + +/* Parse an ALGOL 68 source file. */ + +void +a68_parser (const char *filename) +{ + int renum = 0; + + /* Initialisation. */ + A68 (top_keyword) = NO_KEYWORD; + A68 (top_token) = NO_TOKEN; + A68_PARSER (error_tag) = (TAG_T *) a68_new_tag (); + TOP_NODE (&A68_JOB) = NO_NODE; + TOP_MOID (&A68_JOB) = NO_MOID; + TOP_LINE (&A68_JOB) = NO_LINE; + STANDENV_MOID (&A68_JOB) = NO_MOID; + a68_set_up_tables (); + ERROR_COUNT (&A68_JOB) = WARNING_COUNT (&A68_JOB) = 0; + + /* Tokeniser. */ + if (ERROR_COUNT (&A68_JOB) == 0) + { + bool ok = a68_lexical_analyser (filename); + + if (!ok) + return; + + /* An empty file is not a valid program. */ + if (TOP_NODE (&A68_JOB) == NO_NODE) + { + a68_error (NO_NODE, "file is empty, expected a program"); + return; + } + + TREE_LISTING_SAFE (&A68_JOB) = true; + renum = 0; + renumber_nodes (TOP_NODE (&A68_JOB), &renum); + } + + /* Final initialisations. */ + if (ERROR_COUNT (&A68_JOB) == 0) + { + A68_STANDENV = NO_TABLE; + a68_init_postulates (); + A68 (mode_count) = 0; + make_special_mode (&M_HIP, A68 (mode_count)++); + make_special_mode (&M_UNDEFINED, A68 (mode_count)++); + make_special_mode (&M_ERROR, A68 (mode_count)++); + make_special_mode (&M_VACUUM, A68 (mode_count)++); + make_special_mode (&M_C_STRING, A68 (mode_count)++); + make_special_mode (&M_COLLITEM, A68 (mode_count)++); + } + + /* Handle pragmats. */ + if (ERROR_COUNT (&A68_JOB) == 0) + a68_handle_pragmats (TOP_NODE (&A68_JOB)); + + /* Top-down parser. */ + if (ERROR_COUNT (&A68_JOB) == 0) + { + a68_check_parenthesis (TOP_NODE (&A68_JOB)); + if (ERROR_COUNT (&A68_JOB) == 0) + { + if (OPTION_BRACKETS (&A68_JOB)) + a68_substitute_brackets (TOP_NODE (&A68_JOB)); + A68 (symbol_table_count) = 0; + A68_STANDENV = a68_new_symbol_table (NO_TABLE); + LEVEL (A68_STANDENV) = 0; + a68_top_down_parser (TOP_NODE (&A68_JOB)); + // printf ("AFTER TOP-DOWN\n"); + // a68_dump_parse_tree (TOP_NODE (&A68_JOB)); + } + + renum = 0; + renumber_nodes (TOP_NODE (&A68_JOB), &renum); + } + + /* Standard environment builder. */ + if (ERROR_COUNT (&A68_JOB) == 0) + { + TABLE (TOP_NODE (&A68_JOB)) = a68_new_symbol_table (A68_STANDENV); + a68_make_standard_environ (); + STANDENV_MOID (&A68_JOB) = TOP_MOID (&A68_JOB); + } + + /* Bottom-up parser. */ + if (ERROR_COUNT (&A68_JOB) == 0) + { + a68_preliminary_symbol_table_setup (TOP_NODE (&A68_JOB)); + // printf ("AFTER PRELIMINARY SYMBOL TABLE SETUP\n"); + // a68_dump_parse_tree (TOP_NODE (&A68_JOB), true); + a68_bottom_up_parser (TOP_NODE (&A68_JOB)); + a68_bottom_up_coalesce_pub (TOP_NODE (&A68_JOB)); + renum = 0; + renumber_nodes (TOP_NODE (&A68_JOB), &renum); + } + + // printf ("AFTER BOTTOM-UP\n"); + // a68_dump_parse_tree (TOP_NODE (&A68_JOB), true); + + if (ERROR_COUNT (&A68_JOB) == 0) + { + a68_bottom_up_error_check (TOP_NODE (&A68_JOB)); + a68_victal_checker (TOP_NODE (&A68_JOB)); + if (ERROR_COUNT (&A68_JOB) == 0) + { + a68_finalise_symbol_table_setup (TOP_NODE (&A68_JOB), 1); + // printf ("AFTER FINALISE SYMBOL TABLE SETUP\n"); + // a68_dump_parse_tree (TOP_NODE (&A68_JOB), true, true); + NEST (TABLE (TOP_NODE (&A68_JOB))) = A68 (symbol_table_count) = 3; + a68_reset_symbol_table_nest_count (TOP_NODE (&A68_JOB)); + a68_fill_symbol_table_outer (TOP_NODE (&A68_JOB), TABLE (TOP_NODE (&A68_JOB))); + a68_set_nest (TOP_NODE (&A68_JOB), NO_NODE); + a68_set_proc_level (TOP_NODE (&A68_JOB), 1); + } + renum = 0; + renumber_nodes (TOP_NODE (&A68_JOB), &renum); + } + + /* Mode table builder. */ + if (ERROR_COUNT (&A68_JOB) == 0) + a68_make_moid_list (&A68_JOB); + CROSS_REFERENCE_SAFE (&A68_JOB) = true; + + /* Symbol table builder. */ + if (ERROR_COUNT (&A68_JOB) == 0) + a68_collect_taxes (TOP_NODE (&A68_JOB)); + + /* Post parser. */ + if (ERROR_COUNT (&A68_JOB) == 0) + a68_rearrange_goto_less_jumps (TOP_NODE (&A68_JOB)); + + /* Mode checker. */ + if (ERROR_COUNT (&A68_JOB) == 0) + a68_mode_checker (TOP_NODE (&A68_JOB)); + + /* Coercion inserter. */ + if (ERROR_COUNT (&A68_JOB) == 0) + { + a68_coercion_inserter (TOP_NODE (&A68_JOB)); + renum = 0; + renumber_nodes (TOP_NODE (&A68_JOB), &renum); + } + + /* Application checker. */ + if (ERROR_COUNT (&A68_JOB) == 0) + { + a68_mark_moids (TOP_NODE (&A68_JOB)); + a68_mark_auxilliary (TOP_NODE (&A68_JOB)); + a68_jumps_from_procs (TOP_NODE (&A68_JOB)); + a68_warn_for_unused_tags (TOP_NODE (&A68_JOB)); + } + + /* Static scope checker. */ + if (ERROR_COUNT (&A68_JOB) == 0) + { + tie_label_to_serial (TOP_NODE (&A68_JOB)); + tie_label_to_unit (TOP_NODE (&A68_JOB)); + a68_bind_routine_tags_to_tree (TOP_NODE (&A68_JOB)); + a68_scope_checker (TOP_NODE (&A68_JOB)); + } + + /* Serial dynamic stack allocation checker. */ + if (ERROR_COUNT (&A68_JOB) == 0) + { + a68_serial_dsa (TOP_NODE (&A68_JOB)); + } + + /* Finalise syntax tree. */ + if (ERROR_COUNT (&A68_JOB) == 0) + { + int num = 0; + renumber_nodes (TOP_NODE (&A68_JOB), &num); + NEST (TABLE (TOP_NODE (&A68_JOB))) = A68 (symbol_table_count) = 3; + a68_reset_symbol_table_nest_count (TOP_NODE (&A68_JOB)); + } +} + +/* New_node_info. */ + +NODE_INFO_T * +a68_new_node_info (void) +{ + NODE_INFO_T *z = ggc_cleared_alloc (); + + A68 (new_node_infos)++; + PROCEDURE_LEVEL (z) = 0; + CHAR_IN_LINE (z) = NO_TEXT; + SYMBOL (z) = NO_TEXT; + PRAGMAT (z) = NO_TEXT; + PRAGMAT_TYPE (z) = 0; + PRAGMAT_LINE (z) = NO_LINE; + PRAGMAT_CHAR_IN_LINE (z) = NO_TEXT; + COMMENT (z) = NO_TEXT; + COMMENT_TYPE (z) = 0; + COMMENT_LINE (z) = NO_LINE; + COMMENT_CHAR_IN_LINE (z) = NO_TEXT; + LINE (z) = NO_LINE; + return z; +} + +/* New_genie_info. */ + +GINFO_T * +a68_new_genie_info (void) +{ + GINFO_T *z = ggc_cleared_alloc (); + + A68 (new_genie_infos)++; + PARTIAL_PROC (z) = NO_MOID; + PARTIAL_LOCALE (z) = NO_MOID; + return z; +} + +/* Allocate and return a new parse tree node with proper defaults. */ + +NODE_T * +a68_new_node (void) +{ + NODE_T *z = ggc_cleared_alloc (); + + A68 (new_nodes)++; + TABLE (z) = NO_TABLE; + INFO (z) = NO_NINFO; + GINFO (z) = NO_GINFO; + ATTRIBUTE (z) = STOP; + ANNOTATION (z) = STOP; + MOID (z) = NO_MOID; + NEXT (z) = NO_NODE; + PREVIOUS (z) = NO_NODE; + SUB (z) = NO_NODE; + NEST (z) = NO_NODE; + NON_LOCAL (z) = NO_TABLE; + TAX (z) = NO_TAG; + SEQUENCE (z) = NO_NODE; + PACK (z) = NO_PACK; + CDECL (z) = NULL_TREE; + DYNAMIC_STACK_ALLOCS (z) = false; + PUBLICIZED (z) = false; + return z; +} + +/* Some_node. */ + +NODE_T * +a68_some_node (const char *t) +{ + NODE_T *z = a68_new_node (); + INFO (z) = a68_new_node_info (); + GINFO (z) = a68_new_genie_info (); + NSYMBOL (z) = t; + return z; +} + +/* New_symbol_table. */ + +TABLE_T * +a68_new_symbol_table (TABLE_T *p) +{ + TABLE_T *z = ggc_cleared_alloc (); + + NUM (z) = A68 (symbol_table_count); + LEVEL (z) = A68 (symbol_table_count)++; + NEST (z) = A68 (symbol_table_count); + ATTRIBUTE (z) = 0; + INITIALISE_FRAME (z) = true; + PROC_OPS (z) = true; + INITIALISE_ANON (z) = true; + PREVIOUS (z) = p; + OUTER (z) = NO_TABLE; + IDENTIFIERS (z) = NO_TAG; + OPERATORS (z) = NO_TAG; + MODULES (z) = NO_TAG; + PRIO (z) = NO_TAG; + INDICANTS (z) = NO_TAG; + LABELS (z) = NO_TAG; + ANONYMOUS (z) = NO_TAG; + JUMP_TO (z) = NO_NODE; + SEQUENCE (z) = NO_NODE; + PUBLIC_RANGE (z) = false; + return z; +} + +/* New_moid. */ + +MOID_T * +a68_new_moid (void) +{ + MOID_T *z = ggc_cleared_alloc (); + + A68 (new_modes)++; + ATTRIBUTE (z) = 0; + NUMBER (z) = 0; + DIM (z) = 0; + USE (z) = false; + HAS_ROWS (z) = false; + PORTABLE (z) = true; + DERIVATE (z) = false; + NODE (z) = NO_NODE; + PACK (z) = NO_PACK; + SUB (z) = NO_MOID; + EQUIVALENT_MODE (z) = NO_MOID; + SLICE (z) = NO_MOID; + TRIM (z) = NO_MOID; + DEFLEXED (z) = NO_MOID; + NAME (z) = NO_MOID; + MULTIPLE_MODE (z) = NO_MOID; + NEXT (z) = NO_MOID; + CTYPE (z) = NULL_TREE; + ASM_LABEL (z) = NULL; + return z; +} + +/* New_pack. */ + +PACK_T * +a68_new_pack (void) +{ + PACK_T *z = ggc_cleared_alloc (); + + MOID (z) = NO_MOID; + TEXT (z) = NO_TEXT; + NODE (z) = NO_NODE; + NEXT (z) = NO_PACK; + PREVIOUS (z) = NO_PACK; + return z; +} + +/* New_tag. */ + +TAG_T * +a68_new_tag (void) +{ + TAG_T *z = ggc_cleared_alloc (); + + STATUS (z) = NULL_MASK; + TAG_TABLE (z) = NO_TABLE; + MOID (z) = NO_MOID; + NODE (z) = NO_NODE; + UNIT (z) = NO_NODE; + VALUE (z) = NO_TEXT; + SCOPE (z) = PRIMAL_SCOPE; + SCOPE_ASSIGNED (z) = false; + PRIO (z) = 0; + USE (z) = false; + IN_PROC (z) = false; + HEAP (z) = false; + YOUNGEST_ENVIRON (z) = PRIMAL_SCOPE; + LOC_ASSIGNED (z) = false; + NEXT (z) = NO_TAG; + BODY (z) = NO_TAG; + PORTABLE (z) = true; + VARIABLE (z) = false; + IS_RECURSIVE (z) = false; + PUBLICIZED (z) = true; /* XXX */ + EXPORTED (z) = false; + ASCRIBED_ROUTINE_TEXT (z) = false; + LOWERER (z) = NO_LOWERER; + TAX_TREE_DECL (z) = NULL_TREE; + MOIF (z) = NO_MOIF; + EXTERN_SYMBOL (z) = NO_TEXT; + NUMBER (z) = ++A68_PARSER (tag_number); + return z; +} + +/* Make special, internal mode. */ + +static void +make_special_mode (MOID_T ** n, int m) +{ + (*n) = a68_new_moid (); + ATTRIBUTE (*n) = 0; + NUMBER (*n) = m; + PACK (*n) = NO_PACK; + SUB (*n) = NO_MOID; + EQUIVALENT (*n) = NO_MOID; + DEFLEXED (*n) = NO_MOID; + NAME (*n) = NO_MOID; + SLICE (*n) = NO_MOID; + TRIM (*n) = NO_MOID; + ROWED (*n) = NO_MOID; +} + +/* Whether attributes match in subsequent nodes. */ + +bool +a68_whether (NODE_T * p, ...) +{ + va_list vl; + va_start (vl, p); + int a; + while ((a = va_arg (vl, int)) != STOP) + { + if (p != NO_NODE && a == WILDCARD) + FORWARD (p); + else if (p != NO_NODE && (a == KEYWORD)) + { + if (a68_find_keyword_from_attribute (A68 (top_keyword), ATTRIBUTE (p)) != NO_KEYWORD) + FORWARD (p); + else + { + va_end (vl); + return false; + } + } + else if (p != NO_NODE && (a >= 0 ? a == ATTRIBUTE (p) : (-a) != ATTRIBUTE (p))) + FORWARD (p); + else + { + va_end (vl); + return false; + } + } + va_end (vl); + return true; +} + +/* Whether one of a series of attributes matches a node. */ + +bool +a68_is_one_of (NODE_T *p, ...) +{ + if (p != NO_NODE) + { + bool match = false; + int a; + + va_list vl; + va_start (vl, p); + while ((a = va_arg (vl, int)) != STOP) + match = (match | IS (p, a)); + va_end (vl); + return match; + } + else + return false; +} + + +/* Isolate nodes p-q making p a branch to p-q + + From x - p - a - b - c - q - y + To x - t - y + | + p - a - b - c - q +*/ + +void +a68_make_sub (NODE_T *p, NODE_T *q, enum a68_attribute t) +{ + NODE_T *z = a68_new_node (); + + gcc_assert (p != NO_NODE && q != NO_NODE); + *z = *p; + + if (GINFO (p) != NO_GINFO) + GINFO (z) = a68_new_genie_info (); + + PREVIOUS (z) = NO_NODE; + + if (p == q) + NEXT (z) = NO_NODE; + else + { + if (NEXT (p) != NO_NODE) + PREVIOUS (NEXT (p)) = z; + NEXT (p) = NEXT (q); + if (NEXT (p) != NO_NODE) + PREVIOUS (NEXT (p)) = p; + NEXT (q) = NO_NODE; + } + + SUB (p) = z; + ATTRIBUTE (p) = t; +} + +/* Find symbol table at level I. */ + +static TABLE_T * +find_level (NODE_T *n, int i) +{ + if (n == NO_NODE) + return NO_TABLE; + else + { + TABLE_T *s = TABLE (n); + + if (s != NO_TABLE && LEVEL (s) == i) + return s; + else if ((s = find_level (SUB (n), i)) != NO_TABLE) + return s; + else if ((s = find_level (NEXT (n), i)) != NO_TABLE) + return s; + else + return NO_TABLE; + } +} + +/* Whether P is top of lexical level. */ + +bool +a68_is_new_lexical_level (NODE_T *p) +{ + switch (ATTRIBUTE (p)) + { + case ALT_DO_PART: + case BRIEF_ELIF_PART: + case BRIEF_OUSE_PART: + case BRIEF_CONFORMITY_OUSE_PART: + case CHOICE: + case CLOSED_CLAUSE: + case CONDITIONAL_CLAUSE: + case DO_PART: + case ELIF_PART: + case ELSE_PART: + case CASE_CLAUSE: + case CASE_CHOICE_CLAUSE: + case CASE_IN_PART: + case CASE_OUSE_PART: + case OUT_PART: + case ROUTINE_TEXT: + case SPECIFIED_UNIT: + case THEN_PART: + case CONFORMITY_CLAUSE: + case CONFORMITY_CHOICE: + case CONFORMITY_IN_PART: + case CONFORMITY_OUSE_PART: + case WHILE_PART: + case DEF_PART: + case POSTLUDE_PART: + case ACCESS_CLAUSE: + return true; + case MODULE_TEXT: + /* Module texts introduce an additional lexical level encompassing all + its parts only if it is endowed with revelations. */ + if (SUB (p) != NO_NODE && IS (SUB (p), REVELATION_PART)) + return true; + else + return false; + break; + default: + return false; + } +} + +/* + * Couple of utility functions. + */ + +/* Safely append to buffer. */ + +void +a68_bufcat (char *dst, const char *src, int len) +{ + if (src != NO_TEXT) { + char *d = dst; + const char *s = src; + int n = len; +// Find end of dst and left-adjust; do not go past end + for (; n-- != 0 && d[0] != '\0'; d++) { + ; + } + int dlen = (int) (d - dst); + n = len - dlen; + if (n > 0) { + while (s[0] != '\0') { + if (n != 1) { + (d++)[0] = s[0]; + n--; + } + s++; + } + d[0] = '\0'; + } +// Better sure than sorry + dst[len - 1] = '\0'; + } +} + +/* Safely copy to buffer. */ + +void +a68_bufcpy (char *dst, const char *src, int len) +{ + if (src != NO_TEXT) { + char *d = dst; + const char *s = src; + int n = len; +// Copy as many as fit + if (n > 0 && --n > 0) { + do { + if (((d++)[0] = (s++)[0]) == '\0') { + break; + } + } while (--n > 0); + } + if (n == 0 && len > 0) { +// Not enough room in dst, so terminate + d[0] = '\0'; + } +// Better sure than sorry + dst[len - 1] = '\0'; + } +} + +/* Make a new copy of concatenated strings. */ + +char * +a68_new_string (const char *t, ...) +{ + va_list vl; + va_start (vl, t); + const char *q = t; + if (q == NO_TEXT) { + va_end (vl); + return NO_TEXT; + } + int len = 0; + while (q != NO_TEXT) { + len += (int) strlen (q); + q = va_arg (vl, char *); + } + va_end (vl); + len++; + char *z = (char *) xmalloc ((size_t) len); + z[0] = '\0'; + q = t; + va_start (vl, t); + while (q != NO_TEXT) { + a68_bufcat (z, q, len); + q = va_arg (vl, char *); + } + va_end (vl); + return z; +} + +/* Tie label to the clause it is defined in. */ + +static void +tie_label_to_serial (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, SERIAL_CLAUSE)) + { + bool valid_follow; + + if (NEXT (p) == NO_NODE) + valid_follow = true; + else if (IS (NEXT (p), CLOSE_SYMBOL)) + valid_follow = true; + else if (IS (NEXT (p), END_SYMBOL)) + valid_follow = true; + else if (IS (NEXT (p), OD_SYMBOL)) + valid_follow = true; + else + valid_follow = false; + + if (valid_follow) + JUMP_TO (TABLE (SUB (p))) = NO_NODE; + } + + tie_label_to_serial (SUB (p)); + } +} + +/* Tie label to the clause it is defined in. */ + +static void +tie_label (NODE_T *p, NODE_T *unit) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, DEFINING_IDENTIFIER)) + UNIT (TAX (p)) = unit; + tie_label (SUB (p), unit); + } +} + +/* Tie label to the clause it is defined in. */ + +static void +tie_label_to_unit (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, LABELED_UNIT)) + tie_label (SUB_SUB (p), NEXT_SUB (p)); + tie_label_to_unit (SUB (p)); + } +} + +/* Table with attribute names. */ + +static const char *attribute_names[] = +{ + "STOP", +#define A68_ATTR(ATTR,DESCR) DESCR, +#include "a68-parser-attrs.def" +#undef A68_ATTR +}; + +/* Get the name of an attribute. */ + +const char * +a68_attribute_name (enum a68_attribute attr) +{ + return attribute_names[attr]; +} + +/* Get the location of node P as a GCC location. */ + +location_t +a68_get_node_location (NODE_T *p) +{ + LINE_T *line = LINE (INFO (p)); + + if (line == NO_LINE) + return UNKNOWN_LOCATION; + + unsigned line_number = NUMBER (line); + unsigned column_number = CHAR_IN_LINE (INFO (p)) - STRING (line) + 1; + const char *filename = FILENAME (line); + + location_t gcc_location; + + linemap_add (line_table, LC_ENTER, 0, filename, line_number); + linemap_line_start (line_table, line_number, 0); + gcc_location = linemap_position_for_column (line_table, column_number); + linemap_add (line_table, LC_LEAVE, 0, NULL, 0); + + return gcc_location; +} + +/* Get the location of POS inside LINE as a GCC location. */ + +location_t +a68_get_line_location (LINE_T *line, const char *pos) +{ + location_t loc; + + linemap_add (line_table, LC_ENTER, 0, FILENAME (line), NUMBER (line)); + linemap_line_start (line_table, NUMBER (line), 0); + loc = linemap_position_for_column (line_table, pos - STRING (line) + 1); + linemap_add (line_table, LC_LEAVE, 0, NULL, 0); + return loc; +} From 539d0c130092295479768769120f92b1b12143fc Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:46:33 +0200 Subject: [PATCH 149/373] a68: parser: AST nodes attributes/types Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-parser-attrs.def: New file. --- gcc/algol68/a68-parser-attrs.def | 387 +++++++++++++++++++++++++++++++ 1 file changed, 387 insertions(+) create mode 100644 gcc/algol68/a68-parser-attrs.def diff --git a/gcc/algol68/a68-parser-attrs.def b/gcc/algol68/a68-parser-attrs.def new file mode 100644 index 000000000000..31fc0d91f7db --- /dev/null +++ b/gcc/algol68/a68-parser-attrs.def @@ -0,0 +1,387 @@ +/* This file contains the definitions and documentation for all the different + kind/attributes of Algol 68 parse tree nodes. + Copyright (C) 2025 Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it under the + terms of the GNU General Public License as published by the Free Software + Foundation; either version 3, or (at your option) any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + details. + + You should have received a copy of the GNU General Public License along with + GCC; see the file COPYING3. If not see . */ + +/* Please keep the entries in this file sorted alphabetically. */ + +/* Note that the textual descriptions for the nodes are used in diagnostic + messages and debug dumps. Please make sure to write them in a way you would + expect to be used in statements like "[...] near ATT". */ + +A68_ATTR(A68_PATTERN, "transput pattern") +A68_ATTR(ACCESS_CLAUSE, "access clause") +A68_ATTR(ACCESS_SYMBOL, "access-symbol") +A68_ATTR(ACTUAL_DECLARER_MARK, "actual declarer mark") +A68_ATTR(ALT_ACCESS_SYMBOL, "alt-access-symbol") +A68_ATTR(ALT_DO_PART, "alt do part") +A68_ATTR(ALT_DO_SYMBOL, "alt do symbol") +A68_ATTR(ALT_EQUALS_SYMBOL, "alt equals symbol") +A68_ATTR(ALT_FORMAL_BOUNDS_LIST, "alt formal bounds list") +A68_ATTR(ANDF_SYMBOL, "andf symbol") +A68_ATTR(AND_FUNCTION, "andf pseudo-operator") +A68_ATTR(ANONYMOUS, "anonymous") +A68_ATTR(ARGUMENT, "argument") +A68_ATTR(ARGUMENT_LIST, "argument list") +A68_ATTR(ASSERTION, "assertion") +A68_ATTR(ASSERT_SYMBOL, "assert symbol") +A68_ATTR(ASSIGNATION, "assignation") +A68_ATTR(ASSIGN_SYMBOL, "assignation symbol") +A68_ATTR(ASSIGN_TO_SYMBOL, "assign-to symbol") +A68_ATTR(AT_SYMBOL, "at symbol") +A68_ATTR(BEGIN_SYMBOL, "begin symbol") +A68_ATTR(BITS_C_PATTERN, "bits-c-pattern") +A68_ATTR(BITS_DENOTATION, "bits-denotation") +A68_ATTR(BITS_PATTERN, "bits pattern") +A68_ATTR(BITS_SYMBOL, "bits-symbol") +A68_ATTR(BOLD_COMMENT_SYMBOL, "comment delimiter") +A68_ATTR(BOLD_COMMENT_BEGIN_SYMBOL, "comment opening delimiter") +A68_ATTR(BOLD_COMMENT_END_SYMBOL, "comment closing delimiter") +A68_ATTR(BOLD_PRAGMAT_SYMBOL, "pragmat-symbol") +A68_ATTR(BOLD_TAG, "bold tag") +A68_ATTR(BOOLEAN_PATTERN, "boolean pattern") +A68_ATTR(BOOL_SYMBOL, "bool-symbol") +A68_ATTR(BOUND, "actual declarer bound") +A68_ATTR(BOUNDS, "actual declarer bounds") +A68_ATTR(BOUNDS_LIST, "actual declarer bounds list") +A68_ATTR(BRIEF_COMMENT_BEGIN_SYMBOL, "comment opening delimiter") +A68_ATTR(BRIEF_COMMENT_END_SYMBOL, "comment closing delimiter") +A68_ATTR(BRIEF_OUSE_PART, "ouse-part") +A68_ATTR(BRIEF_CONFORMITY_OUSE_PART, "ouse-part") +A68_ATTR(BRIEF_ELIF_PART, "elif-part") +A68_ATTR(BRIEF_OPERATOR_DECLARATION, "operator declaration") +A68_ATTR(BUS_SYMBOL, "bus-symbol") +A68_ATTR(BYTES_SYMBOL, "bytes-symbol") +A68_ATTR(BY_PART, "by-part") +A68_ATTR(BY_SYMBOL, "by-symbol") +A68_ATTR(CALL, "call") +A68_ATTR(CASE_CHOICE_CLAUSE, "case choice clause") +A68_ATTR(CASE_CLAUSE, "case clause") +A68_ATTR(CASE_IN_PART, "case-in-part") +A68_ATTR(CASE_OUSE_PART, "case-ouse-part") +A68_ATTR(CASE_PART, "case-part") +A68_ATTR(CASE_SYMBOL, "case-symbol") +A68_ATTR(CAST, "cast") +A68_ATTR(CHANNEL_SYMBOL, "channel-symbol") +A68_ATTR(CHAR_C_PATTERN, "char C-like pattern") +A68_ATTR(CHAR_SYMBOL, "char-symbol") +A68_ATTR(CHOICE, "choice") +A68_ATTR(CHOICE_PATTERN, "choice pattern") +A68_ATTR(CLOSED_CLAUSE, "closed clause") +A68_ATTR(CLOSE_SYMBOL, "close symbol") +A68_ATTR(COLLATERAL_CLAUSE, "collateral clause") +A68_ATTR(COLLECTION, "collection") +A68_ATTR(COLON_SYMBOL, "colon-symbol") +A68_ATTR(COMMA_SYMBOL, "comma-symbol") +A68_ATTR(COMPLEX_PATTERN, "complex pattern") +A68_ATTR(COMPLEX_SYMBOL, "complex-symbol") +A68_ATTR(COMPL_SYMBOL, "compl-symbol") +A68_ATTR(CONDITIONAL_CLAUSE, "conditional clause") +A68_ATTR(CONFORMITY_CHOICE, "conformity clause choice") +A68_ATTR(CONFORMITY_CLAUSE, "conformity clause") +A68_ATTR(CONFORMITY_IN_PART, "conformity clause in-part") +A68_ATTR(CONFORMITY_OUSE_PART, "conformity clause ouse-part") +A68_ATTR(CONSTRUCT, "construct") +A68_ATTR(DECLARATION_LIST, "list of declarations") +A68_ATTR(DECLARER, "declarer") +A68_ATTR(DEF_PART, "def-part") +A68_ATTR(DEF_SYMBOL, "def-symbol") +A68_ATTR(DEFINING_IDENTIFIER, "defining identifier") +A68_ATTR(DEFINING_INDICANT, "defining mode") +A68_ATTR(DEFINING_OPERATOR, "defining operator") +A68_ATTR(DEFINING_MODULE_INDICANT, "defining module indicant") +A68_ATTR(DENOTATION, "denotation") +A68_ATTR(DEPROCEDURING, "deproceduring coercion") +A68_ATTR(DEREFERENCING, "dereferencing coercion") +A68_ATTR(DO_PART, "do-part") +A68_ATTR(DO_SYMBOL, "do-symbol") +A68_ATTR(DYNAMIC_REPLICATOR, "format dynamic replicator") +A68_ATTR(EGG_SYMBOL, "egg-symbol") +A68_ATTR(ELIF_IF_PART, "elif if-part") +A68_ATTR(ELIF_PART, "elif-part") +A68_ATTR(ELIF_SYMBOL, "elif-symbol") +A68_ATTR(ELSE_BAR_SYMBOL, "else-bar-symbol") +A68_ATTR(ELSE_OPEN_PART, "else-open-part") +A68_ATTR(ELSE_PART, "else-part") +A68_ATTR(ELSE_SYMBOL, "else-symbol") +A68_ATTR(EMPTY_SYMBOL, "empty-symbol") +A68_ATTR(ENCLOSED_CLAUSE, "enclosed clause") +A68_ATTR(END_SYMBOL, "end-symbol") +A68_ATTR(ENQUIRY_CLAUSE, "enquiry clause") +A68_ATTR(EQUALS_SYMBOL, "equals-symbol") +A68_ATTR(ERROR, "error node") +A68_ATTR(ERROR_IDENTIFIER, "error-identifier") +A68_ATTR(ESAC_SYMBOL, "esac-symbol") +A68_ATTR(EXIT_SYMBOL, "exit-symbol") +A68_ATTR(EXPONENT_FRAME, "exponent-frame") +A68_ATTR(FALSE_SYMBOL, "false-symbol") +A68_ATTR(FED_SYMBOL, "fed-symbol") +A68_ATTR(FIELD, "struct field") +A68_ATTR(FIELD_IDENTIFIER, "field-identifier") +A68_ATTR(FILE_SYMBOL, "file-symbol") +A68_ATTR(FIRM, "firm context") +A68_ATTR(FIXED_C_PATTERN, "fixed-c-pattern") +A68_ATTR(FI_SYMBOL, "fi-symbol") +A68_ATTR(FLEX_SYMBOL, "flex-symbol") +A68_ATTR(FLOAT_C_PATTERN, "float C format pattern") +A68_ATTR(FORMAL_BOUNDS, "formal declarer bounds") +A68_ATTR(FORMAL_BOUNDS_LIST, "list of formal declarer bounds") +A68_ATTR(FORMAL_DECLARERS, "formal declarers") +A68_ATTR(FORMAL_DECLARERS_LIST, "list of formal declarers") +A68_ATTR(FORMAL_DECLARER_MARK, "formal declarer mark") +A68_ATTR(FORMAL_NEST_SYMBOL, "formal-nest-symbol") +A68_ATTR(FORMULA, "formula") +A68_ATTR(FOR_PART, "for-part") +A68_ATTR(FOR_SYMBOL, "for-symbol") +A68_ATTR(FORMAT_CLOSE_SYMBOL, "format-close-symbol") +A68_ATTR(FORMAT_DELIMITER_SYMBOL, "format-delimiter-symbol") +A68_ATTR(FORMAT_IDENTIFIER, "format identifier") +A68_ATTR(FORMAT_A_FRAME, "format A-frame") +A68_ATTR(FORMAT_D_FRAME, "format D-frame") +A68_ATTR(FORMAT_E_FRAME, "format E-frame") +A68_ATTR(FORMAT_I_FRAME, "format I-frame") +A68_ATTR(FORMAT_ITEM_A, "format item-A") +A68_ATTR(FORMAT_ITEM_B, "format item-B") +A68_ATTR(FORMAT_ITEM_C, "format item-C") +A68_ATTR(FORMAT_ITEM_D, "format item-D") +A68_ATTR(FORMAT_ITEM_E, "format item-E") +A68_ATTR(FORMAT_ITEM_F, "format item-F") +A68_ATTR(FORMAT_ITEM_G, "format item-G") +A68_ATTR(FORMAT_ITEM_H, "format item-H") +A68_ATTR(FORMAT_ITEM_I, "format item-I") +A68_ATTR(FORMAT_ITEM_J, "format item-J") +A68_ATTR(FORMAT_ITEM_K, "format item-K") +A68_ATTR(FORMAT_ITEM_L, "format item-L") +A68_ATTR(FORMAT_ITEM_M, "format item-M") +A68_ATTR(FORMAT_ITEM_N, "format item-N") +A68_ATTR(FORMAT_ITEM_O, "format item-O") +A68_ATTR(FORMAT_ITEM_P, "format item-P") +A68_ATTR(FORMAT_ITEM_Q, "format item-Q") +A68_ATTR(FORMAT_ITEM_R, "format item-R") +A68_ATTR(FORMAT_ITEM_S, "format item-S") +A68_ATTR(FORMAT_ITEM_T, "format item-T") +A68_ATTR(FORMAT_ITEM_U, "format item-U") +A68_ATTR(FORMAT_ITEM_V, "format item-V") +A68_ATTR(FORMAT_ITEM_W, "format item-W") +A68_ATTR(FORMAT_ITEM_X, "format item-X") +A68_ATTR(FORMAT_ITEM_Y, "format item-Y") +A68_ATTR(FORMAT_ITEM_Z, "format item-Z") +A68_ATTR(FORMAT_ITEM_ESCAPE, "format item escape") +A68_ATTR(FORMAT_ITEM_MINUS, "format item -") +A68_ATTR(FORMAT_ITEM_PLUS, "format item +") +A68_ATTR(FORMAT_ITEM_POINT, "format item .") +A68_ATTR(FORMAT_OPEN_SYMBOL, "format-open-symbol") +A68_ATTR(FORMAT_PATTERN, "format pattern") +A68_ATTR(FORMAT_POINT_FRAME, "format point frame") +A68_ATTR(FORMAT_SYMBOL, "format-symbol") +A68_ATTR(FORMAT_TEXT, "format text") +A68_ATTR(FORMAT_Z_FRAME, "format Z frame") +A68_ATTR(FROM_PART, "from-part") +A68_ATTR(FROM_SYMBOL, "from-symbol") +A68_ATTR(GENERAL_C_PATTERN, "general C-like pattern") +A68_ATTR(GENERAL_PATTERN, "general pattern") +A68_ATTR(GENERATOR, "generator") +A68_ATTR(GENERIC_ARGUMENT, "generic argument") +A68_ATTR(GENERIC_ARGUMENT_LIST, "generic argument list") +A68_ATTR(GOTO_SYMBOL, "goto-symbol") +A68_ATTR(GO_SYMBOL, "go-symbol") +A68_ATTR(GUARDED_CONDITIONAL_CLAUSE, "guarded conditional clause") +A68_ATTR(GUARDED_LOOP_CLAUSE, "guarded loop clause") +A68_ATTR(HEAP_SYMBOL, "heap-symbol") +A68_ATTR(IDENTIFIER, "identifier") +A68_ATTR(IDENTIFIER_WITH_UNDERSCORES, "identifier with underscores") +A68_ATTR(IDENTITY_DECLARATION, "identity declaration") +A68_ATTR(IDENTITY_RELATION, "identity relation") +A68_ATTR(IF_PART, "if-part") +A68_ATTR(IF_SYMBOL, "if-symbol") +A68_ATTR(INDICANT, "indicant") +A68_ATTR(INITIALISER_SERIES, "initialiser series") +A68_ATTR(INSERTION, "insertion") +A68_ATTR(INTEGRAL_C_PATTERN, "integral C-like pattern") +A68_ATTR(INTEGRAL_MOULD, "integral mould") +A68_ATTR(INTEGRAL_PATTERN, "integral pattern") +A68_ATTR(INT_DENOTATION, "integral denotation") +A68_ATTR(INT_SYMBOL, "int-symbol") +A68_ATTR(IN_SYMBOL, "in-symbol") +A68_ATTR(IN_TYPE_MODE, "in type mode") +A68_ATTR(ISNT_SYMBOL, "isnt-symbol") +A68_ATTR(IS_SYMBOL, "is-symbol") +A68_ATTR(JUMP, "jump") +A68_ATTR(KEYWORD, "keyword") +A68_ATTR(LABEL, "label") +A68_ATTR(LABELED_UNIT, "labeled unit") +A68_ATTR(LABEL_IDENTIFIER, "label identifier") +A68_ATTR(LABEL_SEQUENCE, "label sequence") +A68_ATTR(LITERAL, "literal") +A68_ATTR(LOCAL_LABEL, "local label") +A68_ATTR(LOC_SYMBOL, "loc-symbol") +A68_ATTR(LONGETY, "longsety") +A68_ATTR(LONG_SYMBOL, "long-symbol") +A68_ATTR(LOOP_CLAUSE, "loop clause") +A68_ATTR(LOOP_IDENTIFIER, "loop identifier") +A68_ATTR(MAIN_SYMBOL, "main-symbol") +A68_ATTR(MEEK, "meek context") +A68_ATTR(MODE_BITS, "mode bits") +A68_ATTR(MODE_BOOL, "mode bool") +A68_ATTR(MODE_BYTES, "mode bytes") +A68_ATTR(MODE_CHAR, "mode char") +A68_ATTR(MODE_COMPLEX, "mode complex") +A68_ATTR(MODE_DECLARATION, "mode declaration") +A68_ATTR(MODE_FILE, "mode file") +A68_ATTR(MODE_FORMAT, "mode format") +A68_ATTR(A68_MODE_INT, "mode int") +A68_ATTR(MODE_LONG_LONG_BITS, "mode long long bits") +A68_ATTR(MODE_LONG_LONG_COMPLEX, "mode long long complex") +A68_ATTR(MODE_LONG_LONG_INT, "mode long long int") +A68_ATTR(MODE_LONG_LONG_REAL, "mode long long real") +A68_ATTR(MODE_LONG_BITS, "mode long bits") +A68_ATTR(MODE_LONG_BYTES, "mode long bytes") +A68_ATTR(MODE_LONG_COMPLEX, "mode long complex") +A68_ATTR(MODE_LONG_INT, "mode long int") +A68_ATTR(MODE_LONG_REAL, "mode long real") +A68_ATTR(MODE_NO_CHECK, "mode no check") +A68_ATTR(MODE_REAL, "mode real") +A68_ATTR(MODE_SYMBOL, "mode-symbol") +A68_ATTR(MODULE_INDICANT, "module indicant") +A68_ATTR(MODULE_DECLARATION, "module-declaration") +A68_ATTR(MODULE_SYMBOL, "module-symbol") +A68_ATTR(MODULE_TEXT, "module text") +A68_ATTR(MONADIC_FORMULA, "monadic formula") +A68_ATTR(MONAD_SEQUENCE, "monad sequence") +A68_ATTR(NIHIL, "nihil") +A68_ATTR(NIL_SYMBOL, "nil-symbol") +A68_ATTR(NORMAL_IDENTIFIER, "normal identifier") +A68_ATTR(NO_SORT, "no sort") +A68_ATTR(OD_SYMBOL, "od-symbol") +A68_ATTR(OF_SYMBOL, "of-symbol") +A68_ATTR(OPEN_PART, "open part") +A68_ATTR(OPEN_SYMBOL, "open-symbol") +A68_ATTR(OPERATOR, "operator") +A68_ATTR(OPERATOR_DECLARATION, "operator declaration") +A68_ATTR(OPERATOR_PLAN, "operator plan") +A68_ATTR(OP_SYMBOL, "op-symbol") +A68_ATTR(ORF_SYMBOL, "orf-symbol") +A68_ATTR(OR_FUNCTION, "orel pseudo-operator") +A68_ATTR(OUSE_PART, "ouse-part") +A68_ATTR(OUSE_SYMBOL, "ouse-symbol") +A68_ATTR(OUT_PART, "out-part") +A68_ATTR(OUT_SYMBOL, "out-symbol") +A68_ATTR(OUT_TYPE_MODE, "out type mode") +A68_ATTR(PACKET, "packet") +A68_ATTR(PARALLEL_CLAUSE, "parallel clause") +A68_ATTR(PARAMETER, "parameter") +A68_ATTR(PARAMETER_IDENTIFIER, "parameter identifier") +A68_ATTR(PARAMETER_LIST, "parameter list") +A68_ATTR(PARAMETER_PACK, "parameter pack") +A68_ATTR(PARTICULAR_PROGRAM, "particular program") +A68_ATTR(PAR_SYMBOL, "par-symbol") +A68_ATTR(PICTURE, "format picture") +A68_ATTR(PICTURE_LIST, "format picture list") +A68_ATTR(PIPE_SYMBOL, "pipe-symbol") +A68_ATTR(POINT_SYMBOL, "point-symbol") +A68_ATTR(POSTLUDE_PART, "postlude-part") +A68_ATTR(POSTLUDE_SYMBOL, "postlude-symbol") +A68_ATTR(PRELUDE_PACKET, "prelude-packet") +A68_ATTR(PRIMARY, "primary") +A68_ATTR(PRIORITY, "operator priority") +A68_ATTR(PRIORITY_DECLARATION, "operator priority declaration") +A68_ATTR(PRIO_SYMBOL, "prio-symbol") +A68_ATTR(PROCEDURE_DECLARATION, "procedure declaration") +A68_ATTR(PROCEDURE_VARIABLE_DECLARATION, "procedure variable declaration") +A68_ATTR(PROCEDURING, "proceduring coercion") +A68_ATTR(PROC_SYMBOL, "proc-symbol") +A68_ATTR(PUBLIC_SYMBOL, "public-symbol") +A68_ATTR(QUALIFIER, "qualifier") +A68_ATTR(RADIX_FRAME, "radix frame") +A68_ATTR(REAL_DENOTATION, "real denotation") +A68_ATTR(REAL_PATTERN, "real pattern") +A68_ATTR(REAL_SYMBOL, "real-symbol") +A68_ATTR(REF_SYMBOL, "ref-symbol") +A68_ATTR(REPLICATOR, "format replicator") +A68_ATTR(REVELATION, "revelation") +A68_ATTR(REVELATION_PART, "revelation-part") +A68_ATTR(ROUTINE_TEXT, "routine text") +A68_ATTR(ROUTINE_UNIT, "routine unit") +A68_ATTR(ROWING, "rowing coercion") +A68_ATTR(ROWS_SYMBOL, "rows-symbol") +A68_ATTR(ROW_CHAR_DENOTATION, "row of chars denotation") +A68_ATTR(ROW_SYMBOL, "row-symbol") +A68_ATTR(SECONDARY, "secondary") +A68_ATTR(SELECTION, "selection") +A68_ATTR(SELECTOR, "selector") +A68_ATTR(SEMA_SYMBOL, "sema-symbol") +A68_ATTR(SEMI_SYMBOL, "semi-symbol") +A68_ATTR(SERIAL_CLAUSE, "serial clause") +A68_ATTR(SERIES_MODE, "series mode") +A68_ATTR(SHORTETY, "shortsety") +A68_ATTR(SHORT_SYMBOL, "short-symbol") +A68_ATTR(SIGN_MOULD, "sign mould") +A68_ATTR(SKIP, "skip unit") +A68_ATTR(SKIP_SYMBOL, "skip-symbol") +A68_ATTR(SLICE, "slice") +A68_ATTR(SOFT, "soft context") +A68_ATTR(SOME_CLAUSE, "some clause") +A68_ATTR(SPECIFICATION, "specification") +A68_ATTR(SPECIFIED_UNIT, "specified unit") +A68_ATTR(SPECIFIED_UNIT_LIST, "specified unit list") +A68_ATTR(SPECIFIED_UNIT_UNIT, "specified unit unit") +A68_ATTR(SPECIFIER, "specifier") +A68_ATTR(SPECIFIER_IDENTIFIER, "specifier identifier") +A68_ATTR(STANDARD, "standard") +A68_ATTR(STATIC_REPLICATOR, "static replicator") +A68_ATTR(STATIC_SYMBOL, "static-symbol") +A68_ATTR(STOWED_MODE, "stowed mode") +A68_ATTR(STRING_C_PATTERN, "string C-like pattern") +A68_ATTR(STRING_PATTERN, "string pattern") +A68_ATTR(STRING_SYMBOL, "string-symbol") +A68_ATTR(STRONG, "strong context") +A68_ATTR(STRUCTURED_FIELD, "structured field") +A68_ATTR(STRUCTURED_FIELD_LIST, "structured field list") +A68_ATTR(STRUCTURE_PACK, "structure pack") +A68_ATTR(STRUCT_SYMBOL, "struct-symbol") +A68_ATTR(STYLE_II_COMMENT_SYMBOL, "comment delimiter") +A68_ATTR(STYLE_I_COMMENT_SYMBOL, "comment delimiter") +A68_ATTR(STYLE_I_PRAGMAT_SYMBOL, "pragmat-symbol") +A68_ATTR(SUB_SYMBOL, "sub-symbol") +A68_ATTR(SUB_UNIT, "sub unit") +A68_ATTR(TERTIARY, "tertiary") +A68_ATTR(THEN_BAR_SYMBOL, "then-bar-symbol") +A68_ATTR(THEN_PART, "then-part") +A68_ATTR(THEN_SYMBOL, "then-symbol") +A68_ATTR(TO_PART, "to-part") +A68_ATTR(TO_SYMBOL, "to-symbol") +A68_ATTR(TRIMMER, "trimmer") +A68_ATTR(TRUE_SYMBOL, "true-symbol") +A68_ATTR(UNION_DECLARER_LIST, "union declarer list") +A68_ATTR(UNION_PACK, "union pack") +A68_ATTR(UNION_SYMBOL, "union-symbol") +A68_ATTR(UNIT, "unit") +A68_ATTR(UNITING, "uniting coercion") +A68_ATTR(UNIT_LIST, "unit list") +A68_ATTR(UNIT_SERIES, "unit series") +A68_ATTR(VARIABLE_DECLARATION, "variable declaration") +A68_ATTR(VIRTUAL_DECLARER_MARK, "virtual declarer mark") +A68_ATTR(VOIDING, "voiding coercion") +A68_ATTR(VOID_SYMBOL, "void-symbol") +A68_ATTR(WEAK, "weak context") +A68_ATTR(WHILE_PART, "while-part") +A68_ATTR(WHILE_SYMBOL, "while-symbol") +A68_ATTR(WIDENING, "widening coercion") +A68_ATTR(WILDCARD, "wildcard") + +/* +Local variables: +mode:c +End: +*/ From c08d036dd9560e440cf2db5d7282a6f210d7cb51 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:46:56 +0200 Subject: [PATCH 150/373] a68: parser: scanner Lexer for the Algol 68 front-end. Signed-off-by: Jose E. Marchesi Co-authored-by: Marcel van der Veer --- gcc/algol68/a68-parser-scanner.cc | 2346 +++++++++++++++++++++++++++++ 1 file changed, 2346 insertions(+) create mode 100644 gcc/algol68/a68-parser-scanner.cc diff --git a/gcc/algol68/a68-parser-scanner.cc b/gcc/algol68/a68-parser-scanner.cc new file mode 100644 index 000000000000..966ebdf6ed1d --- /dev/null +++ b/gcc/algol68/a68-parser-scanner.cc @@ -0,0 +1,2346 @@ +/* Context-dependent ALGOL 68 tokeniser. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +/* Context-dependent ALGOL 68 tokeniser. */ + + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "diagnostic.h" +#include "options.h" +#include "vec.h" + +#include "a68.h" + +/* A few forward references of static functions defined in this file. */ + +static void include_files (LINE_T *top); + +/* Standard prelude and postlude for source files. + + These are used for particular programs only. Not for prelude packets. + We need several versions for the several supported stropping regimes. */ + +static const char * +upper_prelude_start[] = { + "BEGIN", + " BEGIN", + NO_TEXT +}; + +static const char * +upper_postlude[] = { + " END;", + " stop: SKIP", + "END", + NO_TEXT +}; + +static const char * +supper_prelude_start[] = { + "begin", + " begin", + NO_TEXT +}; + +static const char * +supper_postlude[] = { + " end;", + " stop: skip", + "end", + NO_TEXT +}; + +/* Macros. */ + +#define NULL_CHAR '\0' +#define STOP_CHAR 127 +#define FORMFEED_CHAR '\f' +#define CR_CHAR '\r' +#define QUOTE_CHAR '"' +#define APOSTROPHE_CHAR '\'' +#define BACKSLASH_CHAR '\\' +#define NEWLINE_CHAR '\n' +#define EXPONENT_CHAR 'e' +#define RADIX_CHAR 'r' +#define POINT_CHAR '.' +#define TAB_CHAR '\t' + +#define MAX_RESTART 256 + +#define EOL(c) ((c) == NEWLINE_CHAR || (c) == NULL_CHAR) +#define SCAN_ERROR(c, u, v, txt) if (c) \ + do \ + { \ + a68_scan_error (u, v, txt); \ + } \ + while (0) + + +#define SCAN_DIGITS(c) \ + while (ISDIGIT (c)) \ + { \ + (sym++)[0] = (c); \ + (c) = next_char (ref_l, ref_s, true); \ + } + +#define SCAN_EXPONENT_PART(c) \ + do \ + { \ + (sym++)[0] = EXPONENT_CHAR; \ + (c) = next_char (ref_l, ref_s, true); \ + if ((c) == '+' || (c) == '-') { \ + (sym++)[0] = (c); \ + (c) = next_char (ref_l, ref_s, true); \ + } \ + SCAN_ERROR (!ISDIGIT (c), *start_l, *start_c, \ + "invalid exponent digit"); \ + SCAN_DIGITS (c); \ + } \ + while (0) + +/* Read bytes from file into buffer. */ + +static ssize_t +io_read (FILE *file, void *buf, size_t n) +{ + int fd = fileno (file); + size_t to_do = n; + int restarts = 0; + char *z = (char *) buf; + while (to_do > 0) + { + ssize_t bytes_read; + + errno = 0; + bytes_read = read (fd, z, to_do); + if (bytes_read < 0) + { + if (errno == EINTR) + { + /* interrupt, retry. */ + bytes_read = 0; + if (restarts++ > MAX_RESTART) + { + return -1; + } + } + else + { + /* read error. */ + return -1; + } + } + else if (bytes_read == 0) + { + /* EOF_CHAR */ + break; + } + to_do -= (size_t) bytes_read; + z += bytes_read; + } + + /* return >= 0 */ + return (ssize_t) n - (ssize_t) to_do; +} + +/* Save scanner state, for character look-ahead. */ + +static void +save_state (LINE_T *ref_l, char *ref_s, char ch) +{ + SCAN_STATE_L (&A68_JOB) = ref_l; + SCAN_STATE_S (&A68_JOB) = ref_s; + SCAN_STATE_C (&A68_JOB) = ch; +} + +/* Restore scanner state, for character look-ahead. */ + +static void +restore_state (LINE_T **ref_l, char **ref_s, char *ch) +{ + *ref_l = SCAN_STATE_L (&A68_JOB); + *ref_s = SCAN_STATE_S (&A68_JOB); + *ch = SCAN_STATE_C (&A68_JOB); +} + +/* New_source_line. */ + +static LINE_T * +new_source_line (void) +{ + LINE_T *z = ggc_cleared_alloc (); + + MARKER (z)[0] = '\0'; + STRING (z) = NO_TEXT; + FILENAME (z) = NO_TEXT; + NUMBER (z) = 0; + NEXT (z) = NO_LINE; + PREVIOUS (z) = NO_LINE; + return z; +} + +/* Append a source line to the internal source file. */ + +static void +append_source_line (const char *str, LINE_T **ref_l, int *line_num, + const char *filename) +{ + LINE_T *z = new_source_line (); + + /* Link line into the chain. */ + STRING (z) = xstrdup (str); + FILENAME (z) = ggc_strdup (filename); + NUMBER (z) = (*line_num)++; + NEXT (z) = NO_LINE; + PREVIOUS (z) = *ref_l; + if (TOP_LINE (&A68_JOB) == NO_LINE) + TOP_LINE (&A68_JOB) = z; + if (*ref_l != NO_LINE) + NEXT (*ref_l) = z; + *ref_l = z; +} + +/* Append environment source lines. */ + +static void +append_environ (const char *str[], LINE_T **ref_l, int *line_num, const char *name) +{ + for (int k = 0; str[k] != NO_TEXT; k++) + { + int zero_line_num = 0; + (*line_num)++; + append_source_line (str[k], ref_l, &zero_line_num, name); + } +} + +/* + * Scanner, tokenises the source code. + */ + +/* Emit a diagnostic if CH is an unworthy character. */ + +static void +unworthy (LINE_T *u, char *v, char ch) +{ + if (ISPRINT (ch)) + { + if (snprintf (A68 (edit_line), SNPRINTF_SIZE, "*%s", + "unworthy character") < 0) + gcc_unreachable (); + } + else + { + if (snprintf (A68 (edit_line), SNPRINTF_SIZE, "*%s %c", + "unworthy character", ch) < 0) + gcc_unreachable (); + } + + a68_scan_error (u, v, A68 (edit_line)); +} + +/* Concatenate lines that terminate in '\' with next line. */ + +static void +concatenate_lines (LINE_T * top) +{ + LINE_T *q; + /* Work from bottom backwards. */ + for (q = top; q != NO_LINE && NEXT (q) != NO_LINE; FORWARD (q)) + ; + + for (; q != NO_LINE; BACKWARD (q)) + { + char *z = STRING (q); + size_t len = strlen (z); + + if (len >= 2 + && z[len - 2] == BACKSLASH_CHAR + && z[len - 1] == NEWLINE_CHAR + && NEXT (q) != NO_LINE + && STRING (NEXT (q)) != NO_TEXT) + { + z[len - 2] = '\0'; + len += (int) strlen (STRING (NEXT (q))); + z = (char *) xmalloc (len + 1); + a68_bufcpy (z, STRING (q), len + 1); + a68_bufcat (z, STRING (NEXT (q)), len + 1); + STRING (NEXT (q))[0] = '\0'; + STRING (q) = z; + } + } +} + +/* Size of source file. */ + +static int +get_source_size (void) +{ + FILE *f = FILE_SOURCE_FD (&A68_JOB); + return (int) lseek (fileno (f), 0, SEEK_END); +} + +/* Read source file FILENAME and make internal copy. */ + +static bool +read_source_file (const char *filename) +{ + struct stat statbuf; + LINE_T *ref_l = NO_LINE; + int line_num = 0; + size_t k; + size_t bytes_read; + ssize_t l; + size_t source_file_size; + char *buffer; + FILE *f; + bool ret = true; + + /* First open the given file. */ + if (!(FILE_SOURCE_FD (&A68_JOB) = fopen (filename, "r"))) + fatal_error (UNKNOWN_LOCATION, "could not open source file %s", + filename); + FILE_SOURCE_NAME (&A68_JOB) = ggc_strdup (filename); + f = FILE_SOURCE_FD (&A68_JOB); + + if (fstat (fileno (f), &statbuf) + || !(S_ISREG (statbuf.st_mode) || S_ISCHR (statbuf.st_mode))) + fatal_error (UNKNOWN_LOCATION, "specified file %s is a directory", + filename); + + if ((source_file_size = get_source_size ()) == 0) + { + /* The source file is empty. */ + ret = false; + goto done; + } + + /* Allocate A68_PARSER (scan_buf), which is an auxiliary buffer used by the + scanner known to be big enough to hold any string contained in the source + file. */ + A68_PARSER (max_scan_buf_length) = source_file_size + 1; + A68_PARSER (max_scan_buf_length) += 1024; /* For the environment. */ + A68_PARSER (scan_buf) = (char *) xmalloc (A68_PARSER (max_scan_buf_length)); + + /* Prelude. */ + append_environ (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING + ? upper_prelude_start : supper_prelude_start, + &ref_l, &line_num, "prelude"); + + /* Read the file into a single buffer, so we save on system calls. */ + line_num = 1; + errno = 0; + buffer = (char *) xmalloc (8 + source_file_size); + if (lseek (fileno (f), 0, SEEK_SET) < 0) + gcc_unreachable (); + errno = 0; + bytes_read = io_read (f, buffer, source_file_size); + gcc_assert (errno == 0 && bytes_read == source_file_size); + + /* Link all lines into the list. */ + k = 0; + while (k < source_file_size) + { + l = 0; + A68_PARSER (scan_buf)[0] = '\0'; + while (k < source_file_size && buffer[k] != NEWLINE_CHAR) + { + if (k < source_file_size - 1 + && buffer[k] == CR_CHAR && buffer[k + 1] == NEWLINE_CHAR) + k++; + else + { + A68_PARSER (scan_buf)[l++] = buffer[k++]; + A68_PARSER (scan_buf)[l] = '\0'; + } + } + A68_PARSER (scan_buf)[l++] = NEWLINE_CHAR; + A68_PARSER (scan_buf)[l] = '\0'; + if (k < source_file_size) + k++; + append_source_line (A68_PARSER (scan_buf), &ref_l, &line_num, + FILE_SOURCE_NAME (&A68_JOB)); + SCAN_ERROR (l != (ssize_t) strlen (A68_PARSER (scan_buf)), + NO_LINE, NO_TEXT, "invalid characters in source file"); + } + + /* Postlude. */ + append_environ (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING + ? upper_postlude : supper_postlude, + &ref_l, &line_num, "postlude"); + + /* Concatenate lines that end with \. */ + concatenate_lines (TOP_LINE (&A68_JOB)); + + /* Include files. */ + include_files (TOP_LINE (&A68_JOB)); + + done: + if (fclose (FILE_SOURCE_FD (&A68_JOB)) != 0) + gcc_unreachable (); + return ret; +} + +/* Get next character from internal copy of source file. + + If ALLOW_TYPO is true then typographical display features are skipped. + + If ALLOW_ONE_UNDER is true then a single underscore character is + skipped. */ + +static char +next_char (LINE_T **ref_l, char **ref_s, bool allow_typo, + bool allow_one_under = false, bool *found_under = NULL) +{ + char ch; + + /* Empty source. */ + if (*ref_l == NO_LINE) + return STOP_CHAR; + + if ((*ref_s)[0] == NEWLINE_CHAR || (*ref_s)[0] == '\0') + { + /* Go to new line. */ + *ref_l = NEXT (*ref_l); + if (*ref_l == NO_LINE) + return STOP_CHAR; + *ref_s = STRING (*ref_l); + } + else + (*ref_s)++; + + /* Deliver next char. */ + ch = (*ref_s)[0]; + if ((allow_typo && (ISSPACE (ch) || ch == FORMFEED_CHAR)) + || (allow_one_under && ch == '_')) + { + if (ch == '_' && found_under != NULL) + *found_under = true; + ch = next_char (ref_l, ref_s, allow_typo); + } + return ch; +} + +/* Find first character that can start a valid symbol. */ + +static void +get_good_char (char *ref_c, LINE_T **ref_l, char **ref_s) +{ + while (*ref_c != STOP_CHAR && (ISSPACE (*ref_c) || (*ref_c == '\0'))) + *ref_c = next_char (ref_l, ref_s, false); +} + +/* Case insensitive strncmp for at most the number of chars in V. */ + +static int +streq (const char *u, const char *v) +{ + int diff; + for (diff = 0; diff == 0 && u[0] != NULL_CHAR && v[0] != NULL_CHAR; u++, v++) + diff = ((int) TOLOWER (u[0])) - ((int) TOLOWER (v[0])); + return diff; +} + +/* Case insensitive strncmp for at most N chars. */ + +static int +strneq (const char *u, const char *v, size_t n) +{ + int diff; + size_t pos = 0; + for (diff = 0; + diff == 0 && u[0] != NULL_CHAR && v[0] != NULL_CHAR && pos < n; + u++, v++, pos++) + diff = ((int) TOLOWER (u[0])) - ((int) TOLOWER (v[0])); + return diff; +} + + +/* Determine whether u is bold tag v, independent of stropping regime. */ + +static bool +is_bold (char *u, const char *v) +{ + size_t len = strlen (v); + + if (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING) + /* UPPER stropping. */ + return strncmp (u, v, len) == 0 && !ISUPPER (u[len]); + else + /* SUPPER stropping. */ + return (strlen (u) >= len + && ISLOWER (u[0]) + && strneq (u, v, len) == 0 + && !ISALPHA (u[len]) + && !ISDIGIT (u[len])); +} + +/* Skip a string denotation. + + This function returns true if the end of the string denotation is found. + Returns false otherwise. */ + +static bool +skip_string (LINE_T **top, char **ch) +{ + LINE_T *u = *top; + char *v = *ch; + v++; + while (u != NO_LINE) + { + while (v[0] != NULL_CHAR) + { + if (v[0] == QUOTE_CHAR && v[1] != QUOTE_CHAR) + { + *top = u; + *ch = &v[1]; + return true; + } + else if (v[0] == QUOTE_CHAR && v[1] == QUOTE_CHAR) + { + v += 2; + } + else + { + v++; + } + } + FORWARD (u); + if (u != NO_LINE) { + v = &(STRING (u)[0]); + } else { + v = NO_TEXT; + } + } + return false; +} + +/* Skip a comment. + + This function returns true if the end of the comment is found. Returns + false otherwise. */ + +static bool +skip_comment (LINE_T **top, char **ch, int delim) +{ + LINE_T *u = *top; + char *v = *ch; + int nesting_level = 1; + v++; + while (u != NO_LINE) + { + while (v[0] != NULL_CHAR) + { + LINE_T *l = u; + char *c = v; + + if (v[0] == QUOTE_CHAR && skip_string (&l, &c) + && (delim == BOLD_COMMENT_BEGIN_SYMBOL || delim == BRIEF_COMMENT_BEGIN_SYMBOL)) + { + u = l; + v = c; + } + else if (is_bold (v, "COMMENT") && delim == BOLD_COMMENT_SYMBOL) + { + *top = u; + *ch = &v[1]; + return true; + } + else if (is_bold (v, "CO") && delim == STYLE_I_COMMENT_SYMBOL) + { + *top = u; + *ch = &v[1]; + return true; + } + else if (v[0] == '#' && delim == STYLE_II_COMMENT_SYMBOL) + { + *top = u; + *ch = &v[1]; + return true; + } + else if (is_bold (v, "ETON") && delim == BOLD_COMMENT_BEGIN_SYMBOL) + { + gcc_assert (nesting_level > 0); + nesting_level -= 1; + if (nesting_level == 0) + { + *top = u; + *ch = &v[1]; + return true; + } + } + else if (v[0] == '}' && delim == BRIEF_COMMENT_BEGIN_SYMBOL) + { + gcc_assert (nesting_level > 0); + nesting_level -= 1; + if (nesting_level == 0) + { + *top = u; + *ch = &v[1]; + return true; + } + } + else + { + if ((is_bold (v, "NOTE") && delim == BOLD_COMMENT_BEGIN_SYMBOL) + || (v[0] == '{' && delim == BRIEF_COMMENT_BEGIN_SYMBOL)) + { + nesting_level += 1; + } + + v++; + } + } + FORWARD (u); + if (u != NO_LINE) + v = &(STRING (u)[0]); + else + v = NO_TEXT; + } + + return false; +} + +/* Skip rest of pragmat. + + This function returns true if the end of the pragmat is found, false + otherwise. */ + +static bool +skip_pragmat (LINE_T **top, char **ch, int delim, bool whitespace) +{ + LINE_T *u = *top; + char *v = *ch; + while (u != NO_LINE) + { + while (v[0] != NULL_CHAR) + { + if (is_bold (v, "PRAGMAT") && delim == BOLD_PRAGMAT_SYMBOL) + { + *top = u; + *ch = &v[1]; + return true; + } + else if (is_bold (v, "PR") && delim == STYLE_I_PRAGMAT_SYMBOL) + { + *top = u; + *ch = &v[1]; + return true; + } + else + { + if (whitespace && !ISSPACE (v[0]) && v[0] != NEWLINE_CHAR) + { + SCAN_ERROR (true, u, v, "error in pragment"); + } + else if (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING && ISUPPER (v[0])) + { + /* Skip a bold word as you may trigger on REPR, for + instance. */ + while (ISUPPER (v[0])) + v++; + } + else if (OPTION_STROPPING (&A68_JOB) == SUPPER_STROPPING && ISLOWER (v[0])) + { + /* Skip a tag as you may trigger on expr, for instance. */ + while (ISLOWER (v[0]) || ISDIGIT (v[0]) || v[0] == '_') + v++; + } + else + { + v++; + } + } + } + + FORWARD (u); + if (u != NO_LINE) + v = &(STRING (u)[0]); + else + v = NO_TEXT; + } + + return false; +} + +/* Return pointer to next token within pragmat. */ + +static char * +get_pragmat_item (LINE_T **top, char **ch) +{ + LINE_T *u = *top; + char *v = *ch; + while (u != NO_LINE) + { + while (v[0] != NULL_CHAR) + { + if (!ISSPACE (v[0]) && v[0] != NEWLINE_CHAR) + { + *top = u; + *ch = v; + return v; + } + else + { + v++; + } + } + FORWARD (u); + if (u != NO_LINE) + v = &(STRING (u)[0]); + else + v = NO_TEXT; + } + + return NO_TEXT; +} + +/* Scan for the next pragmat and yield the first item within it. */ + +static char * +next_preprocessor_item (LINE_T **top, char **ch, int *delim) +{ + LINE_T *u = *top; + char *v = *ch; + *delim = 0; + while (u != NO_LINE) + { + while (v[0] != NULL_CHAR) + { + LINE_T *start_l = u; + char *start_c = v; + + if (v[0] == QUOTE_CHAR) + { + /* Skip string denotation. */ + SCAN_ERROR (!skip_string (&u, &v), start_l, start_c, + "unterminated string"); + } + else if (a68_find_keyword (A68 (top_keyword), "COMMENT") != NO_KEYWORD + && is_bold (v, "COMMENT")) + { + /* Skip comment. */ + SCAN_ERROR (!skip_comment (&u, &v, BOLD_COMMENT_SYMBOL), start_l, start_c, + "unterminated comment"); + } + else if (a68_find_keyword (A68 (top_keyword), "CO") != NO_KEYWORD + && is_bold (v, "CO")) + { + /* skip comment. */ + SCAN_ERROR (!skip_comment (&u, &v, STYLE_I_COMMENT_SYMBOL), start_l, start_c, + "unterminated comment"); + } + else if (a68_find_keyword (A68 (top_keyword), "#") != NO_KEYWORD + && v[0] == '#') + { + SCAN_ERROR (!skip_comment (&u, &v, STYLE_II_COMMENT_SYMBOL), start_l, start_c, + "unterminated comment"); + } + else if (a68_find_keyword (A68 (top_keyword), "NOTE") != NO_KEYWORD + && is_bold (v, "NOTE")) + { + SCAN_ERROR (!skip_comment (&u, &v, BOLD_COMMENT_BEGIN_SYMBOL), start_l, start_c, + "unterminated comment"); + } + else if (a68_find_keyword (A68 (top_keyword), "{") != NO_KEYWORD + && v[0] == '{') + { + SCAN_ERROR (!skip_comment (&u, &v, BRIEF_COMMENT_BEGIN_SYMBOL), start_l, start_c, + "unterminated comment"); + } + else if (is_bold (v, "PRAGMAT") || is_bold (v, "PR")) + { + /* We caught a PRAGMAT. */ + char *item; + if (is_bold (v, "PRAGMAT")) + { + *delim = BOLD_PRAGMAT_SYMBOL; + v = &v[strlen ("PRAGMAT")]; + } + else if (is_bold (v, "PR")) + { + *delim = STYLE_I_PRAGMAT_SYMBOL; + v = &v[strlen ("PR")]; + } + item = get_pragmat_item (&u, &v); + SCAN_ERROR (item == NO_TEXT, start_l, start_c, + "unterminated pragmat"); + + if (streq (item, "INCLUDE") == 0) + { + /* Item "INCLUDE" includes a file. */ + *top = u; + *ch = v; + return item; + } + else + { + /* Unrecognised item - probably options handled later by the + tokeniser. */ + SCAN_ERROR (!skip_pragmat (&u, &v, *delim, false), start_l, start_c, + "unterminated pragmat"); + } + } + else if (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING && ISUPPER (v[0])) + { + /* Skip a bold word as you may trigger on REPR, for instance. */ + while (ISUPPER (v[0])) + v++; + } + else if (OPTION_STROPPING (&A68_JOB) == SUPPER_STROPPING && ISLOWER (v[0])) + { + /* Skip a tag as you may trigger on expr, for instance. */ + while (ISLOWER (v[0]) || ISDIGIT (v[0]) || v[0] == '_') + v++; + } + else + { + v++; + } + } + + FORWARD (u); + if (u != NO_LINE) + v = &(STRING (u)[0]); + else + v = NO_TEXT; + } + + *top = u; + *ch = v; + return NO_TEXT; +} + +/* Concatenate the two paths P1 and P2. */ + +static char * +a68_relpath (const char *p1, const char *p2, const char *fn) +{ +#if defined(__GNU__) + /* The Hurd doesn't define PATH_MAX. */ +# define PATH_MAX 4096 +#endif + + char q[PATH_MAX + 1]; + a68_bufcpy (q, p1, PATH_MAX); + a68_bufcat (q, "/", PATH_MAX); + a68_bufcat (q, p2, PATH_MAX); + a68_bufcat (q, "/", PATH_MAX); + a68_bufcat (q, fn, PATH_MAX); + /* Home directory shortcut ~ is a shell extension. */ + if (strchr (q, '~') != NO_TEXT) { + return NO_TEXT; + } + char *r = (char *) xmalloc (PATH_MAX + 1); + gcc_assert (r != NULL); + /* Error handling in the caller! */ + errno = 0; + r = lrealpath (q); + return r; +} + +/* Return true if we can open the file for reading. False otherwise. */ + +static bool +file_read_p (const char *filename) +{ + return access (filename, R_OK) == 0 ? true : false; +} + +/* Find a file to include into the current source being parsed. Search the file + system for FILENAME and return a string with the file path. If the file is + not found, return NULL. + + When FILENAME is not an absolute path we first try to find it relative to the + current file being parsed (CURFILE). Failing to do that we use the search + paths provided by the -I option. */ + +static char * +find_include_file (const char *curfile, const char *filename) +{ + char *filepath = NO_TEXT; + char *tmpfpath = NO_TEXT; + char *fnbdir = ldirname (filename); + const char *incfile = lbasename (filename); + + if (fnbdir == NULL || incfile == NULL) + gcc_unreachable (); + + if (!IS_ABSOLUTE_PATH (filename)) + { + char *sourcedir = ldirname (curfile); + + if (sourcedir == NULL || fnbdir == NULL) + gcc_unreachable (); + + if (strlen (sourcedir) == 0 && strlen (fnbdir) == 0) + { + free (sourcedir); + sourcedir = (char *) xmalloc (2); + a68_bufcpy (sourcedir, ".", 2); + } + + tmpfpath = a68_relpath (sourcedir, fnbdir, incfile); + if (file_read_p (tmpfpath)) + { + filepath = tmpfpath; + goto cleanup; + } + + for (unsigned ix = 0; ix != vec_safe_length (A68_INCLUDE_PATHS); ix++) + { + const char *include_dir = (*(A68_INCLUDE_PATHS))[ix]; + tmpfpath = a68_relpath (include_dir, fnbdir, incfile); + if (!IS_ABSOLUTE_PATH (tmpfpath)) + tmpfpath = a68_relpath (sourcedir, fnbdir, incfile); + if (file_read_p (tmpfpath)) + { + filepath = tmpfpath; + goto cleanup; + } + } + + cleanup: + free (sourcedir); + goto end; + } + else + { + size_t fnwid = (int) strlen (filename) + 1; + tmpfpath = (char *) xmalloc ((size_t) fnwid); + a68_bufcpy (tmpfpath, filename, fnwid); + + if (file_read_p (tmpfpath)) + { + filepath = tmpfpath; + goto end; + } + } + +end: + free (fnbdir); + return filepath; +} + +/* Include files. + This function handles the INCLUDE pragmat in the source file. */ + +static void +include_files (LINE_T *top) +{ + /* syntax: PR include "filename" PR + + The file gets inserted before the line containing the pragmat. In this way + correct line numbers are preserved which helps diagnostics. A file that + has been included will not be included a second time - it will be ignored. + A rigorous fail-safe, but there is no mechanism to prevent recursive + includes in A68 source code. User reports do not indicate sophisticated + use of INCLUDE, so this is fine for now. + */ + + bool make_pass = true; + while (make_pass) + { + LINE_T *s, *t, *u = top; + char *v = &(STRING (u)[0]); + make_pass = false; + errno = 0; + while (u != NO_LINE) + { + int pr_lim; + char *item = next_preprocessor_item (&u, &v, &pr_lim); + LINE_T *start_l = u; + char *start_c = v; + /* Search for PR include "filename" PR. */ + if (item != NO_TEXT && streq (item, "INCLUDE") == 0) + { + FILE *fp; + int fd; + size_t fsize, k; + int n, linum, bytes_read; + char *fbuf, delim; + BUFFER fnb; + char *fn = NO_TEXT; + /* Skip to filename. */ + while (ISALPHA (v[0])) + v++; + while (ISSPACE (v[0])) + v++; + /* Scan quoted filename. */ + SCAN_ERROR ((v[0] != QUOTE_CHAR && v[0] != '\''), start_l, start_c, + "incorrect filename"); + delim = (v++)[0]; + n = 0; + fnb[0] = NULL_CHAR; + /* Scan Algol 68 string (note: "" denotes a ", while in C it + concatenates). */ + do + { + SCAN_ERROR (EOL (v[0]), start_l, start_c, + "incorrect filename"); + SCAN_ERROR (n == BUFFER_SIZE - 1, start_l, start_c, + "incorrect filename"); + if (v[0] == delim) + { + while (v[0] == delim && v[1] == delim) + { + SCAN_ERROR (n == BUFFER_SIZE - 1, start_l, start_c, + "incorrect filename"); + fnb[n++] = delim; + fnb[n] = NULL_CHAR; + v += 2; + } + } + else if (ISPRINT (v[0])) + { + fnb[n++] = *(v++); + fnb[n] = NULL_CHAR; + } + else + { + SCAN_ERROR (true, start_l, start_c, + "incorrect filename"); + } + } + while (v[0] != delim); + + /* Insist that the pragmat is closed properly. */ + v = &v[1]; + SCAN_ERROR (!skip_pragmat (&u, &v, pr_lim, true), start_l, start_c, + "unterminated pragmat"); + SCAN_ERROR (n == 0, start_l, start_c, + "incorrect filename"); + + char *sourcefile = NO_TEXT; + if (FILENAME (u) != NO_TEXT) + { + sourcefile = xstrdup (FILENAME (u)); + } + else + { + sourcefile = (char *) xmalloc (2); + a68_bufcpy (sourcefile, ".", 1); + } + fn = find_include_file (sourcefile, fnb); + free (sourcefile); + + /* Do not check errno, since errno may be undefined here + after a successful call. */ + if (fn != NO_TEXT) + a68_bufcpy (fnb, fn, BUFFER_SIZE); + else + { + SCAN_ERROR (true, start_l, start_c, + "included file not found"); + } + size_t fnwid = (int) strlen (fnb) + 1; + fn = (char *) xmalloc ((size_t) fnwid); + a68_bufcpy (fn, fnb, fnwid); + + /* Ignore the file when included more than once. */ + for (t = top; t != NO_LINE; t = NEXT (t)) + { + if (strcmp (FILENAME (t), fn) == 0) + goto search_next_pragmat; + } + t = NO_LINE; + + /* Access the file. */ + errno = 0; + fp = fopen (fn, "r"); + SCAN_ERROR (fp == NULL, start_l, start_c, + "error opening included file"); + fd = fileno (fp); + errno = 0; + off_t off = lseek (fd, 0, SEEK_END); + gcc_assert (off >= 0); + fsize = (size_t) off; + SCAN_ERROR (errno != 0, start_l, start_c, + "error while reading file"); + fbuf = (char *) xmalloc (8 + fsize); + errno = 0; + if (lseek (fd, 0, SEEK_SET) < 0) + gcc_unreachable (); + SCAN_ERROR (errno != 0, start_l, start_c, + "error while reading file"); + errno = 0; + bytes_read = (int) io_read (fp, fbuf, (size_t) fsize); + SCAN_ERROR (errno != 0 || (size_t) bytes_read != fsize, start_l, start_c, + "error while reading file"); + + /* Buffer still usable?. */ + if (fsize > A68_PARSER (max_scan_buf_length)) + { + A68_PARSER (max_scan_buf_length) = fsize; + A68_PARSER (scan_buf) = (char *) xmalloc (8 + A68_PARSER (max_scan_buf_length)); + } + + /* Link all lines into the list. */ + linum = 1; + s = u; + t = PREVIOUS (u); + k = 0; + if (fsize == 0) + { + /* If file is empty, insert single empty line. */ + A68_PARSER (scan_buf)[0] = NEWLINE_CHAR; + A68_PARSER (scan_buf)[1] = NULL_CHAR; + append_source_line (A68_PARSER (scan_buf), &t, &linum, fn); + } + else + { + while (k < fsize) + { + n = 0; + A68_PARSER (scan_buf)[0] = NULL_CHAR; + while (k < fsize && fbuf[k] != NEWLINE_CHAR) + { + SCAN_ERROR ((ISCNTRL (fbuf[k]) && !ISSPACE (fbuf[k])) + || fbuf[k] == STOP_CHAR, + start_l, start_c, + "invalid characters in included file"); + A68_PARSER (scan_buf)[n++] = fbuf[k++]; + A68_PARSER (scan_buf)[n] = NULL_CHAR; + } + A68_PARSER (scan_buf)[n++] = NEWLINE_CHAR; + A68_PARSER (scan_buf)[n] = NULL_CHAR; + if (k < fsize) + k++; + append_source_line (A68_PARSER (scan_buf), &t, &linum, fn); + } + } + + /* Conclude and go find another include directive, if any. */ + NEXT (t) = s; + PREVIOUS (s) = t; + concatenate_lines (top); + if (fclose (fp) != 0) + gcc_unreachable (); + make_pass = true; + } + search_next_pragmat: + { (void) 0; }; + } + } +} + +/* Handle a pragment (pragmat or comment). */ + +static char * +pragment (int type, LINE_T **ref_l, char **ref_c) +{ +#define INIT_BUFFER \ + do \ + { \ + chars_in_buf = 0; \ + A68_PARSER (scan_buf)[chars_in_buf] = '\0'; \ + } \ + while (0) + +#define ADD_ONE_CHAR(CH) \ + do \ + { \ + A68_PARSER (scan_buf)[chars_in_buf ++] = (CH); \ + A68_PARSER (scan_buf)[chars_in_buf] = '\0'; \ + } \ + while (0) + + const char *term_s = NO_TEXT; + const char *beg_s = NO_TEXT; + char c = **ref_c, *start_c = *ref_c; + char *z = NO_TEXT; + LINE_T *start_l = *ref_l; + int beg_s_length, term_s_length, chars_in_buf; + bool stop, pragmat = false; + + /* Set terminator to look for. */ + if (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING) + { + if (type == STYLE_I_COMMENT_SYMBOL) + term_s = "CO"; + else if (type == STYLE_II_COMMENT_SYMBOL) + term_s = "#"; + else if (type == BOLD_COMMENT_SYMBOL) + term_s = "COMMENT"; + else if (type == BOLD_COMMENT_BEGIN_SYMBOL) + { + beg_s = "NOTE"; + term_s = "ETON"; + } + else if (type == BRIEF_COMMENT_BEGIN_SYMBOL) + { + beg_s = "{"; + term_s = "}"; + } + else if (type == STYLE_I_PRAGMAT_SYMBOL) + { + term_s = "PR"; + pragmat = true; + } + else if (type == BOLD_PRAGMAT_SYMBOL) + { + term_s = "PRAGMAT"; + pragmat = true; + } + } + else + { + /* SUPPER stropping. */ + if (type == STYLE_I_COMMENT_SYMBOL) + term_s = "co"; + else if (type == STYLE_II_COMMENT_SYMBOL) + term_s = "#"; + else if (type == BOLD_COMMENT_SYMBOL) + term_s = "comment"; + else if (type == BOLD_COMMENT_BEGIN_SYMBOL) + { + beg_s = "note"; + term_s = "eton"; + } + else if (type == BRIEF_COMMENT_BEGIN_SYMBOL) + { + beg_s = "{"; + term_s = "}"; + } + else if (type == STYLE_I_PRAGMAT_SYMBOL) + { + term_s = "pr"; + pragmat = true; + } + else if (type == BOLD_PRAGMAT_SYMBOL) + { + term_s = "pragmat"; + pragmat = true; + } + } + + beg_s_length = (beg_s != NO_TEXT ? (int) strlen (beg_s) : 0); + term_s_length = (int) strlen (term_s); + + /* Scan for terminator. */ + bool nestable_comment = (beg_s != NO_TEXT); + int nesting_level = 1; + INIT_BUFFER; + stop = false; + while (stop == false) + { + SCAN_ERROR (c == STOP_CHAR, start_l, start_c, + "unterminated pragment"); + + /* A ".." or '..' delimited string in a PRAGMAT, or + a ".." in a nestable comment. */ + if ((pragmat && (c == QUOTE_CHAR || c == '\'')) + || (nestable_comment && c == QUOTE_CHAR)) + { + char delim = c; + bool eos = false; + ADD_ONE_CHAR (c); + c = next_char (ref_l, ref_c, false); + while (!eos) + { + SCAN_ERROR (EOL (c), start_l, start_c, + "string within pragment exceeds end of line"); + + if (c == delim) + { + ADD_ONE_CHAR (delim); + save_state (*ref_l, *ref_c, c); + c = next_char (ref_l, ref_c, false); + if (c == delim) + c = next_char (ref_l, ref_c, false); + else + { + restore_state (ref_l, ref_c, &c); + eos = true; + } + } + else if (ISPRINT (c)) + { + ADD_ONE_CHAR (c); + c = next_char (ref_l, ref_c, false); + } + else + unworthy (start_l, start_c, c); + } + } + else if (EOL (c)) + ADD_ONE_CHAR (NEWLINE_CHAR); + else if (ISPRINT (c) || ISSPACE (c)) + ADD_ONE_CHAR (c); + + if (nestable_comment && chars_in_buf >= beg_s_length) + { + /* If we find another instance of the nestable begin mark, bump the + nesting level and continue scanning. */ + if (strcmp (beg_s, + &(A68_PARSER (scan_buf)[chars_in_buf - beg_s_length])) == 0) + { + nesting_level += 1; + goto nextchar; + } + } + + if (chars_in_buf >= term_s_length) + { + /* Check whether we encountered the terminator. Mind nesting if + necessary. */ + if (strcmp (term_s, + &(A68_PARSER (scan_buf)[chars_in_buf - term_s_length])) == 0) + { + if (nestable_comment) + { + gcc_assert (nesting_level > 0); + nesting_level -= 1; + stop = (nesting_level == 0); + } + else + stop = true; + } + } + + nextchar: + c = next_char (ref_l, ref_c, false); + } + + A68_PARSER (scan_buf)[chars_in_buf - term_s_length] = '\0'; + z = a68_new_string (term_s, A68_PARSER (scan_buf), term_s, NO_TEXT); + return z; +#undef ADD_ONE_CHAR +#undef INIT_BUFFER +} + +/* Whether input shows exponent character. */ + +static bool +is_exp_char (LINE_T **ref_l, char **ref_s, char *ch) +{ + bool ret = false; + + char exp_syms[3]; + + /* Note that this works for both UPPER and SUPPER stropping regimes. */ + exp_syms[0] = EXPONENT_CHAR; + exp_syms[1] = TOUPPER (EXPONENT_CHAR); + exp_syms[2] = '\0'; + + save_state (*ref_l, *ref_s, *ch); + if (strchr (exp_syms, *ch) != NO_TEXT) + { + *ch = next_char (ref_l, ref_s, true); + ret = (strchr ("+-0123456789", *ch) != NO_TEXT); + } + restore_state (ref_l, ref_s, ch); + return ret; +} + +/* Whether input shows radix character. */ + +static bool +is_radix_char (LINE_T **ref_l, char **ref_s, char *ch) +{ + bool ret = false; + + save_state (*ref_l, *ref_s, *ch); + /* Note that this works for both UPPER and SUPPER stropping regimes. */ + if (*ch == RADIX_CHAR) + { + *ch = next_char (ref_l, ref_s, true); + ret = (strchr ("0123456789abcdef", *ch) != NO_TEXT); + } + restore_state (ref_l, ref_s, ch); + return ret; +} + +/* Whether input shows decimal point. */ + +static bool +is_decimal_point (LINE_T **ref_l, char **ref_s, char *ch) +{ + bool ret = false; + + save_state (*ref_l, *ref_s, *ch); + if (*ch == POINT_CHAR) + { + char exp_syms[3]; + + /* Note that this works for both UPPER and SUPPER stropping regimes. */ + exp_syms[0] = EXPONENT_CHAR; + exp_syms[1] = TOUPPER (EXPONENT_CHAR); + exp_syms[2] = '\0'; + + *ch = next_char (ref_l, ref_s, true); + if (strchr (exp_syms, *ch) != NO_TEXT) + { + *ch = next_char (ref_l, ref_s, true); + ret = (strchr ("+-0123456789", *ch) != NO_TEXT); + } + else + ret = (strchr ("0123456789", *ch) != NO_TEXT); + } + restore_state (ref_l, ref_s, ch); + return ret; +} + +/* Attribute for format item. */ + +static enum a68_attribute +get_format_item (char ch) +{ + switch (TOLOWER (ch)) + { + case 'a': + return FORMAT_ITEM_A; + case 'b': + return FORMAT_ITEM_B; + case 'c': + return FORMAT_ITEM_C; + case 'd': + return FORMAT_ITEM_D; + case 'e': + return FORMAT_ITEM_E; + case 'f': + return FORMAT_ITEM_F; + case 'g': + return FORMAT_ITEM_G; + case 'h': + return FORMAT_ITEM_H; + case 'i': + return FORMAT_ITEM_I; + case 'j': + return FORMAT_ITEM_J; + case 'k': + return FORMAT_ITEM_K; + case 'l': + case '/': + return FORMAT_ITEM_L; + case 'm': + return FORMAT_ITEM_M; + case 'n': + return FORMAT_ITEM_N; + case 'o': + return FORMAT_ITEM_O; + case 'p': + return FORMAT_ITEM_P; + case 'q': + return FORMAT_ITEM_Q; + case 'r': + return FORMAT_ITEM_R; + case 's': + return FORMAT_ITEM_S; + case 't': + return FORMAT_ITEM_T; + case 'u': + return FORMAT_ITEM_U; + case 'v': + return FORMAT_ITEM_V; + case 'w': + return FORMAT_ITEM_W; + case 'x': + return FORMAT_ITEM_X; + case 'y': + return FORMAT_ITEM_Y; + case 'z': + return FORMAT_ITEM_Z; + case '+': + return FORMAT_ITEM_PLUS; + case '-': + return FORMAT_ITEM_MINUS; + case POINT_CHAR: + return FORMAT_ITEM_POINT; + case '%': + return FORMAT_ITEM_ESCAPE; + default: + return STOP; + } +} + +/* Get next token from internal copy of source file. + + The kind of token is set via the passed pointer ATTR. + The contents of token is set in the scan_buf via SYM. + + The recognized tokens are, by reported ATTR: + + + End of file. + FORMAT_ITEM_* + Item in a format. + STATIC_REPLICATOR + INT denotation for a static replicator in a format. + BOLD_TAG + Bold tag. + IDENTIFIER + A "lower case" identifier. + IDENTIFIER_WITH_UNDERSCORES + A "lower case" identifier whose's at least one taggle + was found adjacent to an underscore. + REAL_DENOTATION + A REAL denotation. + POINT_SYMBOL + . + BITS_DENOTATION + A BITS denotation like 16rffff + INT_DENOTATION + An INT denotation. + ROW_CHAR_DENOTATION + A STRING denotation. + LITERAL + A literal denotation in a format. + STOP + Single-character symbols #$()[]{},;@|: + := /= :=: :/=: + The character is placed in SYM. + EQUALS_SYMBOL + The equality symbol. + OPERATOR + A predefined operator. +*/ + +static void +get_next_token (bool in_format, + LINE_T **ref_l, char **ref_s, + LINE_T **start_l, char **start_c, enum a68_attribute *att) +{ + char c = **ref_s; + char *sym = A68_PARSER (scan_buf); + + sym[0] = '\0'; + get_good_char (&c, ref_l, ref_s); + *start_l = *ref_l; + *start_c = *ref_s; + if (c == STOP_CHAR) + { + /* We are at EOF. */ + (sym++)[0] = STOP_CHAR; + sym[0] = '\0'; + return; + } + + if (in_format) + { + /* In a format. */ + const char *format_items = "/%\\+-.abcdefghijklmnopqrstuvwxyz"; + if (strchr (format_items, c) != NO_TEXT) + { + /* General format items. */ + (sym++)[0] = c; + sym[0] = NULL_CHAR; + *att = get_format_item (c); + (void) next_char (ref_l, ref_s, false); + return; + } + if (ISDIGIT (c)) + { + /* INT denotation for static replicator. */ + SCAN_DIGITS (c); + sym[0] = NULL_CHAR; + *att = STATIC_REPLICATOR; + return; + } + } + + if (ISUPPER (c)) + { + /* Bold taggles are enabled only in gnu68. */ + bool allow_one_under = !OPTION_STRICT (&A68_JOB); + + if (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING) + { + /* In UPPER stropping a bold tag is an upper case word. */ + while (ISUPPER (c)) + { + (sym++)[0] = c; + c = next_char (ref_l, ref_s, false, allow_one_under); + } + sym[0] = '\0'; + *att = BOLD_TAG; + } + else + { + /* In SUPPER stropping a bold tag is a capitalized word that may + contain letters and digits. */ + while (ISALPHA (c) || ISDIGIT (c)) + { + (sym++)[0] = c; + c = next_char (ref_l, ref_s, false, allow_one_under); + } + sym[0] = '\0'; + *att = BOLD_TAG; + } + } + else if (ISLOWER (c)) + { + /* In both UPPER and SUPPER stropping regimes a tag is a lower case word + which may contain letters and digits. + + In SUPPER stropping, however, it is not allowed to have blanks + separating the taggles within tags. */ + + bool allow_one_under = true; + bool found_under = false; + bool allow_typo = OPTION_STROPPING (&A68_JOB) != SUPPER_STROPPING; + + /* Lower case word - identifier. */ + while (ISLOWER (c) || ISDIGIT (c)) + { + (sym++)[0] = c; + c = next_char (ref_l, ref_s, allow_typo, allow_one_under, + &found_under); + } + + sym[0] = '\0'; + *att = found_under ? IDENTIFIER_WITH_UNDERSCORES : IDENTIFIER; + } + else if (c == POINT_CHAR) + { + /* Begins with a point symbol - point, L REAL denotation. */ + if (is_decimal_point (ref_l, ref_s, &c)) + { + (sym++)[0] = '0'; + (sym++)[0] = POINT_CHAR; + c = next_char (ref_l, ref_s, true); + SCAN_DIGITS (c); + if (is_exp_char (ref_l, ref_s, &c)) + SCAN_EXPONENT_PART (c); + sym[0] = '\0'; + *att = REAL_DENOTATION; + } + else + { + c = next_char (ref_l, ref_s, true); + (sym++)[0] = POINT_CHAR; + sym[0] = '\0'; + *att = POINT_SYMBOL; + } + } + else if (ISDIGIT (c)) + { + /* Something that begins with a digit: + L INT denotation, L REAL denotation. */ + SCAN_DIGITS (c); + + if (is_decimal_point (ref_l, ref_s, &c)) + { + c = next_char (ref_l, ref_s, true); + if (is_exp_char (ref_l, ref_s, &c)) + { + (sym++)[0] = POINT_CHAR; + (sym++)[0] = '0'; + SCAN_EXPONENT_PART (c); + *att = REAL_DENOTATION; + } + else + { + (sym++)[0] = POINT_CHAR; + SCAN_DIGITS (c); + if (is_exp_char (ref_l, ref_s, &c)) + SCAN_EXPONENT_PART (c); + *att = REAL_DENOTATION; + } + } + else if (is_exp_char (ref_l, ref_s, &c)) + { + SCAN_EXPONENT_PART (c); + *att = REAL_DENOTATION; + } + else if (is_radix_char (ref_l, ref_s, &c)) + { + (sym++)[0] = c; + c = next_char (ref_l, ref_s, true); + /* This is valid for both UPPER and SUPPER stropping. */ + while (ISDIGIT (c) || strchr ("abcdef", c) != NO_TEXT) + { + (sym++)[0] = c; + c = next_char (ref_l, ref_s, true); + } + *att = BITS_DENOTATION; + } + else + { + *att = INT_DENOTATION; + } + sym[0] = '\0'; + } + else if (c == QUOTE_CHAR) + { + /* STRING denotation. */ + bool stop = false; + + while (!stop) + { + c = next_char (ref_l, ref_s, false); + while (c != QUOTE_CHAR && c != STOP_CHAR) + { + if (c == APOSTROPHE_CHAR) + { + (sym++)[0] = c; + c = next_char (ref_l, ref_s, false); + switch (c) + { + case APOSTROPHE_CHAR: + case 'n': + case 'f': + case 'r': + case 't': + (sym++)[0] = c; + break; + case '(': + { + unsigned int num_code_points = 0; + + (sym++)[0] = c; + /* Process code points. */ + while (1) + { + /* Skip white spaces. */ + while (1) + { + c = next_char (ref_l, ref_s, false); + if (!ISSPACE (c)) + break; + } + + /* See if we are done. */ + if (c == ')') + { + SCAN_ERROR (num_code_points == 0, *start_l, *ref_s, + "expected at least one character point in string break"); + (sym++)[0] = c; + break; + } + else if (c == 'u' || c == 'U') + { + (sym++)[0] = c; + /* Process a code point. */ + char u = c; + int numdigits = (u == 'u' ? 4 : 8); + char *startpos = *ref_s; + int i = 0; + do + { + c = next_char (ref_l, ref_s, false); + if (!(ISDIGIT (c) + || ((c >= 'a') && (c <= 'f')) + || ((c >= 'A') && (c <= 'F')))) + { + SCAN_ERROR (true, *start_l, startpos, + (u == 'u' + ? "expected four hex digits in \ +string break character point" + : "expected eight hex digits in \ +string break character point")); + } + (sym++)[0] = c; + i += 1; + } + while (i < numdigits); + + /* Skip white spaces. */ + while (1) + { + c = next_char (ref_l, ref_s, false); + if (!ISSPACE (c)) + break; + } + + /* Comma or end of list. */ + if (c == ')') + { + (sym++)[0] = c; + break; + } + + SCAN_ERROR (c != ',', *start_l, *ref_s, + "expected , or ) in string break"); + } + else + { + SCAN_ERROR (true, *start_l, *ref_s, + "unterminated list of character codes"); + } + } + break; + } + default: + SCAN_ERROR (true, *start_l, *ref_s, "invalid string break sequence"); + } + } + else + { + SCAN_ERROR (EOL (c), *start_l, *start_c, "string exceeds end of line"); + (sym++)[0] = c; + } + c = next_char (ref_l, ref_s, false); + } + SCAN_ERROR (*ref_l == NO_LINE, *start_l, *start_c, "unterminated string"); + c = next_char (ref_l, ref_s, false); + if (c == QUOTE_CHAR) + (sym++)[0] = QUOTE_CHAR; + else + stop = true; + } + sym[0] = '\0'; + *att = (in_format ? LITERAL : ROW_CHAR_DENOTATION); + } + else if (strchr ("#$()[]{},;@", c) != NO_TEXT) + { + /* Single character symbols. */ + (sym++)[0] = c; + (void) next_char (ref_l, ref_s, false); + sym[0] = '\0'; + *att = STOP; + } + else if (c == '|') + { + /* Bar. */ + (sym++)[0] = c; + c = next_char (ref_l, ref_s, false); + if (c == ':') + { + (sym++)[0] = c; + (void) next_char (ref_l, ref_s, false); + } + sym[0] = '\0'; + *att = STOP; + } + else if (c == ':') + { + /* Colon, semicolon, IS, ISNT. */ + (sym++)[0] = c; + c = next_char (ref_l, ref_s, false); + if (c == '=') + { + (sym++)[0] = c; + if ((c = next_char (ref_l, ref_s, false)) == ':') + { + (sym++)[0] = c; + c = next_char (ref_l, ref_s, false); + } + } + else if (c == '/') + { + (sym++)[0] = c; + if ((c = next_char (ref_l, ref_s, false)) == '=') + { + (sym++)[0] = c; + if ((c = next_char (ref_l, ref_s, false)) == ':') + { + (sym++)[0] = c; + c = next_char (ref_l, ref_s, false); + } + } + } + else if (c == ':') + { + (sym++)[0] = c; + if ((c = next_char (ref_l, ref_s, false)) == '=') + (sym++)[0] = c; + } + + sym[0] = '\0'; + *att = STOP; + + } + else if (c == '=') + { + /* Operator starting with "=". */ + char *scanned = sym; + (sym++)[0] = c; + c = next_char (ref_l, ref_s, false); + if (strchr (NOMADS, c) != NO_TEXT) + { + (sym++)[0] = c; + c = next_char (ref_l, ref_s, false); + } + if (c == '=') + { + (sym++)[0] = c; + if (next_char (ref_l, ref_s, false) == ':') + { + (sym++)[0] = ':'; + c = next_char (ref_l, ref_s, false); + if (strlen (sym) < 4 && c == '=') + { + (sym++)[0] = '='; + (void) next_char (ref_l, ref_s, false); + } + } + } + else if (c == ':') + { + (sym++)[0] = c; + sym[0] = '\0'; + if (next_char (ref_l, ref_s, false) == '=') + { + (sym++)[0] = '='; + (void) next_char (ref_l, ref_s, false); + } + else + { + SCAN_ERROR (!(strcmp (scanned, "=:") == 0 || strcmp (scanned, "==:") == 0), + *start_l, *start_c, "invalid operator tag"); + } + } + sym[0] = '\0'; + if (strcmp (scanned, "=") == 0) + *att = EQUALS_SYMBOL; + else + *att = OPERATOR; + } + else if (strchr (MONADS, c) != NO_TEXT || strchr (NOMADS, c) != NO_TEXT) + { + /* Operator. */ + char *scanned = sym; + (sym++)[0] = c; + c = next_char (ref_l, ref_s, false); + if (strchr (NOMADS, c) != NO_TEXT) + { + (sym++)[0] = c; + c = next_char (ref_l, ref_s, false); + } + if (c == '=') + { + (sym++)[0] = c; + if (next_char (ref_l, ref_s, false) == ':') + { + (sym++)[0] = ':'; + c = next_char (ref_l, ref_s, false); + if (strlen (scanned) < 4 && c == '=') + { + (sym++)[0] = '='; + (void) next_char (ref_l, ref_s, false); + } + } + } + else if (c == ':') + { + (sym++)[0] = c; + sym[0] = '\0'; + if (next_char (ref_l, ref_s, false) == '=') + { + (sym++)[0] = '='; + sym[0] = '\0'; + (void) next_char (ref_l, ref_s, false); + } + else + { + SCAN_ERROR (strcmp (&(scanned[1]), "=:") != 0, + *start_l, *start_c, "invalid operator tag"); + } + } + sym[0] = '\0'; + *att = OPERATOR; + } + else + { + /* Afuuus ... strange characters!. */ + unworthy (*start_l, *start_c, (int) c); + } +} + +/* Whether att opens an embedded clause. */ + +static bool +open_nested_clause (int att) +{ + switch (att) + { + case OPEN_SYMBOL: + case BEGIN_SYMBOL: + case PAR_SYMBOL: + case IF_SYMBOL: + case CASE_SYMBOL: + case FOR_SYMBOL: + case FROM_SYMBOL: + case BY_SYMBOL: + case TO_SYMBOL: + case WHILE_SYMBOL: + case DO_SYMBOL: + case SUB_SYMBOL: + return true; + } + return false; +} + +/* Whether att closes an embedded clause. */ + +static bool +close_nested_clause (int att) +{ + switch (att) + { + case CLOSE_SYMBOL: + case END_SYMBOL: + case FI_SYMBOL: + case ESAC_SYMBOL: + case OD_SYMBOL: + case BUS_SYMBOL: + return true; + } + return false; +} + +/* Cast a string to lower case. */ + +static void +make_lower_case (char *p) +{ + for (; p != NO_TEXT && p[0] != '\0'; p++) + p[0] = TOLOWER (p[0]); +} + +/* Cast a string to upper case. */ + +static void +make_upper_case (char *p) +{ + for (; p != NO_TEXT && p[0] != '\0'; p++) + p[0] = TOUPPER (p[0]); +} + +/* Construct a linear list of tokens. */ + +static void +tokenise_source (NODE_T **root, int level, bool in_format, + LINE_T **l, char **s, LINE_T **start_l, + char **start_c) +{ + char *pragmat_lpr = NO_TEXT; + int pragmat_lprt = 0; + LINE_T *pragmat_lprl = NO_LINE; + char *pragmat_lprc = NULL; + + char *comment_lpr = NO_TEXT; + int comment_lprt = 0; + LINE_T *comment_lprl = NO_LINE; + char *comment_lprc = NULL; + + while (l != NO_VAR && !A68_PARSER (stop_scanner)) + { + enum a68_attribute att = STOP; + get_next_token (in_format, l, s, start_l, start_c, &att); + + if (A68_PARSER (scan_buf)[0] == STOP_CHAR) + A68_PARSER (stop_scanner) = true; + else if (strlen (A68_PARSER (scan_buf)) > 0 || att == ROW_CHAR_DENOTATION || att == LITERAL) + { + KEYWORD_T *kw; + const char *c = NO_TEXT; + bool make_node = true; + const char *trailing = NO_TEXT; + + if (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING) + { + /* In UPPER stropping all symbols in R9.4.1 are expressed as bold + tags like "BEGIN", or symbols like "@". */ + + /* In this stropping regime there is no need to handle + identifiers for which taggles were adjacent to underscores + specially. */ + if (att != IDENTIFIER && att != IDENTIFIER_WITH_UNDERSCORES) + kw = a68_find_keyword (A68 (top_keyword), A68_PARSER (scan_buf)); + else + kw = NO_KEYWORD; + } + else + { + /* In SUPPER stropping all symbols in R9.4.1 are expressed as + tags like "begin", or symbols like "@". */ + + /* Normalize bold tags to all upper-case letters. */ + if (att == BOLD_TAG) + make_upper_case (A68_PARSER (scan_buf)); + + /* If any of the taggles of the scanned identifier were adjacent + to an underscore, that inhibits interpreting it as a + keyword. */ + if (att != BOLD_TAG && att != IDENTIFIER_WITH_UNDERSCORES) + kw = a68_find_keyword (A68 (top_keyword), A68_PARSER (scan_buf)); + else + kw = NO_KEYWORD; + } + + /* Beyond this point it is irrelevant whether an identifier had + taggles adjacent to an underscore. */ + if (att == IDENTIFIER_WITH_UNDERSCORES) + att = IDENTIFIER; + + if (kw == NO_KEYWORD || att == ROW_CHAR_DENOTATION) + { + if (att == IDENTIFIER) + make_lower_case (A68_PARSER (scan_buf)); + if (att != ROW_CHAR_DENOTATION && att != LITERAL) + { + size_t len = strlen (A68_PARSER (scan_buf)); + while (len >= 1 && A68_PARSER (scan_buf)[len - 1] == '_') + { + trailing = "_"; + A68_PARSER (scan_buf)[len - 1] = NULL_CHAR; + len--; + } + } + c = TEXT (a68_add_token (&A68 (top_token), A68_PARSER (scan_buf))); + } + else + { + if (IS (kw, TO_SYMBOL)) + { + /* Merge GO and TO to GOTO. */ + if (*root != NO_NODE && IS (*root, GO_SYMBOL)) + { + ATTRIBUTE (*root) = GOTO_SYMBOL; + NSYMBOL (*root) = TEXT (a68_find_keyword (A68 (top_keyword), "GOTO")); + make_node = false; + } + else + { + att = ATTRIBUTE (kw); + c = TEXT (kw); + } + } + else + { + if (OPTION_STROPPING (&A68_JOB) == UPPER_STROPPING) + { + if (att == 0 || att == BOLD_TAG) + att = ATTRIBUTE (kw); + } + else + { + if (att == 0 || att == IDENTIFIER) + att = ATTRIBUTE (kw); + } + + c = TEXT (kw); + /* Handle pragments. */ + if (att == STYLE_II_COMMENT_SYMBOL + || att == STYLE_I_COMMENT_SYMBOL + || att == BOLD_COMMENT_SYMBOL + || att == BOLD_COMMENT_BEGIN_SYMBOL + || att == BRIEF_COMMENT_BEGIN_SYMBOL) + { + char *nlpr = pragment (ATTRIBUTE (kw), l, s); + + if (comment_lpr == NO_TEXT + || (int) strlen (comment_lpr) == 0) + comment_lpr = nlpr; + else + { + char *stale = comment_lpr; + comment_lpr + = a68_new_string (comment_lpr, "n\n", nlpr, NO_TEXT); + free (stale); + } + comment_lprt = att; + comment_lprl = *start_l; + comment_lprc = *start_c; + make_node = false; + } + else if (att == STYLE_I_PRAGMAT_SYMBOL + || att == BOLD_PRAGMAT_SYMBOL) + { + char *nlpr = pragment (ATTRIBUTE (kw), l, s); + if (pragmat_lpr == NO_TEXT + || (int) strlen (pragmat_lpr) == 0) + pragmat_lpr = nlpr; + else + { + char *stale = pragmat_lpr; + pragmat_lpr + = a68_new_string (pragmat_lpr, " ", nlpr, NO_TEXT); + free (stale); + } + pragmat_lprt = att; + pragmat_lprl = *start_l; + pragmat_lprc = *start_c; + if (!A68_PARSER (stop_scanner)) + make_node = false; + } + } + } + /* Add token to the tree. */ + if (make_node) + { + NODE_T *q = a68_new_node (); + INFO (q) = a68_new_node_info (); + + switch (att) + { + case ASSIGN_SYMBOL: + case END_SYMBOL: + case ESAC_SYMBOL: + case OD_SYMBOL: + case OF_SYMBOL: + case FI_SYMBOL: + case CLOSE_SYMBOL: + case BUS_SYMBOL: + case COLON_SYMBOL: + case COMMA_SYMBOL: + case SEMI_SYMBOL: + GINFO (q) = NO_GINFO; + break; + default: + GINFO (q) = a68_new_genie_info (); + break; + } + + STATUS (q) = (STATUS_MASK_T) 0; + LINE (INFO (q)) = *start_l; + CHAR_IN_LINE (INFO (q)) = *start_c; + PRIO (INFO (q)) = 0; + PROCEDURE_LEVEL (INFO (q)) = 0; + ATTRIBUTE (q) = att; + NSYMBOL (q) = c; + PREVIOUS (q) = *root; + SUB (q) = NEXT (q) = NO_NODE; + TABLE (q) = NO_TABLE; + MOID (q) = NO_MOID; + TAX (q) = NO_TAG; + if (pragmat_lpr != NO_TEXT) + { + NPRAGMAT (q) = pragmat_lpr; + NPRAGMAT_TYPE (q) = pragmat_lprt; + NPRAGMAT_LINE (q) = pragmat_lprl; + NPRAGMAT_CHAR_IN_LINE (q) = pragmat_lprc; + pragmat_lpr = NO_TEXT; + pragmat_lprt = 0; + } + if (comment_lpr != NO_TEXT) + { + NCOMMENT (q) = comment_lpr; + NCOMMENT_TYPE (q) = comment_lprt; + NCOMMENT_LINE (q) = comment_lprl; + NCOMMENT_CHAR_IN_LINE (q) = comment_lprc; + comment_lpr = NO_TEXT; + comment_lprt = 0; + } + if (*root != NO_NODE) + NEXT (*root) = q; + if (TOP_NODE (&A68_JOB) == NO_NODE) + TOP_NODE (&A68_JOB) = q; + *root = q; + if (trailing != NO_TEXT) + a68_warning (q, 0, + "ignoring trailing character H in A", + trailing, att); + } + /* Redirection in tokenising formats. The scanner is a recursive-descent type as + to know when it scans a format text and when not. */ + if (in_format && att == FORMAT_DELIMITER_SYMBOL) + return; + else if (!in_format && att == FORMAT_DELIMITER_SYMBOL) + tokenise_source (root, level + 1, true, l, s, start_l, start_c); + else if (in_format && open_nested_clause (att)) + { + NODE_T *z = PREVIOUS (*root); + + if (z != NO_NODE && a68_is_one_of (z, FORMAT_ITEM_N, FORMAT_ITEM_G, FORMAT_ITEM_H, + FORMAT_ITEM_F, STOP)) + { + tokenise_source (root, level, false, l, s, start_l, start_c); + } + else if (att == OPEN_SYMBOL) + ATTRIBUTE (*root) = FORMAT_OPEN_SYMBOL; + else if (OPTION_BRACKETS (&A68_JOB) && att == SUB_SYMBOL) + ATTRIBUTE (*root) = FORMAT_OPEN_SYMBOL; + } + else if (!in_format && level > 0 && open_nested_clause (att)) + tokenise_source (root, level + 1, false, l, s, start_l, start_c); + else if (!in_format && level > 0 && close_nested_clause (att)) + return; + else if (in_format && att == CLOSE_SYMBOL) + ATTRIBUTE (*root) = FORMAT_CLOSE_SYMBOL; + else if (OPTION_BRACKETS (&A68_JOB) && in_format && att == BUS_SYMBOL) + ATTRIBUTE (*root) = FORMAT_CLOSE_SYMBOL; + } + } +} + +/* Tokenise source file, build initial syntax tree. */ + +bool +a68_lexical_analyser (const char *filename) +{ + LINE_T *l = NO_LINE, *start_l = NO_LINE; + char *s = NO_TEXT, *start_c = NO_TEXT; + NODE_T *root = NO_NODE; + + /* Read the source file into lines. */ + if (!read_source_file (filename)) + return false; + + /* Start tokenising. */ + A68_PARSER (stop_scanner) = false; + if ((l = TOP_LINE (&A68_JOB)) != NO_LINE) + s = STRING (l); + tokenise_source (&root, 0, false, &l, &s, &start_l, &start_c); + + /* If the source is a prelude packet then we should remove the prelude and + postlude nodes from the token stream. We distinguish these nodes by + location. + + Yes this is crude and creepy but it works and it is less annoying than not + adding the prelude/postlude in read_source_file and I got other fish to + fry at this moment. Somebody please fix this in a decent way, thanks - + jemarch. */ + + NODE_T *p = TOP_NODE (&A68_JOB); + for (; p != NO_NODE; FORWARD (p)) + { + LINE_T *l = LINE (INFO (p)); + if (strcmp (FILENAME (l), "prelude") != 0) + break; + } + + if (p != NO_NODE && IS (p, MODULE_SYMBOL)) + { + p = TOP_NODE (&A68_JOB); + while (p != NO_NODE) + { + LINE_T *l = LINE (INFO (p)); + if (strcmp (FILENAME (l), "prelude") == 0 + || strcmp (FILENAME (l), "postlude") == 0) + { + if (PREVIOUS (p) != NO_NODE) + NEXT (PREVIOUS (p)) = NEXT (p); + else + TOP_NODE (&A68_JOB) = NEXT (p); + + if (NEXT (p) != NO_NODE) + PREVIOUS (NEXT (p)) = PREVIOUS (p); + + NODE_T *next = NEXT (p); + p = next; + } + else + p = FORWARD (p); + } + } + + /* Note that A68_PARSER (scan_buf) and A68_PARSER (max_scan_buf_length) are + allocated by read_source_line. */ + free (A68_PARSER (scan_buf)); + A68_PARSER (scan_buf) = NULL; + A68_PARSER (max_scan_buf_length) = 0; + return true; +} From ef6b8bebb7ccef62078fd1495a59043ce47a3d3e Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:47:15 +0200 Subject: [PATCH 151/373] a68: parser: keyword tables management This commit adds code to manage the table of keywords (bold words) in the Algol 68 front-end. Signed-off-by: Jose E. Marchesi Co-authored-by: Marcel van der Veer --- gcc/algol68/a68-parser-keywords.cc | 254 +++++++++++++++++++++++++++++ 1 file changed, 254 insertions(+) create mode 100644 gcc/algol68/a68-parser-keywords.cc diff --git a/gcc/algol68/a68-parser-keywords.cc b/gcc/algol68/a68-parser-keywords.cc new file mode 100644 index 000000000000..427e2b359fdf --- /dev/null +++ b/gcc/algol68/a68-parser-keywords.cc @@ -0,0 +1,254 @@ +/* Keyword tables. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "a68.h" + +/* Apply stropping to the given keyword and return its written form, which must + be upper-case. */ + +const char * +a68_strop_keyword (const char *keyword) +{ + char *stropped = (char *) alloca (strlen (keyword) + 1); + memcpy (stropped, keyword, strlen (keyword) + 1); + + if (OPTION_STROPPING (&A68_JOB) == SUPPER_STROPPING) + { + for (char *p = stropped; *p; ++p) + *p = TOLOWER (*p); + } + + return ggc_strdup (stropped); +} + +/* Add token to the token tree. */ + +TOKEN_T * +a68_add_token (TOKEN_T **p, const char *t) +{ + while (*p != NO_TOKEN) + { + int k = strcmp (t, TEXT (*p)); + + if (k < 0) + p = &LESS (*p); + else if (k > 0) + p = &MORE (*p); + else + return *p; + } + + *p = (TOKEN_T *) ggc_cleared_alloc (); + TEXT (*p) = ggc_strdup (t); + LESS (*p) = MORE (*p) = NO_TOKEN; + return *p; +} + +/* Find keyword, from token name. */ + +KEYWORD_T * +a68_find_keyword (KEYWORD_T *p, const char *t) +{ + while (p != NO_KEYWORD) + { + bool case_insensitive = (OPTION_STROPPING (&A68_JOB) == SUPPER_STROPPING); + int k = (case_insensitive + ? strcasecmp (t, TEXT (p)) + : strcmp (t, TEXT (p))); + + if (k < 0) + p = LESS (p); + else if (k > 0) + p = MORE (p); + else + return p; + } + + return NO_KEYWORD; +} + +/* Find keyword, from attribute. */ + +KEYWORD_T * +a68_find_keyword_from_attribute (KEYWORD_T *p, enum a68_attribute a) +{ + if (p == NO_KEYWORD) + return NO_KEYWORD; + else if (a == ATTRIBUTE (p)) + return p; + else + { + KEYWORD_T *z; + + if ((z = a68_find_keyword_from_attribute (LESS (p), a)) != NO_KEYWORD) + return z; + else if ((z = a68_find_keyword_from_attribute (MORE (p), a)) != NO_KEYWORD) + return z; + } + + return NO_KEYWORD; +} + +/* Add keyword to the tree. */ + +static void +add_keyword (KEYWORD_T **p, enum a68_attribute a, const char *t) +{ + while (*p != NO_KEYWORD) + { + bool case_insensitive = (OPTION_STROPPING (&A68_JOB) == SUPPER_STROPPING); + int k = (case_insensitive + ? strcasecmp (t, TEXT (*p)) + : strcmp (t, TEXT (*p))); + if (k < 0) + p = &LESS (*p); + else + p = &MORE (*p); + } + + *p = (KEYWORD_T *) ggc_cleared_alloc (); + ATTRIBUTE (*p) = a; + TEXT (*p) = t; + LESS (*p) = MORE (*p) = NO_KEYWORD; +} + +/* Make tables of keywords and non-terminals. */ + +void +a68_set_up_tables (void) +{ + /* Entries are randomised to balance the tree. */ + if (OPTION_STRICT (&A68_JOB) == false) + { + /* Symbols from GNU extensions. */ + add_keyword (&A68 (top_keyword), ANDF_SYMBOL, "ANDTH"); + add_keyword (&A68 (top_keyword), ORF_SYMBOL, "OREL"); + add_keyword (&A68 (top_keyword), BRIEF_COMMENT_BEGIN_SYMBOL, "{"); + add_keyword (&A68 (top_keyword), BRIEF_COMMENT_END_SYMBOL, "}"); + + if (OPTION_STROPPING (&A68_JOB) != SUPPER_STROPPING) + { + add_keyword (&A68 (top_keyword), BOLD_COMMENT_BEGIN_SYMBOL, "NOTE"); + add_keyword (&A68 (top_keyword), BOLD_COMMENT_END_SYMBOL, "ETON"); + } + + /* Symbols from MR. */ + add_keyword (&A68 (top_keyword), ACCESS_SYMBOL, "ACCESS"); + add_keyword (&A68 (top_keyword), DEF_SYMBOL, "DEF"); + add_keyword (&A68 (top_keyword), POSTLUDE_SYMBOL, "POSTLUDE"); + add_keyword (&A68 (top_keyword), FED_SYMBOL, "FED"); + add_keyword (&A68 (top_keyword), FORMAL_NEST_SYMBOL, "NEST"); + add_keyword (&A68 (top_keyword), MODULE_SYMBOL, "MODULE"); + add_keyword (&A68 (top_keyword), EGG_SYMBOL, "EGG"); + add_keyword (&A68 (top_keyword), PUBLIC_SYMBOL, "PUB"); + } + + if (OPTION_STROPPING (&A68_JOB) != SUPPER_STROPPING) + { + /* The following representations do not work well with stropping regimes + in which reserved words live in the same namespace than + tags/identifiers. The alternative "brief" representations for these + symbols shall be used instead. */ + add_keyword (&A68 (top_keyword), STYLE_I_COMMENT_SYMBOL, "CO"); + add_keyword (&A68 (top_keyword), BOLD_COMMENT_SYMBOL, "COMMENT"); + add_keyword (&A68 (top_keyword), STYLE_II_COMMENT_SYMBOL, "#"); + } + + add_keyword (&A68 (top_keyword), POINT_SYMBOL, "."); + add_keyword (&A68 (top_keyword), COLON_SYMBOL, ":"); + add_keyword (&A68 (top_keyword), THEN_BAR_SYMBOL, "|"); + add_keyword (&A68 (top_keyword), SUB_SYMBOL, "["); + add_keyword (&A68 (top_keyword), BY_SYMBOL, "BY"); + add_keyword (&A68 (top_keyword), OP_SYMBOL, "OP"); + add_keyword (&A68 (top_keyword), COMMA_SYMBOL, ","); + add_keyword (&A68 (top_keyword), AT_SYMBOL, "AT"); + add_keyword (&A68 (top_keyword), PRIO_SYMBOL, "PRIO"); + add_keyword (&A68 (top_keyword), END_SYMBOL, "END"); + add_keyword (&A68 (top_keyword), GO_SYMBOL, "GO"); + add_keyword (&A68 (top_keyword), TO_SYMBOL, "TO"); + add_keyword (&A68 (top_keyword), ELSE_BAR_SYMBOL, "|:"); + add_keyword (&A68 (top_keyword), THEN_SYMBOL, "THEN"); + add_keyword (&A68 (top_keyword), TRUE_SYMBOL, "TRUE"); + add_keyword (&A68 (top_keyword), PROC_SYMBOL, "PROC"); + add_keyword (&A68 (top_keyword), FOR_SYMBOL, "FOR"); + add_keyword (&A68 (top_keyword), GOTO_SYMBOL, "GOTO"); + add_keyword (&A68 (top_keyword), WHILE_SYMBOL, "WHILE"); + add_keyword (&A68 (top_keyword), IS_SYMBOL, ":=:"); + add_keyword (&A68 (top_keyword), ASSIGN_TO_SYMBOL, "=:"); + add_keyword (&A68 (top_keyword), COMPL_SYMBOL, "COMPL"); + add_keyword (&A68 (top_keyword), FROM_SYMBOL, "FROM"); + add_keyword (&A68 (top_keyword), BOLD_PRAGMAT_SYMBOL, "PRAGMAT"); + add_keyword (&A68 (top_keyword), DO_SYMBOL, "DO"); + add_keyword (&A68 (top_keyword), CASE_SYMBOL, "CASE"); + add_keyword (&A68 (top_keyword), LOC_SYMBOL, "LOC"); + add_keyword (&A68 (top_keyword), CHAR_SYMBOL, "CHAR"); + add_keyword (&A68 (top_keyword), ISNT_SYMBOL, ":/=:"); + add_keyword (&A68 (top_keyword), REF_SYMBOL, "REF"); + add_keyword (&A68 (top_keyword), NIL_SYMBOL, "NIL"); + add_keyword (&A68 (top_keyword), ASSIGN_SYMBOL, ":="); + add_keyword (&A68 (top_keyword), FI_SYMBOL, "FI"); + add_keyword (&A68 (top_keyword), FILE_SYMBOL, "FILE"); + add_keyword (&A68 (top_keyword), PAR_SYMBOL, "PAR"); + add_keyword (&A68 (top_keyword), ASSERT_SYMBOL, "ASSERT"); + add_keyword (&A68 (top_keyword), OUSE_SYMBOL, "OUSE"); + add_keyword (&A68 (top_keyword), IN_SYMBOL, "IN"); + add_keyword (&A68 (top_keyword), LONG_SYMBOL, "LONG"); + add_keyword (&A68 (top_keyword), SEMI_SYMBOL, ";"); + add_keyword (&A68 (top_keyword), EMPTY_SYMBOL, "EMPTY"); + add_keyword (&A68 (top_keyword), MODE_SYMBOL, "MODE"); + add_keyword (&A68 (top_keyword), IF_SYMBOL, "IF"); + add_keyword (&A68 (top_keyword), OD_SYMBOL, "OD"); + add_keyword (&A68 (top_keyword), OF_SYMBOL, "OF"); + add_keyword (&A68 (top_keyword), STRUCT_SYMBOL, "STRUCT"); + add_keyword (&A68 (top_keyword), STYLE_I_PRAGMAT_SYMBOL, "PR"); + add_keyword (&A68 (top_keyword), BUS_SYMBOL, "]"); + add_keyword (&A68 (top_keyword), SKIP_SYMBOL, "SKIP"); + add_keyword (&A68 (top_keyword), SHORT_SYMBOL, "SHORT"); + add_keyword (&A68 (top_keyword), IS_SYMBOL, "IS"); + add_keyword (&A68 (top_keyword), ESAC_SYMBOL, "ESAC"); + add_keyword (&A68 (top_keyword), CHANNEL_SYMBOL, "CHANNEL"); + add_keyword (&A68 (top_keyword), REAL_SYMBOL, "REAL"); + add_keyword (&A68 (top_keyword), STRING_SYMBOL, "STRING"); + add_keyword (&A68 (top_keyword), BOOL_SYMBOL, "BOOL"); + add_keyword (&A68 (top_keyword), ISNT_SYMBOL, "ISNT"); + add_keyword (&A68 (top_keyword), FALSE_SYMBOL, "FALSE"); + add_keyword (&A68 (top_keyword), UNION_SYMBOL, "UNION"); + add_keyword (&A68 (top_keyword), OUT_SYMBOL, "OUT"); + add_keyword (&A68 (top_keyword), BRIEF_COMMENT_END_SYMBOL, "{"); + add_keyword (&A68 (top_keyword), OPEN_SYMBOL, "("); + add_keyword (&A68 (top_keyword), BEGIN_SYMBOL, "BEGIN"); + add_keyword (&A68 (top_keyword), FLEX_SYMBOL, "FLEX"); + add_keyword (&A68 (top_keyword), VOID_SYMBOL, "VOID"); + add_keyword (&A68 (top_keyword), BITS_SYMBOL, "BITS"); + add_keyword (&A68 (top_keyword), ELSE_SYMBOL, "ELSE"); + add_keyword (&A68 (top_keyword), EXIT_SYMBOL, "EXIT"); + add_keyword (&A68 (top_keyword), HEAP_SYMBOL, "HEAP"); + add_keyword (&A68 (top_keyword), INT_SYMBOL, "INT"); + add_keyword (&A68 (top_keyword), BYTES_SYMBOL, "BYTES"); + add_keyword (&A68 (top_keyword), SEMA_SYMBOL, "SEMA"); + add_keyword (&A68 (top_keyword), CLOSE_SYMBOL, ")"); + add_keyword (&A68 (top_keyword), AT_SYMBOL, "@"); + add_keyword (&A68 (top_keyword), ELIF_SYMBOL, "ELIF"); +} From 0c5facd72989cf034d06cb711c35ceb21d30a870 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:47:34 +0200 Subject: [PATCH 152/373] a68: parser: top-down parser Top-down parser for the Algol 68 front-end. Signed-off-by: Jose E. Marchesi Co-authored-by: Marcel van der Veer --- gcc/algol68/a68-parser-top-down.cc | 894 +++++++++++++++++++++++++++++ 1 file changed, 894 insertions(+) create mode 100644 gcc/algol68/a68-parser-top-down.cc diff --git a/gcc/algol68/a68-parser-top-down.cc b/gcc/algol68/a68-parser-top-down.cc new file mode 100644 index 000000000000..79100a0a4af5 --- /dev/null +++ b/gcc/algol68/a68-parser-top-down.cc @@ -0,0 +1,894 @@ +/* Top-down parser for control structure. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "a68.h" + +/* A few forward prototypes of functions defined below. */ + +static NODE_T *top_down_loop (NODE_T *p); +static NODE_T *top_down_skip_unit (NODE_T *p); +static NODE_T *top_down_def (NODE_T *def_p); + +/* Substitute brackets. + + Traditional ALGOL 68 syntax allows ( .. ) to replace [ .. ] in bounds and + slices. This top-down pass substitutes [ .. ] occurrences into ( .. ). */ + +void +a68_substitute_brackets (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + a68_substitute_brackets (SUB (p)); + + switch (ATTRIBUTE (p)) + { + case SUB_SYMBOL: + ATTRIBUTE (p) = OPEN_SYMBOL; + break; + case BUS_SYMBOL: + ATTRIBUTE (p) = CLOSE_SYMBOL; + break; + default: + break; + } + } +} + +/* Intelligible diagnostic from syntax tree branch. */ + +const char * +a68_phrase_to_text (NODE_T * p, NODE_T ** w) +{ +#define MAX_TERMINALS 8 + int count = 0, line = -1; + static BUFFER buffer; + + for (buffer[0] = '\0'; p != NO_NODE && count < MAX_TERMINALS; FORWARD (p)) + { + if (LINE_NUMBER (p) == 0) + continue; + + enum a68_attribute gatt = a68_get_good_attribute (p); + const char *z = a68_attribute_name (gatt); + + /* Where to put the error message? Bob Uzgalis noted that actual + content of a diagnostic is not as important as accurately + indicating *were* the problem is! */ + if (w != NO_VAR) + { + if (count == 0 || (*w) == NO_NODE) + *w = p; + else if (a68_dont_mark_here (*w)) + *w = p; + } + + /* Add initiation. */ + if (count == 0) + { + if (w != NO_VAR) + a68_bufcat (buffer, "construct beginning with", BUFFER_SIZE); + } + else if (count == 1) + a68_bufcat (buffer, " followed by", BUFFER_SIZE); + else if (count == 2) + a68_bufcat (buffer, " and then", BUFFER_SIZE); + else if (count >= 3) + a68_bufcat (buffer, " and", BUFFER_SIZE); + + /* Attribute or symbol. */ + if (z != NO_TEXT && SUB (p) != NO_NODE) + { + if (gatt == IDENTIFIER || gatt == OPERATOR || gatt == DENOTATION) + { + const char *strop_symbol = a68_strop_keyword (NSYMBOL (p)); + if (snprintf (A68 (edit_line), SNPRINTF_SIZE, " %%<%s%%>", strop_symbol) < 0) + gcc_unreachable (); + a68_bufcat (buffer, A68 (edit_line), BUFFER_SIZE); + } + else + { + if (strchr ("aeio", z[0]) != NO_TEXT) + a68_bufcat (buffer, " an", BUFFER_SIZE); + else + a68_bufcat (buffer, " a", BUFFER_SIZE); + + if (snprintf (A68 (edit_line), SNPRINTF_SIZE, " %s", z) < 0) + gcc_unreachable (); + a68_bufcat (buffer, A68 (edit_line), BUFFER_SIZE); + } + } + else if (z != NO_TEXT && SUB (p) == NO_NODE) + { + const char *strop_symbol = a68_strop_keyword (NSYMBOL (p)); + if (snprintf (A68 (edit_line), SNPRINTF_SIZE, " %%<%s%%>", strop_symbol) < 0) + gcc_unreachable (); + a68_bufcat (buffer, A68 (edit_line), BUFFER_SIZE); + } + else if (NSYMBOL (p) != NO_TEXT) + { + const char *strop_symbol = a68_strop_keyword (NSYMBOL (p)); + if (snprintf (A68 (edit_line), SNPRINTF_SIZE, " %%<%s%%>", strop_symbol) < 0) + gcc_unreachable (); + a68_bufcat (buffer, A68 (edit_line), BUFFER_SIZE); + } + /* Add "starting in line nn". */ + if (z != NO_TEXT && line != LINE_NUMBER (p)) + { + line = LINE_NUMBER (p); + if (gatt == SERIAL_CLAUSE || gatt == ENQUIRY_CLAUSE || gatt == INITIALISER_SERIES) + a68_bufcat (buffer, " starting", BUFFER_SIZE); + if (snprintf (A68 (edit_line), SNPRINTF_SIZE, " in line %d", line) < 0) + gcc_unreachable (); + a68_bufcat (buffer, A68 (edit_line), BUFFER_SIZE); + } + count++; + } + + if (p != NO_NODE && count == MAX_TERMINALS) + a68_bufcat (buffer, " etcetera", BUFFER_SIZE); + return buffer; +} + +/* Next is a top-down parser that branches out the basic blocks. + After this we can assign symbol tables to basic blocks. + This renders the two-level grammar LALR. */ + +/* Give diagnose from top-down parser. */ + +static void +top_down_diagnose (NODE_T *start, NODE_T *p, int clause, int expected) +{ + NODE_T *issue = (p != NO_NODE ? p : start); + const char *strop_keyword = a68_strop_keyword (NSYMBOL (start)); + + if (expected != 0) + a68_error (issue, "B expected in A, near Z L", + expected, clause, strop_keyword, LINE (INFO (start))); + else + a68_error (issue, "missing or unbalanced keyword in A, near Z L", + clause, strop_keyword, LINE (INFO (start))); +} + +/* Check for premature exhaustion of tokens. */ + +static void +tokens_exhausted (NODE_T *p, NODE_T *q) +{ + if (p == NO_NODE) + { + a68_error (q, "check for missing or unmatched keyword in clause starting at S"); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } +} + +/* + * This part specifically branches out loop clauses. + */ + +/* Whether in cast or formula with loop clause. */ + +static int +is_loop_cast_formula (NODE_T *p) +{ + /* Accept declarers that can appear in such casts but not much more. */ + if (IS (p, VOID_SYMBOL)) + return 1; + else if (IS (p, INT_SYMBOL)) + return 1; + else if (IS_REF (p)) + return 1; + else if (a68_is_one_of (p, OPERATOR, BOLD_TAG, STOP)) + return 1; + else if (a68_whether (p, UNION_SYMBOL, OPEN_SYMBOL, STOP)) + return 2; + else if (a68_is_one_of (p, OPEN_SYMBOL, SUB_SYMBOL, STOP)) + { + int k = 0; + for (; p != NO_NODE && (a68_is_one_of (p, OPEN_SYMBOL, SUB_SYMBOL, STOP)); FORWARD (p), k++) + ; + return p != NO_NODE && (a68_whether (p, UNION_SYMBOL, OPEN_SYMBOL, STOP) ? k : 0); + } + return 0; +} + +/* Skip a unit in a loop clause (FROM u BY u TO u). */ + +static NODE_T * +top_down_skip_loop_unit (NODE_T *p) +{ + /* Unit may start with, or consist of, a loop. */ + if (a68_is_loop_keyword (p)) + p = top_down_loop (p); + + /* Skip rest of unit. */ + while (p != NO_NODE) + { + int k = is_loop_cast_formula (p); + + if (k != 0) + { + /* operator-cast series ... */ + while (p != NO_NODE && k != 0) + { + while (k != 0) + { + FORWARD (p); + k--; + } + k = is_loop_cast_formula (p); + } + + /* ... may be followed by a loop clause. */ + if (a68_is_loop_keyword (p)) + p = top_down_loop (p); + } + else if (a68_is_loop_keyword (p) || IS (p, OD_SYMBOL)) + /* new loop or end-of-loop. */ + return p; + else if (IS (p, COLON_SYMBOL)) + { + FORWARD (p); + /* skip routine header: loop clause. */ + if (p != NO_NODE && a68_is_loop_keyword (p)) + p = top_down_loop (p); + } + else if (a68_is_one_of (p, SEMI_SYMBOL, COMMA_SYMBOL, STOP) || IS (p, EXIT_SYMBOL)) + /* Statement separators. */ + return p; + else + FORWARD (p); + } + return NO_NODE; +} + +/* Skip a loop clause. */ + +static NODE_T * +top_down_skip_loop_series (NODE_T *p) +{ + bool siga; + + do + { + p = top_down_skip_loop_unit (p); + siga = (p != NO_NODE && (a68_is_one_of (p, SEMI_SYMBOL, EXIT_SYMBOL, + COMMA_SYMBOL, COLON_SYMBOL, + STOP))); + if (siga) + FORWARD (p); + } + while (!(p == NO_NODE || !siga)); + + return p; +} + +/* Make branch of loop parts. */ + +static NODE_T * +top_down_loop (NODE_T *p) +{ + NODE_T *start = p, *q = p; + + if (IS (q, FOR_SYMBOL)) + { + tokens_exhausted (FORWARD (q), start); + + if (IS (q, IDENTIFIER)) + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + else + { + top_down_diagnose (start, q, LOOP_CLAUSE, IDENTIFIER); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + + tokens_exhausted (FORWARD (q), start); + + if (a68_is_one_of (q, FROM_SYMBOL, BY_SYMBOL, TO_SYMBOL, + WHILE_SYMBOL, STOP)) + ; + else if (IS (q, DO_SYMBOL)) + ATTRIBUTE (q) = ALT_DO_SYMBOL; + else + { + top_down_diagnose (start, q, LOOP_CLAUSE, STOP); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + } + + if (IS (q, FROM_SYMBOL)) + { + start = q; + q = top_down_skip_loop_unit (NEXT (q)); + tokens_exhausted (q, start); + if (a68_is_one_of (q, BY_SYMBOL, TO_SYMBOL, WHILE_SYMBOL, STOP)) + ; + else if (IS (q, DO_SYMBOL)) + ATTRIBUTE (q) = ALT_DO_SYMBOL; + else + { + top_down_diagnose (start, q, LOOP_CLAUSE, STOP); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + + a68_make_sub (start, PREVIOUS (q), FROM_SYMBOL); + } + + if (IS (q, BY_SYMBOL)) + { + start = q; + q = top_down_skip_loop_series (NEXT (q)); + tokens_exhausted (q, start); + + if (a68_is_one_of (q, TO_SYMBOL, WHILE_SYMBOL, STOP)) + ; + else if (IS (q, DO_SYMBOL)) + ATTRIBUTE (q) = ALT_DO_SYMBOL; + else + { + top_down_diagnose (start, q, LOOP_CLAUSE, STOP); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + + a68_make_sub (start, PREVIOUS (q), BY_SYMBOL); + } + + if (a68_is_one_of (q, TO_SYMBOL, STOP)) + { + start = q; + q = top_down_skip_loop_series (NEXT (q)); + tokens_exhausted (q, start); + + if (IS (q, WHILE_SYMBOL)) + ; + else if (IS (q, DO_SYMBOL)) + ATTRIBUTE (q) = ALT_DO_SYMBOL; + else + { + top_down_diagnose (start, q, LOOP_CLAUSE, STOP); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + + a68_make_sub (start, PREVIOUS (q), TO_SYMBOL); + } + + if (IS (q, WHILE_SYMBOL)) + { + start = q; + q = top_down_skip_loop_series (NEXT (q)); + tokens_exhausted (q, start); + + if (IS (q, DO_SYMBOL)) + ATTRIBUTE (q) = ALT_DO_SYMBOL; + else + { + top_down_diagnose (start, q, LOOP_CLAUSE, DO_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + + a68_make_sub (start, PREVIOUS (q), WHILE_SYMBOL); + } + + if (a68_is_one_of (q, DO_SYMBOL, ALT_DO_SYMBOL, STOP)) + { + enum a68_attribute k = ATTRIBUTE (q); + + start = q; + q = top_down_skip_loop_series (NEXT (q)); + tokens_exhausted (q, start); + + if (!IS (q, OD_SYMBOL)) + { + top_down_diagnose (start, q, LOOP_CLAUSE, OD_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + + a68_make_sub (start, q, k); + } + + NODE_T *save = NEXT (start); + a68_make_sub (p, start, LOOP_CLAUSE); + return save; +} + +/* Driver for making branches of loop parts. */ + +static void +top_down_loops (NODE_T *p) +{ + NODE_T *q = p; + + for (; q != NO_NODE; FORWARD (q)) + { + if (SUB (q) != NO_NODE) + top_down_loops (SUB (q)); + } + + q = p; + while (q != NO_NODE) + { + if (a68_is_loop_keyword (q) != STOP) + q = top_down_loop (q); + else + FORWARD (q); + } +} + +/* + * Branch anything except parts of a loop. + */ + +/* Skip serial/enquiry clause (unit series). */ + +static NODE_T * +top_down_series (NODE_T *p) +{ + bool siga = true; + while (siga) + { + siga = false; + p = top_down_skip_unit (p); + if (p != NO_NODE) + { + if (a68_is_one_of (p, SEMI_SYMBOL, EXIT_SYMBOL, COMMA_SYMBOL, STOP)) + { + siga = true; + FORWARD (p); + } + } + } + return p; +} + +/* Make branch of DEF .. POSTLUDE .. FED. */ + +static NODE_T * +top_down_def (NODE_T *def_p) +{ + NODE_T *fed_p = top_down_series (NEXT (def_p)); + + if (fed_p == NO_NODE || !(IS (fed_p, FED_SYMBOL) || IS (fed_p, POSTLUDE_SYMBOL))) + { + top_down_diagnose (def_p, fed_p, MODULE_TEXT, FED_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + + a68_make_sub (def_p, PREVIOUS (fed_p), DEF_SYMBOL); + + if (IS (fed_p, POSTLUDE_SYMBOL)) + { + NODE_T *postlude_p = top_down_series (NEXT (fed_p)); + + if (postlude_p == NO_NODE || !IS (postlude_p, FED_SYMBOL)) + { + top_down_diagnose (def_p, fed_p, MODULE_TEXT, FED_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + + a68_make_sub (fed_p, PREVIOUS (postlude_p), POSTLUDE_SYMBOL); + } + + return NEXT (def_p); +} + +/* Make branch of + + ACCESS REVELATION [DEF_SYMBOL] + or + ACCESS REVELATION ENCLOSED_CLAUSE. */ + +static void +top_down_access (NODE_T *p) +{ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (SUB (q) != NO_NODE) + top_down_access (SUB (q)); + } + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, ACCESS_SYMBOL)) + { + NODE_T *end_p = NEXT (q); + + /* Skip joined list of revelations and make branch until the enclosed + clause, DEF_SYMBOL or POSTLUDE_SYMBOL. */ + while (a68_is_one_of (end_p, BOLD_TAG, PUBLIC_SYMBOL, COMMA_SYMBOL, STOP)) + FORWARD (end_p); + + if (IS (end_p, DEF_SYMBOL)) + { + FORWARD (end_p); + if (IS (end_p, POSTLUDE_SYMBOL)) + FORWARD (end_p); + if (IS (end_p, FED_SYMBOL)) + { + ATTRIBUTE (q) = ALT_ACCESS_SYMBOL; + a68_make_sub (q, end_p, ALT_ACCESS_SYMBOL); + } + } + else + a68_make_sub (q, end_p, ACCESS_SYMBOL); + } + } +} + +/* Make branch of BEGIN .. END. */ + +static NODE_T * +top_down_begin (NODE_T *begin_p) +{ + NODE_T *end_p = top_down_series (NEXT (begin_p)); + + if (end_p == NO_NODE || !IS (end_p, END_SYMBOL)) + { + top_down_diagnose (begin_p, end_p, ENCLOSED_CLAUSE, END_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + return NO_NODE; + } + else + { + a68_make_sub (begin_p, end_p, BEGIN_SYMBOL); + return NEXT (begin_p); + } +} + +/* Make branch of ( .. ). */ + +static NODE_T * +top_down_open (NODE_T *open_p) +{ + NODE_T *then_bar_p = top_down_series (NEXT (open_p)), *elif_bar_p; + + if (then_bar_p != NO_NODE && IS (then_bar_p, CLOSE_SYMBOL)) + { + a68_make_sub (open_p, then_bar_p, OPEN_SYMBOL); + return NEXT (open_p); + } + + if (then_bar_p == NO_NODE || !IS (then_bar_p, THEN_BAR_SYMBOL)) + { + top_down_diagnose (open_p, then_bar_p, ENCLOSED_CLAUSE, STOP); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + + a68_make_sub (open_p, PREVIOUS (then_bar_p), OPEN_SYMBOL); + elif_bar_p = top_down_series (NEXT (then_bar_p)); + if (elif_bar_p != NO_NODE && IS (elif_bar_p, CLOSE_SYMBOL)) + { + a68_make_sub (then_bar_p, PREVIOUS (elif_bar_p), THEN_BAR_SYMBOL); + a68_make_sub (open_p, elif_bar_p, OPEN_SYMBOL); + return NEXT (open_p); + } + + if (elif_bar_p != NO_NODE && IS (elif_bar_p, THEN_BAR_SYMBOL)) + { + NODE_T *close_p = top_down_series (NEXT (elif_bar_p)); + + if (close_p == NO_NODE || !IS (close_p, CLOSE_SYMBOL)) + { + top_down_diagnose (open_p, elif_bar_p, ENCLOSED_CLAUSE, CLOSE_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + + a68_make_sub (then_bar_p, PREVIOUS (elif_bar_p), THEN_BAR_SYMBOL); + a68_make_sub (elif_bar_p, PREVIOUS (close_p), THEN_BAR_SYMBOL); + a68_make_sub (open_p, close_p, OPEN_SYMBOL); + return NEXT (open_p); + } + + if (elif_bar_p != NO_NODE && IS (elif_bar_p, ELSE_BAR_SYMBOL)) + { + NODE_T *close_p = top_down_open (elif_bar_p); + a68_make_sub (then_bar_p, PREVIOUS (elif_bar_p), THEN_BAR_SYMBOL); + a68_make_sub (open_p, elif_bar_p, OPEN_SYMBOL); + return close_p; + } + else + { + top_down_diagnose (open_p, elif_bar_p, ENCLOSED_CLAUSE, CLOSE_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + return NO_NODE; + } +} + +/* Make branch of [ .. ]. */ + +static NODE_T * +top_down_sub (NODE_T *sub_p) +{ + NODE_T *bus_p = top_down_series (NEXT (sub_p)); + + if (bus_p != NO_NODE && IS (bus_p, BUS_SYMBOL)) + { + a68_make_sub (sub_p, bus_p, SUB_SYMBOL); + return NEXT (sub_p); + } + else + { + top_down_diagnose (sub_p, bus_p, 0, BUS_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + return NO_NODE; + } +} + +/* Make branch of IF .. THEN .. ELSE .. FI. */ + +static NODE_T * +top_down_if (NODE_T * if_p) +{ + NODE_T *then_p = top_down_series (NEXT (if_p)), *elif_p; + + if (then_p == NO_NODE || !IS (then_p, THEN_SYMBOL)) + { + top_down_diagnose (if_p, then_p, CONDITIONAL_CLAUSE, THEN_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + + a68_make_sub (if_p, PREVIOUS (then_p), IF_SYMBOL); + + elif_p = top_down_series (NEXT (then_p)); + if (elif_p != NO_NODE && IS (elif_p, FI_SYMBOL)) + { + a68_make_sub (then_p, PREVIOUS (elif_p), THEN_SYMBOL); + a68_make_sub (if_p, elif_p, IF_SYMBOL); + return NEXT (if_p); + } + + if (elif_p != NO_NODE && IS (elif_p, ELSE_SYMBOL)) + { + NODE_T *fi_p = top_down_series (NEXT (elif_p)); + + if (fi_p == NO_NODE || !IS (fi_p, FI_SYMBOL)) + { + top_down_diagnose (if_p, fi_p, CONDITIONAL_CLAUSE, FI_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + else + { + a68_make_sub (then_p, PREVIOUS (elif_p), THEN_SYMBOL); + a68_make_sub (elif_p, PREVIOUS (fi_p), ELSE_SYMBOL); + a68_make_sub (if_p, fi_p, IF_SYMBOL); + return NEXT (if_p); + } + } + + if (elif_p != NO_NODE && IS (elif_p, ELIF_SYMBOL)) + { + NODE_T *fi_p = top_down_if (elif_p); + + a68_make_sub (then_p, PREVIOUS (elif_p), THEN_SYMBOL); + a68_make_sub (if_p, elif_p, IF_SYMBOL); + return fi_p; + } + else + { + top_down_diagnose (if_p, elif_p, CONDITIONAL_CLAUSE, FI_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + return NO_NODE; + } +} + +/* Make branch of CASE .. IN .. OUT .. ESAC. */ + +static NODE_T * +top_down_case (NODE_T *case_p) +{ + NODE_T *in_p = top_down_series (NEXT (case_p)), *ouse_p; + + if (in_p == NO_NODE || !IS (in_p, IN_SYMBOL)) + { + top_down_diagnose (case_p, in_p, ENCLOSED_CLAUSE, IN_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + + a68_make_sub (case_p, PREVIOUS (in_p), CASE_SYMBOL); + + ouse_p = top_down_series (NEXT (in_p)); + if (ouse_p != NO_NODE && IS (ouse_p, ESAC_SYMBOL)) + { + a68_make_sub (in_p, PREVIOUS (ouse_p), IN_SYMBOL); + a68_make_sub (case_p, ouse_p, CASE_SYMBOL); + return NEXT (case_p); + } + + if (ouse_p != NO_NODE && IS (ouse_p, OUT_SYMBOL)) + { + NODE_T *esac_p = top_down_series (NEXT (ouse_p)); + + if (esac_p == NO_NODE || !IS (esac_p, ESAC_SYMBOL)) + { + top_down_diagnose (case_p, esac_p, ENCLOSED_CLAUSE, ESAC_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + else + { + a68_make_sub (in_p, PREVIOUS (ouse_p), IN_SYMBOL); + a68_make_sub (ouse_p, PREVIOUS (esac_p), OUT_SYMBOL); + a68_make_sub (case_p, esac_p, CASE_SYMBOL); + return NEXT (case_p); + } + } + + if (ouse_p != NO_NODE && IS (ouse_p, OUSE_SYMBOL)) + { + NODE_T *esac_p = top_down_case (ouse_p); + + a68_make_sub (in_p, PREVIOUS (ouse_p), IN_SYMBOL); + a68_make_sub (case_p, ouse_p, CASE_SYMBOL); + return esac_p; + } + else + { + top_down_diagnose (case_p, ouse_p, ENCLOSED_CLAUSE, ESAC_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + return NO_NODE; + } +} + +/* Skip a unit. */ + +static NODE_T * +top_down_skip_unit (NODE_T *p) +{ + while (p != NO_NODE && !a68_is_unit_terminator (p)) + { + if (IS (p, BEGIN_SYMBOL)) + p = top_down_begin (p); + else if (IS (p, SUB_SYMBOL)) + p = top_down_sub (p); + else if (IS (p, OPEN_SYMBOL)) + p = top_down_open (p); + else if (IS (p, IF_SYMBOL)) + p = top_down_if (p); + else if (IS (p, CASE_SYMBOL)) + p = top_down_case (p); + else + FORWARD (p); + } + return p; +} + +static NODE_T *top_down_skip_format (NODE_T *); + +/* Make branch of ( .. ) in a format. */ + +static NODE_T * +top_down_format_open (NODE_T *open_p) +{ + NODE_T *close_p = top_down_skip_format (NEXT (open_p)); + + if (close_p != NO_NODE && IS (close_p, FORMAT_CLOSE_SYMBOL)) + { + a68_make_sub (open_p, close_p, FORMAT_OPEN_SYMBOL); + return NEXT (open_p); + } + else + { + top_down_diagnose (open_p, close_p, 0, FORMAT_CLOSE_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + return NO_NODE; + } +} + +/* Skip a format text. */ + +static NODE_T * +top_down_skip_format (NODE_T *p) +{ + while (p != NO_NODE) + { + if (IS (p, FORMAT_OPEN_SYMBOL)) + p = top_down_format_open (p); + else if (a68_is_one_of (p, FORMAT_CLOSE_SYMBOL, FORMAT_DELIMITER_SYMBOL, STOP)) + return p; + else + FORWARD (p); + } + return NO_NODE; +} + +/* Make branch of $ .. $. */ + +static void +top_down_formats (NODE_T * p) +{ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (SUB (q) != NO_NODE) + top_down_formats (SUB (q)); + } + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, FORMAT_DELIMITER_SYMBOL)) + { + NODE_T *f = NEXT (q); + + while (f != NO_NODE && !IS (f, FORMAT_DELIMITER_SYMBOL)) + { + if (IS (f, FORMAT_OPEN_SYMBOL)) + f = top_down_format_open (f); + else + f = NEXT (f); + } + + if (f == NO_NODE) + { + top_down_diagnose (p, f, FORMAT_TEXT, FORMAT_DELIMITER_SYMBOL); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + else + a68_make_sub (q, f, FORMAT_DELIMITER_SYMBOL); + } + } +} + +/* Skip prelude packet. */ + +static NODE_T * +top_down_prelude_packet (NODE_T *p) +{ + while (p != NO_NODE) + { + if (IS (p, DEF_SYMBOL)) + p = top_down_def (p); + else + FORWARD (p); + } + + return p; +} + +/* Skip particular program. */ + +static NODE_T * +top_down_particular_program (NODE_T *p) +{ + (void) top_down_series (p); + return p; +} + +/* Make branches of phrases for the bottom-up parser. */ + +void +a68_top_down_parser (NODE_T *p) +{ + if (p == NO_NODE) + return; + + if (!setjmp (A68_PARSER (top_down_crash_exit))) + { + if (IS (p, MODULE_SYMBOL)) + (void) top_down_prelude_packet (p); + else + (void) top_down_particular_program (p); + } + + top_down_loops (p); + top_down_formats (p); + top_down_access (p); +} From 96820d1c465cd901536632b4a8e1484e71297db5 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:47:56 +0200 Subject: [PATCH 153/373] a68: parser: parenthesis checker This pass makes sure all brackets (parenthesis) are matched in the source program. Signed-off-by: Jose E. Marchesi Co-authored-by: Marcel van der Veer --- gcc/algol68/a68-parser-brackets.cc | 223 +++++++++++++++++++++++++++++ 1 file changed, 223 insertions(+) create mode 100644 gcc/algol68/a68-parser-brackets.cc diff --git a/gcc/algol68/a68-parser-brackets.cc b/gcc/algol68/a68-parser-brackets.cc new file mode 100644 index 000000000000..ccb4ab479838 --- /dev/null +++ b/gcc/algol68/a68-parser-brackets.cc @@ -0,0 +1,223 @@ +/* Recursive-descent parenthesis checker. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + + +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "a68.h" + +/* After this checker, we know that at least brackets are matched. This + stabilises later parser phases. + + Note that this checker operates on a linear list of nodes. + + Error diagnostics are placed near offending lines. */ + +/* Intelligible diagnostics for the bracket checker. */ + +static void +bracket_check_error (char *txt, int n, const char *bra, const char *ket) +{ + BUFFER buf; + + if (n == 0) + return; + + const char *strop_ket = a68_strop_keyword (ket); + const char *strop_bra = a68_strop_keyword (bra); + + BUFCLR (buf); + if (snprintf (buf, SNPRINTF_SIZE, "missing matching %%<%s%%>", + (n > 0 ? strop_ket : strop_bra)) < 0) + gcc_unreachable (); + + if (strlen (txt) > 0) + a68_bufcat (txt, " or ", BUFFER_SIZE); + a68_bufcat (txt, buf, BUFFER_SIZE); +} + +/* Diagnose brackets in local branch of the tree. */ + +static char * +bracket_check_diagnose (NODE_T *p) +{ + int begins = 0, opens = 0, format_delims = 0, format_opens = 0; + int subs = 0, ifs = 0, cases = 0, dos = 0; + + for (; p != NO_NODE; FORWARD (p)) + { + switch (ATTRIBUTE (p)) + { + case BEGIN_SYMBOL: + begins++; + break; + case END_SYMBOL: + begins--; + break; + case OPEN_SYMBOL: + opens++; + break; + case CLOSE_SYMBOL: + opens--; + break; + case FORMAT_DELIMITER_SYMBOL: + if (format_delims == 0) + format_delims = 1; + else + format_delims = 0; + break; + case FORMAT_OPEN_SYMBOL: + format_opens++; + break; + case FORMAT_CLOSE_SYMBOL: + format_opens--; + break; + case SUB_SYMBOL: + subs++; + break; + case BUS_SYMBOL: + subs--; + break; + case IF_SYMBOL: + ifs++; + break; + case FI_SYMBOL: + ifs--; + break; + case CASE_SYMBOL: + cases++; + break; + case ESAC_SYMBOL: + cases--; + break; + case DO_SYMBOL: + dos++; + break; + case OD_SYMBOL: + dos--; + break; + default: + break; + } + } + + A68 (edit_line)[0] = '\0'; + bracket_check_error (A68 (edit_line), begins, "BEGIN", "END"); + bracket_check_error (A68 (edit_line), opens, "(", ")"); + bracket_check_error (A68 (edit_line), format_opens, "(", ")"); + bracket_check_error (A68 (edit_line), format_delims, "$", "$"); + bracket_check_error (A68 (edit_line), subs, "[", "]"); + bracket_check_error (A68 (edit_line), ifs, "IF", "FI"); + bracket_check_error (A68 (edit_line), cases, "CASE", "ESAC"); + bracket_check_error (A68 (edit_line), dos, "DO", "OD"); + return A68 (edit_line); +} + +/* Driver for locally diagnosing non-matching tokens. */ + +static NODE_T * +bracket_check_parse (NODE_T *top, NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + int ket = STOP; + NODE_T *q = NO_NODE; + bool ignore_token = false; + + switch (ATTRIBUTE (p)) + { + case BEGIN_SYMBOL: + ket = END_SYMBOL; + q = bracket_check_parse (top, NEXT (p)); + break; + case OPEN_SYMBOL: + ket = CLOSE_SYMBOL; + q = bracket_check_parse (top, NEXT (p)); + break; + case FORMAT_OPEN_SYMBOL: + ket = FORMAT_CLOSE_SYMBOL; + q = bracket_check_parse (top, NEXT (p)); + break; + case SUB_SYMBOL: + ket = BUS_SYMBOL; + q = bracket_check_parse (top, NEXT (p)); + break; + case IF_SYMBOL: + ket = FI_SYMBOL; + q = bracket_check_parse (top, NEXT (p)); + break; + case CASE_SYMBOL: + ket = ESAC_SYMBOL; + q = bracket_check_parse (top, NEXT (p)); + break; + case DO_SYMBOL: + ket = OD_SYMBOL; + q = bracket_check_parse (top, NEXT (p)); + break; + case END_SYMBOL: + case CLOSE_SYMBOL: + case FORMAT_CLOSE_SYMBOL: + case BUS_SYMBOL: + case FI_SYMBOL: + case ESAC_SYMBOL: + case OD_SYMBOL: + return p; + default: + ignore_token = true; + } + + if (ignore_token) + ; + else if (q != NO_NODE && IS (q, ket)) + p = q; + else if (q == NO_NODE) + { + char *diag = bracket_check_diagnose (top); + a68_error (p, "incorrect nesting, check for Y", + (strlen (diag) > 0 ? diag : "missing or unmatched keyword")); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + else + { + char *diag = bracket_check_diagnose (top); + a68_error (q, "unexpected X, check for Y", + ATTRIBUTE (q), + (strlen (diag) > 0 ? diag : "missing or unmatched keyword")); + longjmp (A68_PARSER (top_down_crash_exit), 1); + } + } + return NO_NODE; +} + +/* Driver for globally diagnosing non-matching tokens. */ + +void +a68_check_parenthesis (NODE_T *top) +{ + if (!setjmp (A68_PARSER (top_down_crash_exit))) + { + if (bracket_check_parse (top, top) != NO_NODE) + a68_error (top, "incorrect nesting, check for Y", + "missing or unmatched keyword"); + } +} From 4928aa83e1cd61ab2dfacaf13eceda162890e295 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:48:18 +0200 Subject: [PATCH 154/373] a68: parser: bottom-up parser Bottom-up parser for the Algol 68 front-end. Signed-off-by: Jose E. Marchesi Co-authored-by: Marcel van der Veer --- gcc/algol68/a68-parser-bottom-up.cc | 3026 +++++++++++++++++++++++++++ 1 file changed, 3026 insertions(+) create mode 100644 gcc/algol68/a68-parser-bottom-up.cc diff --git a/gcc/algol68/a68-parser-bottom-up.cc b/gcc/algol68/a68-parser-bottom-up.cc new file mode 100644 index 000000000000..a87a94007b77 --- /dev/null +++ b/gcc/algol68/a68-parser-bottom-up.cc @@ -0,0 +1,3026 @@ +/* Hand-coded bottom-up parser for Algol 68. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +/* This is a Mailloux-type parser, in the sense that it scans a "phrase" for + definitions needed for parsing, and therefore allows for tags to be used + before they are defined, which gives some freedom in top-down programming. + + B. J. Mailloux. On the implementation of Algol 68. + Thesis, Universiteit van Amsterdam (Mathematisch Centrum) [1968]. + + Technically, Mailloux's approach renders the two-level grammar LALR. This + is the bottom-up parser that resolves the structure of the program. */ + +/* *** Thou who adventure here, please read this *** + + On parse trees, phrases and branches + ------------------------------------ + + The Algol 68 parser operates on parse trees in which sibling nodes are + linked together in "phrases" via NEXT and PREVIOUS pointers, and sub-trees + or "branches" start at SUB pointers. For example, in the parse tree + + a + | + b - c - d - e + | + f - g - h - i + | + j + + 'a' is the root of the tree. + 'a', 'b - c - d - e', 'f - g - h -i' and 'j' are phrases. + 'a', 'c' and 'i' introduce branches to sub trees via their SUB pointer. + + From the scanner to the bottom-up parser + ---------------------------------------- + + The lexical analyzer transforms the textual input programs into a single + phrase with all the tokens. For example, the program text + + begin if A then B fi; + C + end; + D + + will be turned by the lexical analyzer into the following parse tree, which + in fact is a list conforming a single phrase: + + begin - if - A - then - B - fi - semi - C - end - semi - D + + This parse tree is then handed over to the top-down parser, which provides + some initial structure and turns the single phrase into an actual tree: + + begin - semi - D + | + begin - if - then - fi - end - semi - C - end + | | + | then - B + if - A + + Note how branches have been created for the closed clause and for the + different parts of the conditional clause. The same would have happened for + loop parts and case parts as well, but it is important to note that the role + of the top-down parser doesn't handle the conditional, loop or case clauses + themselves: it just branches the parts of these clauses that introduce + ranges. Taking care of structuring the clauses is precisely the main role of + the bottom-up parser. + + The bottom-up parser + -------------------- + + The bottom-up parser is given a parse tree like the one above, partially + structured in phrases by the top-down parser. The bottom-up parser then + proceeds from the root-node using two basic operations: + + - reduce a phrase, implemented by 'reduce'. + - reduce a sub-phrase starting at a branch, implemented by 'reduce_branch'. +*/ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "options.h" + +#include "a68.h" + +/* Bottom-up parser, reduces all constructs. */ + + +/* Maximum number of errors the bottom-up parser will try to recover from and + save diagnostics for. */ + +#define MAX_ERRORS 5 + +/* Forward declarations of some of the functions defined below. */ + +static void reduce_branch (NODE_T *q, a68_attribute expect); +static void recover_from_error (NODE_T * p, enum a68_attribute expect, bool suppress); +static void reduce_declarers (NODE_T *p, enum a68_attribute expect); +static void reduce_primary_parts (NODE_T *p, enum a68_attribute expect); +static void reduce_primaries (NODE_T *p, enum a68_attribute expect); +static void reduce_format_texts (NODE_T *p); +static void reduce_secondaries (NODE_T *p); +static void reduce_formulae (NODE_T * p); +static void reduce_tertiaries (NODE_T *p); +static void reduce_right_to_left_constructs (NODE_T *p); +static void reduce_units (NODE_T * p); +static void reduce_erroneous_units (NODE_T *p); +static void reduce_generic_arguments (NODE_T *p); +static void reduce_bounds (NODE_T *p); +static void reduce_serial_clauses (NODE_T *p); +static void reduce_enquiry_clauses (NODE_T *p); +static void reduce_collateral_clauses (NODE_T *p); +static void reduce_arguments (NODE_T *p); +static void reduce_enclosed_clauses (NODE_T *q, enum a68_attribute expect); +static void reduce_basic_declarations (NODE_T *p); +static void reduce_declaration_lists (NODE_T *p); +static void reduce_module_texts (NODE_T *p); +static void reduce_module_text_parts (NODE_T *p); +static NODE_T *reduce_dyadic (NODE_T *p, int u); + +/* Whether a series is serial or collateral. */ + +static enum a68_attribute +serial_or_collateral (NODE_T *p) +{ + int semis = 0, commas = 0, exits = 0; + for (NODE_T *q = p; q != NO_NODE; q = NEXT (q)) + { + if (IS (q, COMMA_SYMBOL)) + commas++; + else if (IS (q, SEMI_SYMBOL)) + semis++; + else if (IS (q, EXIT_SYMBOL)) + exits++; + } + + if (semis == 0 && exits == 0 && commas > 0) + return COLLATERAL_CLAUSE; + else if ((semis > 0 || exits > 0) && commas == 0) + return SERIAL_CLAUSE; + else if (semis == 0 && exits == 0 && commas == 0) + return SERIAL_CLAUSE; + else + /* Heuristic guess to give intelligible error message. */ + return (semis + exits >= commas) ? SERIAL_CLAUSE : COLLATERAL_CLAUSE; +} + +/* Insert a node with attribute "a" after "p". */ + +static void +pad_node (NODE_T *p, enum a68_attribute a) +{ + /* This is used to fill information that Algol 68 does not require to be + present. Filling in gives one format for such construct; this helps later + passes. */ + NODE_T *z = a68_new_node (); + *z = *p; + if (GINFO (p) != NO_GINFO) + GINFO (z) = a68_new_genie_info (); + PREVIOUS (z) = p; + SUB (z) = NO_NODE; + ATTRIBUTE (z) = a; + MOID (z) = NO_MOID; + if (NEXT (z) != NO_NODE) + PREVIOUS (NEXT (z)) = z; + NEXT (p) = z; +} + +/* Diagnose extensions. */ + +static void +a68_extension (NODE_T *p) +{ + a68_warning (p, OPT_Wextensions, "ast node is an extension"); +} + +/* Diagnose for clauses not yielding a value. */ + +static void +empty_clause (NODE_T *p) +{ + a68_error (p, "clause does not yield a value"); +} + +/* Diagnose for missing symbol. */ + +static void +strange_tokens (NODE_T *p) +{ + NODE_T *q = ((p != NO_NODE && NEXT (p) != NO_NODE) ? NEXT (p) : p); + a68_error (q, "possibly a missing or erroneous symbol nearby"); +} + +/* Diagnose for strange separator. */ + +static void +strange_separator (NODE_T *p) +{ + NODE_T *q = ((p != NO_NODE && NEXT (p) != NO_NODE) ? NEXT (p) : p); + a68_error (q, "possibly a missing or erroneous separator nearby"); +} + +/* If match then reduce a sentence, the core bottom-up parser routine. The + reduction of a sequence of nodes stating at P: + + P - A - B - C - D - E - F + + where the attributes passed to this function are Z P A B C, the result of + the reduction is: + + Z - D - E - F + | + P - A - B - C + + Note how the node pointed by P gets changed after a reduction gets + performed. + + P is the AST node from where start matching. + + ATTRS is a sequence of node attributes. The first of these attributes is + the kind of node resulting from the reduction. The rest of attributes are + the matched in order starting at P, then a reduction is performed. Two node + attributes exist that convey special meaning when passing to "reduce": + + STOP marks the end of the variable-length sequence of attributes to match. + + WILDCARD will match any non terminal, with the exception of a keyword. It + is used to recover from errors. + + A is a "noting" function that is invoked and passed P right before doing the + reduction. If A is NO_NOTE then it is not used. + + The boolean Z is set to "true" if the reduction has been performed, and is + left untouched otherwise. If Z is NO_TICK then it is not used. + + It is common to invoke "reduce" in a row in order to try the reduction of + several alternatives, which are mutually exclusive. For example: + + reduce (p, NO_NOTE, NO_TICK, PARTICULAR_PROGRAM, LABEL, ENCLOSED_CLAUSE, STOP); + reduce (p, NO_NOTE, NO_TICK, PARTICULAR_PROGRAM, ENCLOSED_CLAUSE, STOP); + + We know that at much only one of these reductions will succeed, becuase if + the first reduction succeeds, then P gets changed to LABEL which cannot + match ENCLOSED_CLAUSE. + + Sometimes, however, "reduce" is invoked in a row in a way the second + reduction is intended to succeed if the first one succeeds. For example: + + reduce (p, NO_NOTE, NO_TICK, PARALLEL_CLAUSE, PAR_SYMBOL, COLLATERAL_CLAUSE, STOP); + reduce (p, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, PARALLEL_CLAUSE, STOP); + + In this case if the first reduction succeeds, then the resulting + PARALLEL_CLAUSE will be itself reduced to an ENCLOSED_CLAUSE. + + Another typical usage of "reduce" is to put it in a loop in order to reduce + matches of a left-recursive rule. This is where Z comes to play. For + example, consider the rules: + + label : defining identifier, colon symbol ; + label, defining identifier, colon symbol. + + The second alternative is left-recursive, and along with the first rule + defines a sequence of one or more labels, each label consisting on a + defining identifier followed by a colon symbol. We could match these rules + using the following loop: + + while (siga) + { + siga = false; + reduce (q, NO_NOTE, &siga, LABEL, DEFINING_IDENTIFIER, COLON_SYMBOL, STOP); + reduce (q, NO_NOTE, &siga, LABEL, LABEL, DEFINING_IDENTIFIER, COLON_SYMBOL, STOP); + } + + Note how, when presented with a sequence of labels like `l1: l2: l3: ...', + the first call to "reduce" will succeed, turning Q into a LABEL. Then the + second call to "reduce" will also succed, reducing to another LABEL and + setting SIGA to "true". In subsequent iterations of the loop the first call + will always fail, and the second call will keep succeeding as more sequences + of DEFINING_IDENTIFIER, COLON_SYMBOL get matched. */ + +static void +reduce (NODE_T *p, void (*a) (NODE_T *), bool *z, /* attrs */...) +{ + va_list list; + va_start (list, z); + enum a68_attribute expect; + enum a68_attribute result = (enum a68_attribute) va_arg (list, int); + NODE_T *head = p, *tail = NO_NODE; + + while ((expect = (enum a68_attribute) va_arg (list, int)) != STOP) + { + bool keep_matching; + + if (p == NO_NODE) + keep_matching = false; + else if (expect == WILDCARD) + /* WILDCARD matches any non terminal, but no keyword. */ + keep_matching = (a68_attribute_name (ATTRIBUTE (p)) != NO_TEXT); + else + { + if (expect == SKIP) + { + /* Stray "~" matches expected SKIP. */ + if (IS (p, OPERATOR) && IS_LITERALLY (p, "~")) + ATTRIBUTE (p) = SKIP; + } + + if (expect >= 0) + keep_matching = (expect == ATTRIBUTE (p)); + else + keep_matching = (expect != ATTRIBUTE (p)); + } + + if (keep_matching) + { + tail = p; + FORWARD (p); + } + else + { + va_end (list); + return; + } + } + + /* Make reduction. */ + if (a != NO_NOTE) + a (head); + + a68_make_sub (head, tail, result); + va_end (list); + if (z != NO_TICK) + *z = true; +} + +/* Graciously ignore extra semicolons. */ + +static void +ignore_superfluous_semicolons (NODE_T *p) +{ + /* This routine relaxes the parser a bit with respect to superfluous + semicolons, for instance "FI; OD". These provoke only a warning. */ + for (; p != NO_NODE; FORWARD (p)) + { + ignore_superfluous_semicolons (SUB (p)); + + if (NEXT (p) != NO_NODE && IS (NEXT (p), SEMI_SYMBOL) && NEXT_NEXT (p) == NO_NODE) + { + a68_warning (NEXT (p), 0, + "skipped superfluous A", ATTRIBUTE (NEXT (p))); + NEXT (p) = NO_NODE; + } + else if (IS (p, SEMI_SYMBOL) && a68_is_semicolon_less (NEXT (p))) + { + a68_warning (p, 0, + "skipped superfluous A", ATTRIBUTE (p)); + if (PREVIOUS (p) != NO_NODE) + NEXT (PREVIOUS (p)) = NEXT (p); + PREVIOUS (NEXT (p)) = PREVIOUS (p); + } + } +} + +/* Reduce a particular program. */ + +void +reduce_particular_program (NODE_T *p) +{ + /* A program is "label sequence; particular program". */ + a68_extract_labels (p, SERIAL_CLAUSE); + + NODE_T *q = p; + /* Parse the program itself. */ + for (; q != NO_NODE; FORWARD (q)) + { + bool siga = true; + + if (SUB (q) != NO_NODE) + reduce_branch (q, SOME_CLAUSE); + + while (siga) + { + siga = false; + reduce (q, NO_NOTE, &siga, LABEL, DEFINING_IDENTIFIER, COLON_SYMBOL, STOP); + reduce (q, NO_NOTE, &siga, LABEL, LABEL, DEFINING_IDENTIFIER, COLON_SYMBOL, STOP); + } + } + /* Determine the encompassing enclosed clause. */ + for (q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, PARALLEL_CLAUSE, PAR_SYMBOL, COLLATERAL_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, PARALLEL_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CLOSED_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, COLLATERAL_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONDITIONAL_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CASE_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONFORMITY_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, LOOP_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, ACCESS_CLAUSE, STOP); + } + + /* Try reducing a particular program. */ + q = p; + reduce (q, NO_NOTE, NO_TICK, PARTICULAR_PROGRAM, LABEL, ENCLOSED_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, PARTICULAR_PROGRAM, ENCLOSED_CLAUSE, STOP); +} + +/* Reduce a prelude packet. */ + +void +reduce_prelude_packet (NODE_T *p) +{ + /* Extract the module indicants. */ + a68_extract_indicants (p); + + /* Reduce MODULE_TEXTs */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, ALT_ACCESS_SYMBOL)) + reduce_branch (q, MODULE_TEXT); + else if (IS (q, DEF_SYMBOL)) + { + for (NODE_T *v = q; v != NO_NODE; FORWARD (v)) + { + if (IS (v, DEF_SYMBOL)) + reduce_branch (v, DEF_PART); + else if (IS (v, POSTLUDE_SYMBOL)) + reduce_branch (v, POSTLUDE_PART); + } + reduce_module_texts (q); + } + } + + /* Single module declaration. */ + reduce (p, NO_NOTE, NO_TICK, + MODULE_DECLARATION, MODULE_SYMBOL, DEFINING_MODULE_INDICANT, EQUALS_SYMBOL, MODULE_TEXT, STOP); + reduce (p, strange_tokens, NO_TICK, + MODULE_DECLARATION, MODULE_SYMBOL, DEFINING_MODULE_INDICANT, EQUALS_SYMBOL, -MODULE_TEXT, STOP); + + /* Joined module declarations. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + bool siga; + do + { + siga = false; + reduce (q, NO_NOTE, &siga, + MODULE_DECLARATION, MODULE_DECLARATION, + COMMA_SYMBOL, DEFINING_MODULE_INDICANT, EQUALS_SYMBOL, MODULE_TEXT, STOP); + } + while (siga); + } + + /* Try reducing a prelude packet. */ + reduce (p, NO_NOTE, NO_TICK, PRELUDE_PACKET, MODULE_DECLARATION, STOP); +} + +/* Driver for the bottom-up parser. */ + +void +a68_bottom_up_parser (NODE_T *p) +{ + if (p != NO_NODE) + { + if (!setjmp (A68_PARSER (bottom_up_crash_exit))) + { + NODE_T *q; + int error_count_0 = ERROR_COUNT (&A68_JOB); + + ignore_superfluous_semicolons (p); + + /* A compilation unit is a packet, which can be either a particular + program or a prelude packet. */ + if (IS (p, MODULE_SYMBOL)) + reduce_prelude_packet (p); + else + reduce_particular_program (p); + + /* Try reducing the packet. */ + q = p; + reduce (q, NO_NOTE, NO_TICK, PACKET, PARTICULAR_PROGRAM, STOP); + reduce (q, NO_NOTE, NO_TICK, PACKET, PRELUDE_PACKET, STOP); + if (SUB (p) == NO_NODE || NEXT (p) != NO_NODE) + recover_from_error (p, PACKET, + ((ERROR_COUNT (&A68_JOB) - error_count_0) > MAX_ERRORS)); + } + } +} + +/* Reduce the sub-phrase that starts one level down. + + EXPECT is the expected construct for the sub-phrase, and it is used to guide + the parsing by determining what reductions to try. This can be SOME_CLAUSE, + which means either a serial or a collateral clause. + + This is a recursive process. Let's suppose we have the parse tree below and + we call `reduce_branch (b, EXPECT)': + + a - b - c - d - e + | + b - x - y - z + | + v - w + + The first thing this function does is to traverse the 'b' branch + + b - x - y - z + + looking for declarations of indicants, priorities and operators + (a68_extract_{indicants,priorities,operators}). Using this information , it + determines the nature of bold tags occuring in the branch, by turning + BOLD_TAG nodes into either INDICANT nodes or OPERATOR nodes + (a68_elaborate_bold_tags). + + At this point it is possible to try reduce the declarers within the 'b' + subtree, so reduce_declarers is invoked on it. This function is recursive + and performs reductions of several kinds: sequences of 'long' and 'short' + symbols into sizeties, symbols like 'int' and 'real' into indicants, + declarers, declarer lists, etc. + + Once that is done, the 'p' branch is traversed and reduce_branch is invoked + recursively in certain nodes that start a sub-branch: + + | Recursing in branch | with expect | + |--------------------------------------------------+-------------------| + | FORMAT_DELIMITER_SYMBOL, FORMAT_OPEN_SYMBOL | FORMAT_TEXT | + |--------------------------------------------------+-------------------| + | OPEN_SYMBOL, IN_SYMBOL | COLLATERAL_CLAUSE | + |--------------------------------------------------+-------------------| + | IF_SYMBOL, ELIF_SYMBOL, CASE_SYMBOL, OUSE_SYMBOL | ENQUIRY_CLAUSE | + | WHILE_SYMBOL, ELSE_BAR_SYMBOL, DEF_SYMBOL | | + |--------------------------------------------------+-------------------| + | BEGIN_SYMBOL, THEN_BAR_SYMBOL | SOME_CLAUSE | + |--------------------------------------------------+-------------------| + | THEN_SYMBOL, ELSE_SYMBOL, OUT_SYMBOL | SERIAL_CLAUSE | + | DO_SYMBOL, ALT_DO_SYMBOL, POSTLUDE_SYMBOL | | + |--------------------------------------------------+-------------------| + | LOOP_CLAUSE, ACCESS_SYMBOL | ENCLOSED_CLAUSE | + |--------------------------------------------------+-------------------| + | FOR_SYMBOL, FROM_SYMBOL, BY_SYMBOL, TO_SYMBOL | UNIT | + + Once all the sub-branches are reduced, the final step is to finally reduce + the 'b' branch, trying different possibilities: basic declarations, units, + bounds, declaration lists, clauses, module texts, etc. + + Note that reducing a branch requires knowing the kind of resulting subtree. + So if you find yourself wanting to call reduce_branch and don't know what to + pass in EXPECT, you are probably doing something wrong.. very likely you + want to make reduce_branch aware of a new sort of branch. */ + +static void +reduce_branch (NODE_T *q, enum a68_attribute expect) +{ + /* If unsuccessful then the routine will at least copy the resulting + attribute as the parser can repair some faults. This gives less spurious + diagnostics. */ + if (q != NO_NODE && SUB (q) != NO_NODE) + { + NODE_T *p = SUB (q), *u = NO_NODE; + int error_count_0 = ERROR_COUNT (&A68_JOB), error_count_02; + bool declarer_pack = false, no_error; + + switch (expect) + { + case STRUCTURE_PACK: + case PARAMETER_PACK: + case FORMAL_DECLARERS: + case UNION_PACK: + case SPECIFIER: + declarer_pack = true; + break; + default: + declarer_pack = false; + } + + /* Sample all info needed to decide whether a bold tag is operator or + indicant. Find the meaning of bold tags and quit in case of extra + errors. */ + a68_extract_indicants (p); + if (!declarer_pack) + { + a68_extract_priorities (p); + a68_extract_operators (p); + } + + error_count_02 = ERROR_COUNT (&A68_JOB); + a68_elaborate_bold_tags (p); + if ((ERROR_COUNT (&A68_JOB) - error_count_02) > 0) + longjmp (A68_PARSER (bottom_up_crash_exit), 1); + + /* Now we can reduce declarers, knowing which bold tags are indicants. */ + reduce_declarers (p, expect); + /* Parse the phrase, as appropriate. */ + if (declarer_pack == false) + { + error_count_02 = ERROR_COUNT (&A68_JOB); + a68_extract_declarations (p); + if ((ERROR_COUNT (&A68_JOB) - error_count_02) > 0) + longjmp (A68_PARSER (bottom_up_crash_exit), 1); + a68_extract_labels (p, expect); + for (u = p; u != NO_NODE; FORWARD (u)) + { + if (SUB (u) != NO_NODE) + { + if (IS (u, FORMAT_DELIMITER_SYMBOL)) + reduce_branch (u, FORMAT_TEXT); + else if (IS (u, FORMAT_OPEN_SYMBOL)) + reduce_branch (u, FORMAT_TEXT); + else if (IS (u, OPEN_SYMBOL)) + { + if (NEXT (u) != NO_NODE && IS (NEXT (u), THEN_BAR_SYMBOL)) + reduce_branch (u, ENQUIRY_CLAUSE); + else if (PREVIOUS (u) != NO_NODE && IS (PREVIOUS (u), PAR_SYMBOL)) + reduce_branch (u, COLLATERAL_CLAUSE); + } + else if (a68_is_one_of (u, IF_SYMBOL, ELIF_SYMBOL, CASE_SYMBOL, + OUSE_SYMBOL, WHILE_SYMBOL, + ELSE_BAR_SYMBOL, DEF_PART, STOP)) + reduce_branch (u, ENQUIRY_CLAUSE); + else if (IS (u, BEGIN_SYMBOL)) + reduce_branch (u, SOME_CLAUSE); + else if (a68_is_one_of (u, THEN_SYMBOL, ELSE_SYMBOL, OUT_SYMBOL, + DO_SYMBOL, ALT_DO_SYMBOL, + POSTLUDE_PART, STOP)) + reduce_branch (u, SERIAL_CLAUSE); + else if (IS (u, IN_SYMBOL)) + reduce_branch (u, COLLATERAL_CLAUSE); + else if (IS (u, THEN_BAR_SYMBOL)) + reduce_branch (u, SOME_CLAUSE); + else if (IS (u, ACCESS_SYMBOL)) + reduce_branch (u, ENCLOSED_CLAUSE); + else if (IS (u, DEF_SYMBOL)) + reduce_branch (u, DEF_PART); + else if (IS (u, POSTLUDE_SYMBOL)) + reduce_branch (u, POSTLUDE_PART); + else if (IS (u, LOOP_CLAUSE)) + reduce_branch (u, ENCLOSED_CLAUSE); + else if (a68_is_one_of (u, FOR_SYMBOL, FROM_SYMBOL, BY_SYMBOL, TO_SYMBOL, + STOP)) + reduce_branch (u, UNIT); + } + } + + reduce_primary_parts (p, expect); + if (expect != ENCLOSED_CLAUSE) + { + reduce_primaries (p, expect); + if (expect == FORMAT_TEXT) + reduce_format_texts (p); + else + { + reduce_secondaries (p); + reduce_formulae (p); + reduce_tertiaries (p); + } + } + + reduce_right_to_left_constructs (p); + /* Reduce units and declarations. */ + reduce_basic_declarations (p); + reduce_units (p); + reduce_erroneous_units (p); + if (expect != UNIT) + { + if (expect == GENERIC_ARGUMENT) + reduce_generic_arguments (p); + else if (expect == BOUNDS) + reduce_bounds (p); + else + { + reduce_declaration_lists (p); + if (expect != DECLARATION_LIST) + { + for (u = p; u != NO_NODE; FORWARD (u)) + { + reduce (u, NO_NOTE, NO_TICK, LABELED_UNIT, LABEL, UNIT, STOP); + reduce (u, NO_NOTE, NO_TICK, SPECIFIED_UNIT, SPECIFIER, + COLON_SYMBOL, UNIT, STOP); + } + if (expect == SOME_CLAUSE) + expect = serial_or_collateral (p); + if (expect == SERIAL_CLAUSE) + reduce_serial_clauses (p); + else if (expect == ENQUIRY_CLAUSE) + reduce_enquiry_clauses (p); + else if (expect == COLLATERAL_CLAUSE) + reduce_collateral_clauses (p); + else if (expect == ARGUMENT) + reduce_arguments (p); + } + } + } + reduce_enclosed_clauses (p, expect); + if (expect == DEF_PART || expect == POSTLUDE_PART) + reduce_module_text_parts (p); + if (expect == MODULE_TEXT) + reduce_module_texts (p); + } + + /* Do something if parsing failed. */ + if (SUB (p) == NO_NODE || NEXT (p) != NO_NODE) + { + recover_from_error (p, expect, + ((ERROR_COUNT (&A68_JOB) - error_count_0) > MAX_ERRORS)); + no_error = false; + } + else + no_error = true; + ATTRIBUTE (q) = ATTRIBUTE (p); + if (no_error) + SUB (q) = SUB (p); + } +} + +/* Driver for reducing declarers. */ + +static void +reduce_declarers (NODE_T *p, enum a68_attribute expect) +{ + NODE_T *q; bool siga; /* Must be in this scope. */ + + /* Reduce lengtheties. */ + for (q = p; q != NO_NODE; FORWARD (q)) + { + siga = true; + reduce (q, NO_NOTE, NO_TICK, LONGETY, LONG_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, SHORTETY, SHORT_SYMBOL, STOP); + while (siga) + { + siga = false; + reduce (q, NO_NOTE, &siga, LONGETY, LONGETY, LONG_SYMBOL, STOP); + reduce (q, NO_NOTE, &siga, SHORTETY, SHORTETY, SHORT_SYMBOL, STOP); + } + } + + /* Reduce indicants. */ + for (q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, INDICANT, INT_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, INDICANT, REAL_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, INDICANT, BITS_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, INDICANT, BYTES_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, INDICANT, COMPLEX_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, INDICANT, COMPL_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, INDICANT, BOOL_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, INDICANT, CHAR_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, INDICANT, FORMAT_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, INDICANT, STRING_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, INDICANT, FILE_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, INDICANT, CHANNEL_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, INDICANT, SEMA_SYMBOL, STOP); + } + + /* Reduce standard stuff. */ + for (q = p; q != NO_NODE; FORWARD (q)) + { + if (a68_whether (q, LONGETY, INDICANT, STOP)) + { + int a; + + if (SUB_NEXT (q) == NO_NODE) + { + a68_error (NEXT (q), + "Y expected", "appropriate declarer"); + reduce (q, NO_NOTE, NO_TICK, DECLARER, LONGETY, INDICANT, STOP); + } + else + { + a = ATTRIBUTE (SUB_NEXT (q)); + + if (a == INT_SYMBOL || a == REAL_SYMBOL || a == BITS_SYMBOL + || a == BYTES_SYMBOL || a == COMPLEX_SYMBOL + || a == COMPL_SYMBOL) + { + reduce (q, NO_NOTE, NO_TICK, DECLARER, LONGETY, INDICANT, STOP); + } + else + { + a68_error (NEXT (q), + "Y expected", "appropriate declarer"); + reduce (q, NO_NOTE, NO_TICK, DECLARER, LONGETY, INDICANT, STOP); + } + } + } + else if (a68_whether (q, SHORTETY, INDICANT, STOP)) + { + int a; + + if (SUB_NEXT (q) == NO_NODE) + { + a68_error (NEXT (q), + "Y expected", "appropriate declarer"); + reduce (q, NO_NOTE, NO_TICK, DECLARER, SHORTETY, INDICANT, STOP); + } + else + { + a = ATTRIBUTE (SUB_NEXT (q)); + if (a == INT_SYMBOL || a == REAL_SYMBOL || a == BITS_SYMBOL + || a == BYTES_SYMBOL || a == COMPLEX_SYMBOL || a == COMPL_SYMBOL) + { + reduce (q, NO_NOTE, NO_TICK, DECLARER, SHORTETY, INDICANT, STOP); + } + else + { + a68_error (NEXT (q), + "Y expected", "appropriate declarer"); + reduce (q, NO_NOTE, NO_TICK, DECLARER, LONGETY, INDICANT, STOP); + } + } + } + } + + for (q = p; q != NO_NODE; FORWARD (q)) + reduce (q, NO_NOTE, NO_TICK, DECLARER, INDICANT, STOP); + + /* Reduce declarer lists. */ + for (q = p; q != NO_NODE; FORWARD (q)) + { + if (NEXT (q) != NO_NODE && SUB_NEXT (q) != NO_NODE) + { + if (IS (q, STRUCT_SYMBOL)) + { + reduce_branch (NEXT (q), STRUCTURE_PACK); + reduce (q, NO_NOTE, NO_TICK, DECLARER, STRUCT_SYMBOL, STRUCTURE_PACK, STOP); + } + else if (IS (q, UNION_SYMBOL)) + { + reduce_branch (NEXT (q), UNION_PACK); + reduce (q, NO_NOTE, NO_TICK, DECLARER, UNION_SYMBOL, UNION_PACK, STOP); + } + else if (IS (q, PROC_SYMBOL)) + { + if (a68_whether (q, PROC_SYMBOL, OPEN_SYMBOL, STOP)) + { + if (!a68_is_formal_bounds (SUB_NEXT (q))) + reduce_branch (NEXT (q), FORMAL_DECLARERS); + } + } + else if (IS (q, OP_SYMBOL)) + { + if (a68_whether (q, OP_SYMBOL, OPEN_SYMBOL, STOP)) + { + if (!a68_is_formal_bounds (SUB_NEXT (q))) + reduce_branch (NEXT (q), FORMAL_DECLARERS); + } + } + } + } + + /* Reduce row, proc or op declarers. */ + siga = true; + while (siga) + { + siga = false; + + for (q = p; q != NO_NODE; FORWARD (q)) + { + /* FLEX DECL. */ + if (a68_whether (q, FLEX_SYMBOL, DECLARER, STOP)) + reduce (q, NO_NOTE, &siga, DECLARER, FLEX_SYMBOL, DECLARER, STOP); + + /* FLEX [] DECL. */ + if (a68_whether (q, FLEX_SYMBOL, SUB_SYMBOL, DECLARER, STOP) && SUB_NEXT (q) != NO_NODE) + { + reduce_branch (NEXT (q), BOUNDS); + reduce (q, NO_NOTE, &siga, DECLARER, FLEX_SYMBOL, BOUNDS, DECLARER, STOP); + reduce (q, NO_NOTE, &siga, DECLARER, FLEX_SYMBOL, FORMAL_BOUNDS, DECLARER, STOP); + } + + /* FLEX () DECL. */ + if (a68_whether (q, FLEX_SYMBOL, OPEN_SYMBOL, DECLARER, STOP) && SUB_NEXT (q) != NO_NODE) + { + if (!a68_whether (q, FLEX_SYMBOL, OPEN_SYMBOL, DECLARER, COLON_SYMBOL, STOP)) + { + reduce_branch (NEXT (q), BOUNDS); + reduce (q, NO_NOTE, &siga, DECLARER, FLEX_SYMBOL, BOUNDS, DECLARER, STOP); + reduce (q, NO_NOTE, &siga, DECLARER, FLEX_SYMBOL, FORMAL_BOUNDS, DECLARER, STOP); + } + } + + /* [] DECL. */ + if (a68_whether (q, SUB_SYMBOL, DECLARER, STOP) && SUB (q) != NO_NODE) + { + reduce_branch (q, BOUNDS); + reduce (q, NO_NOTE, &siga, DECLARER, BOUNDS, DECLARER, STOP); + reduce (q, NO_NOTE, &siga, DECLARER, FORMAL_BOUNDS, DECLARER, STOP); + } + + /* () DECL. */ + if (a68_whether (q, OPEN_SYMBOL, DECLARER, STOP) && SUB (q) != NO_NODE) + { + if (a68_whether (q, OPEN_SYMBOL, DECLARER, COLON_SYMBOL, STOP)) + { + /* Catch e.g. (INT i) () INT:. */ + if (a68_is_formal_bounds (SUB (q))) + { + reduce_branch (q, BOUNDS); + reduce (q, NO_NOTE, &siga, DECLARER, BOUNDS, DECLARER, STOP); + reduce (q, NO_NOTE, &siga, DECLARER, FORMAL_BOUNDS, DECLARER, STOP); + } + } + else + { + reduce_branch (q, BOUNDS); + reduce (q, NO_NOTE, &siga, DECLARER, BOUNDS, DECLARER, STOP); + reduce (q, NO_NOTE, &siga, DECLARER, FORMAL_BOUNDS, DECLARER, STOP); + } + } + } + + /* PROC DECL, PROC () DECL, OP () DECL. */ + for (q = p; q != NO_NODE; FORWARD (q)) + { + int a = ATTRIBUTE (q); + if (a == REF_SYMBOL) + reduce (q, NO_NOTE, &siga, DECLARER, REF_SYMBOL, DECLARER, STOP); + else if (a == PROC_SYMBOL) + { + reduce (q, NO_NOTE, &siga, DECLARER, PROC_SYMBOL, DECLARER, STOP); + reduce (q, NO_NOTE, &siga, DECLARER, PROC_SYMBOL, FORMAL_DECLARERS, DECLARER, STOP); + reduce (q, NO_NOTE, &siga, DECLARER, PROC_SYMBOL, VOID_SYMBOL, STOP); + reduce (q, NO_NOTE, &siga, DECLARER, PROC_SYMBOL, FORMAL_DECLARERS, VOID_SYMBOL, STOP); + } + else if (a == OP_SYMBOL) + { + reduce (q, NO_NOTE, &siga, OPERATOR_PLAN, OP_SYMBOL, FORMAL_DECLARERS, DECLARER, STOP); + reduce (q, NO_NOTE, &siga, OPERATOR_PLAN, OP_SYMBOL, FORMAL_DECLARERS, VOID_SYMBOL, STOP); + } + } + } + + /* Reduce packs etcetera. */ + if (expect == STRUCTURE_PACK) + { + for (q = p; q != NO_NODE; FORWARD (q)) + { + siga = true; + while (siga) + { + siga = false; + reduce (q, NO_NOTE, &siga, STRUCTURED_FIELD, DECLARER, IDENTIFIER, STOP); + reduce (q, NO_NOTE, &siga, STRUCTURED_FIELD, STRUCTURED_FIELD, COMMA_SYMBOL, IDENTIFIER, STOP); + } + } + + for (q = p; q != NO_NODE; FORWARD (q)) + { + siga = true; + while (siga) + { + siga = false; + reduce (q, NO_NOTE, &siga, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD, STOP); + reduce (q, NO_NOTE, &siga, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD_LIST, + COMMA_SYMBOL, STRUCTURED_FIELD, STOP); + reduce (q, strange_separator, &siga, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD_LIST, + STRUCTURED_FIELD, STOP); + reduce (q, strange_separator, &siga, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD_LIST, + SEMI_SYMBOL, STRUCTURED_FIELD, STOP); + } + } + q = p; + reduce (q, NO_NOTE, NO_TICK, STRUCTURE_PACK, OPEN_SYMBOL, STRUCTURED_FIELD_LIST, + CLOSE_SYMBOL, STOP); + } + else if (expect == PARAMETER_PACK) + { + for (q = p; q != NO_NODE; FORWARD (q)) + { + siga = true; + while (siga) + { + siga = false; + reduce (q, NO_NOTE, &siga, PARAMETER, DECLARER, IDENTIFIER, STOP); + reduce (q, NO_NOTE, &siga, PARAMETER, PARAMETER, COMMA_SYMBOL, IDENTIFIER, STOP); + } + } + + for (q = p; q != NO_NODE; FORWARD (q)) + { + siga = true; + while (siga) + { + siga = false; + reduce (q, NO_NOTE, &siga, PARAMETER_LIST, PARAMETER, STOP); + reduce (q, NO_NOTE, &siga, PARAMETER_LIST, PARAMETER_LIST, COMMA_SYMBOL, PARAMETER, STOP); + } + } + q = p; + reduce (q, NO_NOTE, NO_TICK, PARAMETER_PACK, OPEN_SYMBOL, PARAMETER_LIST, + CLOSE_SYMBOL, STOP); + } + else if (expect == FORMAL_DECLARERS) + { + for (q = p; q != NO_NODE; FORWARD (q)) + { + siga = true; + while (siga) + { + siga = false; + reduce (q, NO_NOTE, &siga, FORMAL_DECLARERS_LIST, DECLARER, STOP); + reduce (q, NO_NOTE, &siga, FORMAL_DECLARERS_LIST, FORMAL_DECLARERS_LIST, + COMMA_SYMBOL, DECLARER, STOP); + reduce (q, strange_separator, &siga, FORMAL_DECLARERS_LIST, FORMAL_DECLARERS_LIST, + SEMI_SYMBOL, DECLARER, STOP); + reduce (q, strange_separator, &siga, FORMAL_DECLARERS_LIST, FORMAL_DECLARERS_LIST, + DECLARER, STOP); + } + } + q = p; + reduce (q, NO_NOTE, NO_TICK, FORMAL_DECLARERS, OPEN_SYMBOL, FORMAL_DECLARERS_LIST, + CLOSE_SYMBOL, STOP); + } + else if (expect == UNION_PACK) + { + for (q = p; q != NO_NODE; FORWARD (q)) + { + siga = true; + while (siga) + { + siga = false; + reduce (q, NO_NOTE, &siga, UNION_DECLARER_LIST, DECLARER, STOP); + reduce (q, NO_NOTE, &siga, UNION_DECLARER_LIST, VOID_SYMBOL, STOP); + reduce (q, NO_NOTE, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST, + COMMA_SYMBOL, DECLARER, STOP); + reduce (q, NO_NOTE, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST, + COMMA_SYMBOL, VOID_SYMBOL, STOP); + reduce (q, strange_separator, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST, + SEMI_SYMBOL, DECLARER, STOP); + reduce (q, strange_separator, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST, + SEMI_SYMBOL, VOID_SYMBOL, STOP); + reduce (q, strange_separator, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST, + DECLARER, STOP); + reduce (q, strange_separator, &siga, UNION_DECLARER_LIST, UNION_DECLARER_LIST, + VOID_SYMBOL, STOP); + } + } + q = p; + reduce (q, NO_NOTE, NO_TICK, UNION_PACK, OPEN_SYMBOL, UNION_DECLARER_LIST, + CLOSE_SYMBOL, STOP); + } + else if (expect == SPECIFIER) + { + reduce (p, NO_NOTE, NO_TICK, SPECIFIER, OPEN_SYMBOL, DECLARER, IDENTIFIER, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, SPECIFIER, OPEN_SYMBOL, DECLARER, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, SPECIFIER, OPEN_SYMBOL, VOID_SYMBOL, CLOSE_SYMBOL, STOP); + } + else + { + for (q = p; q != NO_NODE; FORWARD (q)) + { + if (a68_whether (q, OPEN_SYMBOL, COLON_SYMBOL, STOP) + && !(expect == GENERIC_ARGUMENT || expect == BOUNDS)) + { + if (a68_is_one_of (p, IN_SYMBOL, THEN_BAR_SYMBOL, STOP)) + reduce_branch (q, SPECIFIER); + } + if (a68_whether (q, OPEN_SYMBOL, DECLARER, COLON_SYMBOL, STOP)) + reduce_branch (q, PARAMETER_PACK); + if (a68_whether (q, OPEN_SYMBOL, VOID_SYMBOL, COLON_SYMBOL, STOP)) + reduce_branch (q, PARAMETER_PACK); + } + } +} + +/* Handle cases that need reducing from right-to-left. */ + +static void +reduce_right_to_left_constructs (NODE_T *p) +{ + /* Here are cases that need reducing from right-to-left whereas many things + can be reduced left-to-right. Assignations are a notable example; one + could discuss whether it would not be more natural to write 1 =: k instead + of k := 1. (jemarch: MARY did just that.) The latter is said to be more + natural, or it could be just computing history. Meanwhile we use this + routine. */ + + if (p != NO_NODE) + { + reduce_right_to_left_constructs (NEXT (p)); + /* Assignations. */ + if (IS (p, TERTIARY)) + { + reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, TERTIARY, STOP); + reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, IDENTITY_RELATION, STOP); + reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, AND_FUNCTION, STOP); + reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, OR_FUNCTION, STOP); + reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, ROUTINE_TEXT, STOP); + reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, JUMP, STOP); + reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, SKIP, STOP); + reduce (p, NO_NOTE, NO_TICK, ASSIGNATION, TERTIARY, ASSIGN_SYMBOL, ASSIGNATION, STOP); + } + + /* Routine texts with parameter pack. */ + else if (IS (p, PARAMETER_PACK)) + { + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, ASSIGNATION, STOP); + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, IDENTITY_RELATION, STOP); + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL,AND_FUNCTION, STOP); + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, OR_FUNCTION, STOP); + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, JUMP, STOP); + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, SKIP, STOP); + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, TERTIARY, STOP); + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, DECLARER, COLON_SYMBOL, ROUTINE_TEXT, STOP); + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, ASSIGNATION, STOP); + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, IDENTITY_RELATION, STOP); + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, AND_FUNCTION, STOP); + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, OR_FUNCTION, STOP); + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, JUMP, STOP); + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, SKIP, STOP); + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, TERTIARY, STOP); + reduce (p, NO_NOTE, NO_TICK, + ROUTINE_TEXT, PARAMETER_PACK, VOID_SYMBOL, COLON_SYMBOL, ROUTINE_TEXT, STOP); + } + /* Routine texts without parameter pack. */ + else if (IS (p, DECLARER)) + { + if (!(PREVIOUS (p) != NO_NODE && IS (PREVIOUS (p), PARAMETER_PACK))) + { + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, ASSIGNATION, STOP); + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, IDENTITY_RELATION, STOP); + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, AND_FUNCTION, STOP); + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, OR_FUNCTION, STOP); + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, JUMP, STOP); + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, SKIP, STOP); + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, TERTIARY, STOP); + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, DECLARER, COLON_SYMBOL, ROUTINE_TEXT, STOP); + } + } + else if (IS (p, VOID_SYMBOL)) + { + if (!(PREVIOUS (p) != NO_NODE && IS (PREVIOUS (p), PARAMETER_PACK))) + { + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, ASSIGNATION, STOP); + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, IDENTITY_RELATION, STOP); + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, AND_FUNCTION, STOP); + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, OR_FUNCTION, STOP); + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, JUMP, STOP); + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, SKIP, STOP); + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, TERTIARY, STOP); + reduce (p, NO_NOTE, NO_TICK, ROUTINE_TEXT, VOID_SYMBOL, COLON_SYMBOL, ROUTINE_TEXT, STOP); + } + } + } +} + +/* Reduce primary elements. */ + +static void +reduce_primary_parts (NODE_T *p, enum a68_attribute expect) +{ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (a68_whether (q, IDENTIFIER, OF_SYMBOL, STOP)) + ATTRIBUTE (q) = FIELD_IDENTIFIER; + + reduce (q, NO_NOTE, NO_TICK, NIHIL, NIL_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, SKIP, SKIP_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, SELECTOR, FIELD_IDENTIFIER, OF_SYMBOL, STOP); + /* JUMPs without GOTO are resolved later. */ + reduce (q, NO_NOTE, NO_TICK, JUMP, GOTO_SYMBOL, IDENTIFIER, STOP); + reduce (q, NO_NOTE, NO_TICK, DENOTATION, LONGETY, INT_DENOTATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DENOTATION, LONGETY, REAL_DENOTATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DENOTATION, LONGETY, BITS_DENOTATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DENOTATION, SHORTETY, INT_DENOTATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DENOTATION, SHORTETY, REAL_DENOTATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DENOTATION, SHORTETY, BITS_DENOTATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DENOTATION, INT_DENOTATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DENOTATION, REAL_DENOTATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DENOTATION, BITS_DENOTATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DENOTATION, ROW_CHAR_DENOTATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DENOTATION, TRUE_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, DENOTATION, FALSE_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, DENOTATION, EMPTY_SYMBOL, STOP); + if (expect == SERIAL_CLAUSE || expect == ENQUIRY_CLAUSE || expect == SOME_CLAUSE) + { + bool siga = true; + while (siga) + { + siga = false; + reduce (q, NO_NOTE, &siga, LABEL, DEFINING_IDENTIFIER, COLON_SYMBOL, STOP); + reduce (q, NO_NOTE, &siga, LABEL, LABEL, DEFINING_IDENTIFIER, COLON_SYMBOL, STOP); + } + } + } + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, PARALLEL_CLAUSE, PAR_SYMBOL, COLLATERAL_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, ACCESS_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, PARALLEL_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CLOSED_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, COLLATERAL_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONDITIONAL_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CASE_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONFORMITY_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, LOOP_CLAUSE, STOP); + } +} + +/* Reduce primaries completely. */ + +static void +reduce_primaries (NODE_T *p, enum a68_attribute expect) +{ + NODE_T *q = p; + while (q != NO_NODE) + { + bool fwd = true, siga; + /* Primaries excepts call and slice. */ + reduce (q, NO_NOTE, NO_TICK, PRIMARY, IDENTIFIER, STOP); + reduce (q, NO_NOTE, NO_TICK, PRIMARY, DENOTATION, STOP); + reduce (q, NO_NOTE, NO_TICK, CAST, DECLARER, ENCLOSED_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, CAST, VOID_SYMBOL, ENCLOSED_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ASSERTION, ASSERT_SYMBOL, ENCLOSED_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, PRIMARY, CAST, STOP); + reduce (q, NO_NOTE, NO_TICK, PRIMARY, ENCLOSED_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, PRIMARY, FORMAT_TEXT, STOP); + /* Call and slice. */ + siga = true; + while (siga) + { + NODE_T *x = NEXT (q); + + siga = false; + if (IS (q, PRIMARY) && x != NO_NODE) + { + if (IS (x, OPEN_SYMBOL)) + { + reduce_branch (NEXT (q), GENERIC_ARGUMENT); + reduce (q, NO_NOTE, &siga, SPECIFICATION, PRIMARY, GENERIC_ARGUMENT, STOP); + reduce (q, NO_NOTE, &siga, PRIMARY, SPECIFICATION, STOP); + } + else if (IS (x, SUB_SYMBOL)) + { + reduce_branch (NEXT (q), GENERIC_ARGUMENT); + reduce (q, NO_NOTE, &siga, SPECIFICATION, PRIMARY, GENERIC_ARGUMENT, STOP); + reduce (q, NO_NOTE, &siga, PRIMARY, SPECIFICATION, STOP); + } + } + } + + /* Now that call and slice are known, reduce remaining ( .. ). */ + if (IS (q, OPEN_SYMBOL) && SUB (q) != NO_NODE) + { + reduce_branch (q, SOME_CLAUSE); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CLOSED_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, COLLATERAL_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONDITIONAL_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CASE_CLAUSE, STOP); + reduce (q, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONFORMITY_CLAUSE, STOP); + if (PREVIOUS (q) != NO_NODE) + { + BACKWARD (q); + fwd = false; + } + } + + /* Format text items. */ + if (expect == FORMAT_TEXT) + { + NODE_T *r; + + for (r = p; r != NO_NODE; FORWARD (r)) + { + reduce (r, NO_NOTE, NO_TICK, DYNAMIC_REPLICATOR, FORMAT_ITEM_N, ENCLOSED_CLAUSE, STOP); + reduce (r, NO_NOTE, NO_TICK, GENERAL_PATTERN, FORMAT_ITEM_G, ENCLOSED_CLAUSE, STOP); + reduce (r, NO_NOTE, NO_TICK, GENERAL_PATTERN, FORMAT_ITEM_H, ENCLOSED_CLAUSE, STOP); + reduce (r, NO_NOTE, NO_TICK, FORMAT_PATTERN, FORMAT_ITEM_F, ENCLOSED_CLAUSE, STOP); + } + } + if (fwd) + FORWARD (q); + } +} + +/* Enforce that ambiguous patterns are separated by commas. */ + +static void +ambiguous_patterns (NODE_T *p) +{ + /* Example: printf (($+d.2d +d.2d$, 1, 2)) can produce either "+1.00 +2.00" + or "+1+002.00". A comma must be supplied to resolve the ambiguity. + + The obvious thing would be to weave this into the syntax, letting the BU + parser sort it out. But the C-style patterns do not suffer from Algol 68 + pattern ambiguity, so by solving it this way we maximise freedom in + writing the patterns as we want without introducing two "kinds" of + patterns, and so we have shorter routines for implementing formatted + transput. This is a pragmatic system. */ + NODE_T *q, *last_pat = NO_NODE; + + for (q = p; q != NO_NODE; FORWARD (q)) + { + switch (ATTRIBUTE (q)) + { + /* These are the potentially ambiguous patterns. */ + case INTEGRAL_PATTERN: + case REAL_PATTERN: + case COMPLEX_PATTERN: + case BITS_PATTERN: + if (last_pat != NO_NODE) + a68_error (q, "A and A must be separated by a comma-symbol", + ATTRIBUTE (last_pat), ATTRIBUTE (q)); + last_pat = q; + break; + case COMMA_SYMBOL: + last_pat = NO_NODE; + break; + default: + break; + } + } +} + +/* Reduce C format texts completely. */ + +static void +reduce_c_pattern (NODE_T *p, int pr, int let) +{ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, let, STOP); + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, FORMAT_ITEM_POINT, REPLICATOR, let, STOP); + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, REPLICATOR, let, STOP); + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, REPLICATOR, FORMAT_ITEM_POINT, REPLICATOR, let, STOP); + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, FORMAT_ITEM_PLUS, let, STOP); + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, FORMAT_ITEM_PLUS, FORMAT_ITEM_POINT, REPLICATOR, let, STOP); + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, FORMAT_ITEM_PLUS, REPLICATOR, let, STOP); + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, FORMAT_ITEM_PLUS, REPLICATOR, FORMAT_ITEM_POINT, REPLICATOR, let, STOP); + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, let, STOP); + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, FORMAT_ITEM_POINT, REPLICATOR, let, STOP); + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, REPLICATOR, let, STOP); + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, REPLICATOR, FORMAT_ITEM_POINT, REPLICATOR, let, STOP); + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, FORMAT_ITEM_PLUS, let, STOP); + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, FORMAT_ITEM_PLUS, FORMAT_ITEM_POINT, REPLICATOR, + let, STOP); + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, FORMAT_ITEM_PLUS, REPLICATOR, let, STOP); + reduce (q, NO_NOTE, NO_TICK, pr, + FORMAT_ITEM_ESCAPE, FORMAT_ITEM_MINUS, FORMAT_ITEM_PLUS, REPLICATOR, FORMAT_ITEM_POINT, + REPLICATOR, let, STOP); + } +} + +/* Reduce format texts completely. */ + +static void +reduce_format_texts (NODE_T *p) +{ + /* Replicators. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, REPLICATOR, STATIC_REPLICATOR, STOP); + reduce (q, NO_NOTE, NO_TICK, REPLICATOR, DYNAMIC_REPLICATOR, STOP); + } + + /* "OTHER" patterns. */ + reduce_c_pattern (p, BITS_C_PATTERN, FORMAT_ITEM_B); + reduce_c_pattern (p, BITS_C_PATTERN, FORMAT_ITEM_O); + reduce_c_pattern (p, BITS_C_PATTERN, FORMAT_ITEM_X); + reduce_c_pattern (p, CHAR_C_PATTERN, FORMAT_ITEM_C); + reduce_c_pattern (p, FIXED_C_PATTERN, FORMAT_ITEM_F); + reduce_c_pattern (p, FLOAT_C_PATTERN, FORMAT_ITEM_E); + reduce_c_pattern (p, GENERAL_C_PATTERN, FORMAT_ITEM_G); + reduce_c_pattern (p, INTEGRAL_C_PATTERN, FORMAT_ITEM_D); + reduce_c_pattern (p, INTEGRAL_C_PATTERN, FORMAT_ITEM_I); + reduce_c_pattern (p, STRING_C_PATTERN, FORMAT_ITEM_S); + /* Radix frames. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + reduce (q, NO_NOTE, NO_TICK, RADIX_FRAME, REPLICATOR, FORMAT_ITEM_R, STOP); + + /* Insertions. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_X, STOP); + reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_Y, STOP); + reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_L, STOP); + reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_P, STOP); + reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_Q, STOP); + reduce (q, NO_NOTE, NO_TICK, INSERTION, FORMAT_ITEM_K, STOP); + reduce (q, NO_NOTE, NO_TICK, INSERTION, LITERAL, STOP); + } + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, INSERTION, REPLICATOR, INSERTION, STOP); + } + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + bool siga = true; + while (siga) + { + siga = false; + reduce (q, NO_NOTE, &siga, INSERTION, INSERTION, INSERTION, STOP); + } + } + + /* Replicated suppressible frames. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, FORMAT_A_FRAME, REPLICATOR, FORMAT_ITEM_S, FORMAT_ITEM_A, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_Z_FRAME, REPLICATOR, FORMAT_ITEM_S, FORMAT_ITEM_Z, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_D_FRAME, REPLICATOR, FORMAT_ITEM_S, FORMAT_ITEM_D, STOP); + } + + /* Suppressible frames. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, FORMAT_A_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_A, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_Z_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_Z, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_D_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_D, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_E_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_E, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_POINT_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_POINT, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_I_FRAME, FORMAT_ITEM_S, FORMAT_ITEM_I, STOP); + } + + /* Replicated frames. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, FORMAT_A_FRAME, REPLICATOR, FORMAT_ITEM_A, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_Z_FRAME, REPLICATOR, FORMAT_ITEM_Z, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_D_FRAME, REPLICATOR, FORMAT_ITEM_D, STOP); + } + + /* Frames. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, FORMAT_A_FRAME, FORMAT_ITEM_A, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_Z_FRAME, FORMAT_ITEM_Z, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_D_FRAME, FORMAT_ITEM_D, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_E_FRAME, FORMAT_ITEM_E, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_POINT_FRAME, FORMAT_ITEM_POINT, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_I_FRAME, FORMAT_ITEM_I, STOP); + } + + /* Frames with an insertion. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, FORMAT_A_FRAME, INSERTION, FORMAT_A_FRAME, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_Z_FRAME, INSERTION, FORMAT_Z_FRAME, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_D_FRAME, INSERTION, FORMAT_D_FRAME, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_E_FRAME, INSERTION, FORMAT_E_FRAME, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_POINT_FRAME, INSERTION, FORMAT_POINT_FRAME, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAT_I_FRAME, INSERTION, FORMAT_I_FRAME, STOP); + } + + /* String patterns. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + reduce (q, NO_NOTE, NO_TICK, STRING_PATTERN, REPLICATOR, FORMAT_A_FRAME, STOP); + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + reduce (q, NO_NOTE, NO_TICK, STRING_PATTERN, FORMAT_A_FRAME, STOP); + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + bool siga = true; + while (siga) + { + siga = false; + reduce (q, NO_NOTE, &siga, STRING_PATTERN, STRING_PATTERN, STRING_PATTERN, STOP); + reduce (q, NO_NOTE, &siga, STRING_PATTERN, STRING_PATTERN, INSERTION, STRING_PATTERN, STOP); + } + } + + /* Integral moulds. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, INTEGRAL_MOULD, FORMAT_Z_FRAME, STOP); + reduce (q, NO_NOTE, NO_TICK, INTEGRAL_MOULD, FORMAT_D_FRAME, STOP); + } + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + bool siga = true; + while (siga) + { + siga = false; + reduce (q, NO_NOTE, &siga, INTEGRAL_MOULD, INTEGRAL_MOULD, INTEGRAL_MOULD, STOP); + reduce (q, NO_NOTE, &siga, INTEGRAL_MOULD, INTEGRAL_MOULD, INSERTION, STOP); + } + } + + /* Sign moulds. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_ITEM_PLUS, STOP); + reduce (q, NO_NOTE, NO_TICK, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_ITEM_MINUS, STOP); + } + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, SIGN_MOULD, FORMAT_ITEM_PLUS, STOP); + reduce (q, NO_NOTE, NO_TICK, SIGN_MOULD, FORMAT_ITEM_MINUS, STOP); + } + + /* Exponent frames. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, EXPONENT_FRAME, FORMAT_E_FRAME, SIGN_MOULD, INTEGRAL_MOULD, STOP); + reduce (q, NO_NOTE, NO_TICK, EXPONENT_FRAME, FORMAT_E_FRAME, INTEGRAL_MOULD, STOP); + } + + /* Real patterns. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, + REAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, EXPONENT_FRAME, + STOP); + reduce (q, NO_NOTE, NO_TICK, + REAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, STOP); + reduce (q, NO_NOTE, NO_TICK, + REAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_POINT_FRAME, EXPONENT_FRAME, STOP); + reduce (q, NO_NOTE, NO_TICK, + REAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, FORMAT_POINT_FRAME, STOP); + } + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, + REAL_PATTERN, SIGN_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, EXPONENT_FRAME, STOP); + reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, STOP); + reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, FORMAT_POINT_FRAME, EXPONENT_FRAME, STOP); + reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, FORMAT_POINT_FRAME, STOP); + } + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, + REAL_PATTERN, INTEGRAL_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, EXPONENT_FRAME, STOP); + reduce (q, NO_NOTE, NO_TICK, + REAL_PATTERN, INTEGRAL_MOULD, FORMAT_POINT_FRAME, INTEGRAL_MOULD, STOP); + reduce (q, NO_NOTE, NO_TICK, + REAL_PATTERN, INTEGRAL_MOULD, FORMAT_POINT_FRAME, EXPONENT_FRAME, STOP); + reduce (q, NO_NOTE, NO_TICK, + REAL_PATTERN, INTEGRAL_MOULD, FORMAT_POINT_FRAME, STOP); + reduce (q, NO_NOTE, NO_TICK, + REAL_PATTERN, FORMAT_POINT_FRAME, INTEGRAL_MOULD, EXPONENT_FRAME, STOP); + reduce (q, NO_NOTE, NO_TICK, + REAL_PATTERN, FORMAT_POINT_FRAME, INTEGRAL_MOULD, STOP); + } + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, EXPONENT_FRAME, STOP); + reduce (q, NO_NOTE, NO_TICK, REAL_PATTERN, INTEGRAL_MOULD, EXPONENT_FRAME, STOP); + } + + /* Complex patterns. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + reduce (q, NO_NOTE, NO_TICK, COMPLEX_PATTERN, REAL_PATTERN, FORMAT_I_FRAME, REAL_PATTERN, STOP); + + /* Bits patterns. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + reduce (q, NO_NOTE, NO_TICK, BITS_PATTERN, RADIX_FRAME, INTEGRAL_MOULD, STOP); + + /* Integral patterns. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, INTEGRAL_PATTERN, SIGN_MOULD, INTEGRAL_MOULD, STOP); + reduce (q, NO_NOTE, NO_TICK, INTEGRAL_PATTERN, INTEGRAL_MOULD, STOP); + } + + /* Patterns. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, BOOLEAN_PATTERN, FORMAT_ITEM_B, COLLECTION, STOP); + reduce (q, NO_NOTE, NO_TICK, CHOICE_PATTERN, FORMAT_ITEM_C, COLLECTION, STOP); + } + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, BOOLEAN_PATTERN, FORMAT_ITEM_B, STOP); + reduce (q, NO_NOTE, NO_TICK, GENERAL_PATTERN, FORMAT_ITEM_G, STOP); + reduce (q, NO_NOTE, NO_TICK, GENERAL_PATTERN, FORMAT_ITEM_H, STOP); + } + + ambiguous_patterns (p); + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, a68_extension, NO_TICK, A68_PATTERN, BITS_C_PATTERN, STOP); + reduce (q, a68_extension, NO_TICK, A68_PATTERN, CHAR_C_PATTERN, STOP); + reduce (q, a68_extension, NO_TICK, A68_PATTERN, FIXED_C_PATTERN, STOP); + reduce (q, a68_extension, NO_TICK, A68_PATTERN, FLOAT_C_PATTERN, STOP); + reduce (q, a68_extension, NO_TICK, A68_PATTERN, GENERAL_C_PATTERN, STOP); + reduce (q, a68_extension, NO_TICK, A68_PATTERN, INTEGRAL_C_PATTERN, STOP); + reduce (q, a68_extension, NO_TICK, A68_PATTERN, STRING_C_PATTERN, STOP); + reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, BITS_PATTERN, STOP); + reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, BOOLEAN_PATTERN, STOP); + reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, CHOICE_PATTERN, STOP); + reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, COMPLEX_PATTERN, STOP); + reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, FORMAT_PATTERN, STOP); + reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, GENERAL_PATTERN, STOP); + reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, INTEGRAL_PATTERN, STOP); + reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, REAL_PATTERN, STOP); + reduce (q, NO_NOTE, NO_TICK, A68_PATTERN, STRING_PATTERN, STOP); + } + + /* Pictures. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, PICTURE, INSERTION, STOP); + reduce (q, NO_NOTE, NO_TICK, PICTURE, A68_PATTERN, STOP); + reduce (q, NO_NOTE, NO_TICK, PICTURE, COLLECTION, STOP); + reduce (q, NO_NOTE, NO_TICK, PICTURE, REPLICATOR, COLLECTION, STOP); + } + + /* Picture lists. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, PICTURE)) + { + bool siga = true; + reduce (q, NO_NOTE, NO_TICK, PICTURE_LIST, PICTURE, STOP); + while (siga) + { + siga = false; + reduce (q, NO_NOTE, &siga, PICTURE_LIST, PICTURE_LIST, COMMA_SYMBOL, PICTURE, STOP); + /* We filtered ambiguous patterns, so commas may be omitted */ + reduce (q, NO_NOTE, &siga, PICTURE_LIST, PICTURE_LIST, PICTURE, STOP); + } + } + } +} + +/* Reduce secondaries completely. */ + +static void +reduce_secondaries (NODE_T *p) +{ + NODE_T *q; bool siga; + + for (q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, SECONDARY, PRIMARY, STOP); + reduce (q, NO_NOTE, NO_TICK, GENERATOR, LOC_SYMBOL, DECLARER, STOP); + reduce (q, NO_NOTE, NO_TICK, GENERATOR, HEAP_SYMBOL, DECLARER, STOP); + reduce (q, NO_NOTE, NO_TICK, SECONDARY, GENERATOR, STOP); + } + siga = true; + while (siga) + { + siga = false; + for (q = p; NEXT (q) != NO_NODE; FORWARD (q)) + ; + for (; q != NO_NODE; BACKWARD (q)) + { + reduce (q, NO_NOTE, &siga, SELECTION, SELECTOR, SECONDARY, STOP); + reduce (q, NO_NOTE, &siga, SECONDARY, SELECTION, STOP); + } + } +} + +/* Whether Q is an operator with priority K. */ + +static int +operator_with_priority (NODE_T *q, int k) +{ + return NEXT (q) != NO_NODE + && ATTRIBUTE (NEXT (q)) == OPERATOR && PRIO (INFO (NEXT (q))) == k; +} + +/* Reduce formulae. */ + +static void +reduce_formulae (NODE_T * p) +{ + NODE_T *q = p; + + while (q != NO_NODE) + { + if (a68_is_one_of (q, OPERATOR, SECONDARY, STOP)) + q = reduce_dyadic (q, STOP); + else + FORWARD (q); + } + + /* Reduce the expression. */ + for (int prio = MAX_PRIORITY; prio >= 0; prio--) + { + for (q = p; q != NO_NODE; FORWARD (q)) + { + if (operator_with_priority (q, prio)) + { + bool siga = false; + NODE_T *op = NEXT (q); + if (IS (q, SECONDARY)) + { + reduce (q, NO_NOTE, &siga, FORMULA, SECONDARY, OPERATOR, SECONDARY, STOP); + reduce (q, NO_NOTE, &siga, FORMULA, SECONDARY, OPERATOR, MONADIC_FORMULA, STOP); + reduce (q, NO_NOTE, &siga, FORMULA, SECONDARY, OPERATOR, FORMULA, STOP); + } + else if (IS (q, MONADIC_FORMULA)) + { + reduce (q, NO_NOTE, &siga, FORMULA, MONADIC_FORMULA, OPERATOR, SECONDARY, STOP); + reduce (q, NO_NOTE, &siga, FORMULA, MONADIC_FORMULA, OPERATOR, MONADIC_FORMULA, STOP); + reduce (q, NO_NOTE, &siga, FORMULA, MONADIC_FORMULA, OPERATOR, FORMULA, STOP); + } + if (prio == 0 && siga) + a68_error (op, "S has no priority declaration"); + siga = true; + while (siga) + { + NODE_T *op2 = NEXT (q); + siga = false; + if (operator_with_priority (q, prio)) + reduce (q, NO_NOTE, &siga, FORMULA, FORMULA, OPERATOR, SECONDARY, STOP); + if (operator_with_priority (q, prio)) + reduce (q, NO_NOTE, &siga, FORMULA, FORMULA, OPERATOR, MONADIC_FORMULA, STOP); + if (operator_with_priority (q, prio)) + reduce (q, NO_NOTE, &siga, FORMULA, FORMULA, OPERATOR, FORMULA, STOP); + if (prio == 0 && siga) + a68_error (op2, "S has no priority declaration"); + } + } + } + } +} + +/* Reduce dyadic expressions. */ + +static NODE_T * +reduce_dyadic (NODE_T *p, int u) +{ + /* We work inside out - higher priority expressions get reduced first. */ + if (u > MAX_PRIORITY) + { + if (p == NO_NODE) + return NO_NODE; + else if (IS (p, OPERATOR)) + { + /* Reduce monadic formulas. */ + NODE_T *q = p; + bool siga; + do + { + PRIO (INFO (q)) = 10; + siga = ((NEXT (q) != NO_NODE) && (IS (NEXT (q), OPERATOR))); + if (siga) + FORWARD (q); + } + while (siga); + reduce (q, NO_NOTE, NO_TICK, MONADIC_FORMULA, OPERATOR, SECONDARY, STOP); + while (q != p) + { + BACKWARD (q); + reduce (q, NO_NOTE, NO_TICK, MONADIC_FORMULA, OPERATOR, MONADIC_FORMULA, STOP); + } + } + FORWARD (p); + } + else + { + p = reduce_dyadic (p, u + 1); + while (p != NO_NODE && IS (p, OPERATOR) && PRIO (INFO (p)) == u) + { + FORWARD (p); + p = reduce_dyadic (p, u + 1); + } + } + return p; +} + +/* Reduce tertiaries completely. */ + +static void +reduce_tertiaries (NODE_T *p) +{ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, TERTIARY, NIHIL, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMULA, MONADIC_FORMULA, STOP); + reduce (q, NO_NOTE, NO_TICK, TERTIARY, FORMULA, STOP); + reduce (q, NO_NOTE, NO_TICK, TERTIARY, SECONDARY, STOP); + } + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, IDENTITY_RELATION, TERTIARY, IS_SYMBOL, TERTIARY, STOP); + reduce (q, NO_NOTE, NO_TICK, IDENTITY_RELATION, TERTIARY, ISNT_SYMBOL, TERTIARY, STOP); + } + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, AND_FUNCTION, TERTIARY, ANDF_SYMBOL, TERTIARY, STOP); + reduce (q, NO_NOTE, NO_TICK, OR_FUNCTION, TERTIARY, ORF_SYMBOL, TERTIARY, STOP); + } +} + +/* Reduce units. */ + +static void +reduce_units (NODE_T * p) +{ + /* Stray ~ is a SKIP. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, OPERATOR) && IS_LITERALLY (q, "~")) + ATTRIBUTE (q) = SKIP; + } + + /* Reduce units. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, UNIT, ASSIGNATION, STOP); + reduce (q, NO_NOTE, NO_TICK, UNIT, IDENTITY_RELATION, STOP); + reduce (q, a68_extension, NO_TICK, UNIT, AND_FUNCTION, STOP); + reduce (q, a68_extension, NO_TICK, UNIT, OR_FUNCTION, STOP); + reduce (q, NO_NOTE, NO_TICK, UNIT, ROUTINE_TEXT, STOP); + reduce (q, NO_NOTE, NO_TICK, UNIT, JUMP, STOP); + reduce (q, NO_NOTE, NO_TICK, UNIT, SKIP, STOP); + reduce (q, NO_NOTE, NO_TICK, UNIT, TERTIARY, STOP); + reduce (q, NO_NOTE, NO_TICK, UNIT, ASSERTION, STOP); + } +} + +/* Reduce_generic arguments. */ + +static void +reduce_generic_arguments (NODE_T *p) +{ + NODE_T *q; bool siga; /* In this scope. */ + + for (q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, UNIT)) + { + reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, COLON_SYMBOL, UNIT, AT_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, COLON_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, COLON_SYMBOL, AT_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, COLON_SYMBOL, STOP); + } + else if (IS (q, COLON_SYMBOL)) + { + reduce (q, NO_NOTE, NO_TICK, TRIMMER, COLON_SYMBOL, UNIT, AT_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, TRIMMER, COLON_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, TRIMMER, COLON_SYMBOL, AT_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, TRIMMER, COLON_SYMBOL, STOP); + } + } + + for (q = p; q != NO_NODE; FORWARD (q)) + reduce (q, NO_NOTE, NO_TICK, TRIMMER, UNIT, AT_SYMBOL, UNIT, STOP); + for (q = p; q != NO_NODE; FORWARD (q)) + reduce (q, NO_NOTE, NO_TICK, TRIMMER, AT_SYMBOL, UNIT, STOP); + for (q = p; q && NEXT (q); FORWARD (q)) + { + if (IS (q, COMMA_SYMBOL)) + { + if (!(ATTRIBUTE (NEXT (q)) == UNIT || ATTRIBUTE (NEXT (q)) == TRIMMER)) + pad_node (q, TRIMMER); + } + else + { + if (IS (NEXT (q), COMMA_SYMBOL)) + { + if (!IS (q, UNIT) && !IS (q, TRIMMER)) + pad_node (q, TRIMMER); + } + } + } + + q = NEXT (p); + if (q == NO_NODE) + gcc_unreachable (); + reduce (q, NO_NOTE, NO_TICK, GENERIC_ARGUMENT_LIST, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, GENERIC_ARGUMENT_LIST, TRIMMER, STOP); + do + { + siga = false; + reduce (q, NO_NOTE, &siga, GENERIC_ARGUMENT_LIST, GENERIC_ARGUMENT_LIST, COMMA_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, &siga, GENERIC_ARGUMENT_LIST, GENERIC_ARGUMENT_LIST, COMMA_SYMBOL, TRIMMER, STOP); + reduce (q, strange_separator, &siga, GENERIC_ARGUMENT_LIST, GENERIC_ARGUMENT_LIST, UNIT, STOP); + reduce (q, strange_separator, &siga, GENERIC_ARGUMENT_LIST, GENERIC_ARGUMENT_LIST, TRIMMER, STOP); + } + while (siga); +} + +/* Reduce bounds. */ + +static void +reduce_bounds (NODE_T *p) +{ + NODE_T *q; bool siga; + + for (q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, BOUND, UNIT, COLON_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, BOUND, UNIT, STOP); + } + q = NEXT (p); + reduce (q, NO_NOTE, NO_TICK, BOUNDS_LIST, BOUND, STOP); + reduce (q, NO_NOTE, NO_TICK, FORMAL_BOUNDS_LIST, COMMA_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, ALT_FORMAL_BOUNDS_LIST, COLON_SYMBOL, STOP); + do + { + siga = false; + reduce (q, NO_NOTE, &siga, BOUNDS_LIST, BOUNDS_LIST, COMMA_SYMBOL, BOUND, STOP); + reduce (q, NO_NOTE, &siga, FORMAL_BOUNDS_LIST, FORMAL_BOUNDS_LIST, COMMA_SYMBOL, STOP); + reduce (q, NO_NOTE, &siga, ALT_FORMAL_BOUNDS_LIST, FORMAL_BOUNDS_LIST, COLON_SYMBOL, STOP); + reduce (q, NO_NOTE, &siga, FORMAL_BOUNDS_LIST, ALT_FORMAL_BOUNDS_LIST, COMMA_SYMBOL, STOP); + reduce (q, strange_separator, &siga, BOUNDS_LIST, BOUNDS_LIST, BOUND, STOP); + } + while (siga); +} + +/* Reduce argument packs. */ + +static void +reduce_arguments (NODE_T *p) +{ + if (NEXT (p) != NO_NODE) + { + NODE_T *q = NEXT (p); + bool siga; + reduce (q, NO_NOTE, NO_TICK, ARGUMENT_LIST, UNIT, STOP); + do + { + siga = false; + reduce (q, NO_NOTE, &siga, ARGUMENT_LIST, ARGUMENT_LIST, COMMA_SYMBOL, UNIT, STOP); + reduce (q, strange_separator, &siga, ARGUMENT_LIST, ARGUMENT_LIST, UNIT, STOP); + } + while (siga); + } +} + +/* Reduce declarations. */ + +static void +reduce_basic_declarations (NODE_T *p) +{ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + /* Publicized declarations. */ + reduce (q, NO_NOTE, NO_TICK, + PRIORITY_DECLARATION, PUBLIC_SYMBOL, + PRIO_SYMBOL, DEFINING_OPERATOR, EQUALS_SYMBOL, PRIORITY, STOP); + reduce (q, NO_NOTE, NO_TICK, + MODE_DECLARATION, PUBLIC_SYMBOL, + MODE_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, DECLARER, STOP); + reduce (q, NO_NOTE, NO_TICK, + MODE_DECLARATION, PUBLIC_SYMBOL, + MODE_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, VOID_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, + PROCEDURE_DECLARATION, PUBLIC_SYMBOL, + PROC_SYMBOL, DEFINING_IDENTIFIER, EQUALS_SYMBOL, ROUTINE_TEXT, STOP); + reduce (q, NO_NOTE, NO_TICK, + PROCEDURE_VARIABLE_DECLARATION, PUBLIC_SYMBOL, + PROC_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, ROUTINE_TEXT, + STOP); + reduce (q, NO_NOTE, NO_TICK, + PROCEDURE_VARIABLE_DECLARATION, PUBLIC_SYMBOL, + QUALIFIER, PROC_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, + ROUTINE_TEXT, STOP); + reduce (q, NO_NOTE, NO_TICK, + BRIEF_OPERATOR_DECLARATION, PUBLIC_SYMBOL, + OP_SYMBOL, DEFINING_OPERATOR, EQUALS_SYMBOL, ROUTINE_TEXT, STOP); + + reduce (q, NO_NOTE, NO_TICK, + PRIORITY_DECLARATION, PRIO_SYMBOL, DEFINING_OPERATOR, EQUALS_SYMBOL, PRIORITY, STOP); + reduce (q, NO_NOTE, NO_TICK, + MODE_DECLARATION, MODE_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, DECLARER, STOP); + reduce (q, NO_NOTE, NO_TICK, + MODE_DECLARATION, MODE_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, VOID_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, + PROCEDURE_DECLARATION, PROC_SYMBOL, DEFINING_IDENTIFIER, EQUALS_SYMBOL, ROUTINE_TEXT, STOP); + reduce (q, NO_NOTE, NO_TICK, + PROCEDURE_VARIABLE_DECLARATION, PROC_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, ROUTINE_TEXT, + STOP); + reduce (q, NO_NOTE, NO_TICK, + PROCEDURE_VARIABLE_DECLARATION, QUALIFIER, PROC_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, + ROUTINE_TEXT, STOP); + reduce (q, NO_NOTE, NO_TICK, + BRIEF_OPERATOR_DECLARATION, OP_SYMBOL, DEFINING_OPERATOR, EQUALS_SYMBOL, ROUTINE_TEXT, STOP); +#if 0 + /* XXX for local module definitions */ + reduce (q, NO_NOTE, NO_TICK, + MODULE_DECLARATION, MODULE_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, MODULE_TEXT, STOP); +#endif + /* Errors. */ + reduce (q, strange_tokens, NO_TICK, + PRIORITY_DECLARATION, PRIO_SYMBOL, -DEFINING_OPERATOR, -EQUALS_SYMBOL, -PRIORITY, STOP); + reduce (q, strange_tokens, NO_TICK, + MODE_DECLARATION, MODE_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, -DECLARER, STOP); + reduce (q, strange_tokens, NO_TICK, + PROCEDURE_DECLARATION, PROC_SYMBOL, DEFINING_IDENTIFIER, EQUALS_SYMBOL, -ROUTINE_TEXT, STOP); + reduce (q, strange_tokens, NO_TICK, + PROCEDURE_VARIABLE_DECLARATION, PROC_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, -ROUTINE_TEXT, + STOP); + reduce (q, strange_tokens, NO_TICK, + PROCEDURE_VARIABLE_DECLARATION, QUALIFIER, PROC_SYMBOL, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, + -ROUTINE_TEXT, STOP); + reduce (q, strange_tokens, NO_TICK, + BRIEF_OPERATOR_DECLARATION, OP_SYMBOL, DEFINING_OPERATOR, EQUALS_SYMBOL, -ROUTINE_TEXT, STOP); +#if 0 + /* XXX for local module definitions */ + reduce (q, strange_tokens, NO_TICK, + MODULE_DECLARATION, MODULE_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, -MODULE_TEXT, STOP); +#endif + /* Errors. WILDCARD catches TERTIARY which catches IDENTIFIER. */ + reduce (q, strange_tokens, NO_TICK, PROCEDURE_DECLARATION, PROC_SYMBOL, WILDCARD, ROUTINE_TEXT, STOP); + } + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + bool siga; + do + { + siga = false; + reduce (q, NO_NOTE, &siga, + PRIORITY_DECLARATION, PRIORITY_DECLARATION, COMMA_SYMBOL, DEFINING_OPERATOR, + EQUALS_SYMBOL, PRIORITY, STOP); + reduce (q, NO_NOTE, &siga, + MODE_DECLARATION, MODE_DECLARATION, COMMA_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, + DECLARER, STOP); + reduce (q, NO_NOTE, &siga, + MODE_DECLARATION, MODE_DECLARATION, COMMA_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, + VOID_SYMBOL, STOP); + reduce (q, NO_NOTE, &siga, + PROCEDURE_DECLARATION, PROCEDURE_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER, + EQUALS_SYMBOL, ROUTINE_TEXT, STOP); + reduce (q, NO_NOTE, &siga, + PROCEDURE_VARIABLE_DECLARATION, PROCEDURE_VARIABLE_DECLARATION, COMMA_SYMBOL, + DEFINING_IDENTIFIER, ASSIGN_SYMBOL, ROUTINE_TEXT, STOP); + reduce (q, NO_NOTE, &siga, + BRIEF_OPERATOR_DECLARATION, BRIEF_OPERATOR_DECLARATION, COMMA_SYMBOL, + DEFINING_OPERATOR, EQUALS_SYMBOL, ROUTINE_TEXT, STOP); +#if 0 + /* XXX for local module definitions */ + reduce (q, NO_NOTE, &siga, + MODULE_DECLARATION, MODULE_DECLARATION, COMMA_SYMBOL, DEFINING_INDICANT, EQUALS_SYMBOL, + MODULE_TEXT, STOP); +#endif + /* Errors. WILDCARD catches TERTIARY which catches IDENTIFIER. */ + reduce (q, strange_tokens, &siga, + PROCEDURE_DECLARATION, PROCEDURE_DECLARATION, COMMA_SYMBOL, WILDCARD, ROUTINE_TEXT, STOP); + } + while (siga); + } +} + +/* Reduce declaration lists. */ + +static void +reduce_declaration_lists (NODE_T *p) +{ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, + IDENTITY_DECLARATION, PUBLIC_SYMBOL, + DECLARER, DEFINING_IDENTIFIER, EQUALS_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, + VARIABLE_DECLARATION, PUBLIC_SYMBOL, + QUALIFIER, DECLARER, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, + VARIABLE_DECLARATION, PUBLIC_SYMBOL, + QUALIFIER, DECLARER, DEFINING_IDENTIFIER, STOP); + reduce (q, NO_NOTE, NO_TICK, + VARIABLE_DECLARATION, PUBLIC_SYMBOL, + DECLARER, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, + VARIABLE_DECLARATION, PUBLIC_SYMBOL, + DECLARER, DEFINING_IDENTIFIER, STOP); + + reduce (q, NO_NOTE, NO_TICK, + IDENTITY_DECLARATION, DECLARER, DEFINING_IDENTIFIER, EQUALS_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, + VARIABLE_DECLARATION, QUALIFIER, DECLARER, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, + VARIABLE_DECLARATION, QUALIFIER, DECLARER, DEFINING_IDENTIFIER, STOP); + reduce (q, NO_NOTE, NO_TICK, + VARIABLE_DECLARATION, DECLARER, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, + VARIABLE_DECLARATION, DECLARER, DEFINING_IDENTIFIER, STOP); + } + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + bool siga; + do + { + siga = false; + reduce (q, NO_NOTE, &siga, + IDENTITY_DECLARATION, IDENTITY_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER, + EQUALS_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, &siga, + VARIABLE_DECLARATION, VARIABLE_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER, + ASSIGN_SYMBOL, UNIT, STOP); + if (!a68_whether (q, VARIABLE_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER, + ASSIGN_SYMBOL, UNIT, STOP)) + reduce (q, NO_NOTE, &siga, + VARIABLE_DECLARATION, VARIABLE_DECLARATION, COMMA_SYMBOL, DEFINING_IDENTIFIER, STOP); + } + while (siga); + } + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, + OPERATOR_DECLARATION, PUBLIC_SYMBOL, + OPERATOR_PLAN, DEFINING_OPERATOR, EQUALS_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, + OPERATOR_DECLARATION, OPERATOR_PLAN, DEFINING_OPERATOR, EQUALS_SYMBOL, UNIT, STOP); + } + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + bool siga; + do + { + siga = false; + reduce (q, NO_NOTE, &siga, + OPERATOR_DECLARATION, OPERATOR_DECLARATION, COMMA_SYMBOL, DEFINING_OPERATOR, + EQUALS_SYMBOL, UNIT, STOP); + } + while (siga); + } + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, MODE_DECLARATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, PRIORITY_DECLARATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, BRIEF_OPERATOR_DECLARATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, OPERATOR_DECLARATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, IDENTITY_DECLARATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, PROCEDURE_DECLARATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, PROCEDURE_VARIABLE_DECLARATION, STOP); + reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, VARIABLE_DECLARATION, STOP); +#if 0 + /* XXX for local module definitions */ + reduce (q, NO_NOTE, NO_TICK, DECLARATION_LIST, MODULE_DECLARATION, STOP); +#endif + } + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + bool siga; + do + { + siga = false; + reduce (q, NO_NOTE, &siga, + DECLARATION_LIST, DECLARATION_LIST, COMMA_SYMBOL, DECLARATION_LIST, STOP); + } + while (siga); + } +} + +/* Reduce module text. */ + +static void +reduce_module_texts (NODE_T *p) +{ + if (IS (p, ALT_ACCESS_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, + REVELATION, ALT_ACCESS_SYMBOL, PUBLIC_SYMBOL, MODULE_INDICANT, STOP); + reduce (p, NO_NOTE, NO_TICK, + REVELATION, ALT_ACCESS_SYMBOL, MODULE_INDICANT, STOP); + bool siga; + do + { + siga = false; + reduce (p, NO_NOTE, &siga, + REVELATION, REVELATION, COMMA_SYMBOL, PUBLIC_SYMBOL, MODULE_INDICANT, STOP); + reduce (p, NO_NOTE, &siga, + REVELATION, REVELATION, COMMA_SYMBOL, MODULE_INDICANT, STOP); + } + while (siga); + reduce (p, NO_NOTE, NO_TICK, REVELATION_PART, REVELATION, STOP); + } + + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + reduce (q, NO_NOTE, NO_TICK, MODULE_TEXT, REVELATION_PART, DEF_PART, POSTLUDE_PART, FED_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, MODULE_TEXT, REVELATION_PART, DEF_PART, FED_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, MODULE_TEXT, DEF_PART, POSTLUDE_PART, FED_SYMBOL, STOP); + reduce (q, NO_NOTE, NO_TICK, MODULE_TEXT, DEF_PART, FED_SYMBOL, STOP); + } +} + +/* Reduce def-parts and postlude-parts. + Note that revelations are reduced in reduce_module_texts. */ + +static void +reduce_module_text_parts (NODE_T *p) +{ + if (IS (p, DEF_SYMBOL)) + { + reduce_enquiry_clauses (p); + reduce (p, NO_NOTE, NO_TICK, DEF_PART, DEF_SYMBOL, ENQUIRY_CLAUSE, STOP); + } + else if (IS (p, POSTLUDE_SYMBOL)) + { + reduce_serial_clauses (p); + reduce (p, NO_NOTE, NO_TICK, POSTLUDE_PART, POSTLUDE_SYMBOL, SERIAL_CLAUSE, STOP); + } +} + +/* Reduce serial clauses. */ + +static void +reduce_serial_clauses (NODE_T *p) +{ + if (NEXT (p) != NO_NODE) + { + NODE_T *q = NEXT (p), *u; + bool siga, label_seen; + /* Check wrong exits. */ + for (u = q; u != NO_NODE; FORWARD (u)) + { + if (IS (u, EXIT_SYMBOL)) + { + if (NEXT (u) == NO_NODE || !IS (NEXT (u), LABELED_UNIT)) + a68_error (u, "S must be followed by a labeled unit"); + } + } + + /* Check wrong jumps and declarations. */ + for (u = q, label_seen = false; u != NO_NODE; FORWARD (u)) + { + if (IS (u, LABELED_UNIT)) + label_seen = true; + else if (IS (u, DECLARATION_LIST)) + { + if (label_seen) + a68_error (u, "declaration cannot follow a labeled unit"); + } + } + + /* Reduce serial clauses. */ + reduce (q, NO_NOTE, NO_TICK, SERIAL_CLAUSE, LABELED_UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, SERIAL_CLAUSE, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, INITIALISER_SERIES, DECLARATION_LIST, STOP); + do + { + siga = false; + if (IS (q, SERIAL_CLAUSE)) + { + reduce (q, NO_NOTE, &siga, + SERIAL_CLAUSE, SERIAL_CLAUSE, SEMI_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, &siga, + SERIAL_CLAUSE, SERIAL_CLAUSE, EXIT_SYMBOL, LABELED_UNIT, STOP); + reduce (q, NO_NOTE, &siga, + SERIAL_CLAUSE, SERIAL_CLAUSE, SEMI_SYMBOL, LABELED_UNIT, STOP); + reduce (q, NO_NOTE, &siga, + INITIALISER_SERIES, SERIAL_CLAUSE, SEMI_SYMBOL, DECLARATION_LIST, STOP); + /* Errors */ + reduce (q, strange_separator, &siga, + SERIAL_CLAUSE, SERIAL_CLAUSE, COMMA_SYMBOL, UNIT, STOP); + reduce (q, strange_separator, &siga, + SERIAL_CLAUSE, SERIAL_CLAUSE, COMMA_SYMBOL, LABELED_UNIT, STOP); + reduce (q, strange_separator, &siga, + INITIALISER_SERIES, SERIAL_CLAUSE, COMMA_SYMBOL, DECLARATION_LIST, STOP); + reduce (q, strange_separator, &siga, + SERIAL_CLAUSE, SERIAL_CLAUSE, COLON_SYMBOL, UNIT, STOP); + reduce (q, strange_separator, &siga, + SERIAL_CLAUSE, SERIAL_CLAUSE, COLON_SYMBOL, LABELED_UNIT, STOP); + reduce (q, strange_separator, &siga, + INITIALISER_SERIES, SERIAL_CLAUSE, COLON_SYMBOL, DECLARATION_LIST, STOP); + reduce (q, strange_separator, &siga, + SERIAL_CLAUSE, SERIAL_CLAUSE, UNIT, STOP); + reduce (q, strange_separator, &siga, + SERIAL_CLAUSE, SERIAL_CLAUSE, LABELED_UNIT, STOP); + reduce (q, strange_separator, &siga, + INITIALISER_SERIES, SERIAL_CLAUSE, DECLARATION_LIST, STOP); + } + else if (IS (q, INITIALISER_SERIES)) + { + reduce (q, NO_NOTE, &siga, + SERIAL_CLAUSE, INITIALISER_SERIES, SEMI_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, &siga, + SERIAL_CLAUSE, INITIALISER_SERIES, SEMI_SYMBOL, LABELED_UNIT, STOP); + reduce (q, NO_NOTE, &siga, + INITIALISER_SERIES, INITIALISER_SERIES, SEMI_SYMBOL, DECLARATION_LIST, STOP); + /* Errors */ + reduce (q, strange_separator, &siga, + SERIAL_CLAUSE, INITIALISER_SERIES, COMMA_SYMBOL, UNIT, STOP); + reduce (q, strange_separator, &siga, + SERIAL_CLAUSE, INITIALISER_SERIES, COMMA_SYMBOL, LABELED_UNIT, STOP); + reduce (q, strange_separator, &siga, + INITIALISER_SERIES, INITIALISER_SERIES, COMMA_SYMBOL, DECLARATION_LIST, STOP); + reduce (q, strange_separator, &siga, + SERIAL_CLAUSE, INITIALISER_SERIES, COLON_SYMBOL, UNIT, STOP); + reduce (q, strange_separator, &siga, + SERIAL_CLAUSE, INITIALISER_SERIES, COLON_SYMBOL, LABELED_UNIT, STOP); + reduce (q, strange_separator, &siga, + INITIALISER_SERIES, INITIALISER_SERIES, COLON_SYMBOL, DECLARATION_LIST, STOP); + reduce (q, strange_separator, &siga, + SERIAL_CLAUSE, INITIALISER_SERIES, UNIT, STOP); + reduce (q, strange_separator, &siga, + SERIAL_CLAUSE, INITIALISER_SERIES, LABELED_UNIT, STOP); + reduce (q, strange_separator, &siga, + INITIALISER_SERIES, INITIALISER_SERIES, DECLARATION_LIST, STOP); + } + } + while (siga); + } +} + +/* Reduce enquiry clauses. */ + +static void +reduce_enquiry_clauses (NODE_T *p) +{ + if (NEXT (p) != NO_NODE) + { + NODE_T *q = NEXT (p); + bool siga; + reduce (q, NO_NOTE, NO_TICK, ENQUIRY_CLAUSE, UNIT, STOP); + reduce (q, NO_NOTE, NO_TICK, INITIALISER_SERIES, DECLARATION_LIST, STOP); + do + { + siga = false; + if (IS (q, ENQUIRY_CLAUSE)) + { + reduce (q, NO_NOTE, &siga, + ENQUIRY_CLAUSE, ENQUIRY_CLAUSE, SEMI_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, &siga, + INITIALISER_SERIES, ENQUIRY_CLAUSE, SEMI_SYMBOL, DECLARATION_LIST, STOP); + reduce (q, strange_separator, &siga, + ENQUIRY_CLAUSE, ENQUIRY_CLAUSE, COMMA_SYMBOL, UNIT, STOP); + reduce (q, strange_separator, &siga, + INITIALISER_SERIES, ENQUIRY_CLAUSE, COMMA_SYMBOL, DECLARATION_LIST, STOP); + reduce (q, strange_separator, &siga, + ENQUIRY_CLAUSE, ENQUIRY_CLAUSE, COLON_SYMBOL, UNIT, STOP); + reduce (q, strange_separator, &siga, + INITIALISER_SERIES, ENQUIRY_CLAUSE, COLON_SYMBOL, DECLARATION_LIST, STOP); + reduce (q, strange_separator, &siga, + ENQUIRY_CLAUSE, ENQUIRY_CLAUSE, UNIT, STOP); + reduce (q, strange_separator, &siga, + INITIALISER_SERIES, ENQUIRY_CLAUSE, DECLARATION_LIST, STOP); + } + else if (IS (q, INITIALISER_SERIES)) + { + reduce (q, NO_NOTE, &siga, + ENQUIRY_CLAUSE, INITIALISER_SERIES, SEMI_SYMBOL, UNIT, STOP); + reduce (q, NO_NOTE, &siga, + INITIALISER_SERIES, INITIALISER_SERIES, SEMI_SYMBOL, DECLARATION_LIST, STOP); + reduce (q, strange_separator, &siga, + ENQUIRY_CLAUSE, INITIALISER_SERIES, COMMA_SYMBOL, UNIT, STOP); + reduce (q, strange_separator, &siga, + INITIALISER_SERIES, INITIALISER_SERIES, COMMA_SYMBOL, DECLARATION_LIST, STOP); + reduce (q, strange_separator, &siga, + ENQUIRY_CLAUSE, INITIALISER_SERIES, COLON_SYMBOL, UNIT, STOP); + reduce (q, strange_separator, &siga, + INITIALISER_SERIES, INITIALISER_SERIES, COLON_SYMBOL, DECLARATION_LIST, STOP); + reduce (q, strange_separator, &siga, + ENQUIRY_CLAUSE, INITIALISER_SERIES, UNIT, STOP); + reduce (q, strange_separator, &siga, + INITIALISER_SERIES, INITIALISER_SERIES, DECLARATION_LIST, STOP); + } + } + while (siga); + } +} + +/* Reduce collateral clauses. */ + +static void +reduce_collateral_clauses (NODE_T *p) +{ + if (NEXT (p) != NO_NODE) + { + NODE_T *q = NEXT (p); + if (IS (q, UNIT)) + { + bool siga; + reduce (q, NO_NOTE, NO_TICK, UNIT_LIST, UNIT, STOP); + do + { + siga = false; + reduce (q, NO_NOTE, &siga, UNIT_LIST, UNIT_LIST, COMMA_SYMBOL, UNIT, STOP); + reduce (q, strange_separator, &siga, UNIT_LIST, UNIT_LIST, UNIT, STOP); + } + while (siga); + } + else if (IS (q, SPECIFIED_UNIT)) + { + bool siga; + reduce (q, NO_NOTE, NO_TICK, SPECIFIED_UNIT_LIST, SPECIFIED_UNIT, STOP); + do + { + siga = false; + reduce (q, NO_NOTE, &siga, + SPECIFIED_UNIT_LIST, SPECIFIED_UNIT_LIST, COMMA_SYMBOL, SPECIFIED_UNIT, STOP); + reduce (q, strange_separator, &siga, + SPECIFIED_UNIT_LIST, SPECIFIED_UNIT_LIST, SPECIFIED_UNIT, STOP); + } + while (siga); + } + } +} + +/* Reduces enclosed clauses. */ + +static void +reduce_enclosed_clauses (NODE_T *q, enum a68_attribute expect) +{ + NODE_T *p = q; + + if (SUB (p) == NO_NODE) + { + if (IS (p, FOR_SYMBOL)) + reduce (p, NO_NOTE, NO_TICK, FOR_PART, FOR_SYMBOL, DEFINING_IDENTIFIER, STOP); + else if (IS (p, OPEN_SYMBOL)) + { + if (expect == ENQUIRY_CLAUSE) + reduce (p, NO_NOTE, NO_TICK, OPEN_PART, OPEN_SYMBOL, ENQUIRY_CLAUSE, STOP); + else if (expect == ARGUMENT) + { + reduce (p, NO_NOTE, NO_TICK, ARGUMENT, OPEN_SYMBOL, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, ARGUMENT, OPEN_SYMBOL, ARGUMENT_LIST, CLOSE_SYMBOL, STOP); + reduce (p, empty_clause, NO_TICK, ARGUMENT, OPEN_SYMBOL, INITIALISER_SERIES, CLOSE_SYMBOL, STOP); + } + else if (expect == GENERIC_ARGUMENT) + { + if (a68_whether (p, OPEN_SYMBOL, CLOSE_SYMBOL, STOP)) + { + pad_node (p, TRIMMER); + reduce (p, NO_NOTE, NO_TICK, GENERIC_ARGUMENT, OPEN_SYMBOL, TRIMMER, CLOSE_SYMBOL, STOP); + } + reduce (p, NO_NOTE, NO_TICK, + GENERIC_ARGUMENT, OPEN_SYMBOL, GENERIC_ARGUMENT_LIST, CLOSE_SYMBOL, STOP); + } + else if (expect == BOUNDS) + { + reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, OPEN_SYMBOL, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, BOUNDS, OPEN_SYMBOL, BOUNDS_LIST, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, OPEN_SYMBOL, FORMAL_BOUNDS_LIST, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, + FORMAL_BOUNDS, OPEN_SYMBOL, ALT_FORMAL_BOUNDS_LIST, CLOSE_SYMBOL, STOP); + } + else + { + reduce (p, NO_NOTE, NO_TICK, CLOSED_CLAUSE, OPEN_SYMBOL, SERIAL_CLAUSE, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, COLLATERAL_CLAUSE, OPEN_SYMBOL, UNIT_LIST, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, COLLATERAL_CLAUSE, OPEN_SYMBOL, CLOSE_SYMBOL, STOP); + reduce (p, empty_clause, NO_TICK, + CLOSED_CLAUSE, OPEN_SYMBOL, INITIALISER_SERIES, CLOSE_SYMBOL, STOP); + } + } + else if (IS (p, SUB_SYMBOL)) + { + if (expect == GENERIC_ARGUMENT) + { + if (a68_whether (p, SUB_SYMBOL, BUS_SYMBOL, STOP)) + { + pad_node (p, TRIMMER); + reduce (p, NO_NOTE, NO_TICK, GENERIC_ARGUMENT, SUB_SYMBOL, TRIMMER, BUS_SYMBOL, STOP); + } + reduce (p, NO_NOTE, NO_TICK, + GENERIC_ARGUMENT, SUB_SYMBOL, GENERIC_ARGUMENT_LIST, BUS_SYMBOL, STOP); + } + else if (expect == BOUNDS) + { + reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, SUB_SYMBOL, BUS_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, BOUNDS, SUB_SYMBOL, BOUNDS_LIST, BUS_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, SUB_SYMBOL, FORMAL_BOUNDS_LIST, BUS_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, FORMAL_BOUNDS, SUB_SYMBOL, ALT_FORMAL_BOUNDS_LIST, BUS_SYMBOL, STOP); + } + } + else if (IS (p, BEGIN_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, COLLATERAL_CLAUSE, BEGIN_SYMBOL, UNIT_LIST, END_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, COLLATERAL_CLAUSE, BEGIN_SYMBOL, END_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, CLOSED_CLAUSE, BEGIN_SYMBOL, SERIAL_CLAUSE, END_SYMBOL, STOP); + reduce (p, empty_clause, NO_TICK, CLOSED_CLAUSE, BEGIN_SYMBOL, INITIALISER_SERIES, END_SYMBOL, STOP); + } + else if (IS (p, FORMAT_DELIMITER_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, + FORMAT_TEXT, FORMAT_DELIMITER_SYMBOL, PICTURE_LIST, FORMAT_DELIMITER_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, + FORMAT_TEXT, FORMAT_DELIMITER_SYMBOL, FORMAT_DELIMITER_SYMBOL, STOP); + } + else if (IS (p, FORMAT_OPEN_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, + COLLECTION, FORMAT_OPEN_SYMBOL, PICTURE_LIST, FORMAT_CLOSE_SYMBOL, STOP); + } + else if (IS (p, ACCESS_SYMBOL)) + { + NODE_T *s; + for (s = p; s != NO_NODE; FORWARD (s)) + { + if (SUB (s) != NO_NODE) + { + // XXX why + if (IS (SUB (s), OPEN_SYMBOL)) + reduce_branch (s, SOME_CLAUSE); + else + reduce_branch (s, ENCLOSED_CLAUSE); + } + reduce (s, NO_NOTE, NO_TICK, PARALLEL_CLAUSE, PAR_SYMBOL, COLLATERAL_CLAUSE, STOP); + reduce (s, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, PARALLEL_CLAUSE, STOP); + reduce (s, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CLOSED_CLAUSE, STOP); + reduce (s, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, COLLATERAL_CLAUSE, STOP); + reduce (s, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONDITIONAL_CLAUSE, STOP); + reduce (s, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CASE_CLAUSE, STOP); + reduce (s, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, CONFORMITY_CLAUSE, STOP); + reduce (s, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, LOOP_CLAUSE, STOP); + reduce (s, NO_NOTE, NO_TICK, ENCLOSED_CLAUSE, ACCESS_CLAUSE, STOP); + } + // XXX reduce revelations + reduce (p, NO_NOTE, NO_TICK, + ACCESS_CLAUSE, ACCESS_SYMBOL, MODULE_INDICANT, ENCLOSED_CLAUSE, STOP); + } + else if (IS (p, IF_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, IF_PART, IF_SYMBOL, ENQUIRY_CLAUSE, STOP); + reduce (p, empty_clause, NO_TICK, IF_PART, IF_SYMBOL, INITIALISER_SERIES, STOP); + } + else if (IS (p, THEN_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, THEN_PART, THEN_SYMBOL, SERIAL_CLAUSE, STOP); + reduce (p, empty_clause, NO_TICK, THEN_PART, THEN_SYMBOL, INITIALISER_SERIES, STOP); + } + else if (IS (p, ELSE_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, ELSE_PART, ELSE_SYMBOL, SERIAL_CLAUSE, STOP); + reduce (p, empty_clause, NO_TICK, ELSE_PART, ELSE_SYMBOL, INITIALISER_SERIES, STOP); + } + else if (IS (p, ELIF_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, ELIF_IF_PART, ELIF_SYMBOL, ENQUIRY_CLAUSE, STOP); + } + else if (IS (p, CASE_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, CASE_PART, CASE_SYMBOL, ENQUIRY_CLAUSE, STOP); + reduce (p, empty_clause, NO_TICK, CASE_PART, CASE_SYMBOL, INITIALISER_SERIES, STOP); + } + else if (IS (p, IN_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, CASE_IN_PART, IN_SYMBOL, UNIT_LIST, STOP); + reduce (p, NO_NOTE, NO_TICK, CONFORMITY_IN_PART, IN_SYMBOL, SPECIFIED_UNIT_LIST, STOP); + } + else if (IS (p, OUT_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, OUT_PART, OUT_SYMBOL, SERIAL_CLAUSE, STOP); + reduce (p, empty_clause, NO_TICK, OUT_PART, OUT_SYMBOL, INITIALISER_SERIES, STOP); + } + else if (IS (p, OUSE_SYMBOL)) + reduce (p, NO_NOTE, NO_TICK, OUSE_PART, OUSE_SYMBOL, ENQUIRY_CLAUSE, STOP); + else if (IS (p, THEN_BAR_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, CHOICE, THEN_BAR_SYMBOL, SERIAL_CLAUSE, STOP); + reduce (p, NO_NOTE, NO_TICK, CASE_CHOICE_CLAUSE, THEN_BAR_SYMBOL, UNIT_LIST, STOP); + reduce (p, NO_NOTE, NO_TICK, CONFORMITY_CHOICE, THEN_BAR_SYMBOL, SPECIFIED_UNIT_LIST, STOP); + reduce (p, NO_NOTE, NO_TICK, CONFORMITY_CHOICE, THEN_BAR_SYMBOL, SPECIFIED_UNIT, STOP); + reduce (p, empty_clause, NO_TICK, CHOICE, THEN_BAR_SYMBOL, INITIALISER_SERIES, STOP); + } + else if (IS (p, ELSE_BAR_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, ELSE_OPEN_PART, ELSE_BAR_SYMBOL, ENQUIRY_CLAUSE, STOP); + reduce (p, empty_clause, NO_TICK, ELSE_OPEN_PART, ELSE_BAR_SYMBOL, INITIALISER_SERIES, STOP); + } + else if (IS (p, FROM_SYMBOL)) + reduce (p, NO_NOTE, NO_TICK, FROM_PART, FROM_SYMBOL, UNIT, STOP); + else if (IS (p, BY_SYMBOL)) + reduce (p, NO_NOTE, NO_TICK, BY_PART, BY_SYMBOL, UNIT, STOP); + else if (IS (p, TO_SYMBOL)) + reduce (p, NO_NOTE, NO_TICK, TO_PART, TO_SYMBOL, UNIT, STOP); + else if (IS (p, WHILE_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, WHILE_PART, WHILE_SYMBOL, ENQUIRY_CLAUSE, STOP); + reduce (p, empty_clause, NO_TICK, WHILE_PART, WHILE_SYMBOL, INITIALISER_SERIES, STOP); + } + else if (IS (p, DO_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, DO_PART, DO_SYMBOL, SERIAL_CLAUSE, OD_SYMBOL, STOP); + } + else if (IS (p, ALT_DO_SYMBOL)) + { + reduce (p, NO_NOTE, NO_TICK, ALT_DO_PART, ALT_DO_SYMBOL, SERIAL_CLAUSE, OD_SYMBOL, STOP); + } + } + p = q; + if (SUB (p) != NO_NODE) + { + if (IS (p, OPEN_PART)) + { + reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, OPEN_PART, CHOICE, CHOICE, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, OPEN_PART, CHOICE, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, OPEN_PART, CHOICE, BRIEF_ELIF_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, OPEN_PART, CASE_CHOICE_CLAUSE, CHOICE, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, OPEN_PART, CASE_CHOICE_CLAUSE, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, OPEN_PART, CASE_CHOICE_CLAUSE, BRIEF_OUSE_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, + CONFORMITY_CLAUSE, OPEN_PART, CONFORMITY_CHOICE, CHOICE, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, + CONFORMITY_CLAUSE, OPEN_PART, CONFORMITY_CHOICE, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, + CONFORMITY_CLAUSE, OPEN_PART, CONFORMITY_CHOICE, BRIEF_CONFORMITY_OUSE_PART, STOP); + } + else if (IS (p, ELSE_OPEN_PART)) + { + reduce (p, NO_NOTE, NO_TICK, BRIEF_ELIF_PART, ELSE_OPEN_PART, CHOICE, CHOICE, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, BRIEF_ELIF_PART, ELSE_OPEN_PART, CHOICE, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, BRIEF_ELIF_PART, ELSE_OPEN_PART, CHOICE, BRIEF_ELIF_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, + BRIEF_OUSE_PART, ELSE_OPEN_PART, CASE_CHOICE_CLAUSE, CHOICE, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, BRIEF_OUSE_PART, ELSE_OPEN_PART, CASE_CHOICE_CLAUSE, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, + BRIEF_OUSE_PART, ELSE_OPEN_PART, CASE_CHOICE_CLAUSE, BRIEF_OUSE_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, + BRIEF_CONFORMITY_OUSE_PART, ELSE_OPEN_PART, CONFORMITY_CHOICE, CHOICE, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, + BRIEF_CONFORMITY_OUSE_PART, ELSE_OPEN_PART, CONFORMITY_CHOICE, CLOSE_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, + BRIEF_CONFORMITY_OUSE_PART, ELSE_OPEN_PART, CONFORMITY_CHOICE, BRIEF_CONFORMITY_OUSE_PART, + STOP); + } + else if (IS (p, IF_PART)) + { + reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, IF_PART, THEN_PART, ELSE_PART, FI_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, IF_PART, THEN_PART, ELIF_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, CONDITIONAL_CLAUSE, IF_PART, THEN_PART, FI_SYMBOL, STOP); + } + else if (IS (p, ELIF_IF_PART)) + { + reduce (p, NO_NOTE, NO_TICK, ELIF_PART, ELIF_IF_PART, THEN_PART, ELSE_PART, FI_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, ELIF_PART, ELIF_IF_PART, THEN_PART, FI_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, ELIF_PART, ELIF_IF_PART, THEN_PART, ELIF_PART, STOP); + } + else if (IS (p, CASE_PART)) + { + reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, CASE_PART, CASE_IN_PART, OUT_PART, ESAC_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, CASE_PART, CASE_IN_PART, ESAC_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, CASE_CLAUSE, CASE_PART, CASE_IN_PART, CASE_OUSE_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, + CONFORMITY_CLAUSE, CASE_PART, CONFORMITY_IN_PART, OUT_PART, ESAC_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, + CONFORMITY_CLAUSE, CASE_PART, CONFORMITY_IN_PART, ESAC_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, + CONFORMITY_CLAUSE, CASE_PART, CONFORMITY_IN_PART, CONFORMITY_OUSE_PART, STOP); + } + else if (IS (p, OUSE_PART)) + { + reduce (p, NO_NOTE, NO_TICK, CASE_OUSE_PART, OUSE_PART, CASE_IN_PART, OUT_PART, ESAC_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, CASE_OUSE_PART, OUSE_PART, CASE_IN_PART, ESAC_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, CASE_OUSE_PART, OUSE_PART, CASE_IN_PART, CASE_OUSE_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, + CONFORMITY_OUSE_PART, OUSE_PART, CONFORMITY_IN_PART, OUT_PART, ESAC_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, + CONFORMITY_OUSE_PART, OUSE_PART, CONFORMITY_IN_PART, ESAC_SYMBOL, STOP); + reduce (p, NO_NOTE, NO_TICK, + CONFORMITY_OUSE_PART, OUSE_PART, CONFORMITY_IN_PART, CONFORMITY_OUSE_PART, STOP); + } + else if (IS (p, FOR_PART)) + { + reduce (p, NO_NOTE, NO_TICK, + LOOP_CLAUSE, FOR_PART, FROM_PART, BY_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, BY_PART, WHILE_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, WHILE_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, BY_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, BY_PART, WHILE_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, WHILE_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, BY_PART, TO_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, BY_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, TO_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, FROM_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, BY_PART, TO_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, BY_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, TO_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FOR_PART, ALT_DO_PART, STOP); + } + else if (IS (p, FROM_PART)) + { + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, BY_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, BY_PART, WHILE_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, WHILE_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, BY_PART, TO_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, BY_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, TO_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, FROM_PART, ALT_DO_PART, STOP); + } + else if (IS (p, BY_PART)) + { + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, BY_PART, TO_PART, WHILE_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, BY_PART, WHILE_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, BY_PART, TO_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, BY_PART, ALT_DO_PART, STOP); + } + else if (IS (p, TO_PART)) + { + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, TO_PART, WHILE_PART, ALT_DO_PART, STOP); + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, TO_PART, ALT_DO_PART, STOP); + } + else if (IS (p, WHILE_PART)) + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, WHILE_PART, ALT_DO_PART, STOP); + else if (IS (p, DO_PART)) + reduce (p, NO_NOTE, NO_TICK, LOOP_CLAUSE, DO_PART, STOP); + } +} + +/* Substitute reduction when a phrase could not be parsed. */ + +static void +recover_from_error (NODE_T * p, enum a68_attribute expect, bool suppress) +{ + /* This routine does not do fancy things as that might introduce more + errors. */ + NODE_T *q = p; + if (p == NO_NODE) + return; + + if (expect == SOME_CLAUSE) + expect = serial_or_collateral (p); + + if (!suppress) + { + /* Give an error message. */ + NODE_T *w = p; + const char *seq = a68_phrase_to_text (p, &w); + if (strlen (seq) == 0) + { + if (ERROR_COUNT (&A68_JOB) == 0) + a68_error (w, "expected A", expect); + } + else + a68_error (w, "Y is an invalid A", seq, expect); + + if (ERROR_COUNT (&A68_JOB) >= MAX_ERRORS) + longjmp (A68_PARSER (bottom_up_crash_exit), 1); + } + + /* Try to prevent spurious diagnostics by guessing what was expected. */ + while (NEXT (q) != NO_NODE) + FORWARD (q); + + if (a68_is_one_of (p, BEGIN_SYMBOL, OPEN_SYMBOL, STOP)) + { + if (expect == ARGUMENT || expect == COLLATERAL_CLAUSE + || expect == PARAMETER_PACK || expect == STRUCTURE_PACK + || expect == UNION_PACK) + a68_make_sub (p, q, expect); + else if (expect == ENQUIRY_CLAUSE) + a68_make_sub (p, q, OPEN_PART); + else if (expect == FORMAL_DECLARERS) + a68_make_sub (p, q, FORMAL_DECLARERS); + else + a68_make_sub (p, q, CLOSED_CLAUSE); + } + else if (IS (p, FORMAT_DELIMITER_SYMBOL) && expect == FORMAT_TEXT) + a68_make_sub (p, q, FORMAT_TEXT); + else if (a68_is_one_of (p, THEN_BAR_SYMBOL, CHOICE, STOP)) + a68_make_sub (p, q, CHOICE); + else if (a68_is_one_of (p, IF_SYMBOL, IF_PART, STOP)) + a68_make_sub (p, q, IF_PART); + else if (a68_is_one_of (p, THEN_SYMBOL, THEN_PART, STOP)) + a68_make_sub (p, q, THEN_PART); + else if (a68_is_one_of (p, ELSE_SYMBOL, ELSE_PART, STOP)) + a68_make_sub (p, q, ELSE_PART); + else if (a68_is_one_of (p, ELIF_SYMBOL, ELIF_IF_PART, STOP)) + a68_make_sub (p, q, ELIF_IF_PART); + else if (a68_is_one_of (p, CASE_SYMBOL, CASE_PART, STOP)) + a68_make_sub (p, q, CASE_PART); + else if (a68_is_one_of (p, OUT_SYMBOL, OUT_PART, STOP)) + a68_make_sub (p, q, OUT_PART); + else if (a68_is_one_of (p, OUSE_SYMBOL, OUSE_PART, STOP)) + a68_make_sub (p, q, OUSE_PART); + else if (a68_is_one_of (p, FOR_SYMBOL, FOR_PART, STOP)) + a68_make_sub (p, q, FOR_PART); + else if (a68_is_one_of (p, FROM_SYMBOL, FROM_PART, STOP)) + a68_make_sub (p, q, FROM_PART); + else if (a68_is_one_of (p, BY_SYMBOL, BY_PART, STOP)) + a68_make_sub (p, q, BY_PART); + else if (a68_is_one_of (p, TO_SYMBOL, TO_PART, STOP)) + a68_make_sub (p, q, TO_PART); + else if (a68_is_one_of (p, WHILE_SYMBOL, WHILE_PART, STOP)) + a68_make_sub (p, q, WHILE_PART); + else if (a68_is_one_of (p, DO_SYMBOL, DO_PART, STOP)) + a68_make_sub (p, q, DO_PART); + else if (a68_is_one_of (p, ALT_DO_SYMBOL, ALT_DO_PART, STOP)) + a68_make_sub (p, q, ALT_DO_PART); + else if (a68_attribute_name (expect) != NO_TEXT) + a68_make_sub (p, q, expect); +} + +/* Heuristic aid in pinpointing errors. */ + +static void +reduce_erroneous_units (NODE_T *p) +{ + /* Constructs are reduced to units in an attempt to limit spurious + diagnostics. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + /* Some implementations allow selection from a tertiary, when there is no + risk of ambiguity. GCC follows RR, so some extra attention here to + guide an unsuspecting user. */ + if (a68_whether (q, SELECTOR, -SECONDARY, STOP)) + { + a68_error (NEXT (q), "expected A", SECONDARY); + reduce (q, NO_NOTE, NO_TICK, UNIT, SELECTOR, WILDCARD, STOP); + } + + /* Attention for identity relations that require tertiaries. */ + if (a68_whether (q, -TERTIARY, IS_SYMBOL, TERTIARY, STOP) + || a68_whether (q, TERTIARY, IS_SYMBOL, -TERTIARY, STOP) + || a68_whether (q, -TERTIARY, IS_SYMBOL, -TERTIARY, STOP)) + { + a68_error (NEXT (q), "expected A", TERTIARY); + reduce (q, NO_NOTE, NO_TICK, UNIT, WILDCARD, IS_SYMBOL, WILDCARD, STOP); + } + else if (a68_whether (q, -TERTIARY, ISNT_SYMBOL, TERTIARY, STOP) + || a68_whether (q, TERTIARY, ISNT_SYMBOL, -TERTIARY, STOP) + || a68_whether (q, -TERTIARY, ISNT_SYMBOL, -TERTIARY, STOP)) + { + a68_error (NEXT (q), "expected A", TERTIARY); + reduce (q, NO_NOTE, NO_TICK, UNIT, WILDCARD, ISNT_SYMBOL, WILDCARD, STOP); + } + } +} + +/* + * A posteriori checks of the syntax tree built by the BU parser. + */ + +/* Driver for a posteriori error checking. */ + +void +a68_bottom_up_error_check (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, BOOLEAN_PATTERN)) + { + int k = 0; + a68_count_pictures (SUB (p), &k); + if (!(k == 0 || k == 2)) + a68_error (p, "incorrect number of pictures for A", + ATTRIBUTE (p)); + } + else if (IS (p, PUBLIC_SYMBOL)) + { + /* These should have been removed by a68_bottom_up_coalesce_pub. */ + gcc_unreachable (); + } + else if (a68_is_one_of (p, DEFINING_INDICANT, DEFINING_IDENTIFIER, DEFINING_OPERATOR, STOP)) + { + if (PUBLICIZED (p) && !PUBLIC_RANGE (TABLE (p))) + a68_error (p, + "%licized declaration not in a module definition"); + } + else + a68_bottom_up_error_check (SUB (p)); + } +} + +/* + * Next part rearranges and checks the tree after the symbol tables are finished. + */ + +/* Transfer IDENTIFIER to JUMP where appropriate. */ + +void +a68_rearrange_goto_less_jumps (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, UNIT)) + { + NODE_T *q = SUB (p); + if (IS (q, TERTIARY)) + { + NODE_T *tertiary = q; + q = SUB (q); + if (q != NO_NODE && IS (q, SECONDARY)) + { + q = SUB (q); + if (q != NO_NODE && IS (q, PRIMARY)) + { + q = SUB (q); + if (q != NO_NODE && IS (q, IDENTIFIER)) + { + if (a68_is_identifier_or_label_global (TABLE (q), NSYMBOL (q)) == LABEL) + { + ATTRIBUTE (tertiary) = JUMP; + SUB (tertiary) = q; + } + } + } + } + } + } + else if (IS (p, TERTIARY)) + { + NODE_T *q = SUB (p); + if (q != NO_NODE && IS (q, SECONDARY)) + { + NODE_T *secondary = q; + q = SUB (q); + if (q != NO_NODE && IS (q, PRIMARY)) + { + q = SUB (q); + if (q != NO_NODE && IS (q, IDENTIFIER)) + { + if (a68_is_identifier_or_label_global (TABLE (q), NSYMBOL (q)) == LABEL) + { + ATTRIBUTE (secondary) = JUMP; + SUB (secondary) = q; + } + } + } + } + } + else if (IS (p, SECONDARY)) + { + NODE_T *q = SUB (p); + if (q != NO_NODE && IS (q, PRIMARY)) + { + NODE_T *primary = q; + q = SUB (q); + if (q != NO_NODE && IS (q, IDENTIFIER)) + { + if (a68_is_identifier_or_label_global (TABLE (q), NSYMBOL (q)) == LABEL) + { + ATTRIBUTE (primary) = JUMP; + SUB (primary) = q; + } + } + } + } + else if (IS (p, PRIMARY)) + { + NODE_T *q = SUB (p); + if (q != NO_NODE && IS (q, IDENTIFIER)) + { + if (a68_is_identifier_or_label_global (TABLE (q), NSYMBOL (q)) == LABEL) + a68_make_sub (q, q, JUMP); + } + } + a68_rearrange_goto_less_jumps (SUB (p)); + } +} + +/* + * Coalesce PUBLIC_SYMBOLs resulting from reductions, annotating the + * corresponding defining identifiers, indicators, operators and prios as + * publicized. + */ + +void +a68_bottom_up_coalesce_pub (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (a68_is_one_of (p, + MODE_DECLARATION, PROCEDURE_DECLARATION, PRIORITY_DECLARATION, + PROCEDURE_VARIABLE_DECLARATION, BRIEF_OPERATOR_DECLARATION, + OPERATOR_DECLARATION, IDENTITY_DECLARATION, + VARIABLE_DECLARATION, STOP)) + { + if (SUB (p) != NO_NODE && IS (SUB (p), PUBLIC_SYMBOL)) + { + NODE_T *public_symbol = SUB (p); + + /* Mark the defining entity as PUBlicized. */ + /* XXX handle joined declarations. */ + NODE_T *defining_entity = NEXT (NEXT (SUB (p))); + if (!a68_is_one_of (defining_entity, + DEFINING_INDICANT, DEFINING_IDENTIFIER, DEFINING_OPERATOR, + STOP)) + FORWARD (defining_entity); + gcc_assert (defining_entity != NO_NODE + && a68_is_one_of (defining_entity, + DEFINING_INDICANT, + DEFINING_IDENTIFIER, + DEFINING_OPERATOR, + STOP)); + PUBLICIZED (defining_entity) = true; + + /* Unlink the PUBLIC_SYMBOL node and get rid of it. */ + SUB (p) = NEXT (public_symbol); + PREVIOUS (NEXT (public_symbol)) = NO_NODE; + } + } + a68_bottom_up_coalesce_pub (SUB (p)); + } +} From 6fe1583fbf6c236d7359e86458c2f36a6626089e Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:48:35 +0200 Subject: [PATCH 155/373] a68: parser: syntax check for declarers Thi pass checks the syntax of formal, actual and virtual declarers. Signed-off-by: Jose E. Marchesi Co-authored-by: Marcel van der Veer --- gcc/algol68/a68-parser-victal.cc | 362 +++++++++++++++++++++++++++++++ 1 file changed, 362 insertions(+) create mode 100644 gcc/algol68/a68-parser-victal.cc diff --git a/gcc/algol68/a68-parser-victal.cc b/gcc/algol68/a68-parser-victal.cc new file mode 100644 index 000000000000..b4162fc39821 --- /dev/null +++ b/gcc/algol68/a68-parser-victal.cc @@ -0,0 +1,362 @@ +/* Syntax check for formal, actual and virtual declarers. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "options.h" + +#include "a68.h" + +static bool victal_check_declarer (NODE_T *, int); + +/* Check generator. */ + +static void +victal_check_generator (NODE_T * p) +{ + if (!victal_check_declarer (NEXT (p), ACTUAL_DECLARER_MARK)) + a68_error (p, "Y expected", "actual declarer"); +} + +/* Check formal pack. */ + +static void +victal_check_formal_pack (NODE_T *p, int x, bool *z) +{ + if (p != NO_NODE) + { + if (IS (p, FORMAL_DECLARERS)) + victal_check_formal_pack (SUB (p), x, z); + else if (a68_is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, STOP)) + victal_check_formal_pack (NEXT (p), x, z); + else if (IS (p, FORMAL_DECLARERS_LIST)) + { + victal_check_formal_pack (NEXT (p), x, z); + victal_check_formal_pack (SUB (p), x, z); + } + else if (IS (p, DECLARER)) + { + victal_check_formal_pack (NEXT (p), x, z); + (*z) &= victal_check_declarer (SUB (p), x); + } + } +} + +/* Check operator declaration. */ + +static void +victal_check_operator_dec (NODE_T *p) +{ + if (IS (NEXT (p), FORMAL_DECLARERS)) + { + bool z = true; + victal_check_formal_pack (NEXT (p), FORMAL_DECLARER_MARK, &z); + if (!z) + a68_error (p, "Y expected", "formal declarers"); + FORWARD (p); + } + if (!victal_check_declarer (NEXT (p), FORMAL_DECLARER_MARK)) + a68_error (p, "Y expected", "formal declarer"); +} + +/* Check mode declaration. */ + +static void +victal_check_mode_dec (NODE_T *p) +{ + if (p != NO_NODE) + { + if (IS (p, MODE_DECLARATION)) + { + victal_check_mode_dec (SUB (p)); + victal_check_mode_dec (NEXT (p)); + } + else if (a68_is_one_of (p, MODE_SYMBOL, DEFINING_INDICANT, STOP) + || a68_is_one_of (p, EQUALS_SYMBOL, COMMA_SYMBOL, STOP)) + { + victal_check_mode_dec (NEXT (p)); + } + else if (IS (p, DECLARER)) + { + if (!victal_check_declarer (p, ACTUAL_DECLARER_MARK)) + a68_error (p, "Y expected", "actual declarer"); + } + } +} + +/* Check variable declaration. */ + +static void +victal_check_variable_dec (NODE_T *p) +{ + if (p != NO_NODE) + { + if (IS (p, VARIABLE_DECLARATION)) + { + victal_check_variable_dec (SUB (p)); + victal_check_variable_dec (NEXT (p)); + } + else + { + if (IS (p, QUALIFIER)) + FORWARD (p); + + if (a68_is_one_of (p, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, STOP) + || IS (p, COMMA_SYMBOL)) + victal_check_variable_dec (NEXT (p)); + else if (IS (p, UNIT)) + a68_victal_checker (SUB (p)); + else if (IS (p, DECLARER)) + { + if (!victal_check_declarer (p, ACTUAL_DECLARER_MARK)) + a68_error (p, "Y expected", "actual declarer"); + victal_check_variable_dec (NEXT (p)); + } + } + } +} + +/* Check identity declaration. */ + +static void +victal_check_identity_dec (NODE_T * p) +{ + if (p != NO_NODE) + { + if (IS (p, IDENTITY_DECLARATION)) + { + victal_check_identity_dec (SUB (p)); + victal_check_identity_dec (NEXT (p)); + } + else if (a68_is_one_of (p, DEFINING_IDENTIFIER, EQUALS_SYMBOL, COMMA_SYMBOL, STOP)) + victal_check_identity_dec (NEXT (p)); + else if (IS (p, UNIT)) + a68_victal_checker (SUB (p)); + else if (IS (p, DECLARER)) + { + if (!victal_check_declarer (p, FORMAL_DECLARER_MARK)) + a68_error (p, "Y expected", "formal declarer"); + victal_check_identity_dec (NEXT (p)); + } + } +} + +/* Check routine pack. */ + +static void +victal_check_routine_pack (NODE_T *p, int x, bool *z) +{ + if (p != NO_NODE) + { + if (IS (p, PARAMETER_PACK)) + victal_check_routine_pack (SUB (p), x, z); + else if (a68_is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, STOP)) + victal_check_routine_pack (NEXT (p), x, z); + else if (a68_is_one_of (p, PARAMETER_LIST, PARAMETER, STOP)) + { + victal_check_routine_pack (NEXT (p), x, z); + victal_check_routine_pack (SUB (p), x, z); + } + else if (IS (p, DECLARER)) + *z &= victal_check_declarer (SUB (p), x); + } +} + +/* Check routine text. */ + +static void +victal_check_routine_text (NODE_T *p) +{ + if (IS (p, PARAMETER_PACK)) + { + bool z = true; + victal_check_routine_pack (p, FORMAL_DECLARER_MARK, &z); + if (!z) + a68_error (p, "Y expected", "formal declarers"); + FORWARD (p); + } + if (!victal_check_declarer (p, FORMAL_DECLARER_MARK)) + a68_error (p, "Y expected", "formal declarer"); + a68_victal_checker (NEXT (p)); +} + +/* Check structure pack. */ + +static void +victal_check_structure_pack (NODE_T *p, int x, bool *z) +{ + if (p != NO_NODE) + { + if (IS (p, STRUCTURE_PACK)) + victal_check_structure_pack (SUB (p), x, z); + else if (a68_is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, STOP)) + victal_check_structure_pack (NEXT (p), x, z); + else if (a68_is_one_of (p, STRUCTURED_FIELD_LIST, STRUCTURED_FIELD, STOP)) + { + victal_check_structure_pack (NEXT (p), x, z); + victal_check_structure_pack (SUB (p), x, z); + } + else if (IS (p, DECLARER)) + (*z) &= victal_check_declarer (SUB (p), x); + } +} + +/* Check union pack. */ + +static void +victal_check_union_pack (NODE_T * p, int x, bool * z) +{ + if (p != NO_NODE) + { + if (IS (p, UNION_PACK)) + victal_check_union_pack (SUB (p), x, z); + else if (a68_is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, VOID_SYMBOL, STOP)) + victal_check_union_pack (NEXT (p), x, z); + else if (IS (p, UNION_DECLARER_LIST)) + { + victal_check_union_pack (NEXT (p), x, z); + victal_check_union_pack (SUB (p), x, z); + } + else if (IS (p, DECLARER)) + { + victal_check_union_pack (NEXT (p), x, z); + (*z) &= victal_check_declarer (SUB (p), FORMAL_DECLARER_MARK); + } + } +} + +/* Check declarer. */ + +static bool +victal_check_declarer (NODE_T *p, int x) +{ + if (p == NO_NODE) + return false; + else if (IS (p, DECLARER)) + return victal_check_declarer (SUB (p), x); + else if (a68_is_one_of (p, LONGETY, SHORTETY, STOP)) + return true; + else if (a68_is_one_of (p, VOID_SYMBOL, INDICANT, STANDARD, STOP)) + return true; + else if (IS_REF (p)) + return victal_check_declarer (NEXT (p), VIRTUAL_DECLARER_MARK); + else if (IS_FLEX (p)) + return victal_check_declarer (NEXT (p), x); + else if (IS (p, BOUNDS)) + { + a68_victal_checker (SUB (p)); + if (x == FORMAL_DECLARER_MARK) + { + a68_error (p, "Y expected", "formal bounds"); + (void) victal_check_declarer (NEXT (p), x); + return true; + } + else if (x == VIRTUAL_DECLARER_MARK) + { + a68_error (p, "Y expected", "virtual bounds"); + (void) victal_check_declarer (NEXT (p), x); + return true; + } + else + return victal_check_declarer (NEXT (p), x); + } + else if (IS (p, FORMAL_BOUNDS)) + { + a68_victal_checker (SUB (p)); + if (x == ACTUAL_DECLARER_MARK) + { + a68_error (p, "Y expected", "actual bounds"); + (void) victal_check_declarer (NEXT (p), x); + return true; + } + else + return victal_check_declarer (NEXT (p), x); + } + else if (IS (p, STRUCT_SYMBOL)) + { + bool z = true; + victal_check_structure_pack (NEXT (p), x, &z); + return z; + } + else if (IS (p, UNION_SYMBOL)) + { + bool z = true; + victal_check_union_pack (NEXT (p), FORMAL_DECLARER_MARK, &z); + if (!z) + a68_error (p, "Y expected", "formal declarer pack"); + return true; + } + else if (IS (p, PROC_SYMBOL)) + { + if (IS (NEXT (p), FORMAL_DECLARERS)) + { + bool z = true; + victal_check_formal_pack (NEXT (p), FORMAL_DECLARER_MARK, &z); + if (!z) + a68_error (p, "Y expected", "formal declarer"); + FORWARD (p); + } + if (!victal_check_declarer (NEXT (p), FORMAL_DECLARER_MARK)) + a68_error (p, "Y expected", "formal declarer"); + return true; + } + else + return false; +} + +/* Check cast. */ + +static void +victal_check_cast (NODE_T *p) +{ + if (!victal_check_declarer (p, FORMAL_DECLARER_MARK)) + { + a68_error (p, "Y expected", "formal declarer"); + a68_victal_checker (NEXT (p)); + } +} + +/* Driver for checking VICTALITY of declarers. */ + +void +a68_victal_checker (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, MODE_DECLARATION)) + victal_check_mode_dec (SUB (p)); + else if (IS (p, VARIABLE_DECLARATION)) + victal_check_variable_dec (SUB (p)); + else if (IS (p, IDENTITY_DECLARATION)) + victal_check_identity_dec (SUB (p)); + else if (IS (p, GENERATOR)) + victal_check_generator (SUB (p)); + else if (IS (p, ROUTINE_TEXT)) + victal_check_routine_text (SUB (p)); + else if (IS (p, OPERATOR_PLAN)) + victal_check_operator_dec (SUB (p)); + else if (IS (p, CAST)) + victal_check_cast (SUB (p)); + else + a68_victal_checker (SUB (p)); + } +} From 9c7a056adb4760f91b1b9e32d5c7ed1e2ed51642 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:48:58 +0200 Subject: [PATCH 156/373] a68: parser: standard prelude definitions Definitions of standard identifiers, procedures and modes. Signed-off-by: Jose E. Marchesi Co-authored-by: Marcel van der Veer --- gcc/algol68/a68-parser-prelude.cc | 1502 +++++++++++++++++++++++++++++ 1 file changed, 1502 insertions(+) create mode 100644 gcc/algol68/a68-parser-prelude.cc diff --git a/gcc/algol68/a68-parser-prelude.cc b/gcc/algol68/a68-parser-prelude.cc new file mode 100644 index 000000000000..cb899873f357 --- /dev/null +++ b/gcc/algol68/a68-parser-prelude.cc @@ -0,0 +1,1502 @@ +/* Standard prelude definitions. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "a68.h" + +#define A68_STD true +#define A68_EXT false + +/* ALGOL68C type procs. */ + +#define A68C_DEFIO(name, mode) \ + do \ + { \ + m = a68_proc (MODE (mode), M_REF_FILE, NO_MOID); \ + a68_idf (A68_EXT, "get" #name, m); \ + m = a68_proc (M_VOID, M_REF_FILE, MODE (mode), NO_MOID); \ + a68_idf (A68_EXT, "put" #name, m); \ + m = a68_proc (MODE (mode), NO_MOID); \ + a68_idf (A68_EXT, "read" #name, m); \ + m = a68_proc (M_VOID, MODE (mode), NO_MOID); \ + a68_idf (A68_EXT, "print" #name, m); \ + } \ + while (0) + +/* Enter tag in standenv symbol table. */ + +static void +add_a68_standenv (bool portable, int a, NODE_T* n, char *c, MOID_T *m, + int p, LOWERER_T l = NO_LOWERER) +{ +#define INSERT_TAG(l, n) \ + do { \ + NEXT (n) = *(l); \ + *(l) = (n); \ + } while (0) + + TAG_T *new_one = a68_new_tag (); + + PROCEDURE_LEVEL (INFO (n)) = 0; + USE (new_one) = false; + HEAP (new_one) = HEAP_SYMBOL; + TAG_TABLE (new_one) = A68_STANDENV; + NODE (new_one) = n; + if (c != NO_TEXT) + VALUE (new_one) = TEXT (a68_add_token (&A68 (top_token), c)); + else + VALUE (new_one) = NO_TEXT; + PRIO (new_one) = p; + TAX_TREE_DECL (new_one) = NULL; + LOWERER (new_one) = l; + UNIT (new_one) = NULL; + PORTABLE (new_one) = portable; + MOID (new_one) = m; + NEXT (new_one) = NO_TAG; + if (a == IDENTIFIER) + INSERT_TAG (&IDENTIFIERS (A68_STANDENV), new_one); + else if (a == OP_SYMBOL) + INSERT_TAG (&OPERATORS (A68_STANDENV), new_one); + else if (a == PRIO_SYMBOL) + INSERT_TAG (&PRIO (A68_STANDENV), new_one); + else if (a == INDICANT) + INSERT_TAG (&INDICANTS (A68_STANDENV), new_one); + else if (a == LABEL) + INSERT_TAG (&LABELS (A68_STANDENV), new_one); +#undef INSERT_TAG +} + +/* Compose PROC moid from arguments - first result, than arguments. */ + +static MOID_T * +a68_proc (MOID_T *m, ...) +{ + PACK_T *p = NO_PACK, *q = NO_PACK; + MOID_T *y; + + va_list attribute; + va_start (attribute, m); + while ((y = va_arg (attribute, MOID_T *)) != NO_MOID) + { + PACK_T *new_one = a68_new_pack (); + + MOID (new_one) = y; + TEXT (new_one) = NO_TEXT; + NEXT (new_one) = NO_PACK; + if (q != NO_PACK) + NEXT (q) = new_one; + else + p = new_one; + q = new_one; + } + + va_end (attribute); + return a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, + a68_count_pack_members (p), NO_NODE, m, p); +} + +/* Enter an identifier in standenv. */ + +static void +a68_idf (bool portable, const char *n, MOID_T *m, LOWERER_T l = NO_LOWERER) +{ + add_a68_standenv (portable, IDENTIFIER, + a68_some_node (TEXT (a68_add_token (&A68 (top_token), n))), + NO_TEXT, m, 0, l); +} + +/* Enter a moid in standenv. */ + +static void +a68_mode (int p, const char *t, MOID_T **m) +{ + (*m) = a68_add_mode (&TOP_MOID (&A68_JOB), + STANDARD, p, + a68_some_node (TEXT (a68_find_keyword (A68 (top_keyword), t))), + NO_MOID, NO_PACK); +} + +/* Enter a priority in standenv. */ + +static void +a68_prio (const char *p, int b) +{ + add_a68_standenv (true, PRIO_SYMBOL, + a68_some_node (TEXT (a68_add_token (&A68 (top_token), p))), + NO_TEXT, NO_MOID, b, NO_LOWERER); +} + +/* Enter operator in standenv. */ + +static void +a68_op (bool portable, const char *n, MOID_T *m, LOWERER_T l = NO_LOWERER) +{ + add_a68_standenv (portable, OP_SYMBOL, + a68_some_node (TEXT (a68_add_token (&A68 (top_token), n))), + NO_TEXT, m, 0, l); +} + +/* Enter standard modes in standenv. */ + +static void +stand_moids (void) +{ + /* Primitive A68 moids. */ + a68_mode (0, "VOID", &M_VOID); + /* Standard precision. */ + a68_mode (0, "INT", &M_INT); + a68_mode (0, "REAL", &M_REAL); + a68_mode (0, "COMPL", &M_COMPLEX); + a68_mode (0, "BITS", &M_BITS); + a68_mode (0, "BYTES", &M_BYTES); + /* Multiple precision. */ + a68_mode (-2, "INT", &M_SHORT_SHORT_INT); + a68_mode (-2, "BITS", &M_SHORT_SHORT_BITS); + a68_mode (-1, "INT", &M_SHORT_INT); + a68_mode (-1, "BITS", &M_SHORT_BITS); + a68_mode (1, "INT", &M_LONG_INT); + a68_mode (1, "REAL", &M_LONG_REAL); + a68_mode (1, "COMPL", &M_LONG_COMPLEX); + a68_mode (1, "BITS", &M_LONG_BITS); + a68_mode (1, "BYTES", &M_LONG_BYTES); + a68_mode (2, "REAL", &M_LONG_LONG_REAL); + a68_mode (2, "INT", &M_LONG_LONG_INT); + a68_mode (2, "BITS", &M_LONG_LONG_BITS); + a68_mode (2, "COMPL", &M_LONG_LONG_COMPLEX); + /* Other. */ + a68_mode (0, "BOOL", &M_BOOL); + a68_mode (0, "CHAR", &M_CHAR); + a68_mode (0, "STRING", &M_STRING); + a68_mode (0, "FILE", &M_FILE); + a68_mode (0, "CHANNEL", &M_CHANNEL); + a68_mode (0, "SEMA", &M_SEMA); + /* Rows. */ + M_ROWS = a68_add_mode (&TOP_MOID (&A68_JOB), ROWS_SYMBOL, 0, NO_NODE, NO_MOID, NO_PACK); + /* REFs. */ + M_REF_INT = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_INT, NO_PACK); + M_REF_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_REAL, NO_PACK); + M_REF_COMPLEX = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_COMPLEX, NO_PACK); + M_REF_BITS = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_BITS, NO_PACK); + M_REF_BYTES = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_BYTES, NO_PACK); + /* Multiple precision. */ + M_REF_LONG_INT = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_INT, NO_PACK); + M_REF_LONG_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_REAL, NO_PACK); + M_REF_LONG_COMPLEX = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_COMPLEX, NO_PACK); + M_REF_LONG_LONG_INT = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_LONG_INT, NO_PACK); + M_REF_LONG_LONG_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_LONG_REAL, NO_PACK); + M_REF_LONG_LONG_COMPLEX = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_LONG_COMPLEX, NO_PACK); + M_REF_LONG_BITS = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_BITS, NO_PACK); + M_REF_LONG_LONG_BITS = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_LONG_BITS, NO_PACK); + M_REF_LONG_BYTES = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_LONG_BYTES, NO_PACK); + M_REF_SHORT_INT = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_SHORT_INT, NO_PACK); + M_REF_SHORT_SHORT_INT = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_SHORT_SHORT_INT, NO_PACK +); + M_REF_SHORT_BITS = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_SHORT_BITS, NO_PACK); + M_REF_SHORT_SHORT_BITS = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_SHORT_SHORT_BITS, NO_PACK); + /* Other. */ + M_REF_BOOL = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_BOOL, NO_PACK); + M_REF_CHAR = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_CHAR, NO_PACK); + M_REF_FILE = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_FILE, NO_PACK); + M_REF_REF_FILE = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_REF_FILE, NO_PACK); + /* [] INT. */ + M_ROW_INT = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_INT, NO_PACK); + HAS_ROWS (M_ROW_INT) = true; + SLICE (M_ROW_INT) = M_INT; + M_REF_ROW_INT = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_ROW_INT, NO_PACK); + NAME (M_REF_ROW_INT) = M_REF_INT; + /* [] REAL. */ + M_ROW_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_REAL, NO_PACK); + HAS_ROWS (M_ROW_REAL) = true; + SLICE (M_ROW_REAL) = M_REAL; + M_REF_ROW_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_ROW_REAL, NO_PACK); + NAME (M_REF_ROW_REAL) = M_REF_REAL; + /* [,] REAL. */ + M_ROW_ROW_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 2, NO_NODE, M_REAL, NO_PACK); + HAS_ROWS (M_ROW_ROW_REAL) = true; + SLICE (M_ROW_ROW_REAL) = M_ROW_REAL; + M_REF_ROW_ROW_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_ROW_ROW_REAL, NO_PACK); + NAME (M_REF_ROW_ROW_REAL) = M_REF_ROW_REAL; + /* [] COMPLEX. */ + M_ROW_COMPLEX = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_COMPLEX, NO_PACK); + HAS_ROWS (M_ROW_COMPLEX) = true; + SLICE (M_ROW_COMPLEX) = M_COMPLEX; + M_REF_ROW_COMPLEX = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_ROW_COMPLEX, NO_PACK); + NAME (M_REF_ROW_COMPLEX) = M_REF_COMPLEX; + /* [,] COMPLEX. */ + M_ROW_ROW_COMPLEX = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 2, NO_NODE, M_COMPLEX, NO_PACK); + HAS_ROWS (M_ROW_ROW_COMPLEX) = true; + SLICE (M_ROW_ROW_COMPLEX) = M_ROW_COMPLEX; + M_REF_ROW_ROW_COMPLEX = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_ROW_ROW_COMPLEX, NO_PACK); + NAME (M_REF_ROW_ROW_COMPLEX) = M_REF_ROW_COMPLEX; + /* [] BOOL. */ + M_ROW_BOOL = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_BOOL, NO_PACK); + HAS_ROWS (M_ROW_BOOL) = true; + SLICE (M_ROW_BOOL) = M_BOOL; + /* FLEX [] BOOL. */ + MOID_T *m = a68_add_mode (&TOP_MOID (&A68_JOB), FLEX_SYMBOL, 0, NO_NODE, M_ROW_BOOL, NO_PACK); + HAS_ROWS (m) = true; + M_FLEX_ROW_BOOL = m; + /* [] BITS. */ + M_ROW_BITS = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_BITS, NO_PACK); + HAS_ROWS (M_ROW_BITS) = true; + SLICE (M_ROW_BITS) = M_BITS; + /* [] CHAR. */ + M_ROW_CHAR = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_CHAR, NO_PACK); + HAS_ROWS (M_ROW_CHAR) = true; + SLICE (M_ROW_CHAR) = M_CHAR; + /* [][] CHAR. */ + M_ROW_ROW_CHAR = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_ROW_CHAR, NO_PACK); + HAS_ROWS (M_ROW_ROW_CHAR) = true; + SLICE (M_ROW_ROW_CHAR) = M_ROW_CHAR; + /* MODE STRING = FLEX [] CHAR. */ + m = a68_add_mode (&TOP_MOID (&A68_JOB), FLEX_SYMBOL, 0, NO_NODE, M_ROW_CHAR, NO_PACK); + HAS_ROWS (m) = true; + M_FLEX_ROW_CHAR = m; + EQUIVALENT (M_STRING) = m; + /* REF [] CHAR. */ + M_REF_ROW_CHAR = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, M_ROW_CHAR, NO_PACK); + NAME (M_REF_ROW_CHAR) = M_REF_CHAR; + /* PROC [] CHAR. */ + M_PROC_ROW_CHAR = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, 0, NO_NODE, M_ROW_CHAR, NO_PACK); + /* REF STRING = REF FLEX [] CHAR. */ + M_REF_STRING = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, EQUIVALENT (M_STRING), NO_PACK); + NAME (M_REF_STRING) = M_REF_CHAR; + DEFLEXED (M_REF_STRING) = M_REF_ROW_CHAR; + /* [] STRING. */ + M_ROW_STRING = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_STRING, NO_PACK); + HAS_ROWS (M_ROW_STRING) = true; + SLICE (M_ROW_STRING) = M_STRING; + DEFLEXED (M_ROW_STRING) = M_ROW_ROW_CHAR; + /* PROC STRING. */ + M_PROC_STRING = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, 0, NO_NODE, M_STRING, NO_PACK); + DEFLEXED (M_PROC_STRING) = M_PROC_ROW_CHAR; + /* COMPLEX. */ + PACK_T *z = NO_PACK; + (void) a68_add_mode_to_pack (&z, M_REAL, TEXT (a68_add_token (&A68 (top_token), "im")), NO_NODE); + (void) a68_add_mode_to_pack (&z, M_REAL, TEXT (a68_add_token (&A68 (top_token), "re")), NO_NODE); + m = a68_add_mode (&TOP_MOID (&A68_JOB), STRUCT_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z); + EQUIVALENT (M_COMPLEX) = m; + z = NO_PACK; + (void) a68_add_mode_to_pack (&z, M_REF_REAL, TEXT (a68_add_token (&A68 (top_token), "im")), NO_NODE); + (void) a68_add_mode_to_pack (&z, M_REF_REAL, TEXT (a68_add_token (&A68 (top_token), "re")), NO_NODE); + m = a68_add_mode (&TOP_MOID (&A68_JOB), STRUCT_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z); + NAME (M_REF_COMPLEX) = m; + /* LONG COMPLEX. */ + z = NO_PACK; + (void) a68_add_mode_to_pack (&z, M_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "im")), NO_NODE); + (void) a68_add_mode_to_pack (&z, M_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "re")), NO_NODE); + m = a68_add_mode (&TOP_MOID (&A68_JOB), STRUCT_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z); + EQUIVALENT (M_LONG_COMPLEX) = m; + z = NO_PACK; + (void) a68_add_mode_to_pack (&z, M_REF_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "im")), NO_NODE); + (void) a68_add_mode_to_pack (&z, M_REF_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "re")), NO_NODE); + m = a68_add_mode (&TOP_MOID (&A68_JOB), STRUCT_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z); + NAME (M_REF_LONG_COMPLEX) = m; + /* LONG_LONG COMPLEX. */ + z = NO_PACK; + (void) a68_add_mode_to_pack (&z, M_LONG_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "im")), NO_NODE); + (void) a68_add_mode_to_pack (&z, M_LONG_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "re")), NO_NODE); + m = a68_add_mode (&TOP_MOID (&A68_JOB), STRUCT_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z); + EQUIVALENT (M_LONG_LONG_COMPLEX) = m; + z = NO_PACK; + (void) a68_add_mode_to_pack (&z, M_REF_LONG_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "im")), NO_NODE); + (void) a68_add_mode_to_pack (&z, M_REF_LONG_LONG_REAL, TEXT (a68_add_token (&A68 (top_token), "re")), NO_NODE); + m = a68_add_mode (&TOP_MOID (&A68_JOB), STRUCT_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z); + NAME (M_REF_LONG_LONG_COMPLEX) = m; + /* SEMA. */ + z = NO_PACK; + (void) a68_add_mode_to_pack (&z, M_REF_INT, NO_TEXT, NO_NODE); + EQUIVALENT (M_SEMA) = a68_add_mode (&TOP_MOID (&A68_JOB), STRUCT_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z); + /* PROC VOID. */ + z = NO_PACK; + M_PROC_VOID = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (z), NO_NODE, M_VOID, z); + /* PROC (REAL) REAL. */ + z = NO_PACK; + (void) a68_add_mode_to_pack (&z, M_REAL, NO_TEXT, NO_NODE); + M_PROC_REAL_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (z), NO_NODE, M_REAL, z); + /* PROC (LONG_REAL) LONG_REAL. */ + z = NO_PACK; + (void) a68_add_mode_to_pack (&z, M_LONG_REAL, NO_TEXT, NO_NODE); + M_PROC_LONG_REAL_LONG_REAL = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (z), NO_NODE, M_LONG_REAL, z); + /* IO: PROC (REF FILE) BOOL. */ + z = NO_PACK; + (void) a68_add_mode_to_pack (&z, M_REF_FILE, NO_TEXT, NO_NODE); + M_PROC_REF_FILE_BOOL = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (z), NO_NODE, M_BOOL, z); + /* IO: PROC (REF FILE) VOID. */ + z = NO_PACK; + (void) a68_add_mode_to_pack (&z, M_REF_FILE, NO_TEXT, NO_NODE); + M_PROC_REF_FILE_VOID = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (z), NO_NODE, M_VOID, z); + /* IO: SIMPLIN and SIMPLOUT. */ + M_SIMPLIN = a68_add_mode (&TOP_MOID (&A68_JOB), IN_TYPE_MODE, 0, NO_NODE, NO_MOID, NO_PACK); + M_ROW_SIMPLIN = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_SIMPLIN, NO_PACK); + SLICE (M_ROW_SIMPLIN) = M_SIMPLIN; + M_SIMPLOUT = a68_add_mode (&TOP_MOID (&A68_JOB), OUT_TYPE_MODE, 0, NO_NODE, NO_MOID, NO_PACK); + M_ROW_SIMPLOUT = a68_add_mode (&TOP_MOID (&A68_JOB), ROW_SYMBOL, 1, NO_NODE, M_SIMPLOUT, NO_PACK); + SLICE (M_ROW_SIMPLOUT) = M_SIMPLOUT; +} + +/* Set up standenv - general RR but not transput. */ + +static void +stand_prelude (void) +{ + /* Identifiers. */ + a68_idf (A68_STD, "intlengths", M_INT, a68_lower_intlengths); + a68_idf (A68_STD, "intshorths", M_INT, a68_lower_intshorths); + a68_idf (A68_STD, "maxint", M_INT, a68_lower_maxint); + a68_idf (A68_STD, "longmaxint", M_LONG_INT, a68_lower_maxint); + a68_idf (A68_STD, "longlongmaxint", M_LONG_LONG_INT, a68_lower_maxint); + a68_idf (A68_STD, "shortmaxint", M_SHORT_INT, a68_lower_maxint); + a68_idf (A68_STD, "shortshortmaxint", M_SHORT_SHORT_INT, a68_lower_maxint); + a68_idf (A68_STD, "maxreal", M_REAL, a68_lower_maxreal); + a68_idf (A68_STD, "longmaxreal", M_LONG_REAL, a68_lower_maxreal); + a68_idf (A68_STD, "longlongmaxreal", M_LONG_LONG_REAL, a68_lower_maxreal); + a68_idf (A68_STD, "smallreal", M_REAL, a68_lower_smallreal); + a68_idf (A68_STD, "longsmallreal", M_LONG_REAL, a68_lower_smallreal); + a68_idf (A68_STD, "longlongsmallreal", M_LONG_LONG_REAL, a68_lower_smallreal); + a68_idf (A68_STD, "reallengths", M_INT, a68_lower_reallengths); + a68_idf (A68_STD, "realshorths", M_INT, a68_lower_realshorths); + a68_idf (A68_STD, "bitslengths", M_INT, a68_lower_bitslengths); + a68_idf (A68_STD, "bitsshorths", M_INT, a68_lower_bitsshorths); + a68_idf (A68_STD, "bitswidth", M_INT, a68_lower_bitswidth); + a68_idf (A68_STD, "longbitswidth", M_INT, a68_lower_longbitswidth); + a68_idf (A68_STD, "longlongbitswidth", M_INT, a68_lower_longlongbitswidth); + a68_idf (A68_STD, "shortbitswidth", M_INT, a68_lower_shortbitswidth); + a68_idf (A68_STD, "shortshortbitswidth", M_INT, a68_lower_shortshortbitswidth); + a68_idf (A68_STD, "maxbits", M_BITS, a68_lower_maxbits); + a68_idf (A68_STD, "longmaxbits", M_LONG_BITS, a68_lower_maxbits); + a68_idf (A68_STD, "longlongmaxbits", M_LONG_LONG_BITS, a68_lower_maxbits); + a68_idf (A68_STD, "maxabschar", M_INT, a68_lower_maxabschar); + a68_idf (A68_STD, "intwidth", M_INT, a68_lower_intwidth); + a68_idf (A68_STD, "longintwidth", M_INT, a68_lower_longintwidth); + a68_idf (A68_STD, "longlongintwidth", M_INT, a68_lower_longlongintwidth); + a68_idf (A68_STD, "shortintwidth", M_INT, a68_lower_shortintwidth); + a68_idf (A68_STD, "shortshortintwidth", M_INT, a68_lower_shortshortintwidth); + a68_idf (A68_STD, "realwidth", M_INT, a68_lower_realwidth); + a68_idf (A68_STD, "longrealwidth", M_INT, a68_lower_longrealwidth); + a68_idf (A68_STD, "longlongrealwidth", M_INT, a68_lower_longlongrealwidth); + a68_idf (A68_STD, "expwidth", M_INT, a68_lower_expwidth); + a68_idf (A68_STD, "longexpwidth", M_INT, a68_lower_longexpwidth); + a68_idf (A68_STD, "longlongexpwidth", M_INT, a68_lower_longlongexpwidth); + a68_idf (A68_STD, "pi", M_REAL, a68_lower_pi); + a68_idf (A68_STD, "longpi", M_LONG_REAL, a68_lower_pi); + a68_idf (A68_STD, "longlongpi", M_LONG_LONG_REAL, a68_lower_pi); + a68_idf (A68_STD, "compllengths", M_INT); + a68_idf (A68_STD, "complshorths", M_INT); + a68_idf (A68_STD, "byteslengths", M_INT); + a68_idf (A68_STD, "bytesshorths", M_INT); + a68_idf (A68_STD, "byteswidth", M_INT); + a68_idf (A68_STD, "longbyteswidth", M_INT); + a68_idf (A68_STD, "flip", M_CHAR, a68_lower_flip); + a68_idf (A68_STD, "flop", M_CHAR, a68_lower_flop); + a68_idf (A68_STD, "errorchar", M_CHAR, a68_lower_errorchar); + a68_idf (A68_STD, "nullcharacter", M_CHAR, a68_lower_nullcharacter); + a68_idf (A68_STD, "blank", M_CHAR, a68_lower_blank); + /* BITS procedures. */ + MOID_T *m = a68_proc (M_BITS, M_ROW_BOOL, NO_MOID); + a68_idf (A68_STD, "bitspack", m); + /* SHORT BITS procedures. */ + m = a68_proc (M_SHORT_BITS, M_ROW_BOOL, NO_MOID); + a68_idf (A68_STD, "shortbitspack", m); + /* SHORT SHORT BITS procedures. */ + m = a68_proc (M_SHORT_SHORT_BITS, M_ROW_BOOL, NO_MOID); + a68_idf (A68_STD, "shortshortbitspack", m); + /* LONG BITS procedures. */ + m = a68_proc (M_LONG_BITS, M_ROW_BOOL, NO_MOID); + a68_idf (A68_STD, "longbitspack", m); + /* LONG LONG BITS procedures. */ + m = a68_proc (M_LONG_LONG_BITS, M_ROW_BOOL, NO_MOID); + a68_idf (A68_STD, "longlongbitspack", m); + /* RNG procedures. */ + m = a68_proc (M_VOID, M_INT, NO_MOID); + a68_idf (A68_STD, "firstrandom", m); + /* REAL procedures. */ + m = A68_MCACHE (proc_real); + a68_idf (A68_STD, "nextrandom", m); + a68_idf (A68_STD, "random", m, a68_lower_random); + a68_idf (A68_STD, "rnd", m); + m = A68_MCACHE (proc_real_real); + a68_idf (A68_STD, "arccos", m, a68_lower_acos); + a68_idf (A68_STD, "arcsin", m, a68_lower_asin); + a68_idf (A68_STD, "arctan", m, a68_lower_atan); + a68_idf (A68_STD, "cos", m, a68_lower_cos); + a68_idf (A68_STD, "exp", m, a68_lower_exp); + a68_idf (A68_STD, "ln", m, a68_lower_ln); + a68_idf (A68_STD, "sin", m, a68_lower_sin); + a68_idf (A68_STD, "sqrt", m, a68_lower_sqrt); + a68_idf (A68_STD, "tan", m, a68_lower_tan); + /* LONG REAL procedures. */ + m = a68_proc (M_LONG_REAL, NO_MOID); + a68_idf (A68_STD, "longnextrandom", m); + a68_idf (A68_STD, "longrandom", m, a68_lower_longrandom); + m = a68_proc (M_LONG_REAL, M_LONG_REAL, NO_MOID); + a68_idf (A68_STD, "longarccos", m, a68_lower_long_acos); + a68_idf (A68_STD, "longarcsin", m, a68_lower_long_asin); + a68_idf (A68_STD, "longarctan", m, a68_lower_long_atan); + a68_idf (A68_STD, "longcos", m, a68_lower_long_cos); + a68_idf (A68_STD, "longexp", m, a68_lower_long_exp); + a68_idf (A68_STD, "longln", m, a68_lower_long_ln); + a68_idf (A68_STD, "longsin", m, a68_lower_long_sin); + a68_idf (A68_STD, "longsqrt", m, a68_lower_long_sqrt); + a68_idf (A68_STD, "longtan", m, a68_lower_long_tan); + /* LONG LONG REAL procedures. */ + m = a68_proc (M_LONG_LONG_REAL, NO_MOID); + a68_idf (A68_STD, "longlongnextrandom", m); + a68_idf (A68_STD, "longlongrandom", m, a68_lower_longlongrandom); + m = a68_proc (M_LONG_LONG_REAL, M_LONG_LONG_REAL, NO_MOID); + a68_idf (A68_STD, "longlongarccos", m, a68_lower_long_long_acos); + a68_idf (A68_STD, "longlongarcsin", m, a68_lower_long_long_asin); + a68_idf (A68_STD, "longlongarctan", m, a68_lower_long_long_atan); + a68_idf (A68_STD, "longlongcos", m, a68_lower_long_long_cos); + a68_idf (A68_STD, "longlongexp", m, a68_lower_long_long_exp); + a68_idf (A68_STD, "longlongln", m, a68_lower_long_long_ln); + a68_idf (A68_STD, "longlongsin", m, a68_lower_long_long_sin); + a68_idf (A68_STD, "longlongsqrt", m, a68_lower_long_long_sqrt); + a68_idf (A68_STD, "longlongtan", m, a68_lower_long_long_tan); + /* Priorities. */ + a68_prio ("+:=", 1); + a68_prio ("-:=", 1); + a68_prio ("*:=", 1); + a68_prio ("/:=", 1); + a68_prio ("%:=", 1); + a68_prio ("%*:=", 1); + a68_prio ("+=:", 1); + a68_prio ("PLUSAB", 1); + a68_prio ("MINUSAB", 1); + a68_prio ("TIMESAB", 1); + a68_prio ("DIVAB", 1); + a68_prio ("OVERAB", 1); + a68_prio ("MODAB", 1); + a68_prio ("PLUSTO", 1); + a68_prio ("OR", 2); + a68_prio ("AND", 3); + a68_prio ("XOR", 3); + a68_prio ("=", 4); + a68_prio ("/=", 4); + a68_prio ("<", 5); + a68_prio ("<=", 5); + a68_prio (">", 5); + a68_prio (">=", 5); + a68_prio ("EQ", 4); + a68_prio ("NE", 4); + a68_prio ("LT", 5); + a68_prio ("LE", 5); + a68_prio ("GT", 5); + a68_prio ("GE", 5); + a68_prio ("+", 6); + a68_prio ("-", 6); + a68_prio ("*", 7); + a68_prio ("/", 7); + a68_prio ("OVER", 7); + a68_prio ("%", 7); + a68_prio ("MOD", 7); + a68_prio ("%*", 7); + a68_prio ("ELEM", 7); + a68_prio ("**", 8); + a68_prio ("SHL", 8); + a68_prio ("SHR", 8); + a68_prio ("UP", 8); + a68_prio ("DOWN", 8); + a68_prio ("^", 8); + a68_prio ("LWB", 8); + a68_prio ("UPB", 8); + a68_prio ("I", 9); + a68_prio ("+*", 9); + /* BOOL operators. */ + m = a68_proc (M_BOOL, M_BOOL, NO_MOID); + a68_op (A68_STD, "NOT", m, a68_lower_not2); + a68_op (A68_STD, "~", m, a68_lower_not2); + m = a68_proc (M_INT, M_BOOL, NO_MOID); + a68_op (A68_STD, "ABS", m, a68_lower_boolabs2); + m = a68_proc (M_BOOL, M_BOOL, M_BOOL, NO_MOID); + a68_op (A68_STD, "OR", m, a68_lower_or3); + a68_op (A68_STD, "AND", m, a68_lower_and3); + a68_op (A68_STD, "=", m, a68_lower_bool_eq3); + a68_op (A68_STD, "/=", m, a68_lower_bool_ne3); + a68_op (A68_STD, "EQ", m, a68_lower_bool_eq3); + a68_op (A68_STD, "NE", m, a68_lower_bool_ne3); + /* CHAR operators. */ + m = a68_proc (M_BOOL, M_CHAR, M_CHAR, NO_MOID); + a68_op (A68_STD, "=", m, a68_lower_char_eq3); + a68_op (A68_STD, "/=", m, a68_lower_char_ne3); + a68_op (A68_STD, "<", m, a68_lower_char_lt3); + a68_op (A68_STD, "<=", m, a68_lower_char_le3); + a68_op (A68_STD, ">", m, a68_lower_char_gt3); + a68_op (A68_STD, ">=", m, a68_lower_char_ge3); + a68_op (A68_STD, "EQ", m, a68_lower_char_eq3); + a68_op (A68_STD, "NE", m, a68_lower_char_ne3); + a68_op (A68_STD, "LT", m, a68_lower_char_lt3); + a68_op (A68_STD, "LE", m, a68_lower_char_le3); + a68_op (A68_STD, "GT", m, a68_lower_char_gt3); + a68_op (A68_STD, "GE", m, a68_lower_char_ge3); + m = a68_proc (M_INT, M_CHAR, NO_MOID); + a68_op (A68_STD, "ABS", m, a68_lower_charabs2); + m = a68_proc (M_CHAR, M_INT, NO_MOID); + a68_op (A68_STD, "REPR", m, a68_lower_repr2); + /* STRING operators. */ + m = a68_proc (M_BOOL, M_STRING, M_STRING, NO_MOID); + a68_op (A68_STD, "=", m, a68_lower_string_eq3); + a68_op (A68_STD, "/=", m, a68_lower_string_ne3); + a68_op (A68_STD, "<", m, a68_lower_string_lt3); + a68_op (A68_STD, "<=", m, a68_lower_string_le3); + a68_op (A68_STD, ">=", m, a68_lower_string_ge3); + a68_op (A68_STD, ">", m, a68_lower_string_gt3); + a68_op (A68_STD, "EQ", m, a68_lower_string_eq3); + a68_op (A68_STD, "NE", m, a68_lower_string_ne3); + a68_op (A68_STD, "LT", m, a68_lower_string_lt3); + a68_op (A68_STD, "LE", m, a68_lower_string_le3); + a68_op (A68_STD, "GE", m, a68_lower_string_ge3); + a68_op (A68_STD, "GT", m, a68_lower_string_gt3); + m = a68_proc (M_STRING, M_CHAR, M_CHAR, NO_MOID); + a68_op (A68_STD, "+", m, a68_lower_char_plus3); + m = a68_proc (M_STRING, M_STRING, M_STRING, NO_MOID); + a68_op (A68_STD, "+", m, a68_lower_string_plus3); + m = a68_proc (M_REF_STRING, M_REF_STRING, M_STRING, NO_MOID); + a68_op (A68_STD, "+:=", m, a68_lower_string_plusab3); + a68_op (A68_STD, "PLUSAB", m, a68_lower_string_plusab3); + m = a68_proc (M_REF_STRING, M_REF_STRING, M_INT, NO_MOID); + a68_op (A68_STD, "*:=", m, a68_lower_string_multab3); + a68_op (A68_STD, "TIMESAB", m, a68_lower_string_multab3); + m = a68_proc (M_REF_STRING, M_STRING, M_REF_STRING, NO_MOID); + a68_op (A68_STD, "+=:", m, a68_lower_string_plusto3); + a68_op (A68_STD, "PLUSTO", m, a68_lower_string_plusto3); + m = a68_proc (M_STRING, M_STRING, M_INT, NO_MOID); + a68_op (A68_STD, "*", m, a68_lower_string_mult3); + m = a68_proc (M_STRING, M_INT, M_STRING, NO_MOID); + a68_op (A68_STD, "*", m, a68_lower_string_mult3); + m = a68_proc (M_STRING, M_INT, M_CHAR, NO_MOID); + a68_op (A68_STD, "*", m, a68_lower_char_mult3); + m = a68_proc (M_STRING, M_CHAR, M_INT, NO_MOID); + a68_op (A68_STD, "*", m, a68_lower_char_mult3); + /* SHORT SHORT INT operators. */ + m = a68_proc (M_SHORT_SHORT_INT, M_SHORT_SHORT_INT, NO_MOID); + a68_op (A68_STD, "+", m, a68_lower_confirm2); + a68_op (A68_STD, "-", m, a68_lower_negate2); + a68_op (A68_STD, "ABS", m, a68_lower_intabs2); + m = a68_proc (M_INT, M_SHORT_SHORT_INT, NO_MOID); + a68_op (A68_STD, "SIGN", m, a68_lower_sign2); + m = a68_proc (M_SHORT_INT, M_SHORT_SHORT_INT, NO_MOID); + a68_op (A68_STD, "LENG", m, a68_lower_lengint2); + m = a68_proc (M_BOOL, M_SHORT_SHORT_INT, NO_MOID); + a68_op (A68_STD, "ODD", m, a68_lower_odd2); + m = a68_proc (M_SHORT_SHORT_INT, M_SHORT_SHORT_INT, M_SHORT_SHORT_INT, NO_MOID); + a68_op (A68_STD, "+", m, a68_lower_plus_int); + a68_op (A68_STD, "-", m, a68_lower_minus_int); + a68_op (A68_STD, "*", m, a68_lower_mult_int); + a68_op (A68_STD, "OVER", m, a68_lower_over3); + a68_op (A68_STD, "%", m, a68_lower_over3); + a68_op (A68_STD, "MOD", m, a68_lower_mod3); + a68_op (A68_STD, "%*", m, a68_lower_mod3); + m = a68_proc (M_REF_SHORT_SHORT_INT, M_REF_SHORT_SHORT_INT, M_SHORT_SHORT_INT, NO_MOID); + a68_op (A68_STD, "+:=", m, a68_lower_plusab3); + a68_op (A68_STD, "-:=", m, a68_lower_minusab3); + a68_op (A68_STD, "*:=", m, a68_lower_multab3); + a68_op (A68_STD, "%:=", m, a68_lower_overab3); + a68_op (A68_STD, "%*:=", m, a68_lower_modab3); + a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3); + a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3); + a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3); + a68_op (A68_STD, "OVERAB", m, a68_lower_overab3); + a68_op (A68_STD, "MODAB", m, a68_lower_modab3); + m = a68_proc (M_BOOL, M_SHORT_SHORT_INT, M_SHORT_SHORT_INT, NO_MOID); + a68_op (A68_STD, "EQ", m, a68_lower_int_eq3); + a68_op (A68_STD, "NE", m, a68_lower_int_ne3); + a68_op (A68_STD, "GE", m, a68_lower_int_ge3); + a68_op (A68_STD, "GT", m, a68_lower_int_gt3); + a68_op (A68_STD, "LE", m, a68_lower_int_le3); + a68_op (A68_STD, "LT", m, a68_lower_int_lt3); + a68_op (A68_STD, "=", m, a68_lower_int_eq3); + a68_op (A68_STD, ">=", m, a68_lower_int_ge3); + a68_op (A68_STD, ">", m, a68_lower_int_gt3); + a68_op (A68_STD, "<=", m, a68_lower_int_le3); + a68_op (A68_STD, "<", m, a68_lower_int_lt3); + a68_op (A68_STD, "/=", m, a68_lower_int_ne3); + m = a68_proc (M_SHORT_SHORT_INT, M_SHORT_SHORT_INT, M_INT, NO_MOID); + a68_op (A68_STD, "**", m, a68_lower_pow_int); + a68_op (A68_STD, "^", m, a68_lower_pow_int); + /* SHORT INT operators. */ + m = a68_proc (M_SHORT_INT, M_SHORT_INT, NO_MOID); + a68_op (A68_STD, "+", m, a68_lower_confirm2); + a68_op (A68_STD, "-", m, a68_lower_negate2); + a68_op (A68_STD, "ABS", m, a68_lower_intabs2); + m = a68_proc (M_SHORT_SHORT_INT, M_SHORT_INT, NO_MOID); + a68_op (A68_STD, "SHORTEN", m, a68_lower_shortenint2); + m = a68_proc (M_INT, M_SHORT_INT, NO_MOID); + a68_op (A68_STD, "LENG", m, a68_lower_lengint2); + a68_op (A68_STD, "SIGN", m, a68_lower_sign2); + m = a68_proc (M_BOOL, M_SHORT_INT, NO_MOID); + a68_op (A68_STD, "ODD", m, a68_lower_odd2); + m = a68_proc (M_SHORT_INT, M_SHORT_INT, M_SHORT_INT, NO_MOID); + a68_op (A68_STD, "+", m, a68_lower_plus_int); + a68_op (A68_STD, "-", m, a68_lower_minus_int); + a68_op (A68_STD, "*", m, a68_lower_mult_int); + a68_op (A68_STD, "OVER", m, a68_lower_over3); + a68_op (A68_STD, "%", m, a68_lower_over3); + a68_op (A68_STD, "MOD", m, a68_lower_mod3); + a68_op (A68_STD, "%*", m, a68_lower_mod3); + m = a68_proc (M_REF_SHORT_INT, M_REF_SHORT_INT, M_SHORT_INT, NO_MOID); + a68_op (A68_STD, "+:=", m, a68_lower_plusab3); + a68_op (A68_STD, "-:=", m, a68_lower_minusab3); + a68_op (A68_STD, "*:=", m, a68_lower_multab3); + a68_op (A68_STD, "%:=", m, a68_lower_overab3); + a68_op (A68_STD, "%*:=", m, a68_lower_modab3); + a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3); + a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3); + a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3); + a68_op (A68_STD, "OVERAB", m, a68_lower_overab3); + a68_op (A68_STD, "MODAB", m, a68_lower_modab3); + m = a68_proc (M_BOOL, M_SHORT_INT, M_SHORT_INT, NO_MOID); + a68_op (A68_STD, "=", m, a68_lower_int_eq3); + a68_op (A68_STD, "EQ", m, a68_lower_int_eq3); + a68_op (A68_STD, "/=", m, a68_lower_int_ne3); + a68_op (A68_STD, "NE", m, a68_lower_int_ne3); + a68_op (A68_STD, "<", m, a68_lower_int_lt3); + a68_op (A68_STD, "LT", m, a68_lower_int_lt3); + a68_op (A68_STD, "<=", m, a68_lower_int_le3); + a68_op (A68_STD, "LE", m, a68_lower_int_le3); + a68_op (A68_STD, ">", m, a68_lower_int_gt3); + a68_op (A68_STD, "GT", m, a68_lower_int_gt3); + a68_op (A68_STD, ">=", m, a68_lower_int_ge3); + a68_op (A68_STD, "GE", m, a68_lower_int_ge3); + m = a68_proc (M_SHORT_INT, M_SHORT_INT, M_INT, NO_MOID); + a68_op (A68_STD, "**", m, a68_lower_pow_int); + a68_op (A68_STD, "^", m, a68_lower_pow_int); + /* INT operators. */ + m = a68_proc (M_INT, M_INT, NO_MOID); + a68_op (A68_STD, "+", m, a68_lower_confirm2); + a68_op (A68_STD, "-", m, a68_lower_negate2); + a68_op (A68_STD, "ABS", m, a68_lower_intabs2); + a68_op (A68_STD, "SIGN", m, a68_lower_sign2); + m = a68_proc (M_SHORT_INT, M_INT, NO_MOID); + a68_op (A68_STD, "SHORTEN", m, a68_lower_shortenint2); + m = a68_proc (M_LONG_INT, M_INT, NO_MOID); + a68_op (A68_STD, "LENG", m, a68_lower_lengint2); + m = a68_proc (M_BOOL, M_INT, NO_MOID); + a68_op (A68_STD, "ODD", m, a68_lower_odd2); + m = a68_proc (M_BOOL, M_INT, M_INT, NO_MOID); + a68_op (A68_STD, "=", m, a68_lower_int_eq3); + a68_op (A68_STD, "/=", m, a68_lower_int_ne3); + a68_op (A68_STD, "<", m, a68_lower_int_lt3); + a68_op (A68_STD, "<=", m, a68_lower_int_le3); + a68_op (A68_STD, ">", m, a68_lower_int_gt3); + a68_op (A68_STD, ">=", m, a68_lower_int_ge3); + a68_op (A68_STD, "EQ", m, a68_lower_int_eq3); + a68_op (A68_STD, "NE", m, a68_lower_int_ne3); + a68_op (A68_STD, "LT", m, a68_lower_int_lt3); + a68_op (A68_STD, "LE", m, a68_lower_int_le3); + a68_op (A68_STD, "GT", m, a68_lower_int_gt3); + a68_op (A68_STD, "GE", m, a68_lower_int_ge3); + m = a68_proc (M_INT, M_INT, M_INT, NO_MOID); + a68_op (A68_STD, "+", m, a68_lower_plus_int); + a68_op (A68_STD, "-", m, a68_lower_minus_int); + a68_op (A68_STD, "*", m, a68_lower_mult_int); + a68_op (A68_STD, "OVER", m, a68_lower_over3); + a68_op (A68_STD, "%", m, a68_lower_over3); + a68_op (A68_STD, "MOD", m, a68_lower_mod3); + a68_op (A68_STD, "%*", m, a68_lower_mod3); + a68_op (A68_STD, "**", m, a68_lower_pow_int); + a68_op (A68_STD, "^", m, a68_lower_pow_int); + m = a68_proc (M_REAL, M_INT, M_INT, NO_MOID); + a68_op (A68_STD, "/", m, a68_lower_rdiv3); + m = a68_proc (M_REF_INT, M_REF_INT, M_INT, NO_MOID); + a68_op (A68_STD, "+:=", m, a68_lower_plusab3); + a68_op (A68_STD, "-:=", m, a68_lower_minusab3); + a68_op (A68_STD, "*:=", m, a68_lower_multab3); + a68_op (A68_STD, "%:=", m, a68_lower_overab3); + a68_op (A68_STD, "%*:=", m, a68_lower_modab3); + a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3); + a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3); + a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3); + a68_op (A68_STD, "OVERAB", m, a68_lower_overab3); + a68_op (A68_STD, "MODAB", m, a68_lower_modab3); + /* LONG INT operators */ + m = a68_proc (M_LONG_INT, M_LONG_INT, NO_MOID); + a68_op (A68_STD, "+", m, a68_lower_confirm2); + a68_op (A68_STD, "-", m, a68_lower_negate2); + a68_op (A68_STD, "ABS", m, a68_lower_intabs2); + m = a68_proc (M_INT, M_LONG_INT, NO_MOID); + a68_op (A68_STD, "SHORTEN", m, a68_lower_shortenint2); + a68_op (A68_STD, "SIGN", m, a68_lower_sign2); + m = a68_proc (M_LONG_LONG_INT, M_LONG_INT, NO_MOID); + a68_op (A68_STD, "LENG", m, a68_lower_lengint2); + m = a68_proc (M_BOOL, M_LONG_INT, NO_MOID); + a68_op (A68_STD, "ODD", m, a68_lower_odd2); + m = a68_proc (M_LONG_INT, M_LONG_INT, M_LONG_INT, NO_MOID); + a68_op (A68_STD, "+", m, a68_lower_plus_int); + a68_op (A68_STD, "-", m, a68_lower_minus_int); + a68_op (A68_STD, "*", m, a68_lower_mult_int); + a68_op (A68_STD, "OVER", m, a68_lower_over3); + a68_op (A68_STD, "%", m, a68_lower_over3); + a68_op (A68_STD, "MOD", m, a68_lower_mod3); + a68_op (A68_STD, "%*", m, a68_lower_mod3); + m = a68_proc (M_REF_LONG_INT, M_REF_LONG_INT, M_LONG_INT, NO_MOID); + a68_op (A68_STD, "+:=", m, a68_lower_plusab3); + a68_op (A68_STD, "-:=", m, a68_lower_minusab3); + a68_op (A68_STD, "*:=", m, a68_lower_multab3); + a68_op (A68_STD, "%:=", m, a68_lower_overab3); + a68_op (A68_STD, "%*:=", m, a68_lower_modab3); + a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3); + a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3); + a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3); + a68_op (A68_STD, "OVERAB", m, a68_lower_overab3); + a68_op (A68_STD, "MODAB", m, a68_lower_modab3); + m = a68_proc (M_BOOL, M_LONG_INT, M_LONG_INT, NO_MOID); + a68_op (A68_STD, "=", m, a68_lower_int_eq3); + a68_op (A68_STD, "EQ", m, a68_lower_int_eq3); + a68_op (A68_STD, "/=", m, a68_lower_int_ne3); + a68_op (A68_STD, "NE", m, a68_lower_int_ne3); + a68_op (A68_STD, "<", m, a68_lower_int_lt3); + a68_op (A68_STD, "LT", m, a68_lower_int_lt3); + a68_op (A68_STD, "<=", m, a68_lower_int_le3); + a68_op (A68_STD, "LE", m, a68_lower_int_le3); + a68_op (A68_STD, ">", m, a68_lower_int_gt3); + a68_op (A68_STD, "GT", m, a68_lower_int_gt3); + a68_op (A68_STD, ">=", m, a68_lower_int_ge3); + a68_op (A68_STD, "GE", m, a68_lower_int_ge3); + m = a68_proc (M_LONG_REAL, M_LONG_INT, M_LONG_INT, NO_MOID); + a68_op (A68_STD, "/", m, a68_lower_rdiv3); + m = a68_proc (M_LONG_INT, M_LONG_INT, M_INT, NO_MOID); + a68_op (A68_STD, "**", m, a68_lower_pow_int); + a68_op (A68_STD, "^", m, a68_lower_pow_int); + /* LONG LONG INT operators. */ + m = a68_proc (M_LONG_LONG_INT, M_LONG_LONG_INT, NO_MOID); + a68_op (A68_STD, "+", m, a68_lower_confirm2); + a68_op (A68_STD, "-", m, a68_lower_negate2); + a68_op (A68_STD, "ABS", m, a68_lower_intabs2); + m = a68_proc (M_INT, M_LONG_LONG_INT, NO_MOID); + a68_op (A68_STD, "SIGN", m, a68_lower_sign2); + m = a68_proc (M_LONG_INT, M_LONG_LONG_INT, NO_MOID); + a68_op (A68_STD, "SHORTEN", m, a68_lower_shortenint2); + m = a68_proc (M_BOOL, M_LONG_LONG_INT, NO_MOID); + a68_op (A68_STD, "ODD", m, a68_lower_odd2); + m = a68_proc (M_LONG_LONG_INT, M_LONG_LONG_INT, M_LONG_LONG_INT, NO_MOID); + a68_op (A68_STD, "+", m, a68_lower_plus_int); + a68_op (A68_STD, "-", m, a68_lower_minus_int); + a68_op (A68_STD, "*", m, a68_lower_mult_int); + a68_op (A68_STD, "OVER", m, a68_lower_over3); + a68_op (A68_STD, "%", m, a68_lower_over3); + a68_op (A68_STD, "MOD", m, a68_lower_mod3); + a68_op (A68_STD, "%*", m, a68_lower_mod3); + m = a68_proc (M_REF_LONG_LONG_INT, M_REF_LONG_LONG_INT, M_LONG_LONG_INT, NO_MOID); + a68_op (A68_STD, "+:=", m, a68_lower_plusab3); + a68_op (A68_STD, "-:=", m, a68_lower_minusab3); + a68_op (A68_STD, "*:=", m, a68_lower_multab3); + a68_op (A68_STD, "%:=", m, a68_lower_overab3); + a68_op (A68_STD, "%*:=", m, a68_lower_modab3); + a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3); + a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3); + a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3); + a68_op (A68_STD, "OVERAB", m, a68_lower_overab3); + a68_op (A68_STD, "MODAB", m, a68_lower_modab3); + m = a68_proc (M_LONG_LONG_REAL, M_LONG_LONG_INT, M_LONG_LONG_INT, NO_MOID); + a68_op (A68_STD, "/", m, a68_lower_rdiv3); + m = a68_proc (M_BOOL, M_LONG_LONG_INT, M_LONG_LONG_INT, NO_MOID); + a68_op (A68_STD, "EQ", m, a68_lower_int_eq3); + a68_op (A68_STD, "NE", m, a68_lower_int_ne3); + a68_op (A68_STD, "GE", m, a68_lower_int_ge3); + a68_op (A68_STD, "GT", m, a68_lower_int_gt3); + a68_op (A68_STD, "LE", m, a68_lower_int_le3); + a68_op (A68_STD, "LT", m, a68_lower_int_lt3); + a68_op (A68_STD, "=", m, a68_lower_int_eq3); + a68_op (A68_STD, ">=", m, a68_lower_int_ge3); + a68_op (A68_STD, ">", m, a68_lower_int_gt3); + a68_op (A68_STD, "<=", m, a68_lower_int_le3); + a68_op (A68_STD, "<", m, a68_lower_int_lt3); + a68_op (A68_STD, "/=", m, a68_lower_int_ne3); + m = a68_proc (M_LONG_LONG_INT, M_LONG_LONG_INT, M_INT, NO_MOID); + a68_op (A68_STD, "**", m, a68_lower_pow_int); + a68_op (A68_STD, "^", m, a68_lower_pow_int); + /* SHORT SHORT BITS operators */ + m = a68_proc (M_BOOL, M_SHORT_SHORT_BITS, M_SHORT_SHORT_BITS, NO_MOID); + a68_op (A68_STD, "=", m, a68_lower_bit_eq3); + a68_op (A68_STD, "EQ", m, a68_lower_bit_eq3); + a68_op (A68_STD, "/=", m, a68_lower_bit_ne3); + a68_op (A68_STD, "NE", m, a68_lower_bit_ne3); + a68_op (A68_STD, "<=", m, a68_lower_bit_le3); + a68_op (A68_STD, "LE", m, a68_lower_bit_le3); + a68_op (A68_STD, ">=", m, a68_lower_bit_ge3); + a68_op (A68_STD, "GE", m, a68_lower_bit_ge3); + m = a68_proc (M_SHORT_SHORT_BITS, M_SHORT_SHORT_BITS, NO_MOID); + a68_op (A68_STD, "NOT", m, a68_lower_bitnot2); + a68_op (A68_STD, "~", m, a68_lower_bitnot2); + m = a68_proc (M_SHORT_SHORT_BITS, M_SHORT_SHORT_BITS, M_SHORT_SHORT_BITS, NO_MOID); + a68_op (A68_STD, "AND", m, a68_lower_bitand3); + a68_op (A68_STD, "OR", m, a68_lower_bitior3); + m = a68_proc (M_SHORT_SHORT_BITS, M_SHORT_SHORT_BITS, M_INT, NO_MOID); + a68_op (A68_STD, "SHL", m, a68_lower_shl3); + a68_op (A68_STD, "UP", m, a68_lower_shl3); + a68_op (A68_STD, "SHR", m, a68_lower_shr3); + a68_op (A68_STD, "DOWN", m, a68_lower_shr3); + m = a68_proc (M_BOOL, M_INT, M_SHORT_SHORT_BITS, NO_MOID); + a68_op (A68_STD, "ELEM", m, a68_lower_bitelem3); + m = a68_proc (M_SHORT_SHORT_BITS, M_SHORT_SHORT_INT, NO_MOID); + a68_op (A68_STD, "BIN", m, a68_lower_bin2); + m = a68_proc (M_SHORT_SHORT_INT, M_SHORT_SHORT_BITS, NO_MOID); + a68_op (A68_STD, "ABS", m, a68_lower_bitabs2); + m = a68_proc (M_SHORT_BITS, M_SHORT_SHORT_BITS, NO_MOID); + a68_op (A68_STD, "LENG", m, a68_lower_bitleng2); + /* SHORT BITS operatos. */ + m = a68_proc (M_SHORT_INT, M_SHORT_BITS, NO_MOID); + a68_op (A68_STD, "ABS", m, a68_lower_bitabs2); + m = a68_proc (M_SHORT_BITS, M_SHORT_INT, NO_MOID); + a68_op (A68_STD, "BIN", m, a68_lower_bin2); + m = a68_proc (M_SHORT_BITS, M_SHORT_BITS, NO_MOID); + a68_op (A68_STD, "NOT", m, a68_lower_bitnot2); + a68_op (A68_STD, "~", m, a68_lower_bitnot2); + m = a68_proc (M_BOOL, M_SHORT_BITS, M_SHORT_BITS, NO_MOID); + a68_op (A68_STD, "=", m, a68_lower_bit_eq3); + a68_op (A68_STD, "EQ", m, a68_lower_bit_eq3); + a68_op (A68_STD, "/=", m, a68_lower_bit_ne3); + a68_op (A68_STD, "NE", m, a68_lower_bit_ne3); + a68_op (A68_STD, "<=", m, a68_lower_bit_le3); + a68_op (A68_STD, "LE", m, a68_lower_bit_le3); + a68_op (A68_STD, ">=", m, a68_lower_bit_ge3); + a68_op (A68_STD, "GE", m, a68_lower_bit_ge3); + m = a68_proc (M_SHORT_BITS, M_SHORT_BITS, M_SHORT_BITS, NO_MOID); + a68_op (A68_STD, "AND", m, a68_lower_bitand3); + a68_op (A68_STD, "OR", m, a68_lower_bitior3); + m = a68_proc (M_SHORT_BITS, M_SHORT_BITS, M_INT, NO_MOID); + a68_op (A68_STD, "SHL", m, a68_lower_shl3); + a68_op (A68_STD, "UP", m, a68_lower_shl3); + a68_op (A68_STD, "SHR", m, a68_lower_shr3); + a68_op (A68_STD, "DOWN", m, a68_lower_shr3); + m = a68_proc (M_BOOL, M_INT, M_SHORT_BITS, NO_MOID); + a68_op (A68_STD, "ELEM", m, a68_lower_bitelem3); + m = a68_proc (M_SHORT_SHORT_BITS, M_SHORT_BITS, NO_MOID); + a68_op (A68_STD, "SHORTEN", m, a68_lower_bitshorten2); + m = a68_proc (M_BITS, M_SHORT_BITS, NO_MOID); + a68_op (A68_STD, "LENG", m, a68_lower_bitleng2); + /* BITS operators. */ + m = a68_proc (M_INT, M_BITS, NO_MOID); + a68_op (A68_STD, "ABS", m, a68_lower_bitabs2); + m = a68_proc (M_BITS, M_INT, NO_MOID); + a68_op (A68_STD, "BIN", m, a68_lower_bin2); + m = a68_proc (M_BITS, M_BITS, NO_MOID); + a68_op (A68_STD, "NOT", m, a68_lower_bitnot2); + a68_op (A68_STD, "~", m, a68_lower_bitnot2); + m = a68_proc (M_BOOL, M_BITS, M_BITS, NO_MOID); + a68_op (A68_STD, "=", m, a68_lower_bit_eq3); + a68_op (A68_STD, "/=", m, a68_lower_bit_ne3); + a68_op (A68_STD, "<=", m, a68_lower_bit_le3); + a68_op (A68_STD, ">=", m, a68_lower_bit_ge3); + a68_op (A68_STD, "EQ", m, a68_lower_bit_eq3); + a68_op (A68_STD, "NE", m, a68_lower_bit_ne3); + a68_op (A68_STD, "LE", m, a68_lower_bit_le3); + a68_op (A68_STD, "GE", m, a68_lower_bit_ge3); + m = a68_proc (M_BITS, M_BITS, M_BITS, NO_MOID); + a68_op (A68_STD, "AND", m, a68_lower_bitand3); + a68_op (A68_STD, "OR", m, a68_lower_bitior3); + m = a68_proc (M_BITS, M_BITS, M_INT, NO_MOID); + a68_op (A68_STD, "SHL", m, a68_lower_shl3); + a68_op (A68_STD, "UP", m, a68_lower_shl3); + a68_op (A68_STD, "SHR", m, a68_lower_shr3); + a68_op (A68_STD, "DOWN", m, a68_lower_shr3); + m = a68_proc (M_BOOL, M_INT, M_BITS, NO_MOID); + a68_op (A68_STD, "ELEM", m, a68_lower_bitelem3); + m = a68_proc (M_LONG_BITS, M_BITS, NO_MOID); + a68_op (A68_STD, "LENG", m, a68_lower_bitleng2); + m = a68_proc (M_SHORT_BITS, M_BITS, NO_MOID); + a68_op (A68_STD, "SHORTEN", m, a68_lower_bitshorten2); + /* LONG BITS operatos. */ + m = a68_proc (M_LONG_INT, M_LONG_BITS, NO_MOID); + a68_op (A68_STD, "ABS", m, a68_lower_bitabs2); + m = a68_proc (M_LONG_BITS, M_LONG_INT, NO_MOID); + a68_op (A68_STD, "BIN", m, a68_lower_bin2); + m = a68_proc (M_LONG_BITS, M_LONG_BITS, NO_MOID); + a68_op (A68_STD, "NOT", m, a68_lower_bitnot2); + a68_op (A68_STD, "~", m, a68_lower_bitnot2); + m = a68_proc (M_BOOL, M_LONG_BITS, M_LONG_BITS, NO_MOID); + a68_op (A68_STD, "=", m, a68_lower_bit_eq3); + a68_op (A68_STD, "EQ", m, a68_lower_bit_eq3); + a68_op (A68_STD, "/=", m, a68_lower_bit_ne3); + a68_op (A68_STD, "NE", m, a68_lower_bit_ne3); + a68_op (A68_STD, "<=", m, a68_lower_bit_le3); + a68_op (A68_STD, "LE", m, a68_lower_bit_le3); + a68_op (A68_STD, ">=", m, a68_lower_bit_ge3); + a68_op (A68_STD, "GE", m, a68_lower_bit_ge3); + m = a68_proc (M_LONG_BITS, M_LONG_BITS, M_LONG_BITS, NO_MOID); + a68_op (A68_STD, "AND", m, a68_lower_bitand3); + a68_op (A68_STD, "OR", m, a68_lower_bitior3); + m = a68_proc (M_LONG_BITS, M_LONG_BITS, M_INT, NO_MOID); + a68_op (A68_STD, "SHL", m, a68_lower_shl3); + a68_op (A68_STD, "UP", m, a68_lower_shl3); + a68_op (A68_STD, "SHR", m, a68_lower_shr3); + a68_op (A68_STD, "DOWN", m, a68_lower_shr3); + m = a68_proc (M_BOOL, M_INT, M_LONG_BITS, NO_MOID); + a68_op (A68_STD, "ELEM", m, a68_lower_bitelem3); + m = a68_proc (M_BITS, M_LONG_BITS, NO_MOID); + a68_op (A68_STD, "SHORTEN", m, a68_lower_bitshorten2); + m = a68_proc (M_LONG_LONG_BITS, M_LONG_BITS, NO_MOID); + a68_op (A68_STD, "LENG", m, a68_lower_bitleng2); + /* LONG LONG BITS operators */ + m = a68_proc (M_BOOL, M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID); + a68_op (A68_STD, "=", m, a68_lower_bit_eq3); + a68_op (A68_STD, "EQ", m, a68_lower_bit_eq3); + a68_op (A68_STD, "/=", m, a68_lower_bit_ne3); + a68_op (A68_STD, "NE", m, a68_lower_bit_ne3); + a68_op (A68_STD, "<=", m, a68_lower_bit_le3); + a68_op (A68_STD, "LE", m, a68_lower_bit_le3); + a68_op (A68_STD, ">=", m, a68_lower_bit_ge3); + a68_op (A68_STD, "GE", m, a68_lower_bit_ge3); + m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID); + a68_op (A68_STD, "NOT", m, a68_lower_bitnot2); + a68_op (A68_STD, "~", m, a68_lower_bitnot2); + m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID); + a68_op (A68_STD, "AND", m, a68_lower_bitand3); + a68_op (A68_STD, "OR", m, a68_lower_bitior3); + m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, M_INT, NO_MOID); + a68_op (A68_STD, "SHL", m, a68_lower_shl3); + a68_op (A68_STD, "UP", m, a68_lower_shl3); + a68_op (A68_STD, "SHR", m, a68_lower_shr3); + a68_op (A68_STD, "DOWN", m, a68_lower_shr3); + m = a68_proc (M_BOOL, M_INT, M_LONG_LONG_BITS, NO_MOID); + a68_op (A68_STD, "ELEM", m, a68_lower_bitelem3); + m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_INT, NO_MOID); + a68_op (A68_STD, "BIN", m, a68_lower_bin2); + m = a68_proc (M_LONG_LONG_INT, M_LONG_LONG_BITS, NO_MOID); + a68_op (A68_STD, "ABS", m, a68_lower_bitabs2); + m = a68_proc (M_LONG_BITS, M_LONG_LONG_BITS, NO_MOID); + a68_op (A68_STD, "SHORTEN", m, a68_lower_bitshorten2); + /* REAL operators. */ + m = A68_MCACHE (proc_real_real); + a68_op (A68_STD, "+", m, a68_lower_confirm2); + a68_op (A68_STD, "-", m, a68_lower_negate2); + a68_op (A68_STD, "ABS", m, a68_lower_realabs2); + m = a68_proc (M_INT, M_REAL, NO_MOID); + a68_op (A68_STD, "SIGN", m, a68_lower_realsign2); + a68_op (A68_STD, "ROUND", m, a68_lower_round2); + a68_op (A68_STD, "ENTIER", m, a68_lower_entier2); + m = a68_proc (M_BOOL, M_REAL, M_REAL, NO_MOID); + a68_op (A68_STD, "=", m, a68_lower_real_eq3); + a68_op (A68_STD, "/=", m, a68_lower_real_ne3); + a68_op (A68_STD, "<", m, a68_lower_real_lt3); + a68_op (A68_STD, "<=", m, a68_lower_real_le3); + a68_op (A68_STD, ">", m, a68_lower_real_gt3); + a68_op (A68_STD, ">=", m, a68_lower_real_ge3); + a68_op (A68_STD, "EQ", m, a68_lower_real_eq3); + a68_op (A68_STD, "NE", m, a68_lower_real_ne3); + a68_op (A68_STD, "LT", m, a68_lower_real_lt3); + a68_op (A68_STD, "LE", m, a68_lower_real_le3); + a68_op (A68_STD, "GT", m, a68_lower_real_gt3); + a68_op (A68_STD, "GE", m, a68_lower_real_ge3); + m = A68_MCACHE (proc_real_real_real); + a68_op (A68_STD, "+", m, a68_lower_plus_real); + a68_op (A68_STD, "-", m, a68_lower_minus_real); + a68_op (A68_STD, "*", m, a68_lower_mult_real); + a68_op (A68_STD, "/", m, a68_lower_div3); + a68_op (A68_STD, "**", m, a68_lower_pow_real); + a68_op (A68_STD, "^", m, a68_lower_pow_real); + m = a68_proc (M_REAL, M_REAL, M_INT, NO_MOID); + a68_op (A68_STD, "**", m, a68_lower_pow_real); + a68_op (A68_STD, "^", m, a68_lower_pow_real); + m = a68_proc (M_REF_REAL, M_REF_REAL, M_REAL, NO_MOID); + a68_op (A68_STD, "+:=", m, a68_lower_plusab3); + a68_op (A68_STD, "-:=", m, a68_lower_minusab3); + a68_op (A68_STD, "*:=", m, a68_lower_multab3); + a68_op (A68_STD, "/:=", m, a68_lower_divab3); + a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3); + a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3); + a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3); + a68_op (A68_STD, "DIVAB", m, a68_lower_divab3); + m = a68_proc (M_LONG_REAL, M_REAL, NO_MOID); + a68_op (A68_STD, "LENG", m, a68_lower_lengreal2); + /* LONG REAL operators */ + m = a68_proc (M_LONG_LONG_REAL, M_LONG_REAL, NO_MOID); + a68_op (A68_STD, "LENG", m, a68_lower_lengreal2); + m = a68_proc (M_REAL, M_LONG_REAL, NO_MOID); + a68_op (A68_STD, "SHORTEN", m, a68_lower_shortenreal2); + m = a68_proc (M_LONG_REAL, M_LONG_REAL, NO_MOID); + a68_op (A68_STD, "+", m, a68_lower_confirm2); + a68_op (A68_STD, "-", m, a68_lower_negate2); + a68_op (A68_STD, "ABS", m, a68_lower_realabs2); + m = a68_proc (M_INT, M_LONG_REAL, NO_MOID); + a68_op (A68_STD, "SIGN", m, a68_lower_realsign2); + m = a68_proc (M_LONG_INT, M_LONG_REAL, NO_MOID); + a68_op (A68_STD, "ENTIER", m, a68_lower_entier2); + a68_op (A68_STD, "ROUND", m, a68_lower_round2); + m = a68_proc (M_LONG_REAL, M_LONG_REAL, M_LONG_REAL, NO_MOID); + a68_op (A68_STD, "+", m, a68_lower_plus_real); + a68_op (A68_STD, "-", m, a68_lower_minus_real); + a68_op (A68_STD, "*", m, a68_lower_mult_real); + a68_op (A68_STD, "/", m, a68_lower_div3); + a68_op (A68_STD, "**", m, a68_lower_pow_real); + a68_op (A68_STD, "^", m, a68_lower_pow_real); + m = a68_proc (M_REF_LONG_REAL, M_REF_LONG_REAL, M_LONG_REAL, NO_MOID); + a68_op (A68_STD, "+:=", m, a68_lower_plusab3); + a68_op (A68_STD, "-:=", m, a68_lower_minusab3); + a68_op (A68_STD, "*:=", m, a68_lower_multab3); + a68_op (A68_STD, "/:=", m, a68_lower_divab3); + a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3); + a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3); + a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3); + a68_op (A68_STD, "DIVAB", m, a68_lower_divab3); + m = a68_proc (M_BOOL, M_LONG_REAL, M_LONG_REAL, NO_MOID); + a68_op (A68_STD, "=", m, a68_lower_real_eq3); + a68_op (A68_STD, "EQ", m, a68_lower_real_eq3); + a68_op (A68_STD, "/=", m, a68_lower_real_ne3); + a68_op (A68_STD, "NE", m, a68_lower_real_ne3); + a68_op (A68_STD, "<", m, a68_lower_real_lt3); + a68_op (A68_STD, "LT", m, a68_lower_real_lt3); + a68_op (A68_STD, "<=", m, a68_lower_real_le3); + a68_op (A68_STD, "LE", m, a68_lower_real_le3); + a68_op (A68_STD, ">", m, a68_lower_real_gt3); + a68_op (A68_STD, "GT", m, a68_lower_real_gt3); + a68_op (A68_STD, ">=", m, a68_lower_real_ge3); + a68_op (A68_STD, "GE", m, a68_lower_real_ge3); + m = a68_proc (M_LONG_REAL, M_LONG_REAL, M_INT, NO_MOID); + a68_op (A68_STD, "**", m, a68_lower_pow_real); + a68_op (A68_STD, "^", m, a68_lower_pow_real); + /* LONG LONG REAL operators. */ + m = a68_proc (M_LONG_REAL, M_LONG_LONG_REAL, NO_MOID); + a68_op (A68_STD, "SHORTEN", m, a68_lower_shortenreal2); + m = a68_proc (M_LONG_LONG_REAL, M_LONG_LONG_REAL, NO_MOID); + a68_op (A68_STD, "ABS", m, a68_lower_realabs2); + a68_op (A68_STD, "+", m, a68_lower_confirm2); + a68_op (A68_STD, "-", m, a68_lower_negate2); + m = a68_proc (M_INT, M_LONG_LONG_REAL, NO_MOID); + a68_op (A68_STD, "SIGN", m, a68_lower_realsign2); + m = a68_proc (M_LONG_LONG_INT, M_LONG_LONG_REAL, NO_MOID); + a68_op (A68_STD, "ENTIER", m, a68_lower_entier2); + a68_op (A68_STD, "ROUND", m, a68_lower_round2); + m = a68_proc (M_LONG_LONG_REAL, M_LONG_LONG_REAL, M_LONG_LONG_REAL, NO_MOID); + a68_op (A68_STD, "+", m, a68_lower_plus_real); + a68_op (A68_STD, "-", m, a68_lower_minus_real); + a68_op (A68_STD, "*", m, a68_lower_mult_real); + a68_op (A68_STD, "/", m, a68_lower_div3); + a68_op (A68_STD, "**", m, a68_lower_pow_real); + a68_op (A68_STD, "^", m, a68_lower_pow_real); + m = a68_proc (M_REF_LONG_LONG_REAL, M_REF_LONG_LONG_REAL, M_LONG_LONG_REAL, NO_MOID); + a68_op (A68_STD, "+:=", m, a68_lower_plusab3); + a68_op (A68_STD, "-:=", m, a68_lower_minusab3); + a68_op (A68_STD, "*:=", m, a68_lower_multab3); + a68_op (A68_STD, "/:=", m, a68_lower_divab3); + a68_op (A68_STD, "PLUSAB", m, a68_lower_plusab3); + a68_op (A68_STD, "MINUSAB", m, a68_lower_minusab3); + a68_op (A68_STD, "TIMESAB", m, a68_lower_multab3); + a68_op (A68_STD, "DIVAB", m, a68_lower_divab3); + m = a68_proc (M_BOOL, M_LONG_LONG_REAL, M_LONG_LONG_REAL, NO_MOID); + a68_op (A68_STD, "=", m, a68_lower_real_eq3); + a68_op (A68_STD, "EQ", m, a68_lower_real_eq3); + a68_op (A68_STD, "/=", m, a68_lower_real_ne3); + a68_op (A68_STD, "NE", m, a68_lower_real_ne3); + a68_op (A68_STD, "<", m, a68_lower_real_lt3); + a68_op (A68_STD, "LT", m, a68_lower_real_lt3); + a68_op (A68_STD, "<=", m, a68_lower_real_le3); + a68_op (A68_STD, "LE", m, a68_lower_real_le3); + a68_op (A68_STD, ">", m, a68_lower_real_gt3); + a68_op (A68_STD, "GT", m, a68_lower_real_gt3); + a68_op (A68_STD, ">=", m, a68_lower_real_ge3); + a68_op (A68_STD, "GE", m, a68_lower_real_ge3); + m = a68_proc (M_LONG_LONG_REAL, M_LONG_LONG_REAL, M_INT, NO_MOID); + a68_op (A68_STD, "**", m, a68_lower_pow_real); + a68_op (A68_STD, "^", m, a68_lower_pow_real); + /* ROWS operators. */ + m = a68_proc (M_INT, M_ROWS, NO_MOID); + a68_op (A68_STD, "LWB", m, a68_lower_lwb2); + a68_op (A68_STD, "UPB", m, a68_lower_upb2); + m = a68_proc (M_INT, M_INT, M_ROWS, NO_MOID); + a68_op (A68_STD, "LWB", m, a68_lower_lwb3); + a68_op (A68_STD, "UPB", m, a68_lower_upb3); + /* BYTES operators. */ + m = a68_proc (M_BYTES, M_STRING, NO_MOID); + a68_idf (A68_STD, "bytespack", m); + m = a68_proc (M_CHAR, M_INT, M_BYTES, NO_MOID); + a68_op (A68_STD, "ELEM", m); + m = a68_proc (M_BYTES, M_BYTES, M_BYTES, NO_MOID); + a68_op (A68_STD, "+", m); + m = a68_proc (M_REF_BYTES, M_REF_BYTES, M_BYTES, NO_MOID); + a68_op (A68_STD, "+:=", m); + a68_op (A68_STD, "PLUSAB", m); + m = a68_proc (M_BOOL, M_BYTES, M_BYTES, NO_MOID); + a68_op (A68_STD, "=", m); + a68_op (A68_STD, "/=", m); + a68_op (A68_STD, "<", m); + a68_op (A68_STD, "<=", m); + a68_op (A68_STD, ">", m); + a68_op (A68_STD, ">=", m); + a68_op (A68_STD, "EQ", m); + a68_op (A68_STD, "NE", m); + a68_op (A68_STD, "LT", m); + a68_op (A68_STD, "LE", m); + a68_op (A68_STD, "GT", m); + a68_op (A68_STD, "GE", m); + /* LONG BYTES operators. */ + m = a68_proc (M_LONG_BYTES, M_BYTES, NO_MOID); + a68_op (A68_STD, "LENG", m); + m = a68_proc (M_BYTES, M_LONG_BYTES, NO_MOID); + a68_idf (A68_STD, "SHORTEN", m); + m = a68_proc (M_LONG_BYTES, M_STRING, NO_MOID); + a68_idf (A68_STD, "longbytespack", m); + m = a68_proc (M_CHAR, M_INT, M_LONG_BYTES, NO_MOID); + a68_op (A68_STD, "ELEM", m); + m = a68_proc (M_LONG_BYTES, M_LONG_BYTES, M_LONG_BYTES, NO_MOID); + a68_op (A68_STD, "+", m); + m = a68_proc (M_REF_LONG_BYTES, M_REF_LONG_BYTES, M_LONG_BYTES, NO_MOID); + a68_op (A68_STD, "+:=", m); + a68_op (A68_STD, "PLUSAB", m); + m = a68_proc (M_BOOL, M_LONG_BYTES, M_LONG_BYTES, NO_MOID); + a68_op (A68_STD, "=", m); + a68_op (A68_STD, "/=", m); + a68_op (A68_STD, "<", m); + a68_op (A68_STD, "<=", m); + a68_op (A68_STD, ">", m); + a68_op (A68_STD, ">=", m); + a68_op (A68_STD, "EQ", m); + a68_op (A68_STD, "NE", m); + a68_op (A68_STD, "LT", m); + a68_op (A68_STD, "LE", m); + a68_op (A68_STD, "GT", m); + a68_op (A68_STD, "GE", m); + /* COMPLEX operators. */ + m = a68_proc (M_COMPLEX, M_REAL, M_REAL, NO_MOID); + a68_op (A68_STD, "I", m, a68_lower_reali); + a68_op (A68_STD, "+*", m, a68_lower_reali); + m = a68_proc (M_COMPLEX, M_INT, M_INT, NO_MOID); + a68_op (A68_STD, "I", m, a68_lower_inti); + a68_op (A68_STD, "+*", m, a68_lower_inti); + m = a68_proc (M_REAL, M_COMPLEX, NO_MOID); + a68_op (A68_STD, "RE", m, a68_lower_re2); + a68_op (A68_STD, "IM", m, a68_lower_im2); + a68_op (A68_STD, "ABS", m); + a68_op (A68_STD, "ARG", m); + m = A68_MCACHE (proc_complex_complex); + a68_op (A68_STD, "+", m); + a68_op (A68_STD, "-", m); + a68_op (A68_STD, "CONJ", m, a68_lower_conj2); + m = a68_proc (M_BOOL, M_COMPLEX, M_COMPLEX, NO_MOID); + a68_op (A68_STD, "=", m); + a68_op (A68_STD, "/=", m); + a68_op (A68_STD, "EQ", m); + a68_op (A68_STD, "NE", m); + m = a68_proc (M_COMPLEX, M_COMPLEX, M_COMPLEX, NO_MOID); + a68_op (A68_STD, "+", m); + a68_op (A68_STD, "-", m); + a68_op (A68_STD, "*", m); + a68_op (A68_STD, "/", m); + m = a68_proc (M_COMPLEX, M_COMPLEX, M_INT, NO_MOID); + a68_op (A68_STD, "**", m); + a68_op (A68_STD, "UP", m); + a68_op (A68_STD, "^", m); + m = a68_proc (M_REF_COMPLEX, M_REF_COMPLEX, M_COMPLEX, NO_MOID); + a68_op (A68_STD, "+:=", m); + a68_op (A68_STD, "-:=", m); + a68_op (A68_STD, "*:=", m); + a68_op (A68_STD, "/:=", m); + a68_op (A68_STD, "PLUSAB", m); + a68_op (A68_STD, "MINUSAB", m); + a68_op (A68_STD, "TIMESAB", m); + a68_op (A68_STD, "DIVAB", m); + m = a68_proc (M_COMPLEX, M_COMPLEX, NO_MOID); + a68_op (A68_STD, "SHORTEN", m); + /* LONG COMPLEX operators */ + m = a68_proc (M_LONG_COMPLEX, M_LONG_INT, M_LONG_INT, NO_MOID); + a68_op (A68_STD, "I", m, a68_lower_longinti); + a68_op (A68_STD, "+*", m, a68_lower_longinti); + m = a68_proc (M_LONG_COMPLEX, M_LONG_REAL, M_LONG_REAL, NO_MOID); + a68_op (A68_STD, "I", m, a68_lower_longreali); + a68_op (A68_STD, "+*", m, a68_lower_longreali); + m = a68_proc (M_LONG_LONG_COMPLEX, M_LONG_COMPLEX, NO_MOID); + a68_op (A68_STD, "LENG", m); + m = a68_proc (M_LONG_COMPLEX, M_LONG_LONG_COMPLEX, NO_MOID); + a68_op (A68_STD, "SHORTEN", m); + m = a68_proc (M_LONG_COMPLEX, M_COMPLEX, NO_MOID); + a68_op (A68_STD, "LENG", m); + m = a68_proc (M_COMPLEX, M_LONG_COMPLEX, NO_MOID); + a68_op (A68_STD, "SHORTEN", m); + m = a68_proc (M_LONG_REAL, M_LONG_COMPLEX, NO_MOID); + a68_op (A68_STD, "RE", m, a68_lower_re2); + a68_op (A68_STD, "IM", m, a68_lower_im2); + a68_op (A68_STD, "ARG", m); + a68_op (A68_STD, "ABS", m); + m = a68_proc (M_LONG_COMPLEX, M_LONG_COMPLEX, NO_MOID); + a68_op (A68_STD, "+", m); + a68_op (A68_STD, "-", m); + a68_op (A68_STD, "CONJ", m, a68_lower_conj2); + m = a68_proc (M_LONG_COMPLEX, M_LONG_COMPLEX, M_LONG_COMPLEX, NO_MOID); + a68_op (A68_STD, "+", m); + a68_op (A68_STD, "-", m); + a68_op (A68_STD, "*", m); + a68_op (A68_STD, "/", m); + m = a68_proc (M_LONG_COMPLEX, M_LONG_COMPLEX, M_INT, NO_MOID); + a68_op (A68_STD, "**", m); + a68_op (A68_STD, "UP", m); + a68_op (A68_STD, "^", m); + m = a68_proc (M_BOOL, M_LONG_COMPLEX, M_LONG_COMPLEX, NO_MOID); + a68_op (A68_STD, "=", m); + a68_op (A68_STD, "EQ", m); + a68_op (A68_STD, "/=", m); + a68_op (A68_STD, "NE", m); + m = a68_proc (M_REF_LONG_COMPLEX, M_REF_LONG_COMPLEX, M_LONG_COMPLEX, NO_MOID); + a68_op (A68_STD, "+:=", m); + a68_op (A68_STD, "-:=", m); + a68_op (A68_STD, "*:=", m); + a68_op (A68_STD, "/:=", m); + a68_op (A68_STD, "PLUSAB", m); + a68_op (A68_STD, "MINUSAB", m); + a68_op (A68_STD, "TIMESAB", m); + a68_op (A68_STD, "DIVAB", m); + /* LONG LONG COMPLEX operators. */ + m = a68_proc (M_LONG_LONG_COMPLEX, M_LONG_LONG_INT, M_LONG_LONG_INT, NO_MOID); + a68_op (A68_STD, "I", m, a68_lower_longlonginti); + a68_op (A68_STD, "+*", m, a68_lower_longlonginti); + m = a68_proc (M_LONG_LONG_COMPLEX, M_LONG_LONG_REAL, M_LONG_LONG_REAL, NO_MOID); + a68_op (A68_STD, "I", m, a68_lower_longlongreali); + a68_op (A68_STD, "+*", m, a68_lower_longlongreali); + m = a68_proc (M_LONG_LONG_REAL, M_LONG_LONG_COMPLEX, NO_MOID); + a68_op (A68_STD, "RE", m, a68_lower_re2); + a68_op (A68_STD, "IM", m, a68_lower_im2); + a68_op (A68_STD, "ARG", m); + a68_op (A68_STD, "ABS", m); + m = a68_proc (M_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX, NO_MOID); + a68_op (A68_STD, "+", m); + a68_op (A68_STD, "-", m); + a68_op (A68_STD, "CONJ", m, a68_lower_conj2); + m = a68_proc (M_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX, NO_MOID); + a68_op (A68_STD, "+", m); + a68_op (A68_STD, "-", m); + a68_op (A68_STD, "*", m); + a68_op (A68_STD, "/", m); + m = a68_proc (M_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX, M_INT, NO_MOID); + a68_op (A68_STD, "**", m); + a68_op (A68_STD, "UP", m); + a68_op (A68_STD, "^", m); + m = a68_proc (M_BOOL, M_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX, NO_MOID); + a68_op (A68_STD, "=", m); + a68_op (A68_STD, "EQ", m); + a68_op (A68_STD, "/=", m); + a68_op (A68_STD, "NE", m); + m = a68_proc (M_REF_LONG_LONG_COMPLEX, M_REF_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX, NO_MOID); + a68_op (A68_STD, "+:=", m); + a68_op (A68_STD, "-:=", m); + a68_op (A68_STD, "*:=", m); + a68_op (A68_STD, "/:=", m); + a68_op (A68_STD, "PLUSAB", m); + a68_op (A68_STD, "MINUSAB", m); + a68_op (A68_STD, "TIMESAB", m); + a68_op (A68_STD, "DIVAB", m); + m = a68_proc (M_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX, NO_MOID); + a68_op (A68_STD, "LENG", m); + /* SEMA operators. */ + m = a68_proc (M_SEMA, M_INT, NO_MOID); + a68_op (A68_STD, "LEVEL", m); + m = a68_proc (M_INT, M_SEMA, NO_MOID); + a68_op (A68_STD, "LEVEL", m); + m = a68_proc (M_VOID, M_SEMA, NO_MOID); + a68_op (A68_STD, "UP", m); + a68_op (A68_STD, "DOWN", m); +} + +/* GNU extensions for the standenv. */ + +static void +gnu_prelude (void) +{ + MOID_T *m = NO_MOID; + /* Priorities. */ + a68_prio ("ELEMS", 8); + /* Identifiers. */ + a68_idf (A68_EXT, "infinity", M_REAL, a68_lower_infinity); + a68_idf (A68_EXT, "minusinfinity", M_REAL, a68_lower_minusinfinity); + a68_idf (A68_EXT, "longlonginfinity", M_LONG_LONG_REAL); + a68_idf (A68_EXT, "longlongminusinfinity", M_LONG_LONG_REAL); + a68_idf (A68_EXT, "longinfinity", M_LONG_REAL); + a68_idf (A68_EXT, "longminusinfinity", M_LONG_REAL); + a68_idf (A68_EXT, "minint", M_INT, a68_lower_minint); + a68_idf (A68_EXT, "longminint", M_LONG_INT, a68_lower_minint); + a68_idf (A68_EXT, "longlongminint", M_LONG_LONG_INT, a68_lower_minint); + a68_idf (A68_EXT, "shortminint", M_SHORT_INT, a68_lower_minint); + a68_idf (A68_EXT, "shortshortminint", M_SHORT_SHORT_INT, a68_lower_minint); + a68_idf (A68_EXT, "minreal", M_REAL, a68_lower_minreal); + a68_idf (A68_EXT, "longminreal", M_LONG_REAL, a68_lower_minreal); + a68_idf (A68_EXT, "longlongminreal", M_LONG_LONG_REAL, a68_lower_minreal); + a68_idf (A68_EXT, "eofchar", M_CHAR, a68_lower_eofchar); + a68_idf (A68_EXT, "replacementchar", M_CHAR, a68_lower_replacementchar); + /* REAL procedures. */ + m = A68_MCACHE (proc_real_real); + a68_idf (A68_EXT, "log", m, a68_lower_log); + /* LONG REAL procedures. */ + m = a68_proc (M_LONG_REAL, M_LONG_REAL, NO_MOID); + a68_idf (A68_EXT, "longlog", m, a68_lower_long_log); + /* LONG LONG REAL procedures. */ + m = a68_proc (M_LONG_LONG_REAL, M_LONG_LONG_REAL, NO_MOID); + a68_idf (A68_EXT, "longlonglog", m, a68_lower_long_long_log); + /* BOOL operators. */ + m = a68_proc (M_BOOL, M_BOOL, M_BOOL, NO_MOID); + a68_op (A68_EXT, "XOR", m, a68_lower_xor3); + /* SHORT SHORT BITS operators. */ + m = a68_proc (M_SHORT_SHORT_BITS, M_SHORT_SHORT_BITS, M_SHORT_SHORT_BITS, NO_MOID); + a68_op (A68_EXT, "XOR", m, a68_lower_bitxor3); + /* SHORT BITS operators. */ + m = a68_proc (M_SHORT_BITS, M_SHORT_BITS, M_SHORT_BITS, NO_MOID); + a68_op (A68_EXT, "XOR", m, a68_lower_bitxor3); + /* BITS operators. */ + m = a68_proc (M_BITS, M_BITS, M_BITS, NO_MOID); + a68_op (A68_EXT, "XOR", m, a68_lower_bitxor3); + /* LONG BITS operators. */ + m = a68_proc (M_LONG_BITS, M_LONG_BITS, M_LONG_BITS, NO_MOID); + a68_op (A68_EXT, "XOR", m, a68_lower_bitxor3); + /* LONG LONG BITS operators. */ + m = a68_proc (M_LONG_LONG_BITS, M_LONG_LONG_BITS, M_LONG_LONG_BITS, NO_MOID); + a68_op (A68_EXT, "XOR", m, a68_lower_bitxor3); + /* ROWS operators. */ + m = a68_proc (M_INT, M_ROWS, NO_MOID); + a68_op (A68_EXT, "ELEMS", m, a68_lower_elems2); + m = a68_proc (M_INT, M_INT, M_ROWS, NO_MOID); + a68_op (A68_EXT, "ELEMS", m, a68_lower_elems3); +} + +/* POSIX prelude. */ + +static void +posix_prelude (void) +{ + MOID_T *m = NO_MOID; + + /* Environment variables. */ + m = a68_proc (M_STRING, M_STRING, NO_MOID); + a68_idf (A68_EXT, "getenv", m, a68_lower_posixgetenv); + /* Exit status handling. */ + m = a68_proc (M_VOID, M_INT, NO_MOID); + a68_idf (A68_EXT, "setexitstatus", m, a68_lower_setexitstatus); + /* Argument handling. */ + m = A68_MCACHE (proc_int); + a68_idf (A68_EXT, "argc", m, a68_lower_posixargc); + m = a68_proc (M_STRING, M_INT, NO_MOID); + a68_idf (A68_EXT, "argv", m, a68_lower_posixargv); + /* Error procedures. */ + m = A68_MCACHE (proc_int); + a68_idf (A68_EXT, "errno", m, a68_lower_posixerrno); + m = a68_proc (M_VOID, M_STRING, NO_MOID); + a68_idf (A68_EXT, "perror", m, a68_lower_posixperror); + m = a68_proc (M_STRING, M_INT, NO_MOID); + a68_idf (A68_EXT, "strerror", m, a68_lower_posixstrerror); + /* I/O identifiers. */ + a68_idf (A68_EXT, "stdin", M_INT, a68_lower_posixstdinfiledes); + a68_idf (A68_EXT, "stdout", M_INT, a68_lower_posixstdoutfiledes); + a68_idf (A68_EXT, "stderr", M_INT, a68_lower_posixstderrfiledes); + a68_idf (A68_EXT, "fileodefault", M_BITS, a68_lower_posixfileodefault); + a68_idf (A68_EXT, "fileordwr", M_BITS, a68_lower_posixfileordwr); + a68_idf (A68_EXT, "fileordonly", M_BITS, a68_lower_posixfileordonly); + a68_idf (A68_EXT, "fileowronly", M_BITS, a68_lower_posixfileowronly); + a68_idf (A68_EXT, "fileotrunc", M_BITS, a68_lower_posixfileotrunc); + /* Opening and closing files. */ + m = a68_proc (M_INT, M_STRING, M_BITS, NO_MOID); + a68_idf (A68_EXT, "fopen", m, a68_lower_posixfopen); + a68_idf (A68_EXT, "fcreate", m, a68_lower_posixfcreate); + m = A68_MCACHE (proc_int_int); + a68_idf (A68_EXT, "fclose", m, a68_lower_posixfclose); + /* Getting properties of files. */ + m = a68_proc (M_LONG_LONG_INT, M_INT, NO_MOID); + a68_idf (A68_EXT, "fsize", m, a68_lower_posixfsize); + m = a68_proc (M_LONG_LONG_INT, M_INT, M_LONG_LONG_INT, M_INT, NO_MOID); + a68_idf (A68_EXT, "lseek", m, a68_lower_posixlseek); + a68_idf (A68_EXT, "seekcur", M_INT, a68_lower_posixseekcur); + a68_idf (A68_EXT, "seekend", M_INT, a68_lower_posixseekend); + a68_idf (A68_EXT, "seekset", M_INT, a68_lower_posixseekset); + /* Sockets. */ + m = a68_proc (M_INT, M_STRING, M_INT, NO_MOID); + a68_idf (A68_EXT, "fconnect", m, a68_lower_posixfconnect); + /* String and character output. */ + m = a68_proc (M_CHAR, M_CHAR, NO_MOID); + a68_idf (A68_EXT, "putchar", m, a68_lower_posixputchar); + m = a68_proc (M_VOID, M_STRING, NO_MOID); + a68_idf (A68_EXT, "puts", m, a68_lower_posixputs); + m = a68_proc (M_CHAR, M_INT, M_CHAR, NO_MOID); + a68_idf (A68_EXT, "fputc", m, a68_lower_posixfputc); + m = a68_proc (M_INT, M_INT, M_STRING, NO_MOID); + a68_idf (A68_EXT, "fputs", m, a68_lower_posixfputs); + /* String and character input. */ + m = A68_MCACHE (proc_char); + a68_idf (A68_EXT, "getchar", m, a68_lower_posixgetchar); + m = a68_proc (M_CHAR, M_INT, NO_MOID); + a68_idf (A68_EXT, "fgetc", m, a68_lower_posixfgetc); + m = a68_proc (M_REF_STRING, M_INT, NO_MOID); + a68_idf (A68_EXT, "gets", m, a68_lower_posixgets); + m = a68_proc (M_REF_STRING, M_INT, M_INT, NO_MOID); + a68_idf (A68_EXT, "fgets", m, a68_lower_posixfgets); +} + +/* Transput. */ + +static void +stand_transput (void) +{ + PACK_T *z = NO_PACK; + MOID_T *m = NO_MOID; + + /* Modes. */ + + /* NUMBER */ + z = NO_PACK; + (void) a68_add_mode_to_pack (&z, M_INT, NO_TEXT, NO_NODE); + (void) a68_add_mode_to_pack (&z, M_LONG_INT, NO_TEXT, NO_NODE); + (void) a68_add_mode_to_pack (&z, M_LONG_LONG_INT, NO_TEXT, NO_NODE); + (void) a68_add_mode_to_pack (&z, M_SHORT_INT, NO_TEXT, NO_NODE); + (void) a68_add_mode_to_pack (&z, M_SHORT_SHORT_INT, NO_TEXT, NO_NODE); + (void) a68_add_mode_to_pack (&z, M_REAL, NO_TEXT, NO_NODE); + (void) a68_add_mode_to_pack (&z, M_LONG_REAL, NO_TEXT, NO_NODE); + (void) a68_add_mode_to_pack (&z, M_LONG_LONG_REAL, NO_TEXT, NO_NODE); + M_NUMBER = a68_add_mode (&TOP_MOID (&A68_JOB), UNION_SYMBOL, a68_count_pack_members (z), NO_NODE, NO_MOID, z); + + /* Layout procedures. */ + + /* Conversion procedures. */ + m = a68_proc (M_STRING, M_NUMBER, M_INT, NO_MOID); + a68_idf (A68_STD, "whole", m); +} + +/* Build the standard environ symbol table. */ + +void +a68_make_standard_environ (void) +{ + stand_moids (); + A68_MCACHE (proc_bool) = a68_proc (M_BOOL, NO_MOID); + A68_MCACHE (proc_char) = a68_proc (M_CHAR, NO_MOID); + A68_MCACHE (proc_complex_complex) = a68_proc (M_COMPLEX, M_COMPLEX, NO_MOID); + A68_MCACHE (proc_int) = a68_proc (M_INT, NO_MOID); + A68_MCACHE (proc_int_int) = a68_proc (M_INT, M_INT, NO_MOID); + A68_MCACHE (proc_int_int_real) = a68_proc (M_REAL, M_INT, M_INT, NO_MOID); + A68_MCACHE (proc_int_real) = a68_proc (M_REAL, M_INT, NO_MOID); + A68_MCACHE (proc_int_real_real) = a68_proc (M_REAL, M_INT, M_REAL, NO_MOID); + A68_MCACHE (proc_int_real_real_real) = a68_proc (M_REAL, M_INT, M_REAL, M_REAL, NO_MOID); + A68_MCACHE (proc_real) = a68_proc (M_REAL, NO_MOID); + A68_MCACHE (proc_real_int_real) = a68_proc (M_REAL, M_REAL, M_INT, NO_MOID); + A68_MCACHE (proc_real_real_int_real) = a68_proc (M_REAL, M_REAL, M_REAL, M_INT, NO_MOID); + A68_MCACHE (proc_real_real) = M_PROC_REAL_REAL; + A68_MCACHE (proc_real_real_real) = a68_proc (M_REAL, M_REAL, M_REAL, NO_MOID); + A68_MCACHE (proc_real_real_real_int) = a68_proc (M_INT, M_REAL, M_REAL, M_REAL, NO_MOID); + A68_MCACHE (proc_real_real_real_real) = a68_proc (M_REAL, M_REAL, M_REAL, M_REAL, NO_MOID); + A68_MCACHE (proc_real_real_real_real_real) = a68_proc (M_REAL, M_REAL, M_REAL, M_REAL, M_REAL, NO_MOID); + A68_MCACHE (proc_real_real_real_real_real_real) = a68_proc (M_REAL, M_REAL, M_REAL, M_REAL, M_REAL, M_REAL, NO_MOID); + A68_MCACHE (proc_real_ref_real_ref_int_void) = a68_proc (M_VOID, M_REAL, M_REF_REAL, M_REF_INT, NO_MOID); + A68_MCACHE (proc_void) = a68_proc (M_VOID, NO_MOID); + stand_prelude (); + if (!OPTION_STRICT (&A68_JOB)) + { + gnu_prelude (); + posix_prelude (); + } + stand_transput (); +} From 942dff65c0c566d4d3a9ab9481f4c461ff22059e Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:49:23 +0200 Subject: [PATCH 157/373] a68: parser: parsing of modes Signed-off-by: Jose E. Marchesi Co-authored-by: Marcel van der Veer --- gcc/algol68/a68-moids-diagnostics.cc | 281 +++ gcc/algol68/a68-moids-misc.cc | 1396 ++++++++++++++ gcc/algol68/a68-moids-to-string.cc | 417 ++++ gcc/algol68/a68-parser-modes.cc | 1325 +++++++++++++ gcc/algol68/a68-parser-moids-check.cc | 1878 +++++++++++++++++++ gcc/algol68/a68-parser-moids-coerce.cc | 925 +++++++++ gcc/algol68/a68-parser-moids-equivalence.cc | 183 ++ gcc/algol68/a68-postulates.cc | 103 + 8 files changed, 6508 insertions(+) create mode 100644 gcc/algol68/a68-moids-diagnostics.cc create mode 100644 gcc/algol68/a68-moids-misc.cc create mode 100644 gcc/algol68/a68-moids-to-string.cc create mode 100644 gcc/algol68/a68-parser-modes.cc create mode 100644 gcc/algol68/a68-parser-moids-check.cc create mode 100644 gcc/algol68/a68-parser-moids-coerce.cc create mode 100644 gcc/algol68/a68-parser-moids-equivalence.cc create mode 100644 gcc/algol68/a68-postulates.cc diff --git a/gcc/algol68/a68-moids-diagnostics.cc b/gcc/algol68/a68-moids-diagnostics.cc new file mode 100644 index 000000000000..a984fbc868fd --- /dev/null +++ b/gcc/algol68/a68-moids-diagnostics.cc @@ -0,0 +1,281 @@ +/* MOID diagnostics routines. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "options.h" + +#include "a68.h" + +/* Give accurate error message. */ + +const char * +a68_mode_error_text (NODE_T *n, MOID_T *p, MOID_T *q, int context, int deflex, int depth) +{ +#define TAIL(z) (&(z)[strlen (z)]) +#define ACTUAL_SNPRINTF_SIZE ((SNPRINTF_SIZE - len)) + static BUFFER txt; + size_t len; + if (depth == 1) + txt[0] = '\0'; + if (IS (p, SERIES_MODE)) + { + len = strlen (txt); + PACK_T *u = PACK (p); + + int N = 0; + if (u == NO_PACK) + { + if (snprintf (txt, ACTUAL_SNPRINTF_SIZE, "empty mode-list") < 0) + gcc_unreachable (); + N++; + } + else + { + for (; u != NO_PACK; FORWARD (u)) + { + if (MOID (u) != NO_MOID) + { + if (IS (MOID (u), SERIES_MODE)) + (void) a68_mode_error_text (n, MOID (u), q, context, deflex, depth + 1); + else if (!a68_is_coercible (MOID (u), q, context, deflex)) + { + len = strlen (txt); + if (len > BUFFER_SIZE / 2) + { + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, " etcetera") < 0) + gcc_unreachable (); + N++; + } + else + { + if (len > 0) + { + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, " and ") < 0) + gcc_unreachable (); + N++; + len = strlen (txt); + } + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, "%%<%s%%>", + a68_moid_to_string (MOID (u), MOID_ERROR_WIDTH, n)) < 0) + gcc_unreachable (); + N++; + } + } + } + } + } + if (depth == 1) + { + len = strlen (txt); + if (N == 0) + { + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, "mode") < 0) + gcc_unreachable (); + len = strlen (txt); + } + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, " cannot be coerced to %%<%s%%>", + a68_moid_to_string (q, MOID_ERROR_WIDTH, n)) < 0) + gcc_unreachable (); + } + } + else if (IS (p, STOWED_MODE) && IS_FLEX (q)) + { + PACK_T *u = PACK (p); + len = strlen (txt); + if (u == NO_PACK) + { + if (snprintf (txt, ACTUAL_SNPRINTF_SIZE, "empty mode-list") < 0) + gcc_unreachable (); + } + else + { + for (; u != NO_PACK; FORWARD (u)) + { + if (!a68_is_coercible (MOID (u), SLICE (SUB (q)), context, deflex)) + { + len = strlen (txt); + if (len > BUFFER_SIZE / 2) + { + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, " etcetera") < 0) + gcc_unreachable (); + } + else + { + if (len > 0) + { + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, " and ") < 0) + gcc_unreachable (); + len = strlen (txt); + } + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, "%s", + a68_moid_to_string (MOID (u), MOID_ERROR_WIDTH, n)) < 0) + gcc_unreachable (); + } + } + } + len = strlen (txt); + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, " cannot be coerced to %%<%s%%>", + a68_moid_to_string (SLICE (SUB (q)), MOID_ERROR_WIDTH, n)) < 0) + gcc_unreachable (); + } + } + else if (IS (p, STOWED_MODE) && IS (q, ROW_SYMBOL)) + { + PACK_T *u = PACK (p); + len = strlen (txt); + if (u == NO_PACK) + { + if (snprintf (txt, ACTUAL_SNPRINTF_SIZE, "empty mode-list") < 0) + gcc_unreachable (); + } + else + { + for (; u != NO_PACK; FORWARD (u)) + { + if (!a68_is_coercible (MOID (u), SLICE (q), context, deflex)) + { + len = strlen (txt); + if (len > BUFFER_SIZE / 2) + { + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, " etcetera") < 0) + gcc_unreachable (); + } + else + { + if (len > 0) + { + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, " and ") < 0) + gcc_unreachable (); + len = strlen (txt); + } + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, "%%<%s%%>", + a68_moid_to_string (MOID (u), MOID_ERROR_WIDTH, n)) < 0) + gcc_unreachable (); + } + } + } + len = strlen (txt); + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, " cannot be coerced to %s", + a68_moid_to_string (SLICE (q), MOID_ERROR_WIDTH, n)) < 0) + gcc_unreachable (); + } + } + else if (IS (p, STOWED_MODE) && (IS (q, PROC_SYMBOL) || IS (q, STRUCT_SYMBOL))) + { + PACK_T *u = PACK (p), *v = PACK (q); + len = strlen (txt); + if (u == NO_PACK) + { + if (snprintf (txt, ACTUAL_SNPRINTF_SIZE, "empty mode-list") < 0) + gcc_unreachable (); + } + else + { + for (; u != NO_PACK && v != NO_PACK; FORWARD (u), FORWARD (v)) + { + if (!a68_is_coercible (MOID (u), MOID (v), context, deflex)) + { + len = strlen (txt); + if (len > BUFFER_SIZE / 2) + { + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, " etcetera") < 0) + gcc_unreachable (); + } + else + { + if (len > 0) + { + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, " and ") < 0) + gcc_unreachable (); + len = strlen (txt); + } + if (snprintf (TAIL (txt), ACTUAL_SNPRINTF_SIZE, "%%<%s%%> cannot be coerced to %%<%s%%>", + a68_moid_to_string (MOID (u), MOID_ERROR_WIDTH, n), + a68_moid_to_string (MOID (v), MOID_ERROR_WIDTH, n)) < 0) + gcc_unreachable (); + } + } + } + } + } + return txt; +#undef TAIL +#undef ACTUAL_SNPRINTF_SIZE +} + +/* Cannot coerce error. */ + +void +a68_cannot_coerce (NODE_T *p, MOID_T *from, MOID_T *to, int context, int deflex, int att) +{ + const char *txt = a68_mode_error_text (p, from, to, context, deflex, 1); + + if (att == STOP) + { + if (strlen (txt) == 0) + a68_error (p, "M cannot be coerced to M in C context", from, to, context); + else + a68_error (p, "Y in C context", txt, context); + } + else + { + if (strlen (txt) == 0) + a68_error (p, "M cannot be coerced to M in C-A", from, to, context, att); + else + a68_error (p, "Y in C-A", txt, context, att); + } +} + +/* Give a warning when a value is silently discarded. */ + +void +a68_warn_for_voiding (NODE_T *p, SOID_T *x, SOID_T *y, int c) +{ + (void) c; + + if (CAST (x) == false) + { + if (MOID (x) == M_VOID && MOID (y) != M_ERROR && !(MOID (y) == M_VOID || !a68_is_nonproc (MOID (y)))) + { + if (IS (p, FORMULA)) + a68_warning (p, OPT_Wvoiding, "value of M @ will be voided", MOID (y)); + else + a68_warning (p, OPT_Wvoiding, "value of M @ will be voided", MOID (y)); + } + } +} + +/* Warn for things that are likely unintended. */ + +void +a68_semantic_pitfall (NODE_T *p, MOID_T *m, int c, int u) +{ + /* semantic_pitfall: warn for things that are likely unintended, for instance + REF INT i := LOC INT := 0, which should probably be + REF INT i = LOC INT := 0. */ + if (IS (p, u)) + a68_warning (p, 0, "possibly unintended M A in M A", + MOID (p), u, m, c); + else if (a68_is_one_of (p, UNIT, TERTIARY, SECONDARY, PRIMARY, STOP)) + a68_semantic_pitfall (SUB (p), m, c, u); +} diff --git a/gcc/algol68/a68-moids-misc.cc b/gcc/algol68/a68-moids-misc.cc new file mode 100644 index 000000000000..349c13fd6565 --- /dev/null +++ b/gcc/algol68/a68-moids-misc.cc @@ -0,0 +1,1396 @@ +/* Miscellaneous MOID routines. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "options.h" + +#include "a68.h" + +/* + * MODE checker routines. + */ + +/* Absorb nested series modes recursively. */ + +void +a68_absorb_series_pack (MOID_T **p) +{ + bool siga; + + do + { + PACK_T *z = NO_PACK; + + siga = false; + for (PACK_T *t = PACK (*p); t != NO_PACK; FORWARD (t)) + { + if (MOID (t) != NO_MOID && IS (MOID (t), SERIES_MODE)) + { + siga = true; + for (PACK_T *s = PACK (MOID (t)); s != NO_PACK; FORWARD (s)) + a68_add_mode_to_pack (&z, MOID (s), NO_TEXT, NODE (s)); + } + else + a68_add_mode_to_pack (&z, MOID (t), NO_TEXT, NODE (t)); + } + PACK (*p) = z; + } + while (siga); +} + +/* Make SERIES (u, v). */ + +MOID_T * +a68_make_series_from_moids (MOID_T *u, MOID_T *v) +{ + MOID_T *x = a68_new_moid (); + + ATTRIBUTE (x) = SERIES_MODE; + a68_add_mode_to_pack (&(PACK (x)), u, NO_TEXT, NODE (u)); + a68_add_mode_to_pack (&(PACK (x)), v, NO_TEXT, NODE (v)); + a68_absorb_series_pack (&x); + DIM (x) = a68_count_pack_members (PACK (x)); + (void) a68_register_extra_mode (&TOP_MOID (&A68_JOB), x); + if (DIM (x) == 1) + return MOID (PACK (x)); + else + return x; +} + +/* Absorb firmly related unions in mode. + + For instance invalid UNION (PROC REF UNION (A, B), A, B) -> valid + UNION (A, B), which is used in balancing conformity clauses. */ + +MOID_T * +a68_absorb_related_subsets (MOID_T * m) +{ + /* For instance invalid UNION (PROC REF UNION (A, B), A, B) -> valid UNION + (A, B), which is used in balancing conformity clauses. */ + bool siga; + + do + { + PACK_T *u = NO_PACK; + + siga = false; + for (PACK_T *v = PACK (m); v != NO_PACK; FORWARD (v)) + { + MOID_T *n = a68_depref_completely (MOID (v)); + + if (IS (n, UNION_SYMBOL) && a68_is_subset (n, m, SAFE_DEFLEXING)) + { + /* Unpack it. */ + for (PACK_T *w = PACK (n); w != NO_PACK; FORWARD (w)) + a68_add_mode_to_pack (&u, MOID (w), NO_TEXT, NODE (w)); + siga = true; + } + else + a68_add_mode_to_pack (&u, MOID (v), NO_TEXT, NODE (v)); + } + PACK (m) = a68_absorb_union_pack (u); + } + while (siga); + return m; +} + +/* Absorb nested series and united modes recursively. */ + +void +a68_absorb_series_union_pack (MOID_T **p) +{ + bool siga; + + do + { + PACK_T *z = NO_PACK; + + siga = false; + for (PACK_T *t = PACK (*p); t != NO_PACK; FORWARD (t)) + { + if (MOID (t) != NO_MOID && (IS (MOID (t), SERIES_MODE) || IS (MOID (t), UNION_SYMBOL))) + { + siga = true; + for (PACK_T *s = PACK (MOID (t)); s != NO_PACK; FORWARD (s)) + a68_add_mode_to_pack (&z, MOID (s), NO_TEXT, NODE (s)); + } + else + a68_add_mode_to_pack (&z, MOID (t), NO_TEXT, NODE (t)); + } + PACK (*p) = z; + } + while (siga); +} + +/* Make united mode, from mode that is a SERIES (..). */ + +MOID_T * +a68_make_united_mode (MOID_T *m) +{ + if (m == NO_MOID) + return M_ERROR; + else if (ATTRIBUTE (m) != SERIES_MODE) + return m; + + /* Do not unite a single UNION. */ + if (DIM (m) == 1 && IS (MOID (PACK (m)), UNION_SYMBOL)) + return MOID (PACK (m)); + + /* Straighten the series. */ + a68_absorb_series_union_pack (&m); + /* Copy the series into a UNION. */ + MOID_T *u = a68_new_moid (); + ATTRIBUTE (u) = UNION_SYMBOL; + PACK (u) = NO_PACK; + for (PACK_T *w = PACK (m); w != NO_PACK; FORWARD (w)) + a68_add_mode_to_pack (&(PACK (u)), MOID (w), NO_TEXT, NODE (m)); + + /* Absorb and contract the new UNION. */ + a68_absorb_series_union_pack (&u); + DIM (u) = a68_count_pack_members (PACK (u)); + PACK (u) = a68_absorb_union_pack (PACK (u)); + a68_contract_union (u); + DIM (u) = a68_count_pack_members (PACK (u)); + /* A UNION of one mode is that mode itself. */ + if (DIM (u) == 1) + return MOID (PACK (u)); + else + return a68_register_extra_mode (&TOP_MOID (&A68_JOB), u); +} + +/* Make SOID data structure. */ + +void +a68_make_soid (SOID_T *s, int sort, MOID_T *type, int attribute) +{ + ATTRIBUTE (s) = attribute; + SORT (s) = sort; + MOID (s) = type; + CAST (s) = false; +} + +/* Whether mode is not well defined. */ + +bool +a68_is_mode_isnt_well (MOID_T *p) +{ + if (p == NO_MOID) + return true; + else if (!A68_IF_MODE_IS_WELL (p)) + return true; + else if (PACK (p) != NO_PACK) + { + for (PACK_T *q = PACK (p); q != NO_PACK; FORWARD (q)) + { + if (!A68_IF_MODE_IS_WELL (MOID (q))) + return true; + } + } + return false; +} + +/* Add SOID data to free chain. */ + +void +a68_free_soid_list (SOID_T *root) +{ + if (root != NO_SOID) + { + SOID_T *q = root; + + for (; NEXT (q) != NO_SOID; FORWARD (q)) + ; + NEXT (q) = A68 (top_soid_list); + A68 (top_soid_list) = root; + } +} + +/* Add SOID data structure to soid list. */ + +void +a68_add_to_soid_list (SOID_T **root, NODE_T *where, SOID_T *soid) +{ + if (*root != NO_SOID) + a68_add_to_soid_list (&(NEXT (*root)), where, soid); + else + { + SOID_T *new_one; + + if (A68 (top_soid_list) == NO_SOID) + new_one = (SOID_T *) ggc_cleared_alloc (); + else + { + new_one = A68 (top_soid_list); + FORWARD (A68 (top_soid_list)); + } + + a68_make_soid (new_one, SORT (soid), MOID (soid), 0); + NODE (new_one) = where; + NEXT (new_one) = NO_SOID; + *root = new_one; + } +} + +/* Pack soids in moid, gather resulting moids from terminators in a clause. */ + +MOID_T * +a68_pack_soids_in_moid (SOID_T *top_sl, int attribute) +{ + MOID_T *x = a68_new_moid (); + PACK_T *t, **p; + + ATTRIBUTE (x) = attribute; + DIM (x) = 0; + SUB (x) = NO_MOID; + EQUIVALENT (x) = NO_MOID; + SLICE (x) = NO_MOID; + DEFLEXED (x) = NO_MOID; + NAME (x) = NO_MOID; + NEXT (x) = NO_MOID; + PACK (x) = NO_PACK; + p = &(PACK (x)); + for (; top_sl != NO_SOID; FORWARD (top_sl)) + { + t = a68_new_pack (); + MOID (t) = MOID (top_sl); + TEXT (t) = NO_TEXT; + NODE (t) = NODE (top_sl); + NEXT (t) = NO_PACK; + DIM (x)++; + *p = t; + p = &NEXT (t); + } + (void) a68_register_extra_mode (&TOP_MOID (&A68_JOB), x); + return x; +} + +/* Whether P is compatible with Q. */ + +bool +a68_is_equal_modes (MOID_T *p, MOID_T *q, int deflex) +{ + if (deflex == FORCE_DEFLEXING) + return DEFLEX (p) == DEFLEX (q); + else if (deflex == ALIAS_DEFLEXING) + { + if (IS (p, REF_SYMBOL) && IS (q, REF_SYMBOL)) + return (p == q + || a68_prove_moid_equivalence (p, q) + || a68_prove_moid_equivalence (DEFLEX (p), q) + || DEFLEX (p) == q); + else if (!IS (p, REF_SYMBOL) && !IS (q, REF_SYMBOL)) + return (DEFLEX (p) == DEFLEX (q) + || a68_prove_moid_equivalence (DEFLEX (p), DEFLEX (q))); + } + else if (deflex == SAFE_DEFLEXING) + { + if (!IS (p, REF_SYMBOL) && !IS (q, REF_SYMBOL)) + return (DEFLEX (p) == DEFLEX (q) + || a68_prove_moid_equivalence (DEFLEX (p), DEFLEX (q))); + } + + return (p == q || a68_prove_moid_equivalence (p, q)); +} + +/* Whether mode is deprefable, i.e. whether it can be either deferred or + deprocedured. */ + +bool +a68_is_deprefable (MOID_T *p) +{ + if (IS_REF (p)) + return true; + else + return (IS (p, PROC_SYMBOL) && PACK (p) == NO_PACK); +} + +/* Deref or deproc the mode P once. */ + +MOID_T * +a68_depref_once (MOID_T *p) +{ + if (IS_REF_FLEX (p)) + return SUB_SUB (p); + else if (IS_REF (p)) + return SUB (p); + else if (IS (p, PROC_SYMBOL) && PACK (p) == NO_PACK) + return SUB (p); + else + return NO_MOID; +} + +/* Depref mode completely. */ + +MOID_T * +a68_depref_completely (MOID_T *p) +{ + while (a68_is_deprefable (p)) + p = a68_depref_once (p); + return p; +} + +/* Deproc_completely. */ + +MOID_T * +a68_deproc_completely (MOID_T *p) +{ + while (IS (p, PROC_SYMBOL) && PACK (p) == NO_PACK) + p = a68_depref_once (p); + return p; +} + +/* Depref rows. */ + +MOID_T * +a68_depref_rows (MOID_T *p, MOID_T *q) +{ + if (q == M_ROWS) + { + while (a68_is_deprefable (p)) + p = a68_depref_once (p); + return p; + } + else + return q; +} + +/* Derow mode, strip FLEX and BOUNDS. */ + +MOID_T * +a68_derow (MOID_T *p) +{ + if (IS_ROW (p) || IS_FLEX (p)) + return a68_derow (SUB (p)); + else + return p; +} + +/* Whether rows type. */ + +bool +a68_is_rows_type (MOID_T *p) +{ + switch (ATTRIBUTE (p)) + { + case ROW_SYMBOL: + case FLEX_SYMBOL: + return true; + case UNION_SYMBOL: + { + PACK_T *t = PACK (p); + bool siga = true; + while (t != NO_PACK && siga) + { + siga &= a68_is_rows_type (MOID (t)); + FORWARD (t); + } + return siga; + } + default: + return false; + } +} + +/* Whether mode is PROC (REF FILE) VOID or FORMAT. */ + +bool +a68_is_proc_ref_file_void_or_format (MOID_T *p) +{ + if (p == M_PROC_REF_FILE_VOID) + return true; + else if (p == M_FORMAT) + return true; + else + return false; +} + +/* Whether mode can be transput. */ + +bool +a68_is_transput_mode (MOID_T *p, char rw) +{ + if (p == M_INT) + return true; + else if (p == M_SHORT_INT) + return true; + else if (p == M_SHORT_SHORT_INT) + return true; + else if (p == M_LONG_INT) + return true; + else if (p == M_LONG_LONG_INT) + return true; + else if (p == M_REAL) + return true; + else if (p == M_LONG_REAL) + return true; + else if (p == M_LONG_LONG_REAL) + return true; + else if (p == M_BOOL) + return true; + else if (p == M_CHAR) + return true; + else if (p == M_BITS) + return true; + else if (p == M_SHORT_BITS) + return true; + else if (p == M_SHORT_SHORT_BITS) + return true; + else if (p == M_LONG_BITS) + return true; + else if (p == M_LONG_LONG_BITS) + return true; + else if (p == M_COMPLEX) + return true; + else if (p == M_LONG_COMPLEX) + return true; + else if (p == M_LONG_LONG_COMPLEX) + return true; + else if (p == M_ROW_CHAR) + return true; + else if (p == M_STRING) + return true; + else if (IS (p, UNION_SYMBOL) || IS (p, STRUCT_SYMBOL)) + { + for (PACK_T *q = PACK (p); q != NO_PACK; FORWARD (q)) + { + if (!(a68_is_transput_mode (MOID (q), rw) + || a68_is_proc_ref_file_void_or_format (MOID (q)))) + return false; + } + return true; + } + else if (IS_FLEX (p)) + { + if (SUB (p) == M_ROW_CHAR) + return true; + else + return (rw == 'w' ? a68_is_transput_mode (SUB (p), rw) : false); + } + else if (IS_ROW (p)) + return (a68_is_transput_mode (SUB (p), rw) + || a68_is_proc_ref_file_void_or_format (SUB (p))); + else + return false; +} + +/* Whether mode is printable. */ + +bool +a68_is_printable_mode (MOID_T *p) +{ + if (a68_is_proc_ref_file_void_or_format (p)) + return true; + else + return a68_is_transput_mode (p, 'w'); +} + +/* Whether mode is readable. */ + +bool +a68_is_readable_mode (MOID_T *p) +{ + if (a68_is_proc_ref_file_void_or_format (p)) + return true; + else if (IS_REF (p)) + return a68_is_transput_mode (SUB (p), 'r'); + else if (IS_UNION (p)) + { + for (PACK_T *q = PACK (p); q != NO_PACK; FORWARD (q)) + { + if (!IS_REF (MOID (q))) + return false; + else if (!a68_is_transput_mode (SUB (MOID (q)), 'r')) + return false; + } + return true; + } + else + return false; +} + +/* Whether name struct. */ + +bool +a68_is_name_struct (MOID_T *p) +{ + return (NAME (p) != NO_MOID ? IS (DEFLEX (SUB (p)), STRUCT_SYMBOL) : false); +} + +/* Yield mode to unite to. */ + +MOID_T * +a68_unites_to (MOID_T *m, MOID_T *u) +{ + /* Uniting U (m). */ + MOID_T *v = NO_MOID; + + if (u == M_SIMPLIN || u == M_SIMPLOUT) + return m; + + for (PACK_T *p = PACK (u); p != NO_PACK; FORWARD (p)) + { + /* Prefer []->[] over []->FLEX []. */ + if (m == MOID (p)) + v = MOID (p); + else if (v == NO_MOID && DEFLEX (m) == DEFLEX (MOID (p))) + v = MOID (p); + } + return v; +} + +/* Whether moid in pack. */ + +bool +a68_is_moid_in_pack (MOID_T *u, PACK_T *v, int deflex) +{ + for (; v != NO_PACK; FORWARD (v)) + { + if (a68_is_equal_modes (u, MOID (v), deflex)) + return true; + } + + return false; +} + +/* Whether a rows type in pack. */ + +bool +a68_is_rows_in_pack (PACK_T *v) +{ + for (; v != NO_PACK; FORWARD (v)) + { + if (a68_is_rows_type (MOID (v))) + return true; + } + + return false; +} + +/* Whether P is a subset of Q. */ + +bool +a68_is_subset (MOID_T *p, MOID_T *q, int deflex) +{ + bool j =true; + + for (PACK_T *u = PACK (p); u != NO_PACK && j; FORWARD (u)) + j = (j && a68_is_moid_in_pack (MOID (u), PACK (q), deflex)); + + return j; +} + +/* Whether P can be united to UNION Q. */ + +bool +a68_is_unitable (MOID_T *p, MOID_T *q, int deflex) +{ + if (IS (q, UNION_SYMBOL)) + { + if (IS (p, UNION_SYMBOL)) + return a68_is_subset (p, q, deflex); + else if (p == M_ROWS) + return a68_is_rows_in_pack (PACK (q)); + else + return a68_is_moid_in_pack (p, PACK (q), deflex); + } + + return false; +} + +/* Whether all or some components of U can be firmly coerced to a component + mode of V.. */ + +void +a68_investigate_firm_relations (PACK_T *u, PACK_T *v, bool *all, bool *some) +{ + *all = true; + *some = true; + for (; v != NO_PACK; FORWARD (v)) + { + bool k = false; + + for (PACK_T *w = u; w != NO_PACK; FORWARD (w)) + k |= a68_is_coercible (MOID (w), MOID (v), FIRM, FORCE_DEFLEXING); + *some |= k; + *all &= k; + } +} + +/* Whether there is a soft path from P to Q. */ + +bool +a68_is_softly_coercible (MOID_T *p, MOID_T *q, int deflex) +{ + if (a68_is_equal_modes (p, q, deflex)) + return true; + else if (IS (p, PROC_SYMBOL) && PACK (p) == NO_PACK) + return a68_is_softly_coercible (SUB (p), q, deflex); + else + return false; +} + +/* Whether there is a weak path from P to Q. */ + +bool +a68_is_weakly_coercible (MOID_T * p, MOID_T * q, int deflex) +{ + if (a68_is_equal_modes (p, q, deflex)) + return true; + else if (a68_is_deprefable (p)) + return a68_is_weakly_coercible (a68_depref_once (p), q, deflex); + else + return false; +} + +/* Whether there is a meek path from P to Q. */ + +bool +a68_is_meekly_coercible (MOID_T *p, MOID_T *q, int deflex) +{ + if (a68_is_equal_modes (p, q, deflex)) + return true; + else if (a68_is_deprefable (p)) + return a68_is_meekly_coercible (a68_depref_once (p), q, deflex); + else + return false; +} + +/* Whether there is a firm path from P to Q. */ + +bool +a68_is_firmly_coercible (MOID_T *p, MOID_T *q, int deflex) +{ + if (a68_is_equal_modes (p, q, deflex)) + return true; + else if (q == M_ROWS && a68_is_rows_type (p)) + return true; + else if (a68_is_unitable (p, q, deflex)) + return true; + else if (a68_is_deprefable (p)) + return a68_is_firmly_coercible (a68_depref_once (p), q, deflex); + else + return false; +} + +/* Whether firm. */ + +bool +a68_is_firm (MOID_T *p, MOID_T *q) +{ + return (a68_is_firmly_coercible (p, q, SAFE_DEFLEXING) + || a68_is_firmly_coercible (q, p, SAFE_DEFLEXING)); +} + +/* Whether P widens to Q. + + This function returns: + + The destination mode Q if P, or + Some other mode which is an intermediate step from P to Q, or + NO_MOID if P cannot be widened to Q. + + This means that if P is known to widen to Q (a68_is_widenable (P,Q) return + true) this function can be invoked repeteadly and it will eventually return + Q. */ + +MOID_T * +a68_widens_to (MOID_T *p, MOID_T *q) +{ + if (p == M_INT) + { + if (q == M_REAL || q == M_COMPLEX) + { + return M_REAL; + } + else + { + return NO_MOID; + } + } + else if (p == M_LONG_INT) + { + if (q == M_LONG_REAL) + { + return M_LONG_REAL; + } + else + { + return NO_MOID; + } + } + else if (p == M_LONG_LONG_INT) + { + if (q == M_LONG_LONG_REAL || q == M_LONG_LONG_COMPLEX) + return M_LONG_LONG_REAL; + else + return NO_MOID; + } + else if (p == M_REAL) + { + if (q == M_COMPLEX) + { + return M_COMPLEX; + } + else + { + return NO_MOID; + } + } + else if (p == M_LONG_REAL) + { + if (q == M_LONG_COMPLEX) + return M_LONG_COMPLEX; + else + return NO_MOID; + } + else if (p == M_LONG_LONG_REAL) + { + if (q == M_LONG_LONG_COMPLEX) + return M_LONG_LONG_COMPLEX; + else + return NO_MOID; + } + else if (p == M_BITS) + { + if (q == M_ROW_BOOL) + return M_ROW_BOOL; + else if (q == M_FLEX_ROW_BOOL) + return M_FLEX_ROW_BOOL; + else + return NO_MOID; + } + else if (p == M_SHORT_BITS) + { + if (q == M_ROW_BOOL) + return M_ROW_BOOL; + else if (q == M_FLEX_ROW_BOOL) + return M_FLEX_ROW_BOOL; + else + return NO_MOID; + } + else if (p == M_SHORT_SHORT_BITS) + { + if (q == M_ROW_BOOL) + return M_ROW_BOOL; + else if (q == M_FLEX_ROW_BOOL) + return M_FLEX_ROW_BOOL; + else + return NO_MOID; + } + else if (p == M_LONG_BITS) + { + if (q == M_ROW_BOOL) + return M_ROW_BOOL; + else if (q == M_FLEX_ROW_BOOL) + return M_FLEX_ROW_BOOL; + else + return NO_MOID; + } + else if (p == M_LONG_LONG_BITS) + { + if (q == M_ROW_BOOL) + return M_ROW_BOOL; + else if (q == M_FLEX_ROW_BOOL) + return M_FLEX_ROW_BOOL; + else + return NO_MOID; + } + else if (p == M_BYTES && q == M_ROW_CHAR) + return M_ROW_CHAR; + else if (p == M_LONG_BYTES && q == M_ROW_CHAR) + return M_ROW_CHAR; + else if (p == M_BYTES && q == M_FLEX_ROW_CHAR) + return M_FLEX_ROW_CHAR; + else if (p == M_LONG_BYTES && q == M_FLEX_ROW_CHAR) + return M_FLEX_ROW_CHAR; + else + return NO_MOID; +} + +/* Whether P widens to Q. */ + +bool +a68_is_widenable (MOID_T *p, MOID_T *q) +{ + MOID_T *z = a68_widens_to (p, q); + + if (z != NO_MOID) + return (z == q ? true : a68_is_widenable (z, q)); + else + return false; +} + +/* Whether P is a REF ROW. */ + +bool +a68_is_ref_row (MOID_T *p) +{ + return (NAME (p) != NO_MOID ? IS_ROW (DEFLEX (SUB (p))) : false); +} + +/* Whether strong name. */ + +bool +a68_is_strong_name (MOID_T *p, MOID_T *q) +{ + if (p == q) + return true; + else if (a68_is_ref_row (q)) + return a68_is_strong_name (p, NAME (q)); + else + return false; +} + +/* Whether strong slice. */ + +bool +a68_is_strong_slice (MOID_T *p, MOID_T *q) +{ + if (p == q || a68_is_widenable (p, q)) + return true; + else if (SLICE (q) != NO_MOID) + return a68_is_strong_slice (p, SLICE (q)); + else if (IS_FLEX (q)) + return a68_is_strong_slice (p, SUB (q)); + else if (a68_is_ref_row (q)) + return a68_is_strong_name (p, q); + else + return false; +} + +/* Whether strongly coercible. */ + +bool +a68_is_strongly_coercible (MOID_T *p, MOID_T *q, int deflex) +{ + /* Keep this sequence of statements. */ + if (a68_is_equal_modes (p, q, deflex)) + return true; + else if (q == M_VOID) + return true; + else if ((q == M_SIMPLIN || q == M_ROW_SIMPLIN) && a68_is_readable_mode (p)) + return true; + else if (q == M_ROWS && a68_is_rows_type (p)) + return true; + else if (a68_is_unitable (p, a68_derow (q), deflex)) + return true; + + if (a68_is_ref_row (q) && a68_is_strong_name (p, q)) + return true; + else if (SLICE (q) != NO_MOID && a68_is_strong_slice (p, q)) + return true; + else if (IS_FLEX (q) && a68_is_strong_slice (p, q)) + return true; + else if (a68_is_widenable (p, q)) + return true; + else if (a68_is_deprefable (p)) + return a68_is_strongly_coercible (a68_depref_once (p), q, deflex); + else if (q == M_SIMPLOUT || q == M_ROW_SIMPLOUT) + return a68_is_printable_mode (p); + else + return false; +} + +/* Basic coercions. */ + +bool +a68_basic_coercions (MOID_T *p, MOID_T *q, int c, int deflex) +{ + if (a68_is_equal_modes (p, q, deflex)) + return true; + else if (c == NO_SORT) + return (p == q); + else if (c == SOFT) + return a68_is_softly_coercible (p, q, deflex); + else if (c == WEAK) + return a68_is_weakly_coercible (p, q, deflex); + else if (c == MEEK) + return a68_is_meekly_coercible (p, q, deflex); + else if (c == FIRM) + return a68_is_firmly_coercible (p, q, deflex); + else if (c == STRONG) + return a68_is_strongly_coercible (p, q, deflex); + else + return false; +} + +/* Whether coercible stowed. */ + +bool +a68_is_coercible_stowed (MOID_T *p, MOID_T *q, int c, int deflex) +{ + if (c != STRONG) + /* Such construct is always in a strong position, is it not? */ + return false; + else if (q == M_VOID) + return true; + else if (IS_FLEX (q)) + { + bool j = true; + + for (PACK_T *u = PACK (p); u != NO_PACK && j; FORWARD (u)) + j &= a68_is_coercible (MOID (u), SLICE (SUB (q)), c, deflex); + return j; + } + else if (IS_ROW (q)) + { + bool j = true; + + for (PACK_T *u = PACK (p); u != NO_PACK && j; FORWARD (u)) + j &= a68_is_coercible (MOID (u), SLICE (q), c, deflex); + return j; + } + else if (IS (q, PROC_SYMBOL) || IS (q, STRUCT_SYMBOL)) + { + if (DIM (p) != DIM (q)) + return false; + else + { + PACK_T *u = PACK (p), *v = PACK (q); + bool j = true; + + while (u != NO_PACK && v != NO_PACK && j) + { + j &= a68_is_coercible (MOID (u), MOID (v), c, deflex); + FORWARD (u); + FORWARD (v); + } + return j; + } + } + else + return false; +} + +/* Whether coercible series. */ + +bool +a68_is_coercible_series (MOID_T *p, MOID_T *q, int c, int deflex) +{ + if (c == NO_SORT) + return false; + else if (p == NO_MOID || q == NO_MOID) + return false; + else if (IS (p, SERIES_MODE) && PACK (p) == NO_PACK) + return false; + else if (IS (q, SERIES_MODE) && PACK (q) == NO_PACK) + return false; + else if (PACK (p) == NO_PACK) + return a68_is_coercible (p, q, c, deflex); + else + { + bool j = true; + + for (PACK_T *u = PACK (p); u != NO_PACK && j; FORWARD (u)) + { + if (MOID (u) != NO_MOID) + j &= a68_is_coercible (MOID (u), q, c, deflex); + } + return j; + } +} + +/* Whether P can be coerced to Q in a C context. + + If P is a STOWED modes serie (A, B, ...) and Q is a routine mode like `proc + (X, Y, ...)' then this routine determines whether A can be coerced to X, B + to Y, etc. */ + +bool +a68_is_coercible (MOID_T *p, MOID_T *q, int c, int deflex) +{ + if (a68_is_mode_isnt_well (p) || a68_is_mode_isnt_well (q)) + return true; + else if (a68_is_equal_modes (p, q, deflex)) + return true; + else if (p == M_HIP) + return true; + else if (IS (p, STOWED_MODE)) + return a68_is_coercible_stowed (p, q, c, deflex); + else if (IS (p, SERIES_MODE)) + return a68_is_coercible_series (p, q, c, deflex); + else if (p == M_VACUUM && IS_ROW (DEFLEX (q))) + return true; + else + return a68_basic_coercions (p, q, c, deflex); +} + +/* Whether coercible in context. */ + +bool +a68_is_coercible_in_context (SOID_T *p, SOID_T *q, int deflex) +{ + if (SORT (p) != SORT (q)) + return false; + else if (MOID (p) == MOID (q)) + return true; + else + return a68_is_coercible (MOID (p), MOID (q), SORT (q), deflex); +} + +/* Whether list Y is balanced. */ + +bool +a68_is_balanced (NODE_T *n, SOID_T *y, int sort) +{ + if (sort == STRONG) + return true; + else + { + bool k = false; + + for (; y != NO_SOID && !k; FORWARD (y)) + k = (!IS (MOID (y), STOWED_MODE)); + + if (k == false) + a68_error (n, "construct has no unique mode"); + return k; + } +} + +/* A moid from M to which all other members can be coerced. + If no fulcrum of the balance is found, return NO_MOID. */ + +MOID_T * +a68_get_balanced_mode_or_no_mode (MOID_T *m, int sort, bool return_depreffed, int deflex) +{ + MOID_T *common_moid = NO_MOID; + + if (m != NO_MOID && !a68_is_mode_isnt_well (m) && IS (m, UNION_SYMBOL)) + { + int depref_level; + bool siga = true; + /* Test for increasing depreffing. */ + for (depref_level = 0; siga; depref_level++) + { + siga = false; + /* Test the whole pack. */ + for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p)) + { + /* HIPs are not eligible of course. */ + if (MOID (p) != M_HIP) + { + MOID_T *candidate = MOID (p); + int k; + /* Depref as far as allowed. */ + for (k = depref_level; k > 0 && a68_is_deprefable (candidate); k--) + candidate = a68_depref_once (candidate); + /* Only need testing if all allowed deprefs succeeded. */ + if (k == 0) + { + MOID_T *to = (return_depreffed ? a68_depref_completely (candidate) : candidate); + bool all_coercible = true; + + siga = true; + for (PACK_T *q = PACK (m); q != NO_PACK && all_coercible; FORWARD (q)) + { + MOID_T *from = MOID (q); + if (p != q && from != to) + all_coercible &= a68_is_coercible (from, to, sort, deflex); + } + /* If the pack is coercible to the candidate, we mark the + candidate. We continue searching for longest series + of REF REF PROC REF. */ + if (all_coercible) + { + MOID_T *mark = (return_depreffed ? MOID (p) : candidate); + + if (common_moid == NO_MOID) + common_moid = mark; + else if (IS_FLEX (candidate) && DEFLEX (candidate) == common_moid) + /* We prefer FLEX. */ + common_moid = mark; + } + } + } + } + } + } + + return common_moid; +} + +/* A moid from M to which all other members can be coerced. + If no fulcrum of the balance is found, return M. */ + +MOID_T * +a68_get_balanced_mode (MOID_T *m, int sort, bool return_depreffed, int deflex) +{ + MOID_T *common_moid + = a68_get_balanced_mode_or_no_mode (m, sort, return_depreffed, deflex); + return common_moid == NO_MOID ? m : common_moid; +} + +/* Whether we can search a common mode from a clause or not. */ + +bool +a68_clause_allows_balancing (int att) +{ + switch (att) + { + case CLOSED_CLAUSE: + case CONDITIONAL_CLAUSE: + case CASE_CLAUSE: + case SERIAL_CLAUSE: + case CONFORMITY_CLAUSE: + return true; + } + return false; +} + +/* A unique mode from Z. */ + +MOID_T * +a68_determine_unique_mode (SOID_T *z, int deflex) +{ + if (z == NO_SOID) + return NO_MOID; + else + { + MOID_T *x = MOID (z); + + if (a68_is_mode_isnt_well (x)) + return M_ERROR; + + /* If X is a series containing one union, a68_make_united_mode will + return that union (because 'union (union (...))' is the same than + 'union (...)') and then a68_get_balanced_mode below will try to + balance the modes in that union. Not what we want. */ + if (ATTRIBUTE (x) == SERIES_MODE + && DIM (x) == 1 + && IS (MOID (PACK (x)), UNION_SYMBOL)) + return MOID (PACK (x)); + + x = a68_make_united_mode (x); + if (a68_clause_allows_balancing (ATTRIBUTE (z))) + return a68_get_balanced_mode (x, STRONG, A68_NO_DEPREF, deflex); + else + return x; + } +} + +/* Insert coercion A in the tree. */ + +void +a68_make_coercion (NODE_T *l, enum a68_attribute a, MOID_T *m) +{ + a68_make_sub (l, l, a); + MOID (l) = a68_depref_rows (MOID (l), m); +} + +/* Make widening coercion. */ + +static void +make_widening_coercion (NODE_T *n, MOID_T *p, MOID_T *q) +{ + MOID_T *z = a68_widens_to (p, q); + + a68_make_coercion (n, WIDENING, z); + if (z != q) + make_widening_coercion (n, z, q); +} + +/* Make ref rowing coercion. */ + +void +a68_make_ref_rowing_coercion (NODE_T *n, MOID_T *p, MOID_T *q) +{ + if (DEFLEX (p) != DEFLEX (q)) + { + if (a68_is_widenable (p, q)) + make_widening_coercion (n, p, q); + else if (a68_is_ref_row (q)) + { + a68_make_ref_rowing_coercion (n, p, NAME (q)); + a68_make_coercion (n, ROWING, q); + } + } +} + +/* Make rowing coercion. */ + +void +a68_make_rowing_coercion (NODE_T *n, MOID_T *p, MOID_T *q) +{ + if (DEFLEX (p) != DEFLEX (q)) + { + if (a68_is_widenable (p, q)) + make_widening_coercion (n, p, q); + else if (SLICE (q) != NO_MOID) + { + a68_make_rowing_coercion (n, p, SLICE (q)); + a68_make_coercion (n, ROWING, q); + } + else if (IS_FLEX (q)) + a68_make_rowing_coercion (n, p, SUB (q)); + else if (a68_is_ref_row (q)) + a68_make_ref_rowing_coercion (n, p, q); + } +} + +/* Make uniting coercion. */ + +void +a68_make_uniting_coercion (NODE_T *n, MOID_T *q) +{ + a68_make_coercion (n, UNITING, a68_derow (q)); + if (IS_ROW (q) || IS_FLEX (q)) + a68_make_rowing_coercion (n, a68_derow (q), q); +} + +/* Make depreffing coercion to coerce node N from mode P to mode Q in a strong + context. */ + +void +a68_make_depreffing_coercion (NODE_T *n, MOID_T *p, MOID_T *q) +{ + if (DEFLEX (p) == DEFLEX (q)) + return; + else if (q == M_SIMPLOUT && a68_is_printable_mode (p)) + a68_make_coercion (n, UNITING, q); + else if (q == M_ROW_SIMPLOUT && a68_is_printable_mode (p)) + { + a68_make_coercion (n, UNITING, M_SIMPLOUT); + a68_make_coercion (n, ROWING, M_ROW_SIMPLOUT); + } + else if (q == M_SIMPLIN && a68_is_readable_mode (p)) + a68_make_coercion (n, UNITING, q); + else if (q == M_ROW_SIMPLIN && a68_is_readable_mode (p)) + { + a68_make_coercion (n, UNITING, M_SIMPLIN); + a68_make_coercion (n, ROWING, M_ROW_SIMPLIN); + } + else if (q == M_ROWS && a68_is_rows_type (p)) + { + a68_make_coercion (n, UNITING, M_ROWS); + MOID (n) = M_ROWS; + } + else if (a68_is_widenable (p, q)) + make_widening_coercion (n, p, q); + else if (a68_is_unitable (p, a68_derow (q), SAFE_DEFLEXING)) + a68_make_uniting_coercion (n, q); + else if (a68_is_ref_row (q) && a68_is_strong_name (p, q)) + a68_make_ref_rowing_coercion (n, p, q); + else if (SLICE (q) != NO_MOID && a68_is_strong_slice (p, q)) + a68_make_rowing_coercion (n, p, q); + else if (IS_FLEX (q) && a68_is_strong_slice (p, q)) + a68_make_rowing_coercion (n, p, q); + else if (IS_REF (p)) + { + MOID_T *r = a68_depref_once (p); + a68_make_coercion (n, DEREFERENCING, r); + a68_make_depreffing_coercion (n, r, q); + } + else if (IS (p, PROC_SYMBOL) && PACK (p) == NO_PACK) + { + MOID_T *r = SUB (p); + + a68_make_coercion (n, DEPROCEDURING, r); + a68_make_depreffing_coercion (n, r, q); + } + else if (p != q) + a68_cannot_coerce (n, p, q, NO_SORT, SKIP_DEFLEXING, 0); +} + +/* Whether p is a nonproc mode (that is voided directly). */ + +bool +a68_is_nonproc (MOID_T *p) +{ + if (IS (p, PROC_SYMBOL) && PACK (p) == NO_PACK) + return false; + else if (IS_REF (p)) + return a68_is_nonproc (SUB (p)); + else + return true; +} + +/* Voiden in an appropriate way. */ + +void +a68_make_void (NODE_T *p, MOID_T *q) +{ + switch (ATTRIBUTE (p)) + { + case ASSIGNATION: + case IDENTITY_RELATION: + case GENERATOR: + case CAST: + case DENOTATION: + a68_make_coercion (p, VOIDING, M_VOID); + return; + default: + break; + } + + /* MORFs are an involved case. */ + switch (ATTRIBUTE (p)) + { + case SELECTION: + case SLICE: + case ROUTINE_TEXT: + case FORMULA: + case CALL: + case IDENTIFIER: + /* A nonproc moid value is eliminated directly. */ + if (a68_is_nonproc (q)) + { + a68_make_coercion (p, VOIDING, M_VOID); + return; + } + else + { + /* Descend the chain of e.g. REF PROC .. until a nonproc moid + remains. */ + MOID_T *z = q; + + while (!a68_is_nonproc (z)) + { + if (IS_REF (z)) + a68_make_coercion (p, DEREFERENCING, SUB (z)); + if (IS (z, PROC_SYMBOL) && NODE_PACK (p) == NO_PACK) + a68_make_coercion (p, DEPROCEDURING, SUB (z)); + z = SUB (z); + } + if (z != M_VOID) + a68_make_coercion (p, VOIDING, M_VOID); + return; + } + default: + break; + } + + /* All other is voided straight away. */ + a68_make_coercion (p, VOIDING, M_VOID); +} + +/* Make strong coercion of node N from mode P to mode Q. */ + +void +a68_make_strong (NODE_T *n, MOID_T *p, MOID_T *q) +{ + if (q == M_VOID && p != M_VOID) + a68_make_void (n, p); + else + a68_make_depreffing_coercion (n, p, q); +} diff --git a/gcc/algol68/a68-moids-to-string.cc b/gcc/algol68/a68-moids-to-string.cc new file mode 100644 index 000000000000..9140329db8db --- /dev/null +++ b/gcc/algol68/a68-moids-to-string.cc @@ -0,0 +1,417 @@ +/* Pretty-print a MOID. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "a68.h" + +/* + * A pretty printer for moids. + * + * For example "PROC (REF STRUCT (REF SELF, UNION (INT, VOID))) REF SELF" + * for a procedure yielding a pointer to an object of its own mode. + */ + +static void moid_to_string_2 (char *, MOID_T *, size_t *, NODE_T *, + bool indicant_value); + +/* Add string to MOID text. */ + +static void +add_to_moid_text (char *dst, const char *str, size_t *w) +{ + a68_bufcat (dst, str, BUFFER_SIZE); + (*w) -= strlen (str); +} + +/* Find a tag, searching symbol tables towards the root. */ + +static TAG_T * +find_indicant_global (TABLE_T * table, MOID_T * mode) +{ + if (table != NO_TABLE) + { + for (TAG_T *s = INDICANTS (table); s != NO_TAG; FORWARD (s)) + { + if (MOID (s) == mode) + return s; + } + return find_indicant_global (PREVIOUS (table), mode); + } + else + return NO_TAG; +} + +/* Pack to string. */ + +static void +pack_to_string (char *b, PACK_T *p, size_t *w, bool text, NODE_T *idf, + bool indicant_value) +{ + for (; p != NO_PACK; FORWARD (p)) + { + moid_to_string_2 (b, MOID (p), w, idf, indicant_value); + if (text) + { + if (TEXT (p) != NO_TEXT) + { + add_to_moid_text (b, " ", w); + add_to_moid_text (b, TEXT (p), w); + } + } + if (p != NO_PACK && NEXT (p) != NO_PACK) + add_to_moid_text (b, ", ", w); + } +} + +/* Moid to string 2. */ + +static void moid_to_string_2 (char *b, MOID_T *n, size_t *w, NODE_T *idf, + bool indicant_value) +{ + bool supper_stropping = (OPTION_STROPPING (&A68_JOB) == SUPPER_STROPPING); + const char *strop_self = supper_stropping ? "self" : "SELF"; + const char *strop_hip = supper_stropping ? "hip" : "HIP"; + const char *strop_compl = supper_stropping ? "compl" : "COMPL"; + const char *strop_long_compl = supper_stropping ? "long compl" : "LONG COMPL"; + const char *strop_long_long_compl = supper_stropping ? "long long compl" : "LONG LONG COMPL"; + const char *strop_string = supper_stropping ? "string" : "STRING"; + const char *strop_collitem = supper_stropping ? "collitem" : "COLLITEM"; + const char *strop_simplin = supper_stropping ? "%%" : "%%"; + const char *strop_simplout = supper_stropping ? "%%" : "%%"; + const char *strop_rows = supper_stropping ? "%%" : "%%"; + const char *strop_vacuum = supper_stropping ? "%%" : "%%"; + const char *strop_long = supper_stropping ? "long" : "LONG"; + const char *strop_short = supper_stropping ? "short" : "SHORT"; + const char *strop_ref = supper_stropping ? "ref" : "REF"; + const char *strop_flex = supper_stropping ? "flex" : "FLEX"; + const char *strop_struct = supper_stropping ? "struct" : "STRUCT"; + const char *strop_union = supper_stropping ? "union" : "UNION"; + const char *strop_proc = supper_stropping ? "proc" : "PROC"; + + if (n == NO_MOID) + { + /* Oops. Should not happen. */ + add_to_moid_text (b, "null", w);; + return; + } + + /* Reference to self through REF or PROC. */ + if (a68_is_postulated (A68 (postulates), n)) + { + add_to_moid_text (b, strop_self, w); + return; + } + + /* If declared by a mode-declaration, present the indicant. */ + if (idf != NO_NODE && !IS (n, STANDARD)) + { + TAG_T *indy = find_indicant_global (TABLE (idf), n); + + if (indy != NO_TAG) + { + add_to_moid_text (b, NSYMBOL (NODE (indy)), w); + if (!indicant_value) + return; + else + add_to_moid_text (b, " = ", w); + } + } + + /* Write the standard modes. */ + if (n == M_HIP) + add_to_moid_text (b, strop_hip, w); + else if (n == M_ERROR) + add_to_moid_text (b, "ERROR", w); + else if (n == M_UNDEFINED) + add_to_moid_text (b, "unresolved mode", w); + else if (n == M_C_STRING) + add_to_moid_text (b, "C-STRING", w); + else if (n == M_COMPLEX) + add_to_moid_text (b, strop_compl, w); + else if (n == M_LONG_COMPLEX) + add_to_moid_text (b, strop_long_compl, w); + else if (n == M_LONG_LONG_COMPLEX) + add_to_moid_text (b, strop_long_long_compl, w); + else if (n == M_STRING) + add_to_moid_text (b, strop_string, w); + else if (n == M_COLLITEM) + add_to_moid_text (b, strop_collitem, w); + else if (IS (n, IN_TYPE_MODE)) + add_to_moid_text (b, strop_simplin, w); + else if (IS (n, OUT_TYPE_MODE)) + add_to_moid_text (b, strop_simplout, w); + else if (IS (n, ROWS_SYMBOL)) + add_to_moid_text (b, strop_rows, w); + else if (n == M_VACUUM) + add_to_moid_text (b, strop_vacuum, w); + else if (IS (n, VOID_SYMBOL) || IS (n, STANDARD) || IS (n, INDICANT)) + { + if (DIM (n) > 0) + { + size_t k = DIM (n); + + if ((*w) >= k * strlen ("LONG ") + strlen (NSYMBOL (NODE (n)))) + { + while (k--) + { + add_to_moid_text (b, strop_long, w); + add_to_moid_text (b, " ", w); + } + + const char *strop_symbol = a68_strop_keyword (NSYMBOL (NODE (n))); + add_to_moid_text (b, strop_symbol, w); + } + else + add_to_moid_text (b, "..", w); + } + else if (DIM (n) < 0) + { + size_t k = -DIM (n); + + if ((*w) >= k * strlen ("SHORT ") + strlen (NSYMBOL (NODE (n)))) + { + while (k--) + { + add_to_moid_text (b, strop_short, w); + add_to_moid_text (b, " ", w); + } + + const char *strop_symbol = a68_strop_keyword (NSYMBOL (NODE (n))); + add_to_moid_text (b, strop_symbol, w); + } + else + add_to_moid_text (b, "..", w); + } + else if (DIM (n) == 0) + { + const char *strop_symbol = a68_strop_keyword (NSYMBOL (NODE (n))); + add_to_moid_text (b, strop_symbol, w); + } + + /* Write compxounded modes. */ + } + else if (IS_REF (n)) + { + if ((*w) >= strlen ("REF ..")) + { + add_to_moid_text (b, strop_ref, w); + add_to_moid_text (b, " ", w); + moid_to_string_2 (b, SUB (n), w, idf, indicant_value); + } + else + { + add_to_moid_text (b, strop_ref, w); + add_to_moid_text (b, " ..", w); + } + } + else if (IS_FLEX (n)) + { + if ((*w) >= strlen ("FLEX ..")) + { + add_to_moid_text (b, strop_flex, w); + add_to_moid_text (b, " ", w); + moid_to_string_2 (b, SUB (n), w, idf, indicant_value); + } + else + { + add_to_moid_text (b, strop_flex, w); + add_to_moid_text (b, " ..", w); + } + } + else if (IS_ROW (n)) + { + size_t j = strlen ("[] ..") + (DIM (n) - 1) * strlen (","); + + if ((*w) >= j) + { + size_t k = DIM (n) - 1; + add_to_moid_text (b, "[", w); + while (k-- > 0) + add_to_moid_text (b, ",", w); + add_to_moid_text (b, "] ", w); + moid_to_string_2 (b, SUB (n), w, idf, indicant_value); + } + else if (DIM (n) == 1) + { + add_to_moid_text (b, "[] ..", w); + } + else + { + size_t k = DIM (n); + add_to_moid_text (b, "[", w); + while (k--) + add_to_moid_text (b, ",", w); + add_to_moid_text (b, "] ..", w); + } + } + else if (IS_STRUCT (n)) + { + size_t j = (strlen ("STRUCT ()") + (DIM (n) - 1) + * strlen (".., ") + strlen ("..")); + + if ((*w) >= j) + { + POSTULATE_T *save = A68 (postulates); + a68_make_postulate (&A68 (postulates), n, NO_MOID); + add_to_moid_text (b, strop_struct, w); + add_to_moid_text (b, " (", w); + pack_to_string (b, PACK (n), w, true, idf, indicant_value); + add_to_moid_text (b, ")", w); + a68_free_postulate_list (A68 (postulates), save); + A68 (postulates) = save; + } + else + { + size_t k = DIM (n); + add_to_moid_text (b, strop_struct, w); + add_to_moid_text (b, " (", w); + while (k-- > 0) + add_to_moid_text (b, ",", w); + add_to_moid_text (b, ")", w); + } + } + else if (IS_UNION (n)) + { + size_t j = (strlen ("UNION ()") + (DIM (n) - 1) + * strlen (".., ") + strlen ("..")); + + if ((*w) >= j) + { + POSTULATE_T *save = A68 (postulates); + a68_make_postulate (&A68 (postulates), n, NO_MOID); + add_to_moid_text (b, strop_union, w); + add_to_moid_text (b, " (", w); + pack_to_string (b, PACK (n), w, false, idf, indicant_value); + add_to_moid_text (b, ")", w); + a68_free_postulate_list (A68 (postulates), save); + A68 (postulates) = save; + } + else + { + size_t k = DIM (n); + add_to_moid_text (b, strop_union, w); + add_to_moid_text (b, " (", w); + while (k-- > 0) + add_to_moid_text (b, ",", w); + add_to_moid_text (b, ")", w); + } + } + else if (IS (n, PROC_SYMBOL) && DIM (n) == 0) + { + if ((*w) >= strlen ("PROC ..")) + { + add_to_moid_text (b, strop_proc, w); + add_to_moid_text (b, " ", w); + moid_to_string_2 (b, SUB (n), w, idf, indicant_value); + } + else + { + add_to_moid_text (b, strop_proc, w); + add_to_moid_text (b, " ..", w); + } + } + else if (IS (n, PROC_SYMBOL) && DIM (n) > 0) + { + size_t j = (strlen ("PROC () ..") + (DIM (n) - 1) + * strlen (".., ") + strlen ("..")); + + if ((*w) >= j) + { + POSTULATE_T *save = A68 (postulates); + a68_make_postulate (&A68 (postulates), n, NO_MOID); + add_to_moid_text (b, strop_proc, w); + add_to_moid_text (b, " (", w); + pack_to_string (b, PACK (n), w, false, idf, indicant_value); + add_to_moid_text (b, ") ", w); + moid_to_string_2 (b, SUB (n), w, idf, indicant_value); + a68_free_postulate_list (A68 (postulates), save); + A68 (postulates) = save; + } + else + { + size_t k = DIM (n); + + add_to_moid_text (b, strop_proc, w); + add_to_moid_text (b, " (", w); + while (k-- > 0) + add_to_moid_text (b, ",", w); + add_to_moid_text (b, ") ..", w); + } + } + else if (IS (n, SERIES_MODE) || IS (n, STOWED_MODE)) + { + size_t j = (strlen ("()") + (DIM (n) - 1) + * strlen (".., ") + strlen ("..")); + + if ((*w) >= j) + { + add_to_moid_text (b, "(", w); + pack_to_string (b, PACK (n), w, false, idf, indicant_value); + add_to_moid_text (b, ")", w); + } + else + { + size_t k = DIM (n); + + add_to_moid_text (b, "(", w); + while (k-- > 0) + add_to_moid_text (b, ",", w); + add_to_moid_text (b, ")", w); + } + } + else + { + char str[SMALL_BUFFER_SIZE]; + if (snprintf (str, (size_t) SMALL_BUFFER_SIZE, "\\%d", ATTRIBUTE (n)) < 0) + gcc_unreachable (); + add_to_moid_text (b, str, w); + } +} + +/* Pretty-formatted mode N; W is a measure of width. */ + +const char * +a68_moid_to_string (MOID_T *n, size_t w, NODE_T *idf, bool indicant_value) +{ +#define MAX_MTS 8 + /* We use a static buffer of MAX_MTS strings. This value 8 should be safe. + No more than MAX_MTS calls can be pending in for instance printf. Instead + we could allocate each string on the heap but that leaks memory. */ + static int mts_buff_ptr = 0; + static char mts_buff[8][BUFFER_SIZE]; + char *a = &(mts_buff[mts_buff_ptr][0]); + mts_buff_ptr++; + if (mts_buff_ptr >= MAX_MTS) + mts_buff_ptr = 0; + a[0] = '\0'; + if (w >= BUFFER_SIZE) + w = BUFFER_SIZE - 1; + A68 (postulates) = NO_POSTULATE; + if (n != NO_MOID) + moid_to_string_2 (a, n, &w, idf, indicant_value); + else + a68_bufcat (a, "null", BUFFER_SIZE); + return a; +#undef MAX_MTS +} diff --git a/gcc/algol68/a68-parser-modes.cc b/gcc/algol68/a68-parser-modes.cc new file mode 100644 index 000000000000..4a0128667ca0 --- /dev/null +++ b/gcc/algol68/a68-parser-modes.cc @@ -0,0 +1,1325 @@ +/* Mode table management. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "a68.h" + +/* + * Mode collection, equivalencing and derived modes. + */ + +/* Few forward references. */ + +static MOID_T *get_mode_from_declarer (NODE_T *p); + +/* + * Mode service routines. + */ + +/* Count bounds in declarer in tree. */ + +static int +count_bounds (NODE_T *p) +{ + if (p == NO_NODE) + return 0; + else + { + if (IS (p, BOUND)) + return 1 + count_bounds (NEXT (p)); + else + return count_bounds (NEXT (p)) + count_bounds (SUB (p)); + } +} + +/* Count number of SHORTs or LONGs. */ + +static int +count_sizety (NODE_T *p) +{ + if (p == NO_NODE) + return 0; + else if (IS (p, LONGETY)) + return count_sizety (SUB (p)) + count_sizety (NEXT (p)); + else if (IS (p, SHORTETY)) + return count_sizety (SUB (p)) + count_sizety (NEXT (p)); + else if (IS (p, LONG_SYMBOL)) + return 1; + else if (IS (p, SHORT_SYMBOL)) + return -1; + else + return 0; +} + +/* Count moids in a pack. */ + +int +a68_count_pack_members (PACK_T *u) +{ + int k = 0; + + for (; u != NO_PACK; FORWARD (u)) + k++; + return k; +} + +/* Replace a mode by its equivalent mode. */ + +static void +resolve_equivalent (MOID_T **m) +{ + while ((*m) != NO_MOID + && EQUIVALENT ((*m)) != NO_MOID + && (*m) != EQUIVALENT (*m)) + { + (*m) = EQUIVALENT (*m); + } +} + +/* Reset moid. */ + +static void +reset_moid_tree (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + MOID (p) = NO_MOID; + reset_moid_tree (SUB (p)); + } +} + +/* Renumber moids. */ + +void +a68_renumber_moids (MOID_T *p, int n) +{ + if (p != NO_MOID) + { + NUMBER (p) = n; + a68_renumber_moids (NEXT (p), n + 1); + } +} + +/* See whether a mode equivalent to the mode M exists in the global mode table, + and return it. Return NO_MOID if no equivalent mode is found. */ + +MOID_T * +a68_search_equivalent_mode (MOID_T *m) +{ + for (MOID_T *head = TOP_MOID (&A68_JOB); head != NO_MOID; FORWARD (head)) + { + if (a68_prove_moid_equivalence (head, m)) + return head; + } + + return NO_MOID; +} + +/* Register mode in the global mode table, if mode is unique. */ + +MOID_T * +a68_register_extra_mode (MOID_T **z, MOID_T *u) +{ + /* If we already know this mode, return the existing entry; otherwise link it + in. */ + for (MOID_T *head = TOP_MOID (&A68_JOB); head != NO_MOID; FORWARD (head)) + { + if (a68_prove_moid_equivalence (head, u)) + return head; + } + + /* Link to chain and exit. */ + NUMBER (u) = A68 (mode_count)++; + NEXT (u) = (*z); + return *z = u; +} + +/* Create a new mode. */ + +MOID_T * +a68_create_mode (int att, int dim, NODE_T *node, MOID_T *sub, PACK_T *pack) +{ + MOID_T *new_mode = a68_new_moid (); + + if (sub == NO_MOID) + { + if (att == REF_SYMBOL + || att == FLEX_SYMBOL + || att == ROW_SYMBOL) + gcc_unreachable (); + } + + USE (new_mode) = false; + ATTRIBUTE (new_mode) = att; + DIM (new_mode) = dim; + NODE (new_mode) = node; + HAS_ROWS (new_mode) = (att == ROW_SYMBOL); + SUB (new_mode) = sub; + PACK (new_mode) = pack; + NEXT (new_mode) = NO_MOID; + EQUIVALENT (new_mode) = NO_MOID; + SLICE (new_mode) = NO_MOID; + DEFLEXED (new_mode) = NO_MOID; + NAME (new_mode) = NO_MOID; + MULTIPLE (new_mode) = NO_MOID; + ROWED (new_mode) = NO_MOID; + + return new_mode; +} + +/* Create a new mode and add it to chain Z. */ + +MOID_T * +a68_add_mode (MOID_T **z, int att, int dim, NODE_T *node, MOID_T *sub, PACK_T *pack) +{ + MOID_T *new_mode = a68_create_mode (att, dim, node, sub, pack); + return a68_register_extra_mode (z, new_mode); +} + +/* Contract a UNION. */ + +void +a68_contract_union (MOID_T *u) +{ + for (PACK_T *s = PACK (u); s != NO_PACK; FORWARD (s)) + { + PACK_T *t = s; + + while (t != NO_PACK) + { + if (NEXT (t) != NO_PACK && MOID (NEXT (t)) == MOID (s)) + { + MOID (t) = MOID (t); + NEXT (t) = NEXT_NEXT (t); + } + else + FORWARD (t); + } + } +} + +/* Absorb UNION pack. */ + +PACK_T * +a68_absorb_union_pack (PACK_T * u) +{ + PACK_T *z; + bool siga; + + do + { + z = NO_PACK; + siga = false; + for (PACK_T *t = u; t != NO_PACK; FORWARD (t)) + { + if (IS (MOID (t), UNION_SYMBOL)) + { + siga = true; + for (PACK_T *s = PACK (MOID (t)); s != NO_PACK; FORWARD (s)) + (void) a68_add_mode_to_pack (&z, MOID (s), NO_TEXT, NODE (s)); + } + else + { + (void) a68_add_mode_to_pack (&z, MOID (t), NO_TEXT, NODE (t)); + } + } + u = z; + } + while (siga); + return z; +} + +/* Add row and its slices to chain, recursively. */ + +static MOID_T * +add_row (MOID_T **p, int dim, MOID_T *sub, NODE_T *n, bool derivate) +{ + MOID_T *q = a68_add_mode (p, ROW_SYMBOL, dim, n, sub, NO_PACK); + + DERIVATE (q) |= derivate; + if (dim > 1) + SLICE (q) = add_row (&NEXT (q), dim - 1, sub, n, derivate); + else + SLICE (q) = sub; + return q; +} + +/* Add a moid to a pack, maybe with a (field) name. */ + +void +a68_add_mode_to_pack (PACK_T **p, MOID_T *m, const char *text, NODE_T *node) +{ + PACK_T *z = a68_new_pack (); + + MOID (z) = m; + TEXT (z) = text; + NODE (z) = node; + NEXT (z) = *p; + PREVIOUS (z) = NO_PACK; + if (NEXT (z) != NO_PACK) + PREVIOUS (NEXT (z)) = z; + + /* Link in chain. */ + *p = z; +} + +/* Add a moid to a pack, maybe with a (field) name. */ + +void +a68_add_mode_to_pack_end (PACK_T **p, MOID_T *m, const char *text, NODE_T *node) +{ + PACK_T *z = a68_new_pack (); + + MOID (z) = m; + TEXT (z) = text; + NODE (z) = node; + NEXT (z) = NO_PACK; + if (NEXT (z) != NO_PACK) + PREVIOUS (NEXT (z)) = z; + + /* Link in chain. */ + while ((*p) != NO_PACK) + p = &(NEXT (*p)); + PREVIOUS (z) = (*p); + (*p) = z; +} + +/* Absorb UNION members. */ + +static void +absorb_unions (MOID_T *m) +{ + /* UNION (A, UNION (B, C)) = UNION (A, B, C) or + UNION (A, UNION (A, B)) = UNION (A, B). */ + for (; m != NO_MOID; FORWARD (m)) + { + if (IS (m, UNION_SYMBOL)) + PACK (m) = a68_absorb_union_pack (PACK (m)); + } +} + +/* Contract UNIONs. */ + +static void +contract_unions (MOID_T *m) +{ + /* UNION (A, B, A) -> UNION (A, B). */ + for (; m != NO_MOID; FORWARD (m)) + { + if (IS (m, UNION_SYMBOL) && EQUIVALENT (m) == NO_MOID) + a68_contract_union (m); + } +} + +/* + * Routines to collect MOIDs from the program text. + */ + +/* Search standard mode in standard environ. */ + +static MOID_T * +search_standard_mode (int sizety, NODE_T *indicant) +{ + /* Search standard mode. */ + for (MOID_T *p = TOP_MOID (&A68_JOB); p != NO_MOID; FORWARD (p)) + { + if (IS (p, STANDARD) + && DIM (p) == sizety + && NSYMBOL (NODE (p)) == NSYMBOL (indicant)) + return p; + } + + /* Map onto greater precision. */ + if (sizety < 0) + return search_standard_mode (sizety + 1, indicant); + else if (sizety > 0) + return search_standard_mode (sizety - 1, indicant); + else + return NO_MOID; +} + +/* Collect mode from STRUCT field. */ + +static void +get_mode_from_struct_field (NODE_T *p, PACK_T **u) +{ + if (p != NO_NODE) + { + if (IS (p, IDENTIFIER)) + { + ATTRIBUTE (p) = FIELD_IDENTIFIER; + (void) a68_add_mode_to_pack (u, NO_MOID, NSYMBOL (p), p); + } + else if (IS (p, DECLARER)) + { + MOID_T *new_one = get_mode_from_declarer (p); + + get_mode_from_struct_field (NEXT (p), u); + for (PACK_T *t = *u; t && MOID (t) == NO_MOID; FORWARD (t)) + { + MOID (t) = new_one; + MOID (NODE (t)) = new_one; + } + } + else + { + get_mode_from_struct_field (NEXT (p), u); + get_mode_from_struct_field (SUB (p), u); + } + } +} + +/* Collect MODE from formal pack. */ + +static void +get_mode_from_formal_pack (NODE_T *p, PACK_T **u) +{ + if (p != NO_NODE) + { + if (IS (p, DECLARER)) + { + get_mode_from_formal_pack (NEXT (p), u); + MOID_T *z = get_mode_from_declarer (p); + (void) a68_add_mode_to_pack (u, z, NO_TEXT, p); + } + else + { + get_mode_from_formal_pack (NEXT (p), u); + get_mode_from_formal_pack (SUB (p), u); + } + } +} + +/* Collect MODE or VOID from formal UNION pack. */ + +static void +get_mode_from_union_pack (NODE_T *p, PACK_T **u) +{ + if (p != NO_NODE) + { + if (IS (p, DECLARER) || IS (p, VOID_SYMBOL)) + { + get_mode_from_union_pack (NEXT (p), u); + MOID_T *z = get_mode_from_declarer (p); + (void) a68_add_mode_to_pack (u, z, NO_TEXT, p); + } + else + { + get_mode_from_union_pack (NEXT (p), u); + get_mode_from_union_pack (SUB (p), u); + } + } +} + +/* Collect mode from PROC, OP pack. */ + +static void +get_mode_from_routine_pack (NODE_T *p, PACK_T **u) +{ + if (p != NO_NODE) + { + if (IS (p, IDENTIFIER)) + (void) a68_add_mode_to_pack (u, NO_MOID, NO_TEXT, p); + else if (IS (p, DECLARER)) + { + MOID_T *z = get_mode_from_declarer (p); + + for (PACK_T *t = *u; t != NO_PACK && MOID (t) == NO_MOID; FORWARD (t)) + { + MOID (t) = z; + MOID (NODE (t)) = z; + } + (void) a68_add_mode_to_pack (u, z, NO_TEXT, p); + } + else + { + get_mode_from_routine_pack (NEXT (p), u); + get_mode_from_routine_pack (SUB (p), u); + } + } +} + +/* Collect MODE from DECLARER. */ + +static MOID_T * +get_mode_from_declarer (NODE_T *p) +{ + if (p == NO_NODE) + return NO_MOID; + else + { + if (IS (p, DECLARER)) + { + if (MOID (p) != NO_MOID) + return MOID (p); + else + return MOID (p) = get_mode_from_declarer (SUB (p)); + } + else + { + if (IS (p, VOID_SYMBOL)) + { + MOID (p) = M_VOID; + return MOID (p); + } + else if (IS (p, LONGETY)) + { + if (a68_whether (p, LONGETY, INDICANT, STOP)) + { + int k = count_sizety (SUB (p)); + MOID (p) = search_standard_mode (k, NEXT (p)); + return MOID (p); + } + else + { + return NO_MOID; + } + } + else if (IS (p, SHORTETY)) + { + if (a68_whether (p, SHORTETY, INDICANT, STOP)) + { + int k = count_sizety (SUB (p)); + MOID (p) = search_standard_mode (k, NEXT (p)); + return MOID (p); + } + else + return NO_MOID; + } + else if (IS (p, INDICANT)) + { + MOID_T *q = search_standard_mode (0, p); + if (q != NO_MOID) + MOID (p) = q; + else + { + /* Position of definition tells indicants apart. */ + TAG_T *y = a68_find_tag_global (TABLE (p), INDICANT, NSYMBOL (p)); + if (y == NO_TAG) + a68_error ( p, "tag Z has not been declared properly", NSYMBOL (p)); + else + MOID (p) = a68_add_mode (&TOP_MOID (&A68_JOB), INDICANT, 0, NODE (y), + NO_MOID, NO_PACK); + } + return MOID (p); + } + else if (IS_REF (p)) + { + MOID_T *new_one = get_mode_from_declarer (NEXT (p)); + MOID (p) = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, p, new_one, NO_PACK); + return MOID (p); + } + else if (IS_FLEX (p)) + { + MOID_T *new_one = get_mode_from_declarer (NEXT (p)); + MOID (p) = a68_add_mode (&TOP_MOID (&A68_JOB), FLEX_SYMBOL, 0, p, new_one, NO_PACK); + SLICE (MOID (p)) = SLICE (new_one); + return MOID (p); + } + else if (IS (p, FORMAL_BOUNDS)) + { + MOID_T *new_one = get_mode_from_declarer (NEXT (p)); + MOID (p) = add_row (&TOP_MOID (&A68_JOB), + 1 + a68_count_formal_bounds (SUB (p)), new_one, p, false); + return MOID (p); + } + else if (IS (p, BOUNDS)) + { + MOID_T *new_one = get_mode_from_declarer (NEXT (p)); + MOID (p) = add_row (&TOP_MOID (&A68_JOB), count_bounds (SUB (p)), new_one, p, false); + return MOID (p); + } + else if (IS (p, STRUCT_SYMBOL)) + { + PACK_T *u = NO_PACK; + get_mode_from_struct_field (NEXT (p), &u); + MOID (p) = a68_add_mode (&TOP_MOID (&A68_JOB), + STRUCT_SYMBOL, a68_count_pack_members (u), p, NO_MOID, u); + return MOID (p); + } + else if (IS (p, UNION_SYMBOL)) + { + PACK_T *u = NO_PACK; + get_mode_from_union_pack (NEXT (p), &u); + MOID (p) = a68_add_mode (&TOP_MOID (&A68_JOB), + UNION_SYMBOL, a68_count_pack_members (u), p, NO_MOID, u); + return MOID (p); + } + else if (IS (p, PROC_SYMBOL)) + { + NODE_T *save = p; + PACK_T *u = NO_PACK; + if (IS (NEXT (p), FORMAL_DECLARERS)) + { + get_mode_from_formal_pack (SUB_NEXT (p), &u); + FORWARD (p); + } + MOID_T *new_one = get_mode_from_declarer (NEXT (p)); + MOID (p) = + a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (u), save, new_one, u); + MOID (save) = MOID (p); + return MOID (p); + } + else + return NO_MOID; + } + } +} + +/* Collect MODEs from a routine-text header. */ + +static MOID_T * +get_mode_from_routine_text (NODE_T *p) +{ + PACK_T *u = NO_PACK; + NODE_T *q = p; + + if (IS (p, PARAMETER_PACK)) + { + get_mode_from_routine_pack (SUB (p), &u); + FORWARD (p); + } + MOID_T *n = get_mode_from_declarer (p); + return a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (u), q, n, u); +} + +/* Collect modes from operator-plan. */ + +static MOID_T * +get_mode_from_operator (NODE_T *p) +{ + PACK_T *u = NO_PACK; + NODE_T *save = p; + + if (IS (NEXT (p), FORMAL_DECLARERS)) + { + get_mode_from_formal_pack (SUB_NEXT (p), &u); + FORWARD (p); + } + MOID_T *new_one = get_mode_from_declarer (NEXT (p)); + MOID (p) = a68_add_mode (&TOP_MOID (&A68_JOB), PROC_SYMBOL, a68_count_pack_members (u), save, new_one, u); + return MOID (p); +} + +/* Collect mode from denotation. */ + +static void +get_mode_from_denotation (NODE_T *p, int sizety) +{ + if (p != NO_NODE) + { + if (IS (p, ROW_CHAR_DENOTATION)) + { + const char *s = NSYMBOL (p); + size_t len = strlen (s); + + if (len == 1 + || (len == 2 && s[0] == '\'') + || (len == 8 && s[0] == '\'' && s[1] == '(' && s[2] == 'u') + || (len == 12 && s[0] == '\'' && s[1] == '(' && s[2] == 'U')) + { + MOID (p) = M_CHAR; + } + else + MOID (p) = M_ROW_CHAR; + } + else if (IS (p, TRUE_SYMBOL) || IS (p, FALSE_SYMBOL)) + { + MOID (p) = M_BOOL; + } + else if (IS (p, INT_DENOTATION)) + { + if (sizety == -2) + MOID (p) = M_SHORT_SHORT_INT; + else if (sizety == -1) + MOID (p) = M_SHORT_INT; + else if (sizety == 0) + MOID (p) = M_INT; + else if (sizety == 1) + MOID (p) = M_LONG_INT; + else if (sizety == 2) + MOID (p) = M_LONG_LONG_INT; + else + MOID (p) = (sizety > 0 ? M_LONG_LONG_INT : M_INT); + } + else if (IS (p, REAL_DENOTATION)) + { + if (sizety == 0) + MOID (p) = M_REAL; + else if (sizety == 1) + MOID (p) = M_LONG_REAL; + else if (sizety == 2) + MOID (p) = M_LONG_LONG_REAL; + else + MOID (p) = (sizety > 0 ? M_LONG_LONG_REAL : M_REAL); + } + else if (IS (p, BITS_DENOTATION)) + { + if (sizety == -2) + MOID (p) = M_SHORT_SHORT_BITS; + else if (sizety == -1) + MOID (p) = M_SHORT_BITS; + else if (sizety == 0) + MOID (p) = M_BITS; + else if (sizety == 1) + MOID (p) = M_LONG_BITS; + else if (sizety == 2) + MOID (p) = M_LONG_LONG_BITS; + else + MOID (p) = (sizety > 0 ? M_LONG_LONG_BITS : M_BITS); + } + else if (IS (p, LONGETY) || IS (p, SHORTETY)) + { + get_mode_from_denotation (NEXT (p), count_sizety (SUB (p))); + MOID (p) = MOID (NEXT (p)); + } + else if (IS (p, EMPTY_SYMBOL)) + { + MOID (p) = M_VOID; + } + } +} + +/* Collect modes from the syntax tree. */ + +static void +get_modes_from_tree (NODE_T *p, int attribute) +{ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, VOID_SYMBOL)) + MOID (q) = M_VOID; + else if (IS (q, DECLARER)) + { + if (attribute == VARIABLE_DECLARATION) + { + MOID_T *new_one = get_mode_from_declarer (q); + MOID (q) = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, new_one, NO_PACK); + } + else + MOID (q) = get_mode_from_declarer (q); + } + else if (IS (q, ROUTINE_TEXT)) + { + MOID (q) = get_mode_from_routine_text (SUB (q)); + } + else if (IS (q, OPERATOR_PLAN)) + { + MOID (q) = get_mode_from_operator (SUB (q)); + } + else if (a68_is_one_of (q, LOC_SYMBOL, HEAP_SYMBOL, STOP)) + { + if (attribute == GENERATOR) + { + MOID_T *new_one = get_mode_from_declarer (NEXT (q)); + MOID (NEXT (q)) = new_one; + MOID (q) = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, NO_NODE, new_one, NO_PACK); + } + } + else + { + if (attribute == DENOTATION) + get_mode_from_denotation (q, 0); + } + } + + if (attribute != DENOTATION) + { + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (SUB (q) != NO_NODE) + get_modes_from_tree (SUB (q), ATTRIBUTE (q)); + } + } +} + +//! @brief Collect modes from proc variables. + +static void +get_mode_from_proc_variables (NODE_T *p) +{ + if (p != NO_NODE) + { + if (IS (p, PROCEDURE_VARIABLE_DECLARATION)) + { + get_mode_from_proc_variables (SUB (p)); + get_mode_from_proc_variables (NEXT (p)); + } + else if (IS (p, QUALIFIER) || IS (p, PROC_SYMBOL) || IS (p, COMMA_SYMBOL)) + { + get_mode_from_proc_variables (NEXT (p)); + } + else if (IS (p, DEFINING_IDENTIFIER)) + { + MOID_T *new_one = MOID (NEXT_NEXT (p)); + MOID (p) = a68_add_mode (&TOP_MOID (&A68_JOB), REF_SYMBOL, 0, p, new_one, NO_PACK); + } + } +} + +/* Collect modes from proc variable declarations. */ + +static void +get_mode_from_proc_var_declarations_tree (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + get_mode_from_proc_var_declarations_tree (SUB (p)); + + if (IS (p, PROCEDURE_VARIABLE_DECLARATION)) + get_mode_from_proc_variables (p); + } +} + +/* + * Various routines to test modes. + */ + +/* Whether a mode declaration refers to self or relates to void. + This uses Lindsey's ying-yang algorithm. */ + +static bool +is_well_formed (MOID_T *def, MOID_T *z, bool yin, bool yang, bool video) +{ + if (z == NO_MOID) + return false; + else if (yin && yang) + return z == M_VOID ? video : true; + else if (z == M_VOID) + return video; + else if (IS (z, STANDARD)) + return true; + else if (IS (z, INDICANT)) + { + if (def == NO_MOID) + { + /* Check an applied indicant for relation to VOID. */ + while (z != NO_MOID) + z = EQUIVALENT (z); + if (z == M_VOID) + return video; + else + return true; + } + else + { + if (z == def || USE (z)) + return yin && yang; + else + { + USE (z) = true; + bool wwf = is_well_formed (def, EQUIVALENT (z), yin, yang, video); + USE (z) = false; + return wwf; + } + } + } + else if (IS_REF (z)) + return is_well_formed (def, SUB (z), true, yang, false); + else if (IS (z, PROC_SYMBOL)) + return PACK (z) != NO_PACK ? true : is_well_formed (def, SUB (z), true, yang, true); + else if (IS_ROW (z)) + return is_well_formed (def, SUB (z), yin, yang, false); + else if (IS_FLEX (z)) + return is_well_formed (def, SUB (z), yin, yang, false); + else if (IS (z, STRUCT_SYMBOL)) + { + for (PACK_T *s = PACK (z); s != NO_PACK; FORWARD (s)) + { + if (!is_well_formed (def, MOID (s), yin, true, false)) + return false; + } + return true; + } + else if (IS (z, UNION_SYMBOL)) + { + for (PACK_T *s = PACK (z); s != NO_PACK; FORWARD (s)) + { + if (!is_well_formed (def, MOID (s), yin, yang, true)) + return false; + } + return true; + } + else + { + return false; + } +} + +/* Replace a mode by its equivalent mode (walk chain). */ + +static void +resolve_eq_members (MOID_T *q) +{ + resolve_equivalent (&SUB (q)); + resolve_equivalent (&DEFLEXED (q)); + resolve_equivalent (&MULTIPLE (q)); + resolve_equivalent (&NAME (q)); + resolve_equivalent (&SLICE (q)); + resolve_equivalent (&TRIM (q)); + resolve_equivalent (&ROWED (q)); + for (PACK_T *p = PACK (q); p != NO_PACK; FORWARD (p)) + resolve_equivalent (&MOID (p)); +} + +/* Track equivalent tags. */ + +static void +resolve_eq_tags (TAG_T *z) +{ + for (; z != NO_TAG; FORWARD (z)) + { + if (MOID (z) != NO_MOID) + resolve_equivalent (&MOID (z)); + } +} + +/* Bind modes in syntax tree. */ + +static void +bind_modes (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + resolve_equivalent (&MOID (p)); + + if (SUB (p) != NO_NODE && a68_is_new_lexical_level (p)) + { + TABLE_T *s = TABLE (SUB (p)); + for (TAG_T *z = INDICANTS (s); z != NO_TAG; FORWARD (z)) + { + if (NODE (z) != NO_NODE) + { + resolve_equivalent (&MOID (NEXT_NEXT (NODE (z)))); + MOID (z) = MOID (NEXT_NEXT (NODE (z))); + MOID (NODE (z)) = MOID (z); + } + } + } + bind_modes (SUB (p)); + } +} + +/* Routines for calculating subordinates for selections, for instance selection + from REF STRUCT (A) yields REF A fields and selection from [] STRUCT (A) + yields [] A fields. */ + +/* Make name pack. + Given a pack with modes: M1, M2, ... + Build a pack with modes: REF M1, REF M2, ... */ + +static void +make_name_pack (PACK_T *src, PACK_T **dst, MOID_T **p) +{ + if (src != NO_PACK) + { + make_name_pack (NEXT (src), dst, p); + MOID_T *z = a68_add_mode (p, REF_SYMBOL, 0, NO_NODE, MOID (src), NO_PACK); + (void) a68_add_mode_to_pack (dst, z, TEXT (src), NODE (src)); + } +} + +/* Make flex multiple row pack. + Given a pack with modes: M1, M2, ... + Build a pack with modes: []M1, []M2, ... */ + +static void +make_flex_multiple_row_pack (PACK_T *src, PACK_T **dst, MOID_T **p, int dim) +{ + if (src != NO_PACK) + { + make_flex_multiple_row_pack (NEXT (src), dst, p, dim); + MOID_T *z = add_row (p, dim, MOID (src), NO_NODE, false); + z = a68_add_mode (p, FLEX_SYMBOL, 0, NO_NODE, z, NO_PACK); + (void) a68_add_mode_to_pack (dst, z, TEXT (src), NODE (src)); + } +} + +/* Make name struct. */ + +static MOID_T * +make_name_struct (MOID_T *m, MOID_T **p) +{ + PACK_T *u = NO_PACK; + make_name_pack (PACK (m), &u, p); + return a68_add_mode (p, STRUCT_SYMBOL, DIM (m), NO_NODE, NO_MOID, u); +} + +/* Make name row. */ + +static MOID_T * +make_name_row (MOID_T *m, MOID_T **p) +{ + if (SLICE (m) != NO_MOID) + return a68_add_mode (p, REF_SYMBOL, 0, NO_NODE, SLICE (m), NO_PACK); + else if (SUB (m) != NO_MOID) + return a68_add_mode (p, REF_SYMBOL, 0, NO_NODE, SUB (m), NO_PACK); + else + /* weird, FLEX INT or so ... */ + return NO_MOID; +} + +/* Make multiple row pack. */ + +static void +make_multiple_row_pack (PACK_T *src, PACK_T **dst, MOID_T **p, int dim) +{ + if (src != NO_PACK) + { + make_multiple_row_pack (NEXT (src), dst, p, dim); + (void) a68_add_mode_to_pack (dst, add_row (p, dim, MOID (src), NO_NODE, false), + TEXT (src), NODE (src)); + } +} + +/* Make flex multiple struct. */ + +static MOID_T * +make_flex_multiple_struct (MOID_T *m, MOID_T **p, int dim) +{ + PACK_T *u = NO_PACK; + make_flex_multiple_row_pack (PACK (m), &u, p, dim); + return a68_add_mode (p, STRUCT_SYMBOL, DIM (m), NO_NODE, NO_MOID, u); +} + +/* Make multiple struct. */ + +static MOID_T * +make_multiple_struct (MOID_T *m, MOID_T **p, int dim) +{ + PACK_T *u = NO_PACK; + make_multiple_row_pack (PACK (m), &u, p, dim); + return a68_add_mode (p, STRUCT_SYMBOL, DIM (m), NO_NODE, NO_MOID, u); +} + +/* Whether mode has row. */ + +static bool +is_mode_has_row (MOID_T *m) +{ + if (IS (m, STRUCT_SYMBOL) || IS (m, UNION_SYMBOL)) + { + bool k = false; + + for (PACK_T *p = PACK (m); p != NO_PACK && k == false; FORWARD (p)) + { + HAS_ROWS (MOID (p)) = is_mode_has_row (MOID (p)); + k |= (HAS_ROWS (MOID (p))); + } + return k; + } + else + return (HAS_ROWS (m) || IS_ROW (m) || IS_FLEX (m)); +} + +/* Compute derived modes. */ + +static void +compute_derived_modes (MODULE_T *mod) +{ + MOID_T *z; + int len = 0, nlen = 1; + + /* UNION things. */ + absorb_unions (TOP_MOID (mod)); + contract_unions (TOP_MOID (mod)); + /* The for-statement below prevents an endless loop. */ + for (int k = 1; k <= 10 && len != nlen; k++) + { + /* Make deflexed modes. */ + for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + { + if (SUB (z) != NO_MOID) + { + if (IS_REF_FLEX (z) && DEFLEXED (SUB_SUB (z)) != NO_MOID) + DEFLEXED (z) = a68_add_mode (&TOP_MOID (mod), REF_SYMBOL, 0, NODE (z), + DEFLEXED (SUB_SUB (z)), NO_PACK); + else if (IS_REF (z) && DEFLEXED (SUB (z)) != NO_MOID) + DEFLEXED (z) = a68_add_mode (&TOP_MOID (mod), REF_SYMBOL, 0, NODE (z), + DEFLEXED (SUB (z)), NO_PACK); + else if (IS_ROW (z) && DEFLEXED (SUB (z)) != NO_MOID) + DEFLEXED (z) = a68_add_mode (&TOP_MOID (mod), ROW_SYMBOL, DIM (z), NODE (z), + DEFLEXED (SUB (z)), NO_PACK); + else if (IS_FLEX (z) && DEFLEXED (SUB (z)) != NO_MOID) + DEFLEXED (z) = DEFLEXED (SUB (z)); + else if (IS_FLEX (z)) + DEFLEXED (z) = SUB (z); + else + DEFLEXED (z) = z; + } + } + + /* Derived modes for stowed modes. */ + for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + { + if (NAME (z) == NO_MOID && IS_REF (z)) + { + if (IS (SUB (z), STRUCT_SYMBOL)) + NAME (z) = make_name_struct (SUB (z), &TOP_MOID (mod)); + else if (IS_ROW (SUB (z))) + NAME (z) = make_name_row (SUB (z), &TOP_MOID (mod)); + else if (IS_FLEX (SUB (z)) && SUB_SUB (z) != NO_MOID) + NAME (z) = make_name_row (SUB_SUB (z), &TOP_MOID (mod)); + } + + if (MULTIPLE (z) != NO_MOID) + ; + else if (IS_REF (z)) + { + if (MULTIPLE (SUB (z)) != NO_MOID) + MULTIPLE (z) = make_name_struct (MULTIPLE (SUB (z)), &TOP_MOID (mod)); + } + else if (IS_ROW (z)) + { + if (IS (SUB (z), STRUCT_SYMBOL)) + MULTIPLE (z) = make_multiple_struct (SUB (z), &TOP_MOID (mod), DIM (z)); + } + } + + for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + { + if (TRIM (z) == NO_MOID && IS_FLEX (z)) + TRIM (z) = SUB (z); + if (TRIM (z) == NO_MOID && IS_REF_FLEX (z)) + TRIM (z) = a68_add_mode (&TOP_MOID (mod), REF_SYMBOL, 0, NODE (z), SUB_SUB (z), NO_PACK); + } + + /* Fill out stuff for rows, f.i. inverse relations. */ + for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + { + if (IS_ROW (z) && DIM (z) > 0 && SUB (z) != NO_MOID && !DERIVATE (z)) + (void) add_row (&TOP_MOID (mod), DIM (z) + 1, SUB (z), NODE (z), true); + else if (IS_REF (z) && IS (SUB (z), ROW_SYMBOL) && !DERIVATE (SUB (z))) + { + MOID_T *x = add_row (&TOP_MOID (mod), DIM (SUB (z)) + 1, SUB_SUB (z), NODE (SUB (z)), true); + MOID_T *y = a68_add_mode (&TOP_MOID (mod), REF_SYMBOL, 0, NODE (z), x, NO_PACK); + NAME (y) = z; + } + } + + for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + { + if (IS_ROW (z) && SLICE (z) != NO_MOID) + ROWED (SLICE (z)) = z; + if (IS_REF (z)) + { + MOID_T *y = SUB (z); + if (SLICE (y) != NO_MOID && IS_ROW (SLICE (y)) && NAME (z) != NO_MOID) + ROWED (NAME (z)) = z; + } + } + + bind_modes (TOP_NODE (mod)); + for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + { + if (IS (z, INDICANT) && NODE (z) != NO_NODE) + EQUIVALENT (z) = MOID (NODE (z)); + } + for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + resolve_eq_members (z); + resolve_eq_tags (INDICANTS (A68_STANDENV)); + resolve_eq_tags (IDENTIFIERS (A68_STANDENV)); + resolve_eq_tags (OPERATORS (A68_STANDENV)); + resolve_equivalent (&M_STRING); + resolve_equivalent (&M_COMPLEX); + resolve_equivalent (&M_LONG_COMPLEX); + resolve_equivalent (&M_LONG_LONG_COMPLEX); + resolve_equivalent (&M_SEMA); + /* UNION members could be resolved. */ + absorb_unions (TOP_MOID (mod)); + contract_unions (TOP_MOID (mod)); + /* FLEX INDICANT could be resolved. */ + for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + { + if (IS_FLEX (z) && SUB (z) != NO_MOID) + { + if (SUB_SUB (z) != NO_MOID && IS (SUB_SUB (z), STRUCT_SYMBOL)) + MULTIPLE (z) = make_flex_multiple_struct (SUB_SUB (z), &TOP_MOID (mod), DIM (SUB (z))); + } + } + /* See what new known modes we have generated by resolving.. */ + for (z = TOP_MOID (mod); z != STANDENV_MOID (&A68_JOB); FORWARD (z)) + { + MOID_T *v; + + for (v = NEXT (z); v != NO_MOID; FORWARD (v)) + { + if (a68_prove_moid_equivalence (z, v)) + { + EQUIVALENT (z) = v; + EQUIVALENT (v) = NO_MOID; + } + } + } + + /* Count the modes to check self consistency. */ + len = nlen; + for (nlen = 0, z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + nlen++; + } + + gcc_assert (M_STRING == M_FLEX_ROW_CHAR); + + /* Find out what modes contain rows. */ + for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + HAS_ROWS (z) = is_mode_has_row (z); + + /* Check flexible modes. */ + for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + { + if (IS_FLEX (z) && !IS (SUB (z), ROW_SYMBOL)) + a68_error (NODE (z), "M does not specify a well formed mode", z); + } + + /* Check on fields in structured modes f.i. STRUCT (REAL x, INT n, REAL x) is + wrong. */ + for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + { + if (IS (z, STRUCT_SYMBOL) && EQUIVALENT (z) == NO_MOID) + { + PACK_T *s = PACK (z); + + for (; s != NO_PACK; FORWARD (s)) + { + PACK_T *t = NEXT (s); + bool x = true; + + for (t = NEXT (s); t != NO_PACK && x; FORWARD (t)) + { + if (TEXT (s) == TEXT (t)) + { + a68_error (NODE (z), "multiple declaration of field S"); + while (NEXT (s) != NO_PACK && TEXT (NEXT (s)) == TEXT (t)) + FORWARD (s); + x = false; + } + } + } + } + } + + /* Various union test. */ + for (z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + { + if (IS (z, UNION_SYMBOL) && EQUIVALENT (z) == NO_MOID) + { + PACK_T *s = PACK (z); + /* Discard unions with one member. */ + if (a68_count_pack_members (s) == 1) + a68_error (NODE (z), "M must have at least two components", z); + /* Discard incestuous unions with firmly related modes. */ + for (; s != NO_PACK; FORWARD (s)) + { + PACK_T *t; + + for (t = NEXT (s); t != NO_PACK; FORWARD (t)) + { + if (MOID (t) != MOID (s)) + { + if (a68_is_firm (MOID (s), MOID (t))) + a68_error (NODE (z), "M has firmly related components", z); + } + } + } + + /* Discard incestuous unions with firmly related subsets. */ + for (s = PACK (z); s != NO_PACK; FORWARD (s)) + { + MOID_T *n = a68_depref_completely (MOID (s)); + + if (IS (n, UNION_SYMBOL) && a68_is_subset (n, z, NO_DEFLEXING)) + a68_error (NODE (z), "M has firmly related subset M", z, n); + } + } + } + + /* Wrap up and exit. */ + a68_free_postulate_list (A68 (top_postulate), NO_POSTULATE); + A68 (top_postulate) = NO_POSTULATE; +} + +/* Make list of all modes in the program. */ + +void +a68_make_moid_list (MODULE_T *mod) +{ + bool cont = true; + + /* Collect modes from the syntax tree. */ + reset_moid_tree (TOP_NODE (mod)); + get_modes_from_tree (TOP_NODE (mod), STOP); + get_mode_from_proc_var_declarations_tree (TOP_NODE (mod)); + + /* Connect indicants to their declarers. */ + for (MOID_T *z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + { + if (IS (z, INDICANT)) + { + NODE_T *u = NODE (z); + gcc_assert (NEXT (u) != NO_NODE); + gcc_assert (NEXT_NEXT (u) != NO_NODE); + gcc_assert (MOID (NEXT_NEXT (u)) != NO_MOID); + EQUIVALENT (z) = MOID (NEXT_NEXT (u)); + } + } + + /* Checks on wrong declarations. */ + for (MOID_T *z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + USE (z) = false; + + for (MOID_T *z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + { + if (IS (z, INDICANT) && EQUIVALENT (z) != NO_MOID) + { + if (!is_well_formed (z, EQUIVALENT (z), false, false, true)) + { + a68_error (NODE (z), "M does not specify a well formed mode", z); + cont = false; + } + } + } + + for (MOID_T *z = TOP_MOID (mod); cont && z != NO_MOID; FORWARD (z)) + { + if (IS (z, INDICANT) && EQUIVALENT (z) != NO_MOID) + ; + else if (NODE (z) != NO_NODE) + { + if (!is_well_formed (NO_MOID, z, false, false, true)) + a68_error (NODE (z), "M does not specify a well formed mode", z); + } + } + + for (MOID_T *z = TOP_MOID (mod); z != NO_MOID; FORWARD (z)) + { + if (USE (z)) + gcc_unreachable (); + } + + if (ERROR_COUNT (mod) != 0) + return; + + compute_derived_modes (mod); + a68_init_postulates (); +} diff --git a/gcc/algol68/a68-parser-moids-check.cc b/gcc/algol68/a68-parser-moids-check.cc new file mode 100644 index 000000000000..a7b02cb19576 --- /dev/null +++ b/gcc/algol68/a68-parser-moids-check.cc @@ -0,0 +1,1878 @@ +/* Mode checker routines. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC and fixes by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +/* ALGOL 68 contexts are SOFT, WEAK, MEEK, FIRM and STRONG. + These contexts are increasing in strength: + + SOFT: Deproceduring + + WEAK: Dereferencing to REF [] or REF STRUCT + + MEEK: Deproceduring and dereferencing + + FIRM: MEEK followed by uniting + + STRONG: FIRM followed by rowing, widening or voiding + + Furthermore you will see in this file next switches: + + (1) FORCE_DEFLEXING allows assignment compatibility between FLEX and non FLEX + rows. This can only be the case when there is no danger of altering bounds of a + non FLEX row. + + (2) ALIAS_DEFLEXING prohibits aliasing a FLEX row to a non FLEX row (vice versa + is no problem) so that one cannot alter the bounds of a non FLEX row by + aliasing it to a FLEX row. This is particularly the case when passing names as + parameters to procedures: + + PROC x = (REF STRING s) VOID: ..., PROC y = (REF [] CHAR c) VOID: ...; + + x (LOC STRING); # OK # + + x (LOC [10] CHAR); # Not OK, suppose x changes bounds of s! # + + y (LOC STRING); # OK # + + y (LOC [10] CHAR); # OK # + + (3) SAFE_DEFLEXING sets FLEX row apart from non FLEX row. This holds for names, + not for values, so common things are not rejected, for instance + + STRING x = read string; + + [] CHAR y = read string + + (4) NO_DEFLEXING sets FLEX row apart from non FLEX row. */ + +/* + In the RR grammar: + + SORT: strong; firm; weak; meek; soft. + SORT MOID serial clause; + strong void unit, go on token, SORT MOID serial clause; + declaration, go on token, SORT MOID serial clause; + SORT MOID unit + + And it is the SORT MOID sequence of metanotions, which shall evaluate the + same in the complete rule, that control the balancing! o_O + + Also, it denotes how the SORT MOID of the serial clause gets "passed" to the + last unit in the serial clause. Other units have SOID `strong void'. + + It is used to pass down the required mode on whatever context. Like, + PARTICULAR_PROGRAM evaluates in strong context and requires VOID. + + The ATTRIBUTE in the soid is used to pass down the kind of construct that + introduces the context+required mode. This is used in + a68_determine_unique_mode in order to know whether balancing shall be + performed or not. +*/ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "options.h" + +#include "a68.h" + +/* Forward declarations of some of the functions defined below. */ + +static void mode_check_enclosed (NODE_T *p, SOID_T *x, SOID_T *y); +static void mode_check_unit (NODE_T *p, SOID_T *x, SOID_T *y); +static void mode_check_formula (NODE_T *p, SOID_T *x, SOID_T *y); +static void mode_check_module_declaration (NODE_T *p); +static void mode_check_module_text (NODE_T *p); +static void mode_check_module_declaration (NODE_T *p); + +/* Driver for mode checker. */ + +void +a68_mode_checker (NODE_T *p) +{ + if (IS (p, PACKET)) + { + p = SUB (p); + + if (IS (p, PARTICULAR_PROGRAM)) + { + A68 (top_soid_list) = NO_SOID; + SOID_T x, y; + a68_make_soid (&x, STRONG, M_VOID, 0); + mode_check_enclosed (SUB (p), &x, &y); + MOID (p) = MOID (&y); + } + else if (IS (p, PRELUDE_PACKET)) + mode_check_module_declaration (SUB (p)); + } +} + +/* Mode check on bounds. */ + +static void +mode_check_bounds (NODE_T *p) +{ + if (p == NO_NODE) + return; + else if (IS (p, UNIT)) + { + SOID_T x, y; + a68_make_soid (&x, STRONG, M_INT, 0); + mode_check_unit (p, &x, &y); + if (!a68_is_coercible_in_context (&y, &x, SAFE_DEFLEXING)) + a68_cannot_coerce (p, MOID (&y), M_INT, MEEK, SAFE_DEFLEXING, UNIT); + mode_check_bounds (NEXT (p)); + } + else + { + mode_check_bounds (SUB (p)); + mode_check_bounds (NEXT (p)); + } +} + +/* Mode check declarer. */ + +static void +mode_check_declarer (NODE_T *p) +{ + if (p == NO_NODE) + return; + else if (IS (p, BOUNDS)) + { + mode_check_bounds (SUB (p)); + mode_check_declarer (NEXT (p)); + } + else + { + mode_check_declarer (SUB (p)); + mode_check_declarer (NEXT (p)); + } +} + +/* Mode check identity declaration. */ + +static void +mode_check_identity_declaration (NODE_T *p) +{ + if (p != NO_NODE) + { + switch (ATTRIBUTE (p)) + { + case DECLARER: + mode_check_declarer (SUB (p)); + mode_check_identity_declaration (NEXT (p)); + break; + case DEFINING_IDENTIFIER: + { + SOID_T x, y; + a68_make_soid (&x, STRONG, MOID (p), 0); + mode_check_unit (NEXT_NEXT (p), &x, &y); + if (!a68_is_coercible_in_context (&y, &x, SAFE_DEFLEXING)) + a68_cannot_coerce (NEXT_NEXT (p), MOID (&y), MOID (&x), STRONG, SAFE_DEFLEXING, UNIT); + else if (MOID (&x) != MOID (&y)) + /* Check for instance, REF INT i = LOC REF INT. */ + a68_semantic_pitfall (NEXT_NEXT (p), MOID (&x), IDENTITY_DECLARATION, GENERATOR); + break; + } + default: + mode_check_identity_declaration (SUB (p)); + mode_check_identity_declaration (NEXT (p)); + break; + } + } +} + +/* Mode check variable declaration. */ + +static void +mode_check_variable_declaration (NODE_T *p) +{ + if (p != NO_NODE) + { + switch (ATTRIBUTE (p)) + { + case DECLARER: + mode_check_declarer (SUB (p)); + mode_check_variable_declaration (NEXT (p)); + break; + case DEFINING_IDENTIFIER: + if (a68_whether (p, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP)) + { + SOID_T x, y; + a68_make_soid (&x, STRONG, SUB_MOID (p), 0); + mode_check_unit (NEXT_NEXT (p), &x, &y); + if (!a68_is_coercible_in_context (&y, &x, FORCE_DEFLEXING)) + a68_cannot_coerce (p, MOID (&y), MOID (&x), STRONG, FORCE_DEFLEXING, UNIT); + else if (SUB_MOID (&x) != MOID (&y)) + /* Check for instance, REF INT i = LOC REF INT. */ + a68_semantic_pitfall (NEXT_NEXT (p), MOID (&x), VARIABLE_DECLARATION, GENERATOR); + } + break; + default: + mode_check_variable_declaration (SUB (p)); + mode_check_variable_declaration (NEXT (p)); + break; + } + } +} + +/* Mode check routine text. */ + +static void +mode_check_routine_text (NODE_T *p, SOID_T *y) +{ + SOID_T w; + + if (IS (p, PARAMETER_PACK)) + { + mode_check_declarer (SUB (p)); + FORWARD (p); + } + + mode_check_declarer (SUB (p)); + a68_make_soid (&w, STRONG, MOID (p), 0); + mode_check_unit (NEXT_NEXT (p), &w, y); + if (!a68_is_coercible_in_context (y, &w, FORCE_DEFLEXING)) + a68_cannot_coerce (NEXT_NEXT (p), MOID (y), MOID (&w), STRONG, FORCE_DEFLEXING, UNIT); +} + +/* Mode check proc declaration. */ + +static void +mode_check_proc_declaration (NODE_T *p) +{ + if (p == NO_NODE) + return; + else if (IS (p, ROUTINE_TEXT)) + { + SOID_T x, y; + a68_make_soid (&x, STRONG, NO_MOID, 0); + mode_check_routine_text (SUB (p), &y); + } + else + { + mode_check_proc_declaration (SUB (p)); + mode_check_proc_declaration (NEXT (p)); + } +} + +/* Mode check brief op declaration. */ + +static void +mode_check_brief_op_declaration (NODE_T *p) +{ + if (p == NO_NODE) + return; + else if (IS (p, DEFINING_OPERATOR)) + { + SOID_T y; + + if (MOID (p) != MOID (NEXT_NEXT (p))) + { + SOID_T y2, x; + a68_make_soid (&y2, NO_SORT, MOID (NEXT_NEXT (p)), 0); + a68_make_soid (&x, NO_SORT, MOID (p), 0); + a68_cannot_coerce (NEXT_NEXT (p), MOID (&y2), MOID (&x), STRONG, SKIP_DEFLEXING, ROUTINE_TEXT); + } + mode_check_routine_text (SUB (NEXT_NEXT (p)), &y); + } + else + { + mode_check_brief_op_declaration (SUB (p)); + mode_check_brief_op_declaration (NEXT (p)); + } +} + +/* Mode check op declaration. */ + +static void +mode_check_op_declaration (NODE_T *p) +{ + if (p == NO_NODE) + return; + else if (IS (p, DEFINING_OPERATOR)) + { + SOID_T y, x; + a68_make_soid (&x, STRONG, MOID (p), 0); + mode_check_unit (NEXT_NEXT (p), &x, &y); + if (!a68_is_coercible_in_context (&y, &x, SAFE_DEFLEXING)) + a68_cannot_coerce (NEXT_NEXT (p), MOID (&y), MOID (&x), STRONG, SAFE_DEFLEXING, UNIT); + } + else + { + mode_check_op_declaration (SUB (p)); + mode_check_op_declaration (NEXT (p)); + } +} + +/* Mode check declaration list. */ + +static void +mode_check_declaration_list (NODE_T * p) +{ + if (p != NO_NODE) + { + switch (ATTRIBUTE (p)) + { + case IDENTITY_DECLARATION: + mode_check_identity_declaration (SUB (p)); + break; + case VARIABLE_DECLARATION: + mode_check_variable_declaration (SUB (p)); + break; + case MODE_DECLARATION: + mode_check_declarer (SUB (p)); + break; + case PROCEDURE_DECLARATION: + case PROCEDURE_VARIABLE_DECLARATION: + mode_check_proc_declaration (SUB (p)); + break; + case BRIEF_OPERATOR_DECLARATION: + mode_check_brief_op_declaration (SUB (p)); + break; + case OPERATOR_DECLARATION: + mode_check_op_declaration (SUB (p)); + break; + default: + mode_check_declaration_list (SUB (p)); + mode_check_declaration_list (NEXT (p)); + break; + } + } +} + +/* Mode check serial clause. */ + +static void +mode_check_serial (SOID_T **r, NODE_T *p, SOID_T *x, bool k) +{ + if (p == NO_NODE) + return; + else if (IS (p, INITIALISER_SERIES)) + { + mode_check_serial (r, SUB (p), x, false); + mode_check_serial (r, NEXT (p), x, k); + } + else if (IS (p, DECLARATION_LIST)) + mode_check_declaration_list (SUB (p)); + else if (a68_is_one_of (p, LABEL, SEMI_SYMBOL, EXIT_SYMBOL, STOP)) + mode_check_serial (r, NEXT (p), x, k); + else if (a68_is_one_of (p, SERIAL_CLAUSE, ENQUIRY_CLAUSE, STOP)) + { + if (NEXT (p) != NO_NODE) + { + if (IS (NEXT (p), EXIT_SYMBOL) || IS (NEXT (p), END_SYMBOL) || IS (NEXT (p), CLOSE_SYMBOL)) + mode_check_serial (r, SUB (p), x, true); + else + mode_check_serial (r, SUB (p), x, false); + mode_check_serial (r, NEXT (p), x, k); + } + else + mode_check_serial (r, SUB (p), x, true); + } + else if (IS (p, LABELED_UNIT)) + mode_check_serial (r, SUB (p), x, k); + else if (IS (p, UNIT)) + { + SOID_T y; + + if (k) + mode_check_unit (p, x, &y); + else + { + SOID_T w; + a68_make_soid (&w, STRONG, M_VOID, 0); + mode_check_unit (p, &w, &y); + } + if (NEXT (p) != NO_NODE) + mode_check_serial (r, NEXT (p), x, k); + else + { + if (k) + a68_add_to_soid_list (r, p, &y); + } + } +} + +/* Mode check serial clause units. */ + +static void +mode_check_serial_units (NODE_T *p, SOID_T *x, SOID_T *y, + int att __attribute__((unused))) +{ + SOID_T *top_sl = NO_SOID; + + mode_check_serial (&top_sl, SUB (p), x, true); + if (a68_is_balanced (p, top_sl, SORT (x))) + { + MOID_T *result = a68_pack_soids_in_moid (top_sl, SERIES_MODE); + a68_make_soid (y, SORT (x), result, SERIAL_CLAUSE); + } + else + a68_make_soid (y, SORT (x), (MOID (x) != NO_MOID ? MOID (x) : M_ERROR), 0); + + a68_free_soid_list (top_sl); +} + +/* Mode check unit list. */ + +static void +mode_check_unit_list (SOID_T **r, NODE_T *p, SOID_T *x) +{ + if (p == NO_NODE) + return; + else if (IS (p, UNIT_LIST)) + { + mode_check_unit_list (r, SUB (p), x); + mode_check_unit_list (r, NEXT (p), x); + } + else if (IS (p, COMMA_SYMBOL)) + mode_check_unit_list (r, NEXT (p), x); + else if (IS (p, UNIT)) + { + SOID_T y; + mode_check_unit (p, x, &y); + a68_add_to_soid_list (r, p, &y); + mode_check_unit_list (r, NEXT (p), x); + } +} + +/* Mode check struct display. */ + +static void +mode_check_struct_display (SOID_T **r, NODE_T *p, PACK_T **fields) +{ + if (p == NO_NODE) + return; + else if (IS (p, UNIT_LIST)) + { + mode_check_struct_display (r, SUB (p), fields); + mode_check_struct_display (r, NEXT (p), fields); + } + else if (IS (p, COMMA_SYMBOL)) + mode_check_struct_display (r, NEXT (p), fields); + else if (IS (p, UNIT)) + { + SOID_T x, y; + + if (*fields != NO_PACK) + { + a68_make_soid (&x, STRONG, MOID (*fields), 0); + FORWARD (*fields); + } + else + a68_make_soid (&x, STRONG, NO_MOID, 0); + mode_check_unit (p, &x, &y); + a68_add_to_soid_list (r, p, &y); + mode_check_struct_display (r, NEXT (p), fields); + } +} + +/* Mode check get specified moids. */ + +static void +mode_check_get_specified_moids (NODE_T *p, MOID_T *u) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (a68_is_one_of (p, SPECIFIED_UNIT_LIST, SPECIFIED_UNIT, STOP)) + mode_check_get_specified_moids (SUB (p), u); + else if (IS (p, SPECIFIER)) + { + MOID_T *m = MOID (NEXT_SUB (p)); + a68_add_mode_to_pack (&(PACK (u)), m, NO_TEXT, NODE (m)); + } + } +} + +/* Mode check specified unit list. */ + +void +mode_check_specified_unit_list (SOID_T **r, NODE_T *p, SOID_T *x, MOID_T *u) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (a68_is_one_of (p, SPECIFIED_UNIT_LIST, SPECIFIED_UNIT, STOP)) + mode_check_specified_unit_list (r, SUB (p), x, u); + else if (IS (p, SPECIFIER)) + { + MOID_T *m = MOID (NEXT_SUB (p)); + if (u != NO_MOID && !a68_is_unitable (m, u, SAFE_DEFLEXING)) + a68_error (p, "M is neither component nor subset of M", m, u); + + } + else if (IS (p, UNIT)) + { + SOID_T y; + mode_check_unit (p, x, &y); + a68_add_to_soid_list (r, p, &y); + } + } +} + +/* Mode check united case parts. */ + +static void +mode_check_united_case_parts (SOID_T **ry, NODE_T *p, SOID_T *x) +{ + SOID_T enq_expct, enq_yield; + MOID_T *u = NO_MOID, *v = NO_MOID, *w = NO_MOID; + /* Check the CASE part and deduce the united mode. */ + a68_make_soid (&enq_expct, MEEK, NO_MOID, 0); + mode_check_serial_units (NEXT_SUB (p), &enq_expct, &enq_yield, ENQUIRY_CLAUSE); + /* Deduce the united mode from the enquiry clause. + This requires balancing. */ + u = MOID (&enq_yield); + a68_absorb_series_pack (&u); + DIM (u) = a68_count_pack_members (PACK (u)); + if (DIM (u) == 1) + u = MOID (PACK (u)); + else + { + MOID_T *united, *balanced; + united = a68_make_united_mode (u); + balanced = a68_get_balanced_mode_or_no_mode (united, + STRONG, A68_NO_DEPREF, + SAFE_DEFLEXING); + if (balanced != NO_MOID) + u = balanced; + } + u = a68_depref_completely (u); + /* Also deduce the united mode from the specifiers. */ + v = a68_new_moid (); + ATTRIBUTE (v) = SERIES_MODE; + mode_check_get_specified_moids (NEXT_SUB (NEXT (p)), v); + v = a68_make_united_mode (v); + /* Determine a resulting union. */ + if (u == M_HIP) + w = v; + else + { + if (IS (u, UNION_SYMBOL)) + { + bool uv, vu, some; + a68_investigate_firm_relations (PACK (u), PACK (v), &uv, &some); + a68_investigate_firm_relations (PACK (v), PACK (u), &vu, &some); + if (uv && vu) + { + /* Every component has a specifier. */ + w = u; + } + else if (!uv && !vu) + { + /* Hmmmm ... let the coercer sort it out. */ + w = u; + } + else + { + /* This is all the balancing we allow here for the moment. Firmly + related subsets are not valid so we absorb them. If this + doesn't solve it then we get a coercion-error later. */ + w = a68_absorb_related_subsets (u); + } + } + else + { + a68_error (NEXT_SUB (p), "M is not a united mode", u); + return; + } + } + MOID (SUB (p)) = w; + FORWARD (p); + /* Check the IN part. */ + mode_check_specified_unit_list (ry, NEXT_SUB (p), x, w); + /* OUSE, OUT, ESAC. */ + if ((FORWARD (p)) != NO_NODE) + { + if (a68_is_one_of (p, OUT_PART, CHOICE, STOP)) + mode_check_serial (ry, NEXT_SUB (p), x, true); + else if (a68_is_one_of (p, CONFORMITY_OUSE_PART, BRIEF_CONFORMITY_OUSE_PART, STOP)) + mode_check_united_case_parts (ry, SUB (p), x); + } +} + +/* Mode check united case. */ + +static void +mode_check_united_case (NODE_T *p, SOID_T *x, SOID_T *y) +{ + SOID_T *top_sl = NO_SOID; + + mode_check_united_case_parts (&top_sl, p, x); + if (!a68_is_balanced (p, top_sl, SORT (x))) + { + if (MOID (x) != NO_MOID) + a68_make_soid (y, SORT (x), MOID (x), CONFORMITY_CLAUSE); + else + a68_make_soid (y, SORT (x), M_ERROR, 0); + } + else + { + MOID_T *z = a68_pack_soids_in_moid (top_sl, SERIES_MODE); + a68_make_soid (y, SORT (x), z, CONFORMITY_CLAUSE); + } + a68_free_soid_list (top_sl); +} + +/* Mode check unit list 2. */ + +static void +mode_check_unit_list_2 (NODE_T *p, SOID_T *x, SOID_T *y) +{ + SOID_T *top_sl = NO_SOID; + + if (MOID (x) != NO_MOID) + { + if (IS_FLEX (MOID (x))) + { + SOID_T y2; + a68_make_soid (&y2, SORT (x), SLICE (SUB_MOID (x)), 0); + mode_check_unit_list (&top_sl, SUB (p), &y2); + } + else if (IS_ROW (MOID (x))) + { + SOID_T y2; + a68_make_soid (&y2, SORT (x), SLICE (MOID (x)), 0); + mode_check_unit_list (&top_sl, SUB (p), &y2); + } + else if (IS (MOID (x), STRUCT_SYMBOL)) + { + PACK_T *y2 = PACK (MOID (x)); + mode_check_struct_display (&top_sl, SUB (p), &y2); + } + else + mode_check_unit_list (&top_sl, SUB (p), x); + } + else + mode_check_unit_list (&top_sl, SUB (p), x); + + a68_make_soid (y, STRONG, a68_pack_soids_in_moid (top_sl, STOWED_MODE), 0); + a68_free_soid_list (top_sl); +} + +/* Mode check access. */ + +static void +mode_check_access (NODE_T *p, SOID_T *x, SOID_T *y) +{ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, ENCLOSED_CLAUSE)) + { + mode_check_enclosed (q, x, y); + MOID (p) = MOID (y); + } + } +} + +/* Mode check closed. */ + +static void +mode_check_closed (NODE_T *p, SOID_T *x, SOID_T *y) +{ + if (p == NO_NODE) + return; + else if (IS (p, SERIAL_CLAUSE)) + mode_check_serial_units (p, x, y, SERIAL_CLAUSE); + else if (a68_is_one_of (p, OPEN_SYMBOL, BEGIN_SYMBOL, STOP)) + mode_check_closed (NEXT (p), x, y); + MOID (p) = MOID (y); +} + +/* Mode check collateral. */ + +void +mode_check_collateral (NODE_T *p, SOID_T *x, SOID_T *y) +{ + if (p == NO_NODE) + return; + else if (a68_whether (p, BEGIN_SYMBOL, END_SYMBOL, STOP) + || a68_whether (p, OPEN_SYMBOL, CLOSE_SYMBOL, STOP)) + { + if (SORT (x) == STRONG) + { + if (MOID (x) == NO_MOID) + a68_error (p, "vacuum cannot have row elements (use a Y generator)", + "REF MODE"); + else if (IS_FLEXETY_ROW (MOID (x))) + a68_make_soid (y, STRONG, M_VACUUM, 0); + else + { + /* The syntax only allows vacuums in strong contexts with rowed + modes. See rule 33d. */ + a68_error (p, "a vacuum is not a valid M", MOID (x)); + a68_make_soid (y, STRONG, M_ERROR, 0); + } + } + else + a68_make_soid (y, STRONG, M_UNDEFINED, 0); + } + else + { + if (IS (p, UNIT_LIST)) + mode_check_unit_list_2 (p, x, y); + else if (a68_is_one_of (p, OPEN_SYMBOL, BEGIN_SYMBOL, STOP)) + mode_check_collateral (NEXT (p), x, y); + MOID (p) = MOID (y); + } +} + +/* Mode check conditional 2. */ + +static void +mode_check_conditional_2 (SOID_T **ry, NODE_T *p, SOID_T *x) +{ + SOID_T enq_expct, enq_yield; + + a68_make_soid (&enq_expct, MEEK, M_BOOL, 0); + mode_check_serial_units (NEXT_SUB (p), &enq_expct, &enq_yield, ENQUIRY_CLAUSE); + if (!a68_is_coercible_in_context (&enq_yield, &enq_expct, SAFE_DEFLEXING)) + a68_cannot_coerce (p, MOID (&enq_yield), MOID (&enq_expct), MEEK, SAFE_DEFLEXING, ENQUIRY_CLAUSE); + FORWARD (p); + mode_check_serial (ry, NEXT_SUB (p), x, true); + if ((FORWARD (p)) != NO_NODE) + { + if (a68_is_one_of (p, ELSE_PART, CHOICE, STOP)) + mode_check_serial (ry, NEXT_SUB (p), x, true); + else if (a68_is_one_of (p, ELIF_PART, BRIEF_ELIF_PART, STOP)) + mode_check_conditional_2 (ry, SUB (p), x); + } +} + +/* Mode check conditional. */ + +static void +mode_check_conditional (NODE_T *p, SOID_T *x, SOID_T *y) +{ + SOID_T *top_sl = NO_SOID; + mode_check_conditional_2 (&top_sl, p, x); + if (!a68_is_balanced (p, top_sl, SORT (x))) + { + if (MOID (x) != NO_MOID) + a68_make_soid (y, SORT (x), MOID (x), CONDITIONAL_CLAUSE); + else + a68_make_soid (y, SORT (x), M_ERROR, 0); + } + else + { + MOID_T *z = a68_pack_soids_in_moid (top_sl, SERIES_MODE); + a68_make_soid (y, SORT (x), z, CONDITIONAL_CLAUSE); + } + a68_free_soid_list (top_sl); +} + +/* Mode check int case 2. */ + +static void +mode_check_int_case_2 (SOID_T **ry, NODE_T *p, SOID_T *x) +{ + SOID_T enq_expct, enq_yield; + a68_make_soid (&enq_expct, MEEK, M_INT, 0); + mode_check_serial_units (NEXT_SUB (p), &enq_expct, &enq_yield, ENQUIRY_CLAUSE); + if (!a68_is_coercible_in_context (&enq_yield, &enq_expct, SAFE_DEFLEXING)) + a68_cannot_coerce (p, MOID (&enq_yield), MOID (&enq_expct), MEEK, SAFE_DEFLEXING, ENQUIRY_CLAUSE); + FORWARD (p); + mode_check_unit_list (ry, NEXT_SUB (p), x); + if ((FORWARD (p)) != NO_NODE) + { + if (a68_is_one_of (p, OUT_PART, CHOICE, STOP)) + mode_check_serial (ry, NEXT_SUB (p), x, true); + else if (a68_is_one_of (p, CASE_OUSE_PART, BRIEF_OUSE_PART, STOP)) + mode_check_int_case_2 (ry, SUB (p), x); + } +} + +/* Mode check int case. */ + +static void +mode_check_int_case (NODE_T *p, SOID_T *x, SOID_T *y) +{ + SOID_T *top_sl = NO_SOID; + mode_check_int_case_2 (&top_sl, p, x); + if (!a68_is_balanced (p, top_sl, SORT (x))) + { + if (MOID (x) != NO_MOID) + a68_make_soid (y, SORT (x), MOID (x), CASE_CLAUSE); + else + a68_make_soid (y, SORT (x), M_ERROR, 0); + } + else + { + MOID_T *z = a68_pack_soids_in_moid (top_sl, SERIES_MODE); + a68_make_soid (y, SORT (x), z, CASE_CLAUSE); + } + a68_free_soid_list (top_sl); +} + +/* Mode check loop 2. */ + +static void +mode_check_loop_2 (NODE_T *p, SOID_T *y) +{ + if (p == NO_NODE) + return; + else if (IS (p, FOR_PART)) + mode_check_loop_2 (NEXT (p), y); + else if (a68_is_one_of (p, FROM_PART, BY_PART, TO_PART, STOP)) + { + SOID_T ix, iy; + a68_make_soid (&ix, STRONG, M_INT, 0); + mode_check_unit (NEXT_SUB (p), &ix, &iy); + if (!a68_is_coercible_in_context (&iy, &ix, SAFE_DEFLEXING)) + a68_cannot_coerce (NEXT_SUB (p), MOID (&iy), M_INT, MEEK, SAFE_DEFLEXING, ENQUIRY_CLAUSE); + mode_check_loop_2 (NEXT (p), y); + } + else if (IS (p, WHILE_PART)) + { + SOID_T enq_expct, enq_yield; + a68_make_soid (&enq_expct, MEEK, M_BOOL, 0); + mode_check_serial_units (NEXT_SUB (p), &enq_expct, &enq_yield, ENQUIRY_CLAUSE); + if (!a68_is_coercible_in_context (&enq_yield, &enq_expct, SAFE_DEFLEXING)) + a68_cannot_coerce (p, MOID (&enq_yield), MOID (&enq_expct), MEEK, SAFE_DEFLEXING, ENQUIRY_CLAUSE); + mode_check_loop_2 (NEXT (p), y); + } + else if (a68_is_one_of (p, DO_PART, ALT_DO_PART, STOP)) + { + SOID_T *z = NO_SOID; + NODE_T *do_p = NEXT_SUB (p); + SOID_T ix; + a68_make_soid (&ix, STRONG, M_VOID, 0); + if (IS (do_p, SERIAL_CLAUSE)) + mode_check_serial (&z, do_p, &ix, true); + a68_free_soid_list (z); + } +} + +/* Mode check loop. */ + +static void +mode_check_loop (NODE_T *p, SOID_T *y) +{ + SOID_T *z = NO_SOID; + mode_check_loop_2 (p, z); + a68_make_soid (y, STRONG, M_VOID, 0); +} + +/* Mode check enclosed. */ + +static void +mode_check_enclosed (NODE_T *p, SOID_T *x, SOID_T *y) +{ + if (p == NO_NODE) + return; + else if (IS (p, ENCLOSED_CLAUSE)) + mode_check_enclosed (SUB (p), x, y); + else if (IS (p, CLOSED_CLAUSE)) + mode_check_closed (SUB (p), x, y); + else if (IS (p, ACCESS_CLAUSE)) + mode_check_access (SUB (p), x, y); + else if (IS (p, PARALLEL_CLAUSE)) + { + mode_check_collateral (SUB (NEXT_SUB (p)), x, y); + a68_make_soid (y, STRONG, M_VOID, 0); + MOID (NEXT_SUB (p)) = M_VOID; + } + else if (IS (p, COLLATERAL_CLAUSE)) + mode_check_collateral (SUB (p), x, y); + else if (IS (p, CONDITIONAL_CLAUSE)) + mode_check_conditional (SUB (p), x, y); + else if (IS (p, CASE_CLAUSE)) + mode_check_int_case (SUB (p), x, y); + else if (IS (p, CONFORMITY_CLAUSE)) + mode_check_united_case (SUB (p), x, y); + else if (IS (p, LOOP_CLAUSE)) + mode_check_loop (SUB (p), y); + + MOID (p) = MOID (y); +} + +/* Search table for operator. */ + +static TAG_T * +search_table_for_operator (TAG_T *t, const char *n, MOID_T *x, MOID_T *y) +{ + if (a68_is_mode_isnt_well (x)) + return A68_PARSER (error_tag); + else if (y != NO_MOID && a68_is_mode_isnt_well (y)) + return A68_PARSER (error_tag); + + for (; t != NO_TAG; FORWARD (t)) + { + if (NSYMBOL (NODE (t)) == n || strcmp (NSYMBOL (NODE (t)), n) == 0) + { + PACK_T *p = PACK (MOID (t)); + if (a68_is_coercible (x, MOID (p), FIRM, ALIAS_DEFLEXING)) + { + FORWARD (p); + if (p == NO_PACK && y == NO_MOID) + /* Matched in case of a monadic. */ + return t; + else if (p != NO_PACK && y != NO_MOID + && a68_is_coercible (y, MOID (p), FIRM, ALIAS_DEFLEXING)) + /* Matched in case of a dyadic. */ + return t; + } + } + } + return NO_TAG; +} + +/* Search chain of symbol tables and return matching operator "x n y" or + "n x". */ + +static TAG_T * +search_table_chain_for_operator (TABLE_T *s, const char *n, MOID_T *x, MOID_T *y) +{ + if (a68_is_mode_isnt_well (x)) + return A68_PARSER (error_tag); + else if (y != NO_MOID && a68_is_mode_isnt_well (y)) + return A68_PARSER (error_tag); + + while (s != NO_TABLE) + { + TAG_T *z = search_table_for_operator (OPERATORS (s), n, x, y); + if (z != NO_TAG) + return z; + BACKWARD (s); + } + return NO_TAG; +} + +/* Return a matching operator "x n y". */ + +static TAG_T * +find_operator (TABLE_T *s, const char *n, MOID_T *x, MOID_T *y) +{ + /* Coercions to operand modes are FIRM. */ + MOID_T *u, *v; TAG_T *z; + /* (A) Catch exceptions first. */ + if (x == NO_MOID && y == NO_MOID) + return NO_TAG; + else if (a68_is_mode_isnt_well (x)) + return A68_PARSER (error_tag); + else if (y != NO_MOID && a68_is_mode_isnt_well (y)) + return A68_PARSER (error_tag); + + /* (B) MONADs. */ + if (x != NO_MOID && y == NO_MOID) + { + z = search_table_chain_for_operator (s, n, x, NO_MOID); + if (z != NO_TAG) + return z; + else + { + /* (B.2) A little trick to allow - (0, 1) or ABS (1, long pi). */ + if (a68_is_coercible (x, M_COMPLEX, STRONG, SAFE_DEFLEXING)) + { + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_COMPLEX, NO_MOID); + if (z != NO_TAG) + return z; + } + if (a68_is_coercible (x, M_LONG_COMPLEX, STRONG, SAFE_DEFLEXING)) + { + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_LONG_COMPLEX, NO_MOID); + if (z != NO_TAG) + return z; + } + if (a68_is_coercible (x, M_LONG_LONG_COMPLEX, STRONG, SAFE_DEFLEXING)) + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_LONG_LONG_COMPLEX, NO_MOID); + } + return NO_TAG; + } + /* (C) DYADs. */ + z = search_table_chain_for_operator (s, n, x, y); + if (z != NO_TAG) + return z; + /* (C.2) Vector and matrix "strong coercions" in standard environ. */ + u = DEFLEX (a68_depref_completely (x)); + v = DEFLEX (a68_depref_completely (y)); + if ((u == M_ROW_REAL || u == M_ROW_ROW_REAL) + || (v == M_ROW_REAL || v == M_ROW_ROW_REAL) + || (u == M_ROW_COMPLEX || u == M_ROW_ROW_COMPLEX) + || (v == M_ROW_COMPLEX || v == M_ROW_ROW_COMPLEX)) + { + if (u == M_INT) + { + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_REAL, y); + if (z != NO_TAG) + return z; + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_COMPLEX, y); + if (z != NO_TAG) + return z; + } + else if (v == M_INT) + { + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, x, M_REAL); + if (z != NO_TAG) + return z; + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, x, M_COMPLEX); + if (z != NO_TAG) + return z; + } + else if (u == M_REAL) + { + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_COMPLEX, y); + if (z != NO_TAG) + return z; + } + else if (v == M_REAL) + { + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, x, M_COMPLEX); + if (z != NO_TAG) + return z; + } + } + /* (C.3) Look in standenv for an appropriate cross-term. */ + u = a68_make_series_from_moids (x, y); + u = a68_make_united_mode (u); + v = a68_get_balanced_mode (u, STRONG, A68_NO_DEPREF, SAFE_DEFLEXING); + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, v, v); + if (z != NO_TAG) + return z; + if (a68_is_coercible_series (u, M_REAL, STRONG, SAFE_DEFLEXING)) + { + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_REAL, M_REAL); + if (z != NO_TAG) + return z; + } + if (a68_is_coercible_series (u, M_LONG_REAL, STRONG, SAFE_DEFLEXING)) + { + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_LONG_REAL, M_LONG_REAL); + if (z != NO_TAG) + return z; + } + if (a68_is_coercible_series (u, M_LONG_LONG_REAL, STRONG, SAFE_DEFLEXING)) + { + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_LONG_LONG_REAL, M_LONG_LONG_REAL); + if (z != NO_TAG) + return z; + } + if (a68_is_coercible_series (u, M_COMPLEX, STRONG, SAFE_DEFLEXING)) + { + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_COMPLEX, M_COMPLEX); + if (z != NO_TAG) + return z; + } + if (a68_is_coercible_series (u, M_LONG_COMPLEX, STRONG, SAFE_DEFLEXING)) + { + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_LONG_COMPLEX, M_LONG_COMPLEX); + if (z != NO_TAG) + return z; + } + if (a68_is_coercible_series (u, M_LONG_LONG_COMPLEX, STRONG, SAFE_DEFLEXING)) + { + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, M_LONG_LONG_COMPLEX, M_LONG_LONG_COMPLEX); + if (z != NO_TAG) + return z; + } + /* (C.4) Now allow for depreffing for REF REAL +:= INT and alike. */ + v = a68_get_balanced_mode (u, STRONG, A68_DEPREF, SAFE_DEFLEXING); + z = search_table_for_operator (OPERATORS (A68_STANDENV), n, v, v); + if (z != NO_TAG) + return z; + return NO_TAG; +} + +/* Mode check monadic operator. */ + +static void +mode_check_monadic_operator (NODE_T *p, SOID_T *x, SOID_T *y) +{ + if (p != NO_NODE) + { + TAG_T *t; + MOID_T *u = a68_determine_unique_mode (y, SAFE_DEFLEXING); + if (a68_is_mode_isnt_well (u)) + a68_make_soid (y, SORT (x), M_ERROR, 0); + else if (u == M_HIP) + { + a68_error (NEXT (p), "M construct is an invalid operand", u); + a68_make_soid (y, SORT (x), M_ERROR, 0); + } + else + { + if (strchr (NOMADS, *(NSYMBOL (p))) != NO_TEXT) + { + t = NO_TAG; + a68_error (p, "monadic S cannot start with a character from Z", NOMADS); + a68_make_soid (y, SORT (x), M_ERROR, 0); + } + else + { + t = find_operator (TABLE (p), NSYMBOL (p), u, NO_MOID); + if (t == NO_TAG) + { + a68_error (p, "monadic operator S O has not been declared", u); + a68_make_soid (y, SORT (x), M_ERROR, 0); + } + } + if (t != NO_TAG) + MOID (p) = MOID (t); + TAX (p) = t; + if (t != NO_TAG && t != A68_PARSER (error_tag)) + { + MOID (p) = MOID (t); + a68_make_soid (y, SORT (x), SUB_MOID (t), 0); + } + else + { + MOID (p) = M_ERROR; + a68_make_soid (y, SORT (x), M_ERROR, 0); + } + } + } +} + +/* Mode check monadic formula. */ + +static void +mode_check_monadic_formula (NODE_T *p, SOID_T *x, SOID_T *y) +{ + SOID_T e; + a68_make_soid (&e, FIRM, NO_MOID, 0); + mode_check_formula (NEXT (p), &e, y); + mode_check_monadic_operator (p, &e, y); + a68_make_soid (y, SORT (x), MOID (y), 0); +} + +/* Mode check formula. */ + +static void +mode_check_formula (NODE_T *p, SOID_T *x, SOID_T *y) +{ + SOID_T ls; + if (IS (p, MONADIC_FORMULA)) + mode_check_monadic_formula (SUB (p), x, &ls); + else if (IS (p, FORMULA)) + mode_check_formula (SUB (p), x, &ls); + else if (IS (p, SECONDARY)) + { + SOID_T e; + a68_make_soid (&e, FIRM, NO_MOID, 0); + mode_check_unit (SUB (p), &e, &ls); + } + MOID_T *u = a68_determine_unique_mode (&ls, SAFE_DEFLEXING); + MOID (p) = u; + SOID_T rs; + if (NEXT (p) == NO_NODE) + a68_make_soid (y, SORT (x), u, 0); + else + { + NODE_T *q = NEXT_NEXT (p); + if (IS (q, MONADIC_FORMULA)) + mode_check_monadic_formula (SUB (NEXT_NEXT (p)), x, &rs); + else if (IS (q, FORMULA)) + mode_check_formula (SUB (NEXT_NEXT (p)), x, &rs); + else if (IS (q, SECONDARY)) + { + SOID_T e; + a68_make_soid (&e, FIRM, NO_MOID, 0); + mode_check_unit (SUB (q), &e, &rs); + } + MOID_T *v = a68_determine_unique_mode (&rs, SAFE_DEFLEXING); + MOID (q) = v; + if (a68_is_mode_isnt_well (u) || a68_is_mode_isnt_well (v)) + a68_make_soid (y, SORT (x), M_ERROR, 0); + else if (u == M_HIP) + { + a68_error (p, "M construct is an invalid operand", u); + a68_make_soid (y, SORT (x), M_ERROR, 0); + } + else if (v == M_HIP) + { + a68_error (q, "M construct is an invalid operand", u); + a68_make_soid (y, SORT (x), M_ERROR, 0); + } + else + { + TAG_T *op = find_operator (TABLE (NEXT (p)), NSYMBOL (NEXT (p)), u, v); + if (op == NO_TAG) + { + a68_error (NEXT (p), "dyadic operator O S O has not been declared", u, v); + a68_make_soid (y, SORT (x), M_ERROR, 0); + } + if (op != NO_TAG) + MOID (NEXT (p)) = MOID (op); + TAX (NEXT (p)) = op; + if (op != NO_TAG && op != A68_PARSER (error_tag)) + a68_make_soid (y, SORT (x), SUB_MOID (op), 0); + else + a68_make_soid (y, SORT (x), M_ERROR, 0); + } + } +} + +/* Mode check assignation. */ + +static void +mode_check_assignation (NODE_T *p, SOID_T *x, SOID_T *y) +{ + /* Get destination mode. */ + SOID_T name, tmp, value; + a68_make_soid (&name, SOFT, NO_MOID, 0); + mode_check_unit (SUB (p), &name, &tmp); + /* SOFT coercion. */ + MOID_T *ori = a68_determine_unique_mode (&tmp, SAFE_DEFLEXING); + MOID_T *name_moid = a68_deproc_completely (ori); + if (ATTRIBUTE (name_moid) != REF_SYMBOL) + { + if (A68_IF_MODE_IS_WELL (name_moid)) + a68_error (p, "M A does not yield a name", ori, ATTRIBUTE (SUB (p))); + a68_make_soid (y, SORT (x), M_ERROR, 0); + return; + } + MOID (p) = name_moid; + /* Get source mode. */ + a68_make_soid (&name, STRONG, SUB (name_moid), 0); + mode_check_unit (NEXT_NEXT (p), &name, &value); + if (!a68_is_coercible_in_context (&value, &name, FORCE_DEFLEXING)) + { + a68_cannot_coerce (p, MOID (&value), MOID (&name), STRONG, FORCE_DEFLEXING, UNIT); + a68_make_soid (y, SORT (x), M_ERROR, 0); + } + else + a68_make_soid (y, SORT (x), name_moid, 0); +} + +/* Mode check identity relation. */ + +static void +mode_check_identity_relation (NODE_T *p, SOID_T *x, SOID_T *y) +{ + NODE_T *ln = p, *rn = NEXT_NEXT (p); + SOID_T e, l, r; + a68_make_soid (&e, SOFT, NO_MOID, 0); + mode_check_unit (SUB (ln), &e, &l); + mode_check_unit (SUB (rn), &e, &r); + /* SOFT coercion. */ + MOID_T *oril = a68_determine_unique_mode (&l, SAFE_DEFLEXING); + MOID_T *orir = a68_determine_unique_mode (&r, SAFE_DEFLEXING); + MOID_T *lhs = a68_deproc_completely (oril); + MOID_T *rhs = a68_deproc_completely (orir); + if (A68_IF_MODE_IS_WELL (lhs) && lhs != M_HIP && ATTRIBUTE (lhs) != REF_SYMBOL) + { + a68_error (ln, "M A does not yield a name", oril, ATTRIBUTE (SUB (ln))); + lhs = M_ERROR; + } + if (A68_IF_MODE_IS_WELL (rhs) && rhs != M_HIP && ATTRIBUTE (rhs) != REF_SYMBOL) + { + a68_error (rn, "M A does not yield a name", orir, ATTRIBUTE (SUB (rn))); + rhs = M_ERROR; + } + if (lhs == M_HIP && rhs == M_HIP) + a68_error (p, "construct has no unique mode"); + + if (a68_is_coercible (lhs, rhs, STRONG, SAFE_DEFLEXING)) + lhs = rhs; + else if (a68_is_coercible (rhs, lhs, STRONG, SAFE_DEFLEXING)) + rhs = lhs; + else + { + a68_cannot_coerce (NEXT (p), rhs, lhs, SOFT, SKIP_DEFLEXING, TERTIARY); + lhs = rhs = M_ERROR; + } + MOID (ln) = lhs; + MOID (rn) = rhs; + a68_make_soid (y, SORT (x), M_BOOL, 0); +} + +/* Mode check bool functions ANDF and ORF. */ + +static void +mode_check_bool_function (NODE_T *p, SOID_T *x, SOID_T *y) +{ + SOID_T e, l, r; + NODE_T *ln = p, *rn = NEXT_NEXT (p); + a68_make_soid (&e, STRONG, M_BOOL, 0); + mode_check_unit (SUB (ln), &e, &l); + if (!a68_is_coercible_in_context (&l, &e, SAFE_DEFLEXING)) + a68_cannot_coerce (ln, MOID (&l), MOID (&e), MEEK, SAFE_DEFLEXING, TERTIARY); + mode_check_unit (SUB (rn), &e, &r); + if (!a68_is_coercible_in_context (&r, &e, SAFE_DEFLEXING)) + a68_cannot_coerce (rn, MOID (&r), MOID (&e), MEEK, SAFE_DEFLEXING, TERTIARY); + MOID (ln) = M_BOOL; + MOID (rn) = M_BOOL; + a68_make_soid (y, SORT (x), M_BOOL, 0); +} + +/* Mode check cast. */ + +static void +mode_check_cast (NODE_T *p, SOID_T *x, SOID_T *y) +{ + SOID_T w; + mode_check_declarer (p); + a68_make_soid (&w, STRONG, MOID (p), 0); + CAST (&w) = true; + mode_check_enclosed (SUB_NEXT (p), &w, y); + if (!a68_is_coercible_in_context (y, &w, SAFE_DEFLEXING)) + a68_cannot_coerce (NEXT (p), MOID (y), MOID (&w), STRONG, SAFE_DEFLEXING, ENCLOSED_CLAUSE); + a68_make_soid (y, SORT (x), MOID (p), 0); +} + +/* Mode check assertion. */ + +static void +mode_check_assertion (NODE_T *p) +{ + SOID_T w, y; + a68_make_soid (&w, STRONG, M_BOOL, 0); + mode_check_enclosed (SUB_NEXT (p), &w, &y); + SORT (&y) = SORT (&w); + if (!a68_is_coercible_in_context (&y, &w, NO_DEFLEXING)) + a68_cannot_coerce (NEXT (p), MOID (&y), MOID (&w), MEEK, NO_DEFLEXING, ENCLOSED_CLAUSE); +} + +/* Mode check argument list. */ + +static void +mode_check_argument_list (SOID_T **r, NODE_T *p, PACK_T **x, PACK_T **v, PACK_T **w) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, GENERIC_ARGUMENT_LIST)) + ATTRIBUTE (p) = ARGUMENT_LIST; + + if (IS (p, ARGUMENT_LIST)) + mode_check_argument_list (r, SUB (p), x, v, w); + else if (IS (p, UNIT)) + { + SOID_T y, z; + if (*x != NO_PACK) + { + a68_make_soid (&z, STRONG, MOID (*x), 0); + a68_add_mode_to_pack_end (v, MOID (*x), NO_TEXT, p); + FORWARD (*x); + } + else + a68_make_soid (&z, STRONG, NO_MOID, 0); + mode_check_unit (p, &z, &y); + a68_add_to_soid_list (r, p, &y); + } + else if (IS (p, TRIMMER)) + { + SOID_T z; + if (SUB (p) != NO_NODE) + { + a68_error (p, "syntax error detected in A", ARGUMENT); + a68_make_soid (&z, STRONG, M_ERROR, 0); + a68_add_mode_to_pack_end (v, M_VOID, NO_TEXT, p); + a68_add_mode_to_pack_end (w, MOID (*x), NO_TEXT, p); + FORWARD (*x); + } + else if (*x != NO_PACK) + { + a68_make_soid (&z, STRONG, MOID (*x), 0); + a68_add_mode_to_pack_end (v, M_VOID, NO_TEXT, p); + a68_add_mode_to_pack_end (w, MOID (*x), NO_TEXT, p); + FORWARD (*x); + } + else + a68_make_soid (&z, STRONG, NO_MOID, 0); + a68_add_to_soid_list (r, p, &z); + } + else if (IS (p, SUB_SYMBOL) && !OPTION_BRACKETS (&A68_JOB)) + a68_error (p, "syntax error detected in A", CALL); + } +} + +/* Mode check argument list 2. */ + +static void +mode_check_argument_list_2 (NODE_T *p, PACK_T *x, SOID_T *y, PACK_T **v, PACK_T **w) +{ + SOID_T *top_sl = NO_SOID; + mode_check_argument_list (&top_sl, SUB (p), &x, v, w); + a68_make_soid (y, STRONG, a68_pack_soids_in_moid (top_sl, STOWED_MODE), 0); + a68_free_soid_list (top_sl); +} + +/* Mode check meek int. */ + +static void +mode_check_meek_int (NODE_T *p) +{ + SOID_T x, y; + a68_make_soid (&x, MEEK, M_INT, 0); + mode_check_unit (p, &x, &y); + if (!a68_is_coercible_in_context (&y, &x, SAFE_DEFLEXING)) + a68_cannot_coerce (p, MOID (&y), MOID (&x), MEEK, SAFE_DEFLEXING, 0); +} + +/* Mode check trimmer. */ + +static void +mode_check_trimmer (NODE_T *p) +{ + if (p == NO_NODE) + return; + else if (IS (p, TRIMMER)) + mode_check_trimmer (SUB (p)); + else if (IS (p, UNIT)) + { + mode_check_meek_int (p); + mode_check_trimmer (NEXT (p)); + } + else + mode_check_trimmer (NEXT (p)); +} + +/* Mode check indexer. */ + +static void +mode_check_indexer (NODE_T *p, int *subs, int *trims) +{ + if (p == NO_NODE) + return; + else if (IS (p, TRIMMER)) + { + (*trims)++; + mode_check_trimmer (SUB (p)); + } + else if (IS (p, UNIT)) + { + (*subs)++; + mode_check_meek_int (p); + } + else + { + mode_check_indexer (SUB (p), subs, trims); + mode_check_indexer (NEXT (p), subs, trims); + } +} + +/* Mode check call. */ + +static void +mode_check_call (NODE_T *p, MOID_T *n, SOID_T *x, SOID_T *y) +{ + MOID (p) = n; + /* "partial_locale" is the mode of the locale. */ + PARTIAL_LOCALE (GINFO (p)) = a68_new_moid (); + ATTRIBUTE (PARTIAL_LOCALE (GINFO (p))) = PROC_SYMBOL; + PACK (PARTIAL_LOCALE (GINFO (p))) = NO_PACK; + SUB (PARTIAL_LOCALE (GINFO (p))) = SUB (n); + /* "partial_proc" is the mode of the resulting proc. */ + PARTIAL_PROC (GINFO (p)) = a68_new_moid (); + ATTRIBUTE (PARTIAL_PROC (GINFO (p))) = PROC_SYMBOL; + PACK (PARTIAL_PROC (GINFO (p))) = NO_PACK; + SUB (PARTIAL_PROC (GINFO (p))) = SUB (n); + /* Check arguments and construct modes. */ + SOID_T d; + mode_check_argument_list_2 (NEXT (p), PACK (n), &d, &PACK (PARTIAL_LOCALE (GINFO (p))), + &PACK (PARTIAL_PROC (GINFO (p)))); + DIM (PARTIAL_PROC (GINFO (p))) = a68_count_pack_members (PACK (PARTIAL_PROC (GINFO (p)))); + DIM (PARTIAL_LOCALE (GINFO (p))) = a68_count_pack_members (PACK (PARTIAL_LOCALE (GINFO (p)))); + PARTIAL_PROC (GINFO (p)) = a68_register_extra_mode (&TOP_MOID (&A68_JOB), PARTIAL_PROC (GINFO (p))); + PARTIAL_LOCALE (GINFO (p)) = a68_register_extra_mode (&TOP_MOID (&A68_JOB), PARTIAL_LOCALE (GINFO (p))); + if (DIM (MOID (&d)) != DIM (n)) + { + a68_error (p, "incorrect number of arguments for M", n); + a68_make_soid (y, SORT (x), SUB (n), 0); + /* a68_make_soid (y, SORT (x), M_ERROR, 0);. */ + } + else + { + if (!a68_is_coercible (MOID (&d), n, STRONG, ALIAS_DEFLEXING)) + a68_cannot_coerce (p, MOID (&d), n, STRONG, ALIAS_DEFLEXING, ARGUMENT); + if (DIM (PARTIAL_PROC (GINFO (p))) == 0) + a68_make_soid (y, SORT (x), SUB (n), 0); + else + { + a68_warning (NEXT (p), OPT_Wextensions, "@ is an extension"); + a68_make_soid (y, SORT (x), PARTIAL_PROC (GINFO (p)), 0); + } + } +} + +/* Mode check slice. */ + +static void +mode_check_slice (NODE_T *p, MOID_T *ori, SOID_T *x, SOID_T *y) +{ + MOID_T *m = a68_depref_completely (ori), *n = ori; + /* WEAK coercion. */ + while ((IS_REF (n) && !a68_is_ref_row (n)) || (IS (n, PROC_SYMBOL) && PACK (n) == NO_PACK)) + n = a68_depref_once (n); + + if (n == NO_MOID || !(SLICE (DEFLEX (n)) != NO_MOID || a68_is_ref_row (n))) + { + if (A68_IF_MODE_IS_WELL (n)) + a68_error (p, "M A does not yield a row or procedure", + n, ATTRIBUTE (SUB (p))); + a68_make_soid (y, SORT (x), M_ERROR, 0); + } + + MOID (p) = n; + int dim = 0, subs = 0, trims = 0; + mode_check_indexer (SUB_NEXT (p), &subs, &trims); + bool is_ref; + if ((is_ref = a68_is_ref_row (n)) != 0) + dim = DIM (DEFLEX (SUB (n))); + else + dim = DIM (DEFLEX (n)); + + if ((subs + trims) != dim) + { + a68_error (p, "incorrect number of indexers for M", n); + a68_make_soid (y, SORT (x), M_ERROR, 0); + } + else + { + if (subs > 0 && trims == 0) + { + ANNOTATION (NEXT (p)) = SLICE; + m = n; + } + else + { + ANNOTATION (NEXT (p)) = TRIMMER; + m = n; + } + while (subs > 0) + { + if (is_ref) + m = NAME (m); + else + { + if (IS_FLEX (m)) + m = SUB (m); + m = SLICE (m); + } + gcc_assert (m != NO_MOID); + subs--; + } + /* A trim cannot be but deflexed. */ + if (ANNOTATION (NEXT (p)) == TRIMMER && TRIM (m) != NO_MOID) + { + gcc_assert (TRIM (m) != NO_MOID); + a68_make_soid (y, SORT (x), TRIM (m), 0); + } + else + a68_make_soid (y, SORT (x), m, 0); + } +} + +/* Mode check specification. */ + +static enum a68_attribute +mode_check_specification (NODE_T *p, SOID_T *x, SOID_T *y) +{ + SOID_T w, d; + a68_make_soid (&w, WEAK, NO_MOID, 0); + mode_check_unit (SUB (p), &w, &d); + MOID_T *ori = a68_determine_unique_mode (&d, SAFE_DEFLEXING); + MOID_T *m = a68_depref_completely (ori); + if (IS (m, PROC_SYMBOL)) + { + /* Assume CALL. */ + mode_check_call (p, m, x, y); + return CALL; + } + else if (IS_ROW (m) || IS_FLEX (m)) + { + /* Assume SLICE. */ + mode_check_slice (p, ori, x, y); + return SLICE; + } + else + { + if (m != M_ERROR) + a68_error (p, "M construct must yield a routine or a row value", m); + a68_make_soid (y, SORT (x), M_ERROR, 0); + return PRIMARY; + } +} + +/* Mode check selection. */ + +static void +mode_check_selection (NODE_T *p, SOID_T *x, SOID_T *y) +{ + bool deflex = false; + NODE_T *secondary = SUB_NEXT (p); + SOID_T w, d; + a68_make_soid (&w, WEAK, NO_MOID, 0); + mode_check_unit (secondary, &w, &d); + MOID_T *n, *ori; + n = ori = a68_determine_unique_mode (&d, SAFE_DEFLEXING); + PACK_T *t = NO_PACK, *t_2 = NO_PACK; + bool coerce = true; + while (coerce) + { + if (IS (n, STRUCT_SYMBOL)) + { + coerce = false; + t = PACK (n); + } + else if (IS_REF (n) && (IS_ROW (SUB (n)) || IS_FLEX (SUB (n))) && MULTIPLE (n) != NO_MOID) + { + coerce = false; + deflex = true; + t = PACK (MULTIPLE (n)); + } + else if ((IS_ROW (n) || IS_FLEX (n)) && MULTIPLE (n) != NO_MOID) + { + coerce = false; + deflex = true; + t = PACK (MULTIPLE (n)); + } + else if (IS_REF (n) && a68_is_name_struct (n)) + { + coerce = false; + t = PACK (NAME (n)); + } + else if (a68_is_deprefable (n)) + { + coerce = true; + n = SUB (n); + t = NO_PACK; + } + else + { + coerce = false; + t = NO_PACK; + } + } + if (t == NO_PACK) + { + if (A68_IF_MODE_IS_WELL (MOID (&d))) + a68_error (secondary, "M A does not yield a structured value", ori, ATTRIBUTE (secondary)); + a68_make_soid (y, SORT (x), M_ERROR, 0); + return; + } + + MOID (NEXT (p)) = n; + const char *fs = NSYMBOL (SUB (p)); + MOID_T *str = n; + while (IS_REF (str)) + str = SUB (str); + if (IS_FLEX (str)) + str = SUB (str); + if (IS_ROW (str)) + str = SUB (str); + t_2 = PACK (str); + while (t != NO_PACK && t_2 != NO_PACK) + { + if (TEXT (t) == fs || strcmp (TEXT (t), fs) == 0) + { + MOID_T *ret = MOID (t); + if (deflex && TRIM (ret) != NO_MOID) + ret = TRIM (ret); + a68_make_soid (y, SORT (x), ret, 0); + MOID (p) = ret; + NODE_PACK (SUB (p)) = t_2; + return; + } + FORWARD (t); + FORWARD (t_2); + } + a68_make_soid (&d, NO_SORT, n, 0); + a68_error (p, "M has no field Z", str, fs); + a68_make_soid (y, SORT (x), M_ERROR, 0); +} + +/* Mode check format text. */ + +static void +mode_check_format_text (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + mode_check_format_text (SUB (p)); + if (IS (p, FORMAT_PATTERN)) + { + SOID_T x, y; + a68_make_soid (&x, STRONG, M_FORMAT, 0); + mode_check_enclosed (SUB (NEXT_SUB (p)), &x, &y); + if (!a68_is_coercible_in_context (&y, &x, SAFE_DEFLEXING)) + a68_cannot_coerce (p, MOID (&y), MOID (&x), STRONG, SAFE_DEFLEXING, ENCLOSED_CLAUSE); + } + else if (IS (p, GENERAL_PATTERN) && NEXT_SUB (p) != NO_NODE) + { + SOID_T x, y; + a68_make_soid (&x, STRONG, M_ROW_INT, 0); + mode_check_enclosed (SUB (NEXT_SUB (p)), &x, &y); + if (!a68_is_coercible_in_context (&y, &x, SAFE_DEFLEXING)) + a68_cannot_coerce (p, MOID (&y), MOID (&x), STRONG, SAFE_DEFLEXING, ENCLOSED_CLAUSE); + } + else if (IS (p, DYNAMIC_REPLICATOR)) + { + SOID_T x, y; + a68_make_soid (&x, STRONG, M_INT, 0); + mode_check_enclosed (SUB (NEXT_SUB (p)), &x, &y); + if (!a68_is_coercible_in_context (&y, &x, SAFE_DEFLEXING)) + a68_cannot_coerce (p, MOID (&y), MOID (&x), STRONG, SAFE_DEFLEXING, ENCLOSED_CLAUSE); + } + } +} + +/* Mode check unit. */ + +static void +mode_check_unit (NODE_T *p, SOID_T *x, SOID_T *y) +{ + if (p == NO_NODE) + return; + else if (a68_is_one_of (p, UNIT, TERTIARY, SECONDARY, PRIMARY, STOP)) + mode_check_unit (SUB (p), x, y); + /* Ex primary. */ + else if (IS (p, SPECIFICATION)) + { + ATTRIBUTE (p) = mode_check_specification (SUB (p), x, y); + a68_warn_for_voiding (p, x, y, ATTRIBUTE (p)); + } + else if (IS (p, CAST)) + { + mode_check_cast (SUB (p), x, y); + a68_warn_for_voiding (p, x, y, CAST); + } + else if (IS (p, DENOTATION)) + { + a68_make_soid (y, SORT (x), MOID (SUB (p)), 0); + a68_warn_for_voiding (p, x, y, DENOTATION); + } + else if (IS (p, IDENTIFIER)) + { + if ((TAX (p) == NO_TAG) && (MOID (p) == NO_MOID)) + { + int att = a68_first_tag_global (TABLE (p), NSYMBOL (p)); + if (att == STOP) + { + (void) a68_add_tag (TABLE (p), IDENTIFIER, p, M_ERROR, NORMAL_IDENTIFIER); + a68_error (p, "tag S has not been declared properly"); + MOID (p) = M_ERROR; + } + else + { + TAG_T *z = a68_find_tag_global (TABLE (p), att, NSYMBOL (p)); + if (att == IDENTIFIER && z != NO_TAG) + MOID (p) = MOID (z); + else + { + (void) a68_add_tag (TABLE (p), IDENTIFIER, p, M_ERROR, NORMAL_IDENTIFIER); + a68_error (p, "tag S has not been declared properly"); + MOID (p) = M_ERROR; + } + } + } + a68_make_soid (y, SORT (x), MOID (p), 0); + a68_warn_for_voiding (p, x, y, IDENTIFIER); + } + else if (IS (p, ENCLOSED_CLAUSE)) + mode_check_enclosed (SUB (p), x, y); + else if (IS (p, FORMAT_TEXT)) + { + mode_check_format_text (p); + a68_make_soid (y, SORT (x), M_FORMAT, 0); + a68_warn_for_voiding (p, x, y, FORMAT_TEXT); + /* Ex secondary. */ + } + else if (IS (p, GENERATOR)) + { + mode_check_declarer (SUB (p)); + a68_make_soid (y, SORT (x), MOID (SUB (p)), 0); + a68_warn_for_voiding (p, x, y, GENERATOR); + } + else if (IS (p, SELECTION)) + { + mode_check_selection (SUB (p), x, y); + a68_warn_for_voiding (p, x, y, SELECTION); + /* Ex tertiary. */ + } + else if (IS (p, NIHIL)) + a68_make_soid (y, STRONG, M_HIP, 0); + else if (IS (p, FORMULA)) + { + mode_check_formula (p, x, y); + if (!IS_REF (MOID (y))) + a68_warn_for_voiding (p, x, y, FORMULA); + } + else if (a68_is_one_of (p, JUMP, SKIP, STOP)) + { + if (SORT (x) != STRONG) + a68_warning (p, 0, "@ should not be in C context", SORT (x)); + /* a68_make_soid (y, STRONG, M_HIP, 0); */ + a68_make_soid (y, SORT (x), M_HIP, 0); + } + else if (IS (p, ASSIGNATION)) + mode_check_assignation (SUB (p), x, y); + else if (IS (p, IDENTITY_RELATION)) + { + mode_check_identity_relation (SUB (p), x, y); + a68_warn_for_voiding (p, x, y, IDENTITY_RELATION); + } + else if (IS (p, ROUTINE_TEXT)) + { + mode_check_routine_text (SUB (p), y); + a68_make_soid (y, SORT (x), MOID (p), 0); + a68_warn_for_voiding (p, x, y, ROUTINE_TEXT); + } + else if (IS (p, ASSERTION)) + { + mode_check_assertion (SUB (p)); + a68_make_soid (y, STRONG, M_VOID, 0); + } + else if (IS (p, AND_FUNCTION)) + { + mode_check_bool_function (SUB (p), x, y); + a68_warn_for_voiding (p, x, y, AND_FUNCTION); + } + else if (IS (p, OR_FUNCTION)) + { + mode_check_bool_function (SUB (p), x, y); + a68_warn_for_voiding (p, x, y, OR_FUNCTION); + } + + MOID (p) = MOID (y); +} + +/* Mode check a module text. */ + +static void +mode_check_module_text (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, DEF_PART) || IS (p, POSTLUDE_PART)) + { + /* XXX unde def is an enquiry clause */ + SOID_T *z = NO_SOID; + SOID_T ix; + a68_make_soid (&ix, STRONG, M_VOID, 0); + mode_check_serial (&z, NEXT_SUB (p), &ix, true); + a68_free_soid_list (z); + } + } +} + +/* Mode check a module declaration. */ + +static void +mode_check_module_declaration (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, MODULE_TEXT)) + mode_check_module_text (SUB (p)); + else + mode_check_module_declaration (SUB (p)); + } +} diff --git a/gcc/algol68/a68-parser-moids-coerce.cc b/gcc/algol68/a68-parser-moids-coerce.cc new file mode 100644 index 000000000000..3e127c909f14 --- /dev/null +++ b/gcc/algol68/a68-parser-moids-coerce.cc @@ -0,0 +1,925 @@ +/* Mode coercion driver. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "options.h" + +#include "a68.h" + +#define A68_INSERT_COERCIONS(n, p, q) a68_make_strong ((n), (p), MOID (q)) + +/* A few forward references of functions defined below. */ + +static void coerce_unit (NODE_T *p, SOID_T *q); +static void coerce_formula (NODE_T *p, SOID_T *q __attribute__ ((unused))); +static void coerce_operand (NODE_T *p, SOID_T *q); +static void coerce_enclosed (NODE_T *p, SOID_T *q); + +/* Coerce bounds. */ + +static void +coerce_bounds (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, UNIT)) + { + SOID_T q; + a68_make_soid (&q, MEEK, M_INT, 0); + coerce_unit (p, &q); + } + else + coerce_bounds (SUB (p)); + } +} + +/* Coerce declarer. */ + +static void +coerce_declarer (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, BOUNDS)) + coerce_bounds (SUB (p)); + else + coerce_declarer (SUB (p)); + } +} + +/* Coerce identity declaration. */ + +static void +coerce_identity_declaration (NODE_T *p) +{ + if (p != NO_NODE) + { + switch (ATTRIBUTE (p)) + { + case DECLARER: + coerce_declarer (SUB (p)); + coerce_identity_declaration (NEXT (p)); + break; + case DEFINING_IDENTIFIER: + { + SOID_T q; + a68_make_soid (&q, STRONG, MOID (p), 0); + coerce_unit (NEXT_NEXT (p), &q); + break; + } + default: + coerce_identity_declaration (SUB (p)); + coerce_identity_declaration (NEXT (p)); + break; + } + } +} + +/* Coerce variable declaration. */ + +static void +coerce_variable_declaration (NODE_T *p) +{ + if (p != NO_NODE) + { + switch (ATTRIBUTE (p)) + { + case DECLARER: + coerce_declarer (SUB (p)); + coerce_variable_declaration (NEXT (p)); + break; + case DEFINING_IDENTIFIER: + if (a68_whether (p, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP)) + { + SOID_T q; + a68_make_soid (&q, STRONG, SUB_MOID (p), 0); + coerce_unit (NEXT_NEXT (p), &q); + break; + } + /* Fallthrough. */ + default: + coerce_variable_declaration (SUB (p)); + coerce_variable_declaration (NEXT (p)); + break; + } + } +} + +/* Coerce routine text. */ + +static void +coerce_routine_text (NODE_T *p) +{ + if (IS (p, PARAMETER_PACK)) + FORWARD (p); + SOID_T w; + a68_make_soid (&w, STRONG, MOID (p), 0); + coerce_unit (NEXT_NEXT (p), &w); +} + +/* Coerce proc declaration. */ + +static void +coerce_proc_declaration (NODE_T *p) +{ + if (p == NO_NODE) + return; + else if (IS (p, ROUTINE_TEXT)) + coerce_routine_text (SUB (p)); + else + { + coerce_proc_declaration (SUB (p)); + coerce_proc_declaration (NEXT (p)); + } +} + +/* Coerce_op_declaration. */ + +static void +coerce_op_declaration (NODE_T *p) +{ + if (p == NO_NODE) + return; + else if (IS (p, DEFINING_OPERATOR)) + { + SOID_T q; + a68_make_soid (&q, STRONG, MOID (p), 0); + coerce_unit (NEXT_NEXT (p), &q); + } + else + { + coerce_op_declaration (SUB (p)); + coerce_op_declaration (NEXT (p)); + } +} + +/* Coerce brief op declaration. */ + +static void +coerce_brief_op_declaration (NODE_T *p) +{ + if (p == NO_NODE) + return; + else if (IS (p, DEFINING_OPERATOR)) + coerce_routine_text (SUB (NEXT_NEXT (p))); + else + { + coerce_brief_op_declaration (SUB (p)); + coerce_brief_op_declaration (NEXT (p)); + } +} + +/* Coerce declaration list. */ + +static void +coerce_declaration_list (NODE_T *p) +{ + if (p != NO_NODE) + { + switch (ATTRIBUTE (p)) + { + case IDENTITY_DECLARATION: + coerce_identity_declaration (SUB (p)); + break; + case VARIABLE_DECLARATION: + coerce_variable_declaration (SUB (p)); + break; + case MODE_DECLARATION: + coerce_declarer (SUB (p)); + break; + case PROCEDURE_DECLARATION: + case PROCEDURE_VARIABLE_DECLARATION: + coerce_proc_declaration (SUB (p)); + break; + case BRIEF_OPERATOR_DECLARATION: + coerce_brief_op_declaration (SUB (p)); + break; + case OPERATOR_DECLARATION: + coerce_op_declaration (SUB (p)); + break; + default: + coerce_declaration_list (SUB (p)); + coerce_declaration_list (NEXT (p)); + break; + } + } +} + +/* Coerce serial. */ + +static void +coerce_serial (NODE_T *p, SOID_T *q, bool k) +{ + if (p == NO_NODE) + return; + else if (IS (p, INITIALISER_SERIES)) + { + coerce_serial (SUB (p), q, false); + coerce_serial (NEXT (p), q, k); + } + else if (IS (p, DECLARATION_LIST)) + coerce_declaration_list (SUB (p)); + else if (a68_is_one_of (p, LABEL, SEMI_SYMBOL, EXIT_SYMBOL, STOP)) + coerce_serial (NEXT (p), q, k); + else if (a68_is_one_of (p, SERIAL_CLAUSE, ENQUIRY_CLAUSE, STOP)) + { + NODE_T *z = NEXT (p); + if (z != NO_NODE) + { + if (IS (z, EXIT_SYMBOL) || IS (z, END_SYMBOL) || IS (z, CLOSE_SYMBOL)) + coerce_serial (SUB (p), q, true); + else + coerce_serial (SUB (p), q, false); + } + else + coerce_serial (SUB (p), q, true); + coerce_serial (NEXT (p), q, k); + } + else if (IS (p, LABELED_UNIT)) + coerce_serial (SUB (p), q, k); + else if (IS (p, UNIT)) + { + if (k) + coerce_unit (p, q); + else + { + SOID_T strongvoid; + a68_make_soid (&strongvoid, STRONG, M_VOID, 0); + coerce_unit (p, &strongvoid); + } + } +} + +/* Coerce closed. */ + +static void +coerce_closed (NODE_T *p, SOID_T *q) +{ + if (IS (p, SERIAL_CLAUSE)) + coerce_serial (p, q, true); + else if (a68_is_one_of (p, OPEN_SYMBOL, BEGIN_SYMBOL, STOP)) + coerce_closed (NEXT (p), q); +} + +/* Coerce access clause. */ + +static void +coerce_access (NODE_T *p, SOID_T *q) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, ENCLOSED_CLAUSE)) + coerce_enclosed (p, q); + } +} + +/* Coerce conditional. */ + +static void +coerce_conditional (NODE_T *p, SOID_T *q) +{ + SOID_T w; + a68_make_soid (&w, MEEK, M_BOOL, 0); + coerce_serial (NEXT_SUB (p), &w, true); + FORWARD (p); + coerce_serial (NEXT_SUB (p), q, true); + if ((FORWARD (p)) != NO_NODE) + { + if (a68_is_one_of (p, ELSE_PART, CHOICE, STOP)) + coerce_serial (NEXT_SUB (p), q, true); + else if (a68_is_one_of (p, ELIF_PART, BRIEF_ELIF_PART, STOP)) + coerce_conditional (SUB (p), q); + } +} + +/* Coerce unit list. */ + +static void +coerce_unit_list (NODE_T *p, SOID_T *q) +{ + if (p == NO_NODE) + return; + else if (IS (p, UNIT_LIST)) + { + coerce_unit_list (SUB (p), q); + coerce_unit_list (NEXT (p), q); + } + else if (a68_is_one_of (p, OPEN_SYMBOL, BEGIN_SYMBOL, COMMA_SYMBOL, STOP)) + coerce_unit_list (NEXT (p), q); + else if (IS (p, UNIT)) + { + coerce_unit (p, q); + coerce_unit_list (NEXT (p), q); + } +} + +/* Coerce int case. */ + +static void +coerce_int_case (NODE_T *p, SOID_T *q) +{ + SOID_T w; + a68_make_soid (&w, MEEK, M_INT, 0); + coerce_serial (NEXT_SUB (p), &w, true); + FORWARD (p); + coerce_unit_list (NEXT_SUB (p), q); + if ((FORWARD (p)) != NO_NODE) + { + if (a68_is_one_of (p, OUT_PART, CHOICE, STOP)) + coerce_serial (NEXT_SUB (p), q, true); + else if (a68_is_one_of (p, CASE_OUSE_PART, BRIEF_OUSE_PART, STOP)) + coerce_int_case (SUB (p), q); + } +} + +/* Coerce spec unit list. */ + +static void +coerce_spec_unit_list (NODE_T *p, SOID_T *q) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (a68_is_one_of (p, SPECIFIED_UNIT_LIST, SPECIFIED_UNIT, STOP)) + coerce_spec_unit_list (SUB (p), q); + else if (IS (p, UNIT)) + coerce_unit (p, q); + } +} + +/* Coerce united case. */ + +static void +coerce_united_case (NODE_T *p, SOID_T *q) +{ + SOID_T w; + a68_make_soid (&w, MEEK, MOID (SUB (p)), 0); + coerce_serial (NEXT_SUB (p), &w, true); + FORWARD (p); + coerce_spec_unit_list (NEXT_SUB (p), q); + if ((FORWARD (p)) != NO_NODE) + { + if (a68_is_one_of (p, OUT_PART, CHOICE, STOP)) + coerce_serial (NEXT_SUB (p), q, true); + else if (a68_is_one_of (p, CONFORMITY_OUSE_PART, BRIEF_CONFORMITY_OUSE_PART, STOP)) + coerce_united_case (SUB (p), q); + } +} + +/* Coerce loop. */ + +static void +coerce_loop (NODE_T *p) +{ + if (IS (p, FOR_PART)) + coerce_loop (NEXT (p)); + else if (a68_is_one_of (p, FROM_PART, BY_PART, TO_PART, STOP)) + { + SOID_T w; + a68_make_soid (&w, MEEK, M_INT, 0); + coerce_unit (NEXT_SUB (p), &w); + coerce_loop (NEXT (p)); + } + else if (IS (p, WHILE_PART)) + { + SOID_T w; + a68_make_soid (&w, MEEK, M_BOOL, 0); + coerce_serial (NEXT_SUB (p), &w, true); + coerce_loop (NEXT (p)); + } + else if (a68_is_one_of (p, DO_PART, ALT_DO_PART, STOP)) + { + SOID_T w; + NODE_T *do_p = NEXT_SUB (p); + a68_make_soid (&w, STRONG, M_VOID, 0); + coerce_serial (do_p, &w, true); + } +} + +/* Coerce struct display. */ + +static void +coerce_struct_display (PACK_T **r, NODE_T *p) +{ + if (p == NO_NODE) + return; + else if (IS (p, UNIT_LIST)) + { + coerce_struct_display (r, SUB (p)); + coerce_struct_display (r, NEXT (p)); + } + else if (a68_is_one_of (p, OPEN_SYMBOL, BEGIN_SYMBOL, COMMA_SYMBOL, STOP)) + coerce_struct_display (r, NEXT (p)); + else if (IS (p, UNIT)) + { + SOID_T s; + a68_make_soid (&s, STRONG, MOID (*r), 0); + coerce_unit (p, &s); + FORWARD (*r); + coerce_struct_display (r, NEXT (p)); + } +} + +/* Coerce collateral. */ + +static void +coerce_collateral (NODE_T *p, SOID_T *q) +{ + if (!(a68_whether (p, BEGIN_SYMBOL, END_SYMBOL, STOP) + || a68_whether (p, OPEN_SYMBOL, CLOSE_SYMBOL, STOP))) + { + if (IS (MOID (q), STRUCT_SYMBOL)) + { + PACK_T *t = PACK (MOID (q)); + coerce_struct_display (&t, p); + } + else if (IS_FLEX (MOID (q))) + { + SOID_T w; + a68_make_soid (&w, STRONG, SLICE (SUB_MOID (q)), 0); + coerce_unit_list (p, &w); + } + else if (IS_ROW (MOID (q))) + { + SOID_T w; + a68_make_soid (&w, STRONG, SLICE (MOID (q)), 0); + coerce_unit_list (p, &w); + } + else + { + /* if (MOID (q) != M_VOID). */ + coerce_unit_list (p, q); + } + } +} + +/* Coerce_enclosed. */ + +static void +coerce_enclosed (NODE_T *p, SOID_T *q) +{ + if (IS (p, ENCLOSED_CLAUSE)) + coerce_enclosed (SUB (p), q); + else if (IS (p, CLOSED_CLAUSE)) + coerce_closed (SUB (p), q); + else if (IS (p, COLLATERAL_CLAUSE)) + coerce_collateral (SUB (p), q); + else if (IS (p, ACCESS_CLAUSE)) + coerce_access (SUB (p), q); + else if (IS (p, PARALLEL_CLAUSE)) + coerce_collateral (SUB (NEXT_SUB (p)), q); + else if (IS (p, CONDITIONAL_CLAUSE)) + coerce_conditional (SUB (p), q); + else if (IS (p, CASE_CLAUSE)) + coerce_int_case (SUB (p), q); + else if (IS (p, CONFORMITY_CLAUSE)) + coerce_united_case (SUB (p), q); + else if (IS (p, LOOP_CLAUSE)) + coerce_loop (SUB (p)); + + MOID (p) = a68_depref_rows (MOID (p), MOID (q)); +} + +/* Get monad moid. */ + +static MOID_T * +get_monad_moid (NODE_T *p) +{ + if (TAX (p) != NO_TAG && TAX (p) != A68_PARSER (error_tag)) + { + MOID (p) = MOID (TAX (p)); + return MOID (PACK (MOID (p))); + } + else + return M_ERROR; +} + +/* Coerce monad oper. */ + +static void +coerce_monad_oper (NODE_T *p, SOID_T *q) +{ + if (p != NO_NODE) + { + SOID_T z; + a68_make_soid (&z, FIRM, MOID (PACK (MOID (TAX (p)))), 0); + A68_INSERT_COERCIONS (NEXT (p), MOID (q), &z); + } +} + +/* Coerce monad formula. */ + +static void +coerce_monad_formula (NODE_T *p) +{ + SOID_T e; + a68_make_soid (&e, STRONG, get_monad_moid (p), 0); + coerce_operand (NEXT (p), &e); + coerce_monad_oper (p, &e); +} + +/* Coerce operand. */ + +static void +coerce_operand (NODE_T *p, SOID_T *q) +{ + if (IS (p, MONADIC_FORMULA)) + { + coerce_monad_formula (SUB (p)); + if (MOID (p) != MOID (q)) + { + a68_make_sub (p, p, FORMULA); + A68_INSERT_COERCIONS (p, MOID (p), q); + a68_make_sub (p, p, TERTIARY); + } + MOID (p) = a68_depref_rows (MOID (p), MOID (q)); + } + else if (IS (p, FORMULA)) + { + coerce_formula (SUB (p), q); + A68_INSERT_COERCIONS (p, MOID (p), q); + MOID (p) = a68_depref_rows (MOID (p), MOID (q)); + } + else if (IS (p, SECONDARY)) + { + coerce_unit (SUB (p), q); + MOID (p) = MOID (SUB (p)); + } +} + +/* Coerce formula. */ + +static void +coerce_formula (NODE_T *p, SOID_T *q __attribute__ ((unused))) +{ + if (IS (p, MONADIC_FORMULA) && NEXT (p) == NO_NODE) + coerce_monad_formula (SUB (p)); + else + { + if (TAX (NEXT (p)) != NO_TAG && TAX (NEXT (p)) != A68_PARSER (error_tag)) + { + SOID_T s; + NODE_T *op = NEXT (p), *nq = NEXT_NEXT (p); + MOID_T *w = MOID (op); + MOID_T *u = MOID (PACK (w)), *v = MOID (NEXT (PACK (w))); + a68_make_soid (&s, STRONG, u, 0); + coerce_operand (p, &s); + a68_make_soid (&s, STRONG, v, 0); + coerce_operand (nq, &s); + } + } +} + +/* Coerce assignation. */ + +static void +coerce_assignation (NODE_T *p) +{ + SOID_T w; + a68_make_soid (&w, SOFT, MOID (p), 0); + coerce_unit (SUB (p), &w); + a68_make_soid (&w, STRONG, SUB_MOID (p), 0); + coerce_unit (NEXT_NEXT (p), &w); +} + +/* Coerce relation. */ + +static void +coerce_relation (NODE_T *p) +{ + SOID_T w; + a68_make_soid (&w, STRONG, MOID (p), 0); + coerce_unit (SUB (p), &w); + a68_make_soid (&w, STRONG, MOID (NEXT_NEXT (p)), 0); + coerce_unit (SUB (NEXT_NEXT (p)), &w); +} + +/* Coerce bool function. */ + +static void +coerce_bool_function (NODE_T *p) +{ + SOID_T w; + a68_make_soid (&w, STRONG, M_BOOL, 0); + coerce_unit (SUB (p), &w); + coerce_unit (SUB (NEXT_NEXT (p)), &w); +} + +/* Coerce assertion. */ + +static void +coerce_assertion (NODE_T *p) +{ + SOID_T w; + a68_make_soid (&w, MEEK, M_BOOL, 0); + coerce_enclosed (SUB_NEXT (p), &w); +} + +/* Coerce selection. */ + +static void +coerce_selection (NODE_T * p) +{ + SOID_T w; + a68_make_soid (&w, STRONG, MOID (NEXT (p)), 0); + coerce_unit (SUB_NEXT (p), &w); +} + +/* Coerce cast. */ + +static void +coerce_cast (NODE_T * p) +{ + coerce_declarer (p); + SOID_T w; + a68_make_soid (&w, STRONG, MOID (p), 0); + coerce_enclosed (NEXT (p), &w); +} + +/* Coerce argument list. */ + +static void +coerce_argument_list (PACK_T **r, NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, ARGUMENT_LIST)) + coerce_argument_list (r, SUB (p)); + else if (IS (p, UNIT)) + { + SOID_T s; + a68_make_soid (&s, STRONG, MOID (*r), 0); + coerce_unit (p, &s); + FORWARD (*r); + } + else if (IS (p, TRIMMER)) + FORWARD (*r); + } +} + +/* Coerce call. */ + +static void +coerce_call (NODE_T *p) +{ + MOID_T *proc = MOID (p); + SOID_T w; + a68_make_soid (&w, MEEK, proc, 0); + coerce_unit (SUB (p), &w); + FORWARD (p); + PACK_T *t = PACK (proc); + coerce_argument_list (&t, SUB (p)); +} + +/* Coerce meek int. */ + +static void +coerce_meek_int (NODE_T *p) +{ + SOID_T x; + a68_make_soid (&x, MEEK, M_INT, 0); + coerce_unit (p, &x); +} + +/* Coerce trimmer. */ + +static void +coerce_trimmer (NODE_T *p) +{ + if (p != NO_NODE) + { + if (IS (p, UNIT)) + { + coerce_meek_int (p); + coerce_trimmer (NEXT (p)); + } + else + coerce_trimmer (NEXT (p)); + } +} + +/* Coerce indexer. */ + +static void +coerce_indexer (NODE_T *p) +{ + if (p != NO_NODE) + { + if (IS (p, TRIMMER)) + coerce_trimmer (SUB (p)); + else if (IS (p, UNIT)) + coerce_meek_int (p); + else + { + coerce_indexer (SUB (p)); + coerce_indexer (NEXT (p)); + } + } +} + +/* Coerce_slice. */ + +static void +coerce_slice (NODE_T *p) +{ + SOID_T w; + MOID_T *row = MOID (p); + a68_make_soid (&w, STRONG, row, 0); + coerce_unit (SUB (p), &w); + coerce_indexer (SUB_NEXT (p)); +} + +/* Coerce format text. */ + +static void +coerce_format_text (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + coerce_format_text (SUB (p)); + if (IS (p, FORMAT_PATTERN)) + { + SOID_T x; + a68_make_soid (&x, STRONG, M_FORMAT, 0); + coerce_enclosed (SUB (NEXT_SUB (p)), &x); + } + else if (IS (p, GENERAL_PATTERN) && NEXT_SUB (p) != NO_NODE) + { + SOID_T x; + a68_make_soid (&x, STRONG, M_ROW_INT, 0); + coerce_enclosed (SUB (NEXT_SUB (p)), &x); + } + else if (IS (p, DYNAMIC_REPLICATOR)) + { + SOID_T x; + a68_make_soid (&x, STRONG, M_INT, 0); + coerce_enclosed (SUB (NEXT_SUB (p)), &x); + } + } +} + +/* Coerce unit. */ + +static void +coerce_unit (NODE_T *p, SOID_T *q) +{ + if (p == NO_NODE) + return; + else if (a68_is_one_of (p, UNIT, TERTIARY, SECONDARY, PRIMARY, STOP)) + { + coerce_unit (SUB (p), q); + MOID (p) = MOID (SUB (p)); + /* Ex primary. */ + } + else if (IS (p, CALL)) + { + coerce_call (SUB (p)); + A68_INSERT_COERCIONS (p, MOID (p), q); + } + else if (IS (p, SLICE)) + { + coerce_slice (SUB (p)); + A68_INSERT_COERCIONS (p, MOID (p), q); + } + else if (IS (p, CAST)) + { + coerce_cast (SUB (p)); + A68_INSERT_COERCIONS (p, MOID (p), q); + } + else if (a68_is_one_of (p, DENOTATION, IDENTIFIER, STOP)) + A68_INSERT_COERCIONS (p, MOID (p), q); + else if (IS (p, FORMAT_TEXT)) + { + coerce_format_text (SUB (p)); + A68_INSERT_COERCIONS (p, MOID (p), q); + } + else if (IS (p, ENCLOSED_CLAUSE)) + { + coerce_enclosed (p, q); + /* Ex secondary. */ + } + else if (IS (p, SELECTION)) + { + coerce_selection (SUB (p)); + A68_INSERT_COERCIONS (p, MOID (p), q); + } + else if (IS (p, GENERATOR)) + { + coerce_declarer (SUB (p)); + A68_INSERT_COERCIONS (p, MOID (p), q); + /* Ex tertiary. */ + } + else if (IS (p, NIHIL)) + { + if (ATTRIBUTE (MOID (q)) != REF_SYMBOL && MOID (q) != M_VOID) + a68_error (p, "context does not require a name"); + MOID (p) = a68_depref_rows (MOID (p), MOID (q)); + } + else if (IS (p, FORMULA)) + { + coerce_formula (SUB (p), q); + A68_INSERT_COERCIONS (p, MOID (p), q); + } + else if (IS (p, JUMP)) + { + if (MOID (q) == M_PROC_VOID) + a68_make_sub (p, p, PROCEDURING); + MOID (p) = a68_depref_rows (MOID (p), MOID (q)); + } + else if (IS (p, SKIP)) + MOID (p) = a68_depref_rows (MOID (p), MOID (q)); + else if (IS (p, ASSIGNATION)) + { + coerce_assignation (SUB (p)); + A68_INSERT_COERCIONS (p, MOID (p), q); + MOID (p) = a68_depref_rows (MOID (p), MOID (q)); + } + else if (IS (p, IDENTITY_RELATION)) + { + coerce_relation (SUB (p)); + A68_INSERT_COERCIONS (p, MOID (p), q); + } + else if (IS (p, ROUTINE_TEXT)) + { + coerce_routine_text (SUB (p)); + A68_INSERT_COERCIONS (p, MOID (p), q); + } + else if (a68_is_one_of (p, AND_FUNCTION, OR_FUNCTION, STOP)) + { + coerce_bool_function (SUB (p)); + A68_INSERT_COERCIONS (p, MOID (p), q); + } + else if (IS (p, ASSERTION)) + { + coerce_assertion (SUB (p)); + A68_INSERT_COERCIONS (p, MOID (p), q); + } +} + +/* Coerce module text. */ + +static void +coerce_module_text (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, DEF_PART) || IS (p, POSTLUDE_PART)) + { + SOID_T w; + a68_make_soid (&w, STRONG, M_VOID, 0); + coerce_serial (NEXT_SUB (p), &w, true); + } + } +} + +/* Coerce module declaration. */ + +static void +coerce_module_declaration (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, MODULE_TEXT)) + coerce_module_text (SUB (p)); + else + coerce_module_declaration (SUB (p)); + } +} + +/* Driver for coercion insertions. */ + +void +a68_coercion_inserter (NODE_T *p) +{ + if (IS (p, PACKET)) + { + p = SUB (p); + if (IS (p, PARTICULAR_PROGRAM)) + { + SOID_T q; + a68_make_soid (&q, STRONG, M_VOID, 0); + coerce_enclosed (SUB (p), &q); + } + else if (IS (p, PRELUDE_PACKET)) + coerce_module_declaration (SUB (p)); + } +} diff --git a/gcc/algol68/a68-parser-moids-equivalence.cc b/gcc/algol68/a68-parser-moids-equivalence.cc new file mode 100644 index 000000000000..c022f9cb6732 --- /dev/null +++ b/gcc/algol68/a68-parser-moids-equivalence.cc @@ -0,0 +1,183 @@ +/* Prove equivalence of modes. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "a68.h" + +/* Routines for establishing equivalence of modes. + After I made this mode equivalencer (in 1993), I found: + + Algol Bulletin 30.3.3 C.H.A. Koster: On infinite modes, 86-89 [1969], + + which essentially concurs with this test on mode equivalence I wrote. + It is elementary logic anyway: prove equivalence, assuming equivalence. */ + +/* Forward declarations of some of the functions defined below. */ + +static bool are_modes_equivalent (MOID_T * a, MOID_T * b); + +/* Whether packs are equivalent, same sequence of equivalence modes. */ + +static bool +are_packs_equivalent (PACK_T *s, PACK_T *t, + bool compare_names = true) +{ + for (; s != NO_PACK && t != NO_PACK; s = s->next, t = t->next) + { + if (!are_modes_equivalent (MOID (s), MOID (t))) + return false; + if (compare_names) + { + if (TEXT (s) != TEXT (t) + && TEXT (s) != NO_TEXT + && TEXT (t) != NO_TEXT + && strcmp (TEXT (s), TEXT (t)) != 0) + return false; + } + } + + return s == NO_PACK && t == NO_PACK; +} + +/* Whether packs are subsets. */ + +static bool +is_united_subset (PACK_T *s, PACK_T *t) +{ + /* For all modes in 's' there must be an equivalent in 't'. */ + for (PACK_T *p = s; p != NO_PACK; p = p->next) + { + bool f = false; + for (PACK_T *q = t; q != NO_PACK && !f; q = q->next) + f = are_modes_equivalent (MOID (p), MOID (q)); + + if (!f) + return false; + } + + return true; +} + +/* Whether packs are subsets. */ + +static bool +are_united_packs_equivalent (PACK_T *s, PACK_T *t) +{ + return is_united_subset (s, t) && is_united_subset (t, s); +} + +/* Whether moids A and B are structurally equivalent. */ + +static bool +are_modes_equivalent (MOID_T * a, MOID_T * b) +{ + /* First lets try some cheap heuristics. */ + + if (a == NO_MOID || b == NO_MOID) + /* Modes can be NO_MOID in partial argument lists. */ + return false; + else if (a == M_ERROR || b == M_ERROR) + return false; + else if (a == b) + return true; + else if (ATTRIBUTE (a) != ATTRIBUTE (b)) + return false; + else if (DIM (a) != DIM (b)) + return false; + else if (IS (a, STANDARD)) + return (a == b); + else if (EQUIVALENT (a) == b || EQUIVALENT (b) == a) + return true; + else if (a68_is_postulated_pair (A68 (top_postulate), a, b) + || a68_is_postulated_pair (A68 (top_postulate), b, a)) + return true; + else if (IS (a, INDICANT)) + { + if (NODE (a) == NO_NODE || NODE (b) == NO_NODE) + return false; + else + return (NODE (a) == NODE (b) + || strcmp (NSYMBOL (NODE (a)), NSYMBOL (NODE (b))) == 0); + } + + /* Investigate structure. */ + + /* We now know that 'a' and 'b' have same attribute, dimension, ... */ + if (IS (a, REF_SYMBOL)) + /* REF MODE */ + return are_modes_equivalent (a->sub, b->sub); + else if (IS (a, ROW_SYMBOL)) + /* [] MODE */ + return are_modes_equivalent (a->sub, b->sub); + else if (IS (a, FLEX_SYMBOL)) + /* FLEX [...] MODE */ + return are_modes_equivalent (a->sub, b->sub); + else if (IS (a, STRUCT_SYMBOL)) + { + /* STRUCT (...) */ + POSTULATE_T *save = A68 (top_postulate); + a68_make_postulate (&A68 (top_postulate), a, b); + bool z = are_packs_equivalent (PACK (a), PACK (b)); + a68_free_postulate_list (A68 (top_postulate), save); + A68 (top_postulate) = save; + return z; + } + else if (IS (a, UNION_SYMBOL)) + /* UNION (...) */ + return are_united_packs_equivalent (PACK (a), PACK (b)); + else if (IS (a, PROC_SYMBOL) && PACK (a) == NO_PACK && PACK (b) == NO_PACK) + /* PROC MOID */ + return are_modes_equivalent (a->sub, b->sub); + else if (IS (a, PROC_SYMBOL) && PACK (a) != NO_PACK && PACK (b) != NO_PACK) + { + /* PROC (...) MOID */ + POSTULATE_T *save = A68 (top_postulate); + a68_make_postulate (&A68 (top_postulate), a, b); + bool z = are_modes_equivalent (a->sub, b->sub); + if (z) + z = are_packs_equivalent (PACK (a), PACK (b), + false /* compare_names */); + a68_free_postulate_list (A68 (top_postulate), save); + A68 (top_postulate) = save; + return z; + } + else if (IS (a, SERIES_MODE) || IS (a, STOWED_MODE)) + /* Modes occurring in displays. */ + return are_packs_equivalent (PACK (a), PACK (b)); + + return false; +} + +//! @brief Whether two modes are structurally equivalent. + +bool +a68_prove_moid_equivalence (MOID_T *p, MOID_T *q) +{ +// Prove two modes to be equivalent under assumption that they indeed are. + POSTULATE_T *save = A68 (top_postulate); + bool z = are_modes_equivalent (p, q); + a68_free_postulate_list (A68 (top_postulate), save); + A68 (top_postulate) = save; + return z; +} diff --git a/gcc/algol68/a68-postulates.cc b/gcc/algol68/a68-postulates.cc new file mode 100644 index 000000000000..f291205114d4 --- /dev/null +++ b/gcc/algol68/a68-postulates.cc @@ -0,0 +1,103 @@ +/* Postulates needed for improving equivalence of modes. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "a68.h" + +/* Initialise use of postulate-lists. */ + +void +a68_init_postulates (void) +{ + A68 (top_postulate) = NO_POSTULATE; + A68 (top_postulate_list) = NO_POSTULATE; +} + +/* Make old postulates available for new use. */ + +void +a68_free_postulate_list (POSTULATE_T *start, POSTULATE_T *stop) +{ + if (start == stop) + return; + + POSTULATE_T *last = start; + for (; NEXT (last) != stop; FORWARD (last)) + ; + + NEXT (last) = A68 (top_postulate_list); + A68 (top_postulate_list) = start; +} + +/* Add postulates to postulate-list. */ + +void +a68_make_postulate (POSTULATE_T **p, MOID_T *a, MOID_T *b) +{ + POSTULATE_T *new_one; + + if (A68 (top_postulate_list) != NO_POSTULATE) + { + new_one = A68 (top_postulate_list); + A68 (top_postulate_list) = A68 (top_postulate_list)->next; + } + else + { + new_one = (POSTULATE_T *) ggc_cleared_alloc (); + A68 (new_postulates)++; + } + + new_one->a = a; + new_one->b = b; + new_one->next = *p; + *p = new_one; +} + +/* Where postulates are in the list. */ + +POSTULATE_T +*a68_is_postulated_pair (POSTULATE_T *p, MOID_T *a, MOID_T *b) +{ + for (; p != NO_POSTULATE; p = p->next) + { + if (p->a == a && p->b == b) + return p; + } + + return NO_POSTULATE; +} + +/* Where postulate is in the list. */ + +POSTULATE_T +*a68_is_postulated (POSTULATE_T *p, MOID_T *a) +{ + for (; p != NO_POSTULATE; p = p->next) + { + if (p->a == a) + return p; + } + + return NO_POSTULATE; +} From 95b025f3a187def451a92ff107fd64e08d1773e1 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:49:38 +0200 Subject: [PATCH 158/373] a68: parser: symbol table management Signed-off-by: Jose E. Marchesi Co-authored-by: Marcel van der Veer --- gcc/algol68/a68-parser-taxes.cc | 1806 +++++++++++++++++++++++++++++++ 1 file changed, 1806 insertions(+) create mode 100644 gcc/algol68/a68-parser-taxes.cc diff --git a/gcc/algol68/a68-parser-taxes.cc b/gcc/algol68/a68-parser-taxes.cc new file mode 100644 index 000000000000..fa9f9471d983 --- /dev/null +++ b/gcc/algol68/a68-parser-taxes.cc @@ -0,0 +1,1806 @@ +/* Symbol table management. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "options.h" + +#include "a68.h" + +/* + * Symbol table handling, managing TAGS. + */ + +/* Forward declarations for several functions defined below. */ + +static TAG_T *find_tag_local (TABLE_T *table, int a, const char *name); + +/* Set level for procedures. */ + +void +a68_set_proc_level (NODE_T *p, int n) +{ + for (; p != NO_NODE; FORWARD (p)) + { + PROCEDURE_LEVEL (INFO (p)) = n; + if (IS (p, ROUTINE_TEXT)) + a68_set_proc_level (SUB (p), n + 1); + else + a68_set_proc_level (SUB (p), n); + } +} + +/* Set nests for diagnostics. */ + +void +a68_set_nest (NODE_T *p, NODE_T *s) +{ + for (; p != NO_NODE; FORWARD (p)) + { + NEST (p) = s; + if (IS (p, PARTICULAR_PROGRAM)) + a68_set_nest (SUB (p), p); + else if (IS (p, CLOSED_CLAUSE) && LINE_NUMBER (p) != 0) + a68_set_nest (SUB (p), p); + else if (IS (p, COLLATERAL_CLAUSE) && LINE_NUMBER (p) != 0) + a68_set_nest (SUB (p), p); + else if (IS (p, CONDITIONAL_CLAUSE) && LINE_NUMBER (p) != 0) + a68_set_nest (SUB (p), p); + else if (IS (p, CASE_CLAUSE) && LINE_NUMBER (p) != 0) + a68_set_nest (SUB (p), p); + else if (IS (p, CONFORMITY_CLAUSE) && LINE_NUMBER (p) != 0) + a68_set_nest (SUB (p), p); + else if (IS (p, LOOP_CLAUSE) && LINE_NUMBER (p) != 0) + a68_set_nest (SUB (p), p); + else + a68_set_nest (SUB (p), s); + } +} + +/* + * Routines that work with tags and symbol tables. + */ + +static void tax_tags (NODE_T *); +static void tax_specifier_list (NODE_T *); +static void tax_parameter_list (NODE_T *); +static void tax_format_texts (NODE_T *); + +/* Find a tag, searching symbol tables towards the root. */ + +int +a68_first_tag_global (TABLE_T * table, const char *name) +{ + if (table != NO_TABLE) + { + for (TAG_T *s = IDENTIFIERS (table); s != NO_TAG; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + return IDENTIFIER; + } + for (TAG_T *s = INDICANTS (table); s != NO_TAG; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + return INDICANT; + } + for (TAG_T *s = LABELS (table); s != NO_TAG; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + return LABEL; + } + for (TAG_T *s = OPERATORS (table); s != NO_TAG; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + return OP_SYMBOL; + } + for (TAG_T *s = MODULES (table); s != NO_TAG; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + return MODULE_SYMBOL; + } + for (TAG_T *s = PRIO (table); s != NO_TAG; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + return PRIO_SYMBOL; + } + return a68_first_tag_global (PREVIOUS (table), name); + } + else + return STOP; +} + +/* Whether routine can be "lengthety-mapped". */ + +static bool +is_mappable_routine (const char *z) +{ +#define ACCEPT(u, v) {\ + if (strlen (u) >= strlen (v)) {\ + if (strcmp (&u[strlen (u) - strlen (v)], v) == 0) {\ + return true;\ + }}} + + /* Math routines. */ + ACCEPT (z, "arccos"); + ACCEPT (z, "arccosdg"); + ACCEPT (z, "arccot"); + ACCEPT (z, "arccotdg"); + ACCEPT (z, "arcsin"); + ACCEPT (z, "arcsindg"); + ACCEPT (z, "arctan"); + ACCEPT (z, "arctandg"); + ACCEPT (z, "beta"); + ACCEPT (z, "betainc"); + ACCEPT (z, "cbrt"); + ACCEPT (z, "cos"); + ACCEPT (z, "cosdg"); + ACCEPT (z, "cospi"); + ACCEPT (z, "cot"); + ACCEPT (z, "cot"); + ACCEPT (z, "cotdg"); + ACCEPT (z, "cotpi"); + ACCEPT (z, "curt"); + ACCEPT (z, "erf"); + ACCEPT (z, "erfc"); + ACCEPT (z, "exp"); + ACCEPT (z, "gamma"); + ACCEPT (z, "gammainc"); + ACCEPT (z, "gammaincg"); + ACCEPT (z, "gammaincgf"); + ACCEPT (z, "ln"); + ACCEPT (z, "log"); + ACCEPT (z, "pi"); + ACCEPT (z, "sin"); + ACCEPT (z, "sindg"); + ACCEPT (z, "sinpi"); + ACCEPT (z, "sqrt"); + ACCEPT (z, "tan"); + ACCEPT (z, "tandg"); + ACCEPT (z, "tanpi"); + /* Random generator. */ + ACCEPT (z, "nextrandom"); + ACCEPT (z, "random"); + /* BITS. */ + ACCEPT (z, "bitspack"); + /* Enquiries. */ + ACCEPT (z, "maxint"); + ACCEPT (z, "intwidth"); + ACCEPT (z, "maxreal"); + ACCEPT (z, "realwidth"); + ACCEPT (z, "expwidth"); + ACCEPT (z, "maxbits"); + ACCEPT (z, "bitswidth"); + ACCEPT (z, "byteswidth"); + ACCEPT (z, "smallreal"); + return false; +#undef ACCEPT +} + +/* Map "short sqrt" onto "sqrt" etcetera. */ + +static TAG_T * +bind_lengthety_identifier (const char *u) +{ +#define CAR(u, v) (strncmp (u, v, strlen(v)) == 0) + /* We can only map routines blessed by "is_mappable_routine", so there is no + "short print" or "long char in string". */ + if (CAR (u, "short")) + { + do + { + u = &u[strlen ("short")]; + const char *v = TEXT (a68_add_token (&A68 (top_token), u)); + TAG_T *w = find_tag_local (A68_STANDENV, IDENTIFIER, v); + if (w != NO_TAG && is_mappable_routine (v)) + return w; + } + while (CAR (u, "short")); + } + else if (CAR (u, "long")) + { + do + { + u = &u[strlen ("long")]; + const char *v = TEXT (a68_add_token (&A68 (top_token), u)); + TAG_T *w = find_tag_local (A68_STANDENV, IDENTIFIER, v); + if (w != NO_TAG && is_mappable_routine (v)) + return w; + } + while (CAR (u, "long")); + } + + return NO_TAG; +#undef CAR +} + +/* Bind identifier tags to the symbol table. */ + +static void +bind_identifier_tag_to_symbol_table (NODE_T * p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + bind_identifier_tag_to_symbol_table (SUB (p)); + + if (a68_is_one_of (p, IDENTIFIER, DEFINING_IDENTIFIER, STOP)) + { + int att = a68_first_tag_global (TABLE (p), NSYMBOL (p)); + + if (att == STOP) + { + TAG_T *z = bind_lengthety_identifier (NSYMBOL (p)); + + if (z != NO_TAG) + MOID (p) = MOID (z); + TAX (p) = z; + } + else + { + TAG_T *z = a68_find_tag_global (TABLE (p), att, NSYMBOL (p)); + + if (att == IDENTIFIER && z != NO_TAG) + MOID (p) = MOID (z); + else if (att == LABEL && z != NO_TAG) + ; + else if ((z = bind_lengthety_identifier (NSYMBOL (p))) != NO_TAG) + MOID (p) = MOID (z); + else + { + a68_error (p, "tag S has not been declared properly"); + z = a68_add_tag (TABLE (p), IDENTIFIER, p, M_ERROR, NORMAL_IDENTIFIER); + MOID (p) = M_ERROR; + } + TAX (p) = z; + if (IS (p, DEFINING_IDENTIFIER)) + NODE (z) = p; + } + } + } +} + +/* Tell whether the given tree refers to the applied indicant INDICANT in an + actual declarer. */ + +static bool +declarer_contains_indicant (NODE_T *p, NODE_T *indicant) +{ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, DECLARER) + && IS (SUB (q), INDICANT) + && ((TAX (SUB (q)) && IS_RECURSIVE (TAX (SUB (q)))) + || IS_LITERALLY (SUB (q), NSYMBOL (indicant)))) + { + return true; + } + + if (declarer_contains_indicant (SUB (q), indicant)) + return true; + } + + return false; +} + +/* Bind indicant tags to the symbol table. */ + +static void +bind_indicant_tag_to_symbol_table (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + bind_indicant_tag_to_symbol_table (SUB (p)); + + if (a68_is_one_of (p, INDICANT, DEFINING_INDICANT, STOP)) + { + TAG_T *z = a68_find_tag_global (TABLE (p), INDICANT, NSYMBOL (p)); + + if (z != NO_TAG) + { + MOID (p) = MOID (z); + TAX (p) = z; + if (IS (p, DEFINING_INDICANT)) + { + NODE (z) = p; + IS_RECURSIVE (z) = declarer_contains_indicant (NEXT_NEXT (p), p); + } + } + } + } +} + +/* Enter specifier identifiers in the symbol table. */ + +static void +tax_specifiers (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + tax_specifiers (SUB (p)); + + if (SUB (p) != NO_NODE && IS (p, SPECIFIER)) + tax_specifier_list (SUB (p)); + } +} + +/* Enter specifier identifiers in the symbol table. */ + +static void +tax_specifier_list (NODE_T *p) +{ + if (p != NO_NODE) + { + if (IS (p, OPEN_SYMBOL)) + tax_specifier_list (NEXT (p)); + else if (a68_is_one_of (p, CLOSE_SYMBOL, VOID_SYMBOL, STOP)) + ; + else if (IS (p, IDENTIFIER)) + { + TAG_T *z = a68_add_tag (TABLE (p), IDENTIFIER, p, NO_MOID, SPECIFIER_IDENTIFIER); + HEAP (z) = LOC_SYMBOL; + } + else if (IS (p, DECLARER)) + { + tax_specifiers (SUB (p)); + tax_specifier_list (NEXT (p)); + /* last identifier entry is identifier with this declarer. */ + if (IDENTIFIERS (TABLE (p)) != NO_TAG + && PRIO (IDENTIFIERS (TABLE (p))) == SPECIFIER_IDENTIFIER) + MOID (IDENTIFIERS (TABLE (p))) = MOID (p); + } + } +} + +/* Enter parameter identifiers in the symbol table. */ + +static void +tax_parameters (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (SUB (p) != NO_NODE) + { + tax_parameters (SUB (p)); + if (IS (p, PARAMETER_PACK)) + tax_parameter_list (SUB (p)); + } + } +} + +/* Enter parameter identifiers in the symbol table. */ + +static void +tax_parameter_list (NODE_T *p) +{ + if (p != NO_NODE) + { + if (a68_is_one_of (p, OPEN_SYMBOL, COMMA_SYMBOL, STOP)) + tax_parameter_list (NEXT (p)); + else if (IS (p, CLOSE_SYMBOL)) + ; + else if (a68_is_one_of (p, PARAMETER_LIST, PARAMETER, STOP)) + { + tax_parameter_list (NEXT (p)); + tax_parameter_list (SUB (p)); + } + else if (IS (p, IDENTIFIER)) + { + /* parameters are always local. */ + HEAP (a68_add_tag (TABLE (p), IDENTIFIER, p, NO_MOID, PARAMETER_IDENTIFIER)) = LOC_SYMBOL; + } + else if (IS (p, DECLARER)) + { + tax_parameter_list (NEXT (p)); + /* last identifier entries are identifiers with this declarer. */ + for (TAG_T *s = IDENTIFIERS (TABLE (p)); s != NO_TAG && MOID (s) == NO_MOID; FORWARD (s)) + MOID (s) = MOID (p); + tax_parameters (SUB (p)); + } + } +} + +/* Enter FOR identifiers in the symbol table. */ + +static void +tax_for_identifiers (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + tax_for_identifiers (SUB (p)); + + if (IS (p, FOR_SYMBOL)) + { + if ((FORWARD (p)) != NO_NODE) + (void) a68_add_tag (TABLE (p), IDENTIFIER, p, M_INT, LOOP_IDENTIFIER); + } + } +} + +/* Enter routine texts in the symbol table. */ + +static void +tax_routine_texts (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + tax_routine_texts (SUB (p)); + + if (IS (p, ROUTINE_TEXT)) + { + TAG_T *z = a68_add_tag (TABLE (p), ANONYMOUS, p, MOID (p), ROUTINE_TEXT); + TAX (p) = z; + HEAP (z) = LOC_SYMBOL; + USE (z) = true; + } + } +} + +/* Enter format texts in the symbol table. */ + +static void +tax_format_texts (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + tax_format_texts (SUB (p)); + + if (IS (p, FORMAT_TEXT)) + { + TAG_T *z = a68_add_tag (TABLE (p), ANONYMOUS, p, M_FORMAT, FORMAT_TEXT); + TAX (p) = z; + USE (z) = true; + } + else if (IS (p, FORMAT_DELIMITER_SYMBOL) && NEXT (p) != NO_NODE) + { + TAG_T *z = a68_add_tag (TABLE (p), ANONYMOUS, p, M_FORMAT, FORMAT_IDENTIFIER); + TAX (p) = z; + USE (z) = true; + } + } +} + +/* Enter FORMAT pictures in the symbol table. */ + +static void +tax_pictures (NODE_T * p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + tax_pictures (SUB (p)); + + if (IS (p, PICTURE)) + TAX (p) = a68_add_tag (TABLE (p), ANONYMOUS, p, M_COLLITEM, FORMAT_IDENTIFIER); + } +} + +/* Enter generators in the symbol table. */ + +static void +tax_generators (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + tax_generators (SUB (p)); + + if (IS (p, GENERATOR)) + { + if (IS (SUB (p), LOC_SYMBOL)) + { + TAG_T *z = a68_add_tag (TABLE (p), ANONYMOUS, p, SUB_MOID (SUB (p)), GENERATOR); + HEAP (z) = LOC_SYMBOL; + USE (z) = true; + TAX (p) = z; + } + } + } +} + +/* Find a firmly related operator for operands. */ + +static TAG_T * +find_firmly_related_op (TABLE_T *c, const char *n, MOID_T *l, MOID_T *r, TAG_T *self) +{ + if (c != NO_TABLE) + { + TAG_T *s = OPERATORS (c); + + for (; s != NO_TAG; FORWARD (s)) + { + if (s != self && NSYMBOL (NODE (s)) == n) + { + PACK_T *t = PACK (MOID (s)); + if (t != NO_PACK && a68_is_firm (MOID (t), l)) + { + /* catch monadic operator. */ + if ((FORWARD (t)) == NO_PACK) + { + if (r == NO_MOID) + return s; + } + else + { + /* catch dyadic operator. */ + if (r != NO_MOID && a68_is_firm (MOID (t), r)) + return s; + } + } + } + } + } + return NO_TAG; +} + +/* Check for firmly related operators in this range. */ + +static void +test_firmly_related_ops_local (NODE_T *p, TAG_T *s) +{ + if (s != NO_TAG) + { + PACK_T *u = PACK (MOID (s)); + + if (u != NO_PACK) + { + MOID_T *l = MOID (u); + MOID_T *r = (NEXT (u) != NO_PACK ? MOID (NEXT (u)) : NO_MOID); + TAG_T *t = find_firmly_related_op (TAG_TABLE (s), NSYMBOL (NODE (s)), l, r, s); + + if (t != NO_TAG) + { + a68_error (p, "M Z is firmly related to M Z", + MOID (s), NSYMBOL (NODE (s)), MOID (t), + NSYMBOL (NODE (t))); + } + else + { + /* Warn for hidden firmly related operators defined in outer + ranges, if requested. */ + for (TABLE_T *prev = PREVIOUS (TAG_TABLE (s)); + prev != NO_TABLE; + prev = PREVIOUS (prev)) + { + TAG_T *t = find_firmly_related_op (prev, NSYMBOL (NODE (s)), l, r, + NO_TAG /* self */); + if (t != NO_TAG) + { + if (TAG_TABLE (t) == A68_STANDENV + && warn_algol68_hidden_declarations > 0) + { + if (a68_warning (p, OPT_Whidden_declarations_, + "Z hides a firmly related operator in a larger reach", + NSYMBOL (NODE (s)))) + { + a68_inform (NO_NODE, + "operator M Z defined in the standard prelude", + MOID (t), NSYMBOL (NODE (t))); + } + } + else if (warn_algol68_hidden_declarations > 1) + { + if (a68_warning (p, OPT_Whidden_declarations_, + "Z hides a firmly related operator in a larger reach", + NSYMBOL (NODE (s)))) + { + a68_inform (NODE (t), + "previous hidden declaration of S declared here", + NSYMBOL (NODE (s))); + } + } + + /* Report only one level of hidding or it gets messy. */ + break; + } + } + } + } + if (NEXT (s) != NO_TAG) + test_firmly_related_ops_local ((p == NO_NODE ? NO_NODE : NODE (NEXT (s))), NEXT (s)); + } +} + +/* Find firmly related operators in this program. */ + +static void +test_firmly_related_ops (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (SUB (p) != NO_NODE && a68_is_new_lexical_level (p)) + { + TAG_T *oops = OPERATORS (TABLE (SUB (p))); + + if (oops != NO_TAG) + test_firmly_related_ops_local (NODE (oops), oops); + } + test_firmly_related_ops (SUB (p)); + } +} + +/* Driver for the processing of TAXes. */ + +void +a68_collect_taxes (NODE_T *p) +{ + tax_tags (p); + tax_specifiers (p); + tax_parameters (p); + tax_for_identifiers (p); + tax_routine_texts (p); + tax_pictures (p); + tax_format_texts (p); + tax_generators (p); + bind_identifier_tag_to_symbol_table (p); + bind_indicant_tag_to_symbol_table (p); + test_firmly_related_ops (p); + test_firmly_related_ops_local (NO_NODE, OPERATORS (A68_STANDENV)); +} + +/* Whether tag has already been declared in this range. */ + +static void +already_declared (NODE_T *n, int a) +{ + if (find_tag_local (TABLE (n), a, NSYMBOL (n)) != NO_TAG) + a68_error (n, "multiple declaration of tag S"); +} + +/* Whether tag has already been declared in this range. */ + +static void +already_declared_hidden (NODE_T *n, int a) +{ + if (find_tag_local (TABLE (n), a, NSYMBOL (n)) != NO_TAG) + a68_error (n, "multiple declaration of tag S"); + + TAG_T *s = a68_find_tag_global (PREVIOUS (TABLE (n)), a, NSYMBOL (n)); + + if (s != NO_TAG + && ((TAG_TABLE (s) == A68_STANDENV && warn_algol68_hidden_declarations > 0) + || (TAG_TABLE (s) != A68_STANDENV && warn_algol68_hidden_declarations > 1))) + { + if (a68_warning (n, OPT_Whidden_declarations_, + "Z hides a declaration with larger reach", + NSYMBOL (n))) + { + if (TAG_TABLE (s) == A68_STANDENV) + a68_inform (NO_NODE, + "M Z defined in the standard prelude", + MOID (s), NSYMBOL (NODE (s))); + else + a68_inform (NODE (s), + "previous hidden declaration of S declared here", + NSYMBOL (n)); + } + } +} + +/* Add tag to local symbol table. */ + +TAG_T * +a68_add_tag (TABLE_T *s, int a, NODE_T *n, MOID_T *m, int p) +{ +#define INSERT_TAG(l, n) {NEXT (n) = *(l); *(l) = (n);} + if (s != NO_TABLE) + { + TAG_T *z = a68_new_tag (); + + TAG_TABLE (z) = s; + PRIO (z) = p; + MOID (z) = m; + NODE (z) = n; + /* TAX(n) = z;. */ + switch (a) + { + case IDENTIFIER: + already_declared_hidden (n, IDENTIFIER); + already_declared_hidden (n, LABEL); + INSERT_TAG (&IDENTIFIERS (s), z); + break; + case INDICANT: + already_declared_hidden (n, INDICANT); + already_declared (n, OP_SYMBOL); + already_declared (n, PRIO_SYMBOL); + INSERT_TAG (&INDICANTS (s), z); + break; + case LABEL: + already_declared_hidden (n, LABEL); + already_declared_hidden (n, IDENTIFIER); + INSERT_TAG (&LABELS (s), z); + break; + case OP_SYMBOL: + already_declared (n, INDICANT); + INSERT_TAG (&OPERATORS (s), z); + break; + case MODULE_SYMBOL: + already_declared (n, INDICANT); + INSERT_TAG (&MODULES (s), z); + break; + case PRIO_SYMBOL: + already_declared (n, PRIO_SYMBOL); + already_declared (n, INDICANT); + INSERT_TAG (&PRIO (s), z); + break; + case ANONYMOUS: + INSERT_TAG (&ANONYMOUS (s), z); + break; + default: + gcc_unreachable (); + } + return z; + } + else + return NO_TAG; +} + +/* Find a tag, searching symbol tables towards the root. */ + +TAG_T * +a68_find_tag_global (TABLE_T *table, int a, const char *name) +{ + if (table != NO_TABLE) + { + TAG_T *s = NO_TAG; + switch (a) + { + case IDENTIFIER: + s = IDENTIFIERS (table); + break; + case INDICANT: + s = INDICANTS (table); + break; + case LABEL: + s = LABELS (table); + break; + case OP_SYMBOL: + s = OPERATORS (table); + break; + case MODULE_SYMBOL: + s = MODULES (table); + break; + case PRIO_SYMBOL: + s = PRIO (table); + break; + default: + gcc_unreachable (); + break; + } + + for (; s != NO_TAG; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + return s; + } + return a68_find_tag_global (PREVIOUS (table), a, name); + } + else + return NO_TAG; +} + +/* Whether identifier or label global. */ + +int +a68_is_identifier_or_label_global (TABLE_T *table, const char *name) +{ + if (table != NO_TABLE) + { + for (TAG_T *s = IDENTIFIERS (table); s != NO_TAG; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + return IDENTIFIER; + } + for (TAG_T *s = LABELS (table); s != NO_TAG; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + return LABEL; + } + return a68_is_identifier_or_label_global (PREVIOUS (table), name); + } + else + return 0; +} + +/* Find a tag, searching only local symbol table. */ + +static TAG_T * +find_tag_local (TABLE_T *table, int a, const char *name) +{ + if (table != NO_TABLE) + { + TAG_T *s = NO_TAG; + + if (a == OP_SYMBOL) + s = OPERATORS (table); + else if (a == MODULE_SYMBOL) + s = MODULES (table); + else if (a == PRIO_SYMBOL) + s = PRIO (table); + else if (a == IDENTIFIER) + s = IDENTIFIERS (table); + else if (a == INDICANT) + s = INDICANTS (table); + else if (a == LABEL) + s = LABELS (table); + else + gcc_unreachable (); + + for (; s != NO_TAG; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + return s; + } + } + return NO_TAG; +} + +/* Whether context specifies HEAP or LOC for an identifier. + + The boolean *E is set to true if an explicit qualifier was found, false + otherwise. */ + +static int +tab_qualifier (NODE_T *p, bool *e) +{ + *e = false; + if (p != NO_NODE) + { + if (a68_is_one_of (p, UNIT, ASSIGNATION, TERTIARY, SECONDARY, GENERATOR, STOP)) + return tab_qualifier (SUB (p), e); + else if (a68_is_one_of (p, LOC_SYMBOL, HEAP_SYMBOL, STOP)) + { + *e = true; + return ATTRIBUTE (p) == LOC_SYMBOL ? LOC_SYMBOL : HEAP_SYMBOL; + } + else + return LOC_SYMBOL; + } + else + return LOC_SYMBOL; +} + +/* Enter identity declarations in the symbol table. + + E is true if HEAP or LOC got specified explicitly in the identity + declaration's formal parameter. */ + +static void +tax_identity_dec (NODE_T *p, MOID_T **m) +{ + if (p != NO_NODE) + { + if (IS (p, IDENTITY_DECLARATION)) + { + tax_identity_dec (SUB (p), m); + tax_identity_dec (NEXT (p), m); + } + else if (IS (p, DECLARER)) + { + tax_tags (SUB (p)); + *m = MOID (p); + tax_identity_dec (NEXT (p), m); + } + else if (IS (p, COMMA_SYMBOL)) + { + tax_identity_dec (NEXT (p), m); + } + else if (IS (p, DEFINING_IDENTIFIER)) + { + TAG_T *entry = find_tag_local (TABLE (p), IDENTIFIER, NSYMBOL (p)); + gcc_assert (entry != NO_TAG); + + MOID (p) = *m; + HEAP (entry) = LOC_SYMBOL; + TAX (p) = entry; + MOID (entry) = *m; + PUBLICIZED (entry) = PUBLICIZED (p); + bool e; + if (ATTRIBUTE (*m) == REF_SYMBOL) + { + HEAP (entry) = tab_qualifier (NEXT_NEXT (p), &e); + if (e && HEAP (entry) == LOC_SYMBOL && PUBLICIZED (entry)) + a68_warning (p, 0, "value of local generator will be out of scope"); + } + tax_identity_dec (NEXT_NEXT (p), m); + } + else + tax_tags (p); + } +} + +/* Enter variable declarations in the symbol table. + + E is true if an explicit sample generator was specified in the variable + declaration. */ + +static void +tax_variable_dec (NODE_T *p, int *q, MOID_T **m, bool e) +{ + if (p != NO_NODE) + { + if (IS (p, VARIABLE_DECLARATION)) + { + tax_variable_dec (SUB (p), q, m, e); + tax_variable_dec (NEXT (p), q, m, e); + } + else if (IS (p, DECLARER)) + { + tax_tags (SUB (p)); + *m = MOID (p); + tax_variable_dec (NEXT (p), q, m, e); + } + else if (IS (p, QUALIFIER)) + { + *q = ATTRIBUTE (SUB (p)); + tax_variable_dec (NEXT (p), q, m, true); + } + else if (IS (p, COMMA_SYMBOL)) + { + tax_variable_dec (NEXT (p), q, m, e); + } + else if (IS (p, DEFINING_IDENTIFIER)) + { + TAG_T *entry = find_tag_local (TABLE (p), IDENTIFIER, NSYMBOL (p)); + + MOID (p) = *m; + TAX (p) = entry; + PUBLICIZED (entry) = PUBLICIZED (p); + + if (PUBLICIZED (p) && e && *q == LOC_SYMBOL) + a68_error (p, "publicized variable should not be allocated on the stack"); + + if (PUBLICIZED (p)) + HEAP (entry) = STATIC_SYMBOL; + else + HEAP (entry) = *q; + + if (HEAP (entry) == LOC_SYMBOL) + { + TAG_T *z = a68_add_tag (TABLE (p), ANONYMOUS, p, SUB (*m), GENERATOR); + HEAP (z) = LOC_SYMBOL; + USE (z) = true; + BODY (entry) = z; + } + else + { + BODY (entry) = NO_TAG; + } + MOID (entry) = *m; + tax_variable_dec (NEXT (p), q, m, e); + } + else + tax_tags (p); + } +} + +/* Enter procedure variable declarations in the symbol table. + + E is true if an explicit sample generator was specified in the procedure + variable declaration. */ + +static void +tax_proc_variable_dec (NODE_T *p, int *q, bool e) +{ + if (p != NO_NODE) + { + if (IS (p, PROCEDURE_VARIABLE_DECLARATION)) + { + tax_proc_variable_dec (SUB (p), q, e); + tax_proc_variable_dec (NEXT (p), q, e); + } + else if (IS (p, QUALIFIER)) + { + *q = ATTRIBUTE (SUB (p)); + tax_proc_variable_dec (NEXT (p), q, true); + } + else if (a68_is_one_of (p, PROC_SYMBOL, COMMA_SYMBOL, STOP)) + { + tax_proc_variable_dec (NEXT (p), q, e); + } + else if (IS (p, DEFINING_IDENTIFIER)) + { + TAG_T *entry = find_tag_local (TABLE (p), IDENTIFIER, NSYMBOL (p)); + + TAX (p) = entry; + MOID (entry) = MOID (p); + PUBLICIZED (entry) = PUBLICIZED (p); + + if (PUBLICIZED (p) && e && *q == LOC_SYMBOL) + a68_error (p, "publicized variable should not be allocated on the stack"); + + if (PUBLICIZED (p)) + HEAP (entry) = STATIC_SYMBOL; + else + HEAP (entry) = *q; + + if (HEAP (entry) == LOC_SYMBOL) + { + TAG_T *z = a68_add_tag (TABLE (p), ANONYMOUS, p, SUB_MOID (p), GENERATOR); + HEAP (z) = LOC_SYMBOL; + USE (z) = true; + BODY (entry) = z; + } + else + { + BODY (entry) = NO_TAG; + } + tax_proc_variable_dec (NEXT (p), q, e); + } + else + tax_tags (p); + } +} + +/* Enter procedure declarations in the symbol table. */ + +static void +tax_proc_dec (NODE_T *p) +{ + if (p != NO_NODE) + { + if (IS (p, PROCEDURE_DECLARATION)) + { + tax_proc_dec (SUB (p)); + tax_proc_dec (NEXT (p)); + } + else if (a68_is_one_of (p, PROC_SYMBOL, COMMA_SYMBOL, STOP)) + { + tax_proc_dec (NEXT (p)); + } + else if (IS (p, DEFINING_IDENTIFIER)) + { + TAG_T *entry = find_tag_local (TABLE (p), IDENTIFIER, NSYMBOL (p)); + + MOID_T *m = MOID (NEXT_NEXT (p)); + MOID (p) = m; + TAX (p) = entry; + HEAP (entry) = LOC_SYMBOL; + MOID (entry) = m; + PUBLICIZED (entry) = PUBLICIZED (p); + tax_proc_dec (NEXT (p)); + } + else + tax_tags (p); + } +} + +/* Check validity of operator declaration. */ + +static void +check_operator_dec (NODE_T *p, MOID_T *u) +{ + int k = 0; + + if (u == NO_MOID) + { + NODE_T *pack = SUB_SUB (NEXT_NEXT (p)); /* Where the parameter pack + is. */ + if (ATTRIBUTE (NEXT_NEXT (p)) != ROUTINE_TEXT) + pack = SUB (pack); + k = 1 + a68_count_operands (pack); + } + else + k = a68_count_pack_members (PACK (u)); + + if (k < 1 || k > 2) + { + a68_error (p, "incorrect number of operands for S"); + k = 0; + } + + if (k == 1 && strchr (NOMADS, NSYMBOL (p)[0]) != NO_TEXT) + { + a68_error (p, "monadic S cannot start with a character from Z", NOMADS); + } + else if (k == 2 && !a68_find_tag_global (TABLE (p), PRIO_SYMBOL, NSYMBOL (p))) + { + a68_error (p, "dyadic S has no priority declaration"); + } +} + +/* Enter operator declarations in the symbol table. */ + +static void +tax_op_dec (NODE_T *p, MOID_T **m) +{ + if (p != NO_NODE) + { + if (IS (p, OPERATOR_DECLARATION)) + { + tax_op_dec (SUB (p), m); + tax_op_dec (NEXT (p), m); + } + else if (IS (p, OPERATOR_PLAN)) + { + tax_tags (SUB (p)); + *m = MOID (p); + tax_op_dec (NEXT (p), m); + } + else if (IS (p, OP_SYMBOL)) + { + tax_op_dec (NEXT (p), m); + } + else if (IS (p, COMMA_SYMBOL)) + { + tax_op_dec (NEXT (p), m); + } + else if (IS (p, DEFINING_OPERATOR)) + { + TAG_T *entry = OPERATORS (TABLE (p)); + check_operator_dec (p, *m); + while (entry != NO_TAG && NODE (entry) != p) + FORWARD (entry); + MOID (p) = *m; + TAX (p) = entry; + HEAP (entry) = LOC_SYMBOL; + MOID (entry) = *m; + PUBLICIZED (entry) = PUBLICIZED (p); + tax_op_dec (NEXT (p), m); + } + else + { + tax_tags (p); + } + } +} + +/* Enter module declarations in the symbol table. */ + +static void +tax_module_dec (NODE_T *p) +{ + if (p != NO_NODE) + { + if (IS (p, MODULE_DECLARATION)) + { + tax_module_dec (SUB (p)); + tax_module_dec (NEXT (p)); + } + else if (IS (p, MODULE_SYMBOL)) + { + tax_module_dec (NEXT (p)); + } + else if (IS (p, COMMA_SYMBOL)) + { + tax_module_dec (NEXT (p)); + } + else if (IS (p, DEFINING_MODULE_INDICANT)) + { + TAG_T *entry = MODULES (TABLE (p)); + while (entry != NO_TAG && NODE (entry) != p) + FORWARD (entry); + MOID (p) = NO_MOID; + TAX (p) = entry; + HEAP (entry) = LOC_SYMBOL; + MOID (entry) = NO_MOID; + PUBLICIZED (entry) = PUBLICIZED (p); + tax_module_dec (NEXT (p)); + } + else + { + tax_tags (p); + } + } +} + +/* Enter brief operator declarations in the symbol table. */ + +static void +tax_brief_op_dec (NODE_T *p) +{ + if (p != NO_NODE) + { + if (IS (p, BRIEF_OPERATOR_DECLARATION)) + { + tax_brief_op_dec (SUB (p)); + tax_brief_op_dec (NEXT (p)); + } + else if (a68_is_one_of (p, OP_SYMBOL, COMMA_SYMBOL, STOP)) + { + tax_brief_op_dec (NEXT (p)); + } + else if (IS (p, DEFINING_OPERATOR)) + { + TAG_T *entry = OPERATORS (TABLE (p)); + MOID_T *m = MOID (NEXT_NEXT (p)); + check_operator_dec (p, NO_MOID); + while (entry != NO_TAG && NODE (entry) != p) + FORWARD (entry); + MOID (p) = m; + TAX (p) = entry; + HEAP (entry) = LOC_SYMBOL; + MOID (entry) = m; + PUBLICIZED (entry) = PUBLICIZED (p); + tax_brief_op_dec (NEXT (p)); + } + else + { + tax_tags (p); + } + } +} + +/* Enter priority declarations in the symbol table. */ + +static void tax_prio_dec (NODE_T *p) +{ + if (p != NO_NODE) + { + if (IS (p, PRIORITY_DECLARATION)) + { + tax_prio_dec (SUB (p)); + tax_prio_dec (NEXT (p)); + } + else if (a68_is_one_of (p, PRIO_SYMBOL, COMMA_SYMBOL, STOP)) + { + tax_prio_dec (NEXT (p)); + } + else if (IS (p, DEFINING_OPERATOR)) + { + TAG_T *entry = PRIO (TABLE (p)); + while (entry != NO_TAG && NODE (entry) != p) + FORWARD (entry); + MOID (p) = NO_MOID; + TAX (p) = entry; + HEAP (entry) = LOC_SYMBOL; + PUBLICIZED (entry) = PUBLICIZED (p); + tax_prio_dec (NEXT (p)); + } + else + { + tax_tags (p); + } + } +} + +/* Enter TAXes in the symbol table. */ + +static void +tax_tags (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + int heap = LOC_SYMBOL; + MOID_T *m = NO_MOID; + + if (IS (p, IDENTITY_DECLARATION)) + tax_identity_dec (p, &m); + else if (IS (p, VARIABLE_DECLARATION)) + tax_variable_dec (p, &heap, &m, false); + else if (IS (p, PROCEDURE_DECLARATION)) + tax_proc_dec (p); + else if (IS (p, PROCEDURE_VARIABLE_DECLARATION)) + tax_proc_variable_dec (p, &heap, false); + else if (IS (p, OPERATOR_DECLARATION)) + tax_op_dec (p, &m); + else if (IS (p, BRIEF_OPERATOR_DECLARATION)) + tax_brief_op_dec (p); + else if (IS (p, PRIORITY_DECLARATION)) + tax_prio_dec (p); + else if (IS (p, MODULE_DECLARATION)) + tax_module_dec (p); + else + tax_tags (SUB (p)); + } +} + +/* Reset symbol table nest count. */ + +void +a68_reset_symbol_table_nest_count (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (SUB (p) != NO_NODE && a68_is_new_lexical_level (p)) + NEST (TABLE (SUB (p))) = A68 (symbol_table_count)++; + a68_reset_symbol_table_nest_count (SUB (p)); + } +} + +//! @brief Bind routines in symbol table to the tree. + +void +a68_bind_routine_tags_to_tree (NODE_T *p) +{ + /* By inserting coercions etc. some may have shifted. */ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, ROUTINE_TEXT) && TAX (p) != NO_TAG) + NODE (TAX (p)) = p; + a68_bind_routine_tags_to_tree (SUB (p)); + } +} + +/* Bind formats in symbol table to tree. */ + +static void +bind_format_tags_to_tree (NODE_T *p) +{ + /* By inserting coercions etc. some may have shifted. */ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, FORMAT_TEXT) && TAX (p) != NO_TAG) + NODE (TAX (p)) = p; + else if (IS (p, FORMAT_DELIMITER_SYMBOL) && NEXT (p) != NO_NODE && TAX (p) != NO_TAG) + NODE (TAX (p)) = p; + + bind_format_tags_to_tree (SUB (p)); + } +} + +/* Fill outer level of symbol table. */ + +void +a68_fill_symbol_table_outer (NODE_T *p, TABLE_T *s) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (TABLE (p) != NO_TABLE) + OUTER (TABLE (p)) = s; + + if (SUB (p) != NO_NODE && IS (p, ROUTINE_TEXT)) + a68_fill_symbol_table_outer (SUB (p), TABLE (SUB (p))); + else if (SUB (p) != NO_NODE && IS (p, FORMAT_TEXT)) + a68_fill_symbol_table_outer (SUB (p), TABLE (SUB (p))); + else if (SUB (p) != NO_NODE && IS (p, MODULE_TEXT)) + a68_fill_symbol_table_outer (SUB (p), TABLE (SUB (p))); + else + a68_fill_symbol_table_outer (SUB (p), s); + } +} + +/* Flood branch in tree with local symbol table S. */ + +static void +flood_with_symbol_table_restricted (NODE_T *p, TABLE_T *s) +{ + for (; p != NO_NODE; FORWARD (p)) + { + TABLE (p) = s; + if (ATTRIBUTE (p) != ROUTINE_TEXT && ATTRIBUTE (p) != SPECIFIED_UNIT) + { + if (a68_is_new_lexical_level (p)) + PREVIOUS (TABLE (SUB (p))) = s; + else + flood_with_symbol_table_restricted (SUB (p), s); + } + } +} + +/* Final structure of symbol table after parsing. */ + +void +a68_finalise_symbol_table_setup (NODE_T *p, int l) +{ + TABLE_T *s = TABLE (p); + NODE_T *q = p; + + while (q != NO_NODE) + { + /* routine texts are ranges. */ + if (IS (q, ROUTINE_TEXT)) + flood_with_symbol_table_restricted (SUB (q), a68_new_symbol_table (s)); + + /* specifiers are ranges. */ + else if (IS (q, SPECIFIED_UNIT)) + flood_with_symbol_table_restricted (SUB (q), a68_new_symbol_table (s)); + + /* level count and recursion. */ + if (SUB (q) != NO_NODE) + { + if (a68_is_new_lexical_level (q)) + { + LEX_LEVEL (SUB (q)) = l + 1; + gcc_assert (TABLE (SUB (q)) != s); + PREVIOUS (TABLE (SUB (q))) = s; + a68_finalise_symbol_table_setup (SUB (q), l + 1); + if (IS (q, WHILE_PART)) + { + /* This was a bug that went unnoticed for 15 years!. */ + TABLE_T *s2 = TABLE (SUB (q)); + if ((FORWARD (q)) == NO_NODE) + return; + if (IS (q, ALT_DO_PART)) + { + PREVIOUS (TABLE (SUB (q))) = s2; + LEX_LEVEL (SUB (q)) = l + 2; + a68_finalise_symbol_table_setup (SUB (q), l + 2); + } + } + if (IS (q, DEF_PART)) + { + TABLE_T *s2 = TABLE (SUB (q)); + if ((FORWARD (q)) == NO_NODE) + return; + if (IS (q, POSTLUDE_PART)) + { + PREVIOUS (TABLE (SUB (q))) = s2; + LEX_LEVEL (SUB (q)) = l + 2; + a68_finalise_symbol_table_setup (SUB (q), l + 2); + } + } + } + else + { + TABLE (SUB (q)) = s; + a68_finalise_symbol_table_setup (SUB (q), l); + } + } + TABLE (q) = s; + + if (IS (q, FOR_SYMBOL)) + FORWARD (q); + FORWARD (q); + } + + /* FOR identifiers are in the DO ... OD range. */ + for (q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, FOR_SYMBOL)) + TABLE (NEXT (q)) = TABLE (SEQUENCE (NEXT (q))); + } +} + +/* First structure of symbol table for parsing. */ + +void +a68_preliminary_symbol_table_setup (NODE_T *p) +{ + TABLE_T *s = TABLE (p); + bool not_a_for_range = false; + + /* Let the tree point to the current symbol table. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + TABLE (q) = s; + + /* insert new tables when required. */ + for (NODE_T *q = p; q != NO_NODE && !not_a_for_range; FORWARD (q)) + { + if (SUB (q) != NO_NODE) + { + /* BEGIN ... END, CODE ... EDOC, DO ... OD, $ ... $, { ... } are + ranges. */ + if (a68_is_one_of (q, BEGIN_SYMBOL, DO_SYMBOL, ALT_DO_SYMBOL, + FORMAT_DELIMITER_SYMBOL, STOP)) + { + TABLE (SUB (q)) = a68_new_symbol_table (s); + a68_preliminary_symbol_table_setup (SUB (q)); + } + /* ( ... ) is a range. */ + else if (IS (q, OPEN_SYMBOL)) + { + if (a68_whether (q, OPEN_SYMBOL, THEN_BAR_SYMBOL, STOP)) + { + TABLE (SUB (q)) = s; + a68_preliminary_symbol_table_setup (SUB (q)); + FORWARD (q); + TABLE (SUB (q)) = a68_new_symbol_table (s); + a68_preliminary_symbol_table_setup (SUB (q)); + if ((FORWARD (q)) == NO_NODE) + not_a_for_range = true; + else + { + if (IS (q, THEN_BAR_SYMBOL)) + { + TABLE (SUB (q)) = a68_new_symbol_table (s); + a68_preliminary_symbol_table_setup (SUB (q)); + } + if (IS (q, OPEN_SYMBOL)) + { + TABLE (SUB (q)) = a68_new_symbol_table (s); + a68_preliminary_symbol_table_setup (SUB (q)); + } + } + } + else + { + /* Don't worry about STRUCT (...), UNION (...), PROC (...) + yet. */ + TABLE (SUB (q)) = a68_new_symbol_table (s); + a68_preliminary_symbol_table_setup (SUB (q)); + } + } + /* IF ... THEN ... ELSE ... FI are ranges. */ + else if (IS (q, IF_SYMBOL)) + { + if (a68_whether (q, IF_SYMBOL, THEN_SYMBOL, STOP)) + { + TABLE (SUB (q)) = s; + a68_preliminary_symbol_table_setup (SUB (q)); + FORWARD (q); + TABLE (SUB (q)) = a68_new_symbol_table (s); + a68_preliminary_symbol_table_setup (SUB (q)); + if ((FORWARD (q)) == NO_NODE) + not_a_for_range = true; + else + if (IS (q, ELSE_SYMBOL)) + { + TABLE (SUB (q)) = a68_new_symbol_table (s); + a68_preliminary_symbol_table_setup (SUB (q)); + } + if (IS (q, IF_SYMBOL)) + { + TABLE (SUB (q)) = a68_new_symbol_table (s); + a68_preliminary_symbol_table_setup (SUB (q)); + } + } + else + { + TABLE (SUB (q)) = a68_new_symbol_table (s); + a68_preliminary_symbol_table_setup (SUB (q)); + } + } + /* CASE ... IN ... OUT ... ESAC are ranges. */ + else if (IS (q, CASE_SYMBOL)) + { + if (a68_whether (q, CASE_SYMBOL, IN_SYMBOL, STOP)) + { + TABLE (SUB (q)) = s; + a68_preliminary_symbol_table_setup (SUB (q)); + FORWARD (q); + TABLE (SUB (q)) = a68_new_symbol_table (s); + a68_preliminary_symbol_table_setup (SUB (q)); + if ((FORWARD (q)) == NO_NODE) + not_a_for_range = true; + else + { + if (IS (q, OUT_SYMBOL)) + { + TABLE (SUB (q)) = a68_new_symbol_table (s); + a68_preliminary_symbol_table_setup (SUB (q)); + } + if (IS (q, CASE_SYMBOL)) + { + TABLE (SUB (q)) = a68_new_symbol_table (s); + a68_preliminary_symbol_table_setup (SUB (q)); + } + } + } + else + { + TABLE (SUB (q)) = a68_new_symbol_table (s); + a68_preliminary_symbol_table_setup (SUB (q)); + } + } + /* WHILE ... DO ... OD are ranges. */ + else if (IS (q, WHILE_SYMBOL)) + { + TABLE_T *u = a68_new_symbol_table (s); + TABLE (SUB (q)) = u; + a68_preliminary_symbol_table_setup (SUB (q)); + if ((FORWARD (q)) == NO_NODE) + not_a_for_range = true; + else if (IS (q, ALT_DO_SYMBOL)) + { + TABLE (SUB (q)) = a68_new_symbol_table (u); + a68_preliminary_symbol_table_setup (SUB (q)); + } + } + /* ACCESS ... DEF ...POSTLUDE ...FED are ranges. */ + else if (IS (q, ALT_ACCESS_SYMBOL)) + { + TABLE_T *u = a68_new_symbol_table (s); + TABLE (SUB (q)) = u; + a68_preliminary_symbol_table_setup (SUB (q)); + if (NEXT (q) == NO_NODE) + not_a_for_range = true; + else if (IS ((FORWARD (q)), DEF_SYMBOL)) + { + TABLE_T *v = a68_new_symbol_table (u); + TABLE (SUB (q)) = v; + a68_preliminary_symbol_table_setup (SUB (q)); + } + } + /* DEF ... POSTLUDE ... FED are ranges. */ + else if (IS (q, DEF_SYMBOL)) + { + TABLE_T *u = a68_new_symbol_table (s); + PUBLIC_RANGE (u) = true; + TABLE (SUB (q)) = u; + a68_preliminary_symbol_table_setup (SUB (q)); + if (NEXT (q) == NO_NODE) + not_a_for_range = true; + else if (IS ((FORWARD (q)), POSTLUDE_SYMBOL)) + { + TABLE_T *v = a68_new_symbol_table (u); + TABLE (SUB (q)) = v; + a68_preliminary_symbol_table_setup (SUB (q)); + } + } + /* ACCESS ... CONTROLLED_CLAUSE are ranges. */ + else if (IS (q, ACCESS_SYMBOL)) + { + TABLE_T *u = a68_new_symbol_table (s); + TABLE (SUB (q)) = u; + a68_preliminary_symbol_table_setup (SUB (q)); + if (NEXT (q) == NO_NODE) + not_a_for_range = true; + } + else + { + TABLE (SUB (q)) = s; + a68_preliminary_symbol_table_setup (SUB (q)); + } + } + } + /* FOR identifiers will go to the DO ... OD range. */ + if (!not_a_for_range) + { + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, FOR_SYMBOL)) + { + NODE_T *r = q; + TABLE (NEXT (q)) = NO_TABLE; + for (; r != NO_NODE && TABLE (NEXT (q)) == NO_TABLE; FORWARD (r)) + { + if ((a68_is_one_of (r, WHILE_SYMBOL, ALT_DO_SYMBOL, STOP)) + && (NEXT (q) != NO_NODE && SUB (r) != NO_NODE)) + { + TABLE (NEXT (q)) = TABLE (SUB (r)); + SEQUENCE (NEXT (q)) = SUB (r); + } + } + } + } + } +} + +/* Mark a mode as in use. */ + +static void +mark_mode (MOID_T *m) +{ + if (m != NO_MOID && USE (m) == false) + { + PACK_T *p = PACK (m); + USE (m) = true; + for (; p != NO_PACK; FORWARD (p)) + { + mark_mode (MOID (p)); + mark_mode (SUB (m)); + mark_mode (SLICE (m)); + } + } +} + +//! @brief Traverse tree and mark modes as used. + +void +a68_mark_moids (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + a68_mark_moids (SUB (p)); + if (MOID (p) != NO_MOID) + mark_mode (MOID (p)); + } +} + +/* Mark various tags as used. */ + +void +a68_mark_auxilliary (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (SUB (p) != NO_NODE) + { + /* You get no warnings on unused PROC parameters. That is ok since + A68 has some parameters that you may not use at all - think of + PROC (REF FILE) BOOL event routines in transput. */ + a68_mark_auxilliary (SUB (p)); + } + else if (IS (p, OPERATOR)) + { + TAG_T *z; + + if (TAX (p) != NO_TAG) + USE (TAX (p)) = true; + + if ((z = a68_find_tag_global (TABLE (p), PRIO_SYMBOL, NSYMBOL (p))) != NO_TAG) + USE (z) = true; + } + else if (IS (p, INDICANT)) + { + TAG_T *z = a68_find_tag_global (TABLE (p), INDICANT, NSYMBOL (p)); + + if (z != NO_TAG) + { + TAX (p) = z; + USE (z) = true; + } + } + else if (IS (p, IDENTIFIER)) + { + if (TAX (p) != NO_TAG) + USE (TAX (p)) = true; + } + } +} + +/* Check a single tag. */ + +static void +unused (TAG_T *s) +{ + for (; s != NO_TAG; FORWARD (s)) + { + if (LINE_NUMBER (NODE (s)) > 0 && !USE (s)) + a68_warning (NODE (s), OPT_Wunused, "tag S is not used", NODE (s)); + } +} + +/* Driver for traversing tree and warn for unused tags. */ + +void +a68_warn_for_unused_tags (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (SUB (p) != NO_NODE) + { + if (a68_is_new_lexical_level (p)) + { + unused (MODULES (TABLE (SUB (p)))); + unused (OPERATORS (TABLE (SUB (p)))); + unused (PRIO (TABLE (SUB (p)))); + unused (IDENTIFIERS (TABLE (SUB (p)))); + unused (LABELS (TABLE (SUB (p)))); + unused (INDICANTS (TABLE (SUB (p)))); + } + } + a68_warn_for_unused_tags (SUB (p)); + } +} + +/* Mark jumps and procedured jumps. */ + +void +a68_jumps_from_procs (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, PROCEDURING)) + { + NODE_T *u = SUB_SUB (p); + + if (IS (u, GOTO_SYMBOL)) + FORWARD (u); + USE (TAX (u)) = true; + } + else if (IS (p, JUMP)) + { + NODE_T *u = SUB (p); + + if (IS (u, GOTO_SYMBOL)) + FORWARD (u); + if ((TAX (u) == NO_TAG) && (MOID (u) == NO_MOID) + && (a68_find_tag_global (TABLE (u), LABEL, NSYMBOL (u)) == NO_TAG)) + { + (void) a68_add_tag (TABLE (u), LABEL, u, NO_MOID, LOCAL_LABEL); + a68_error (u, "tag S has not been declared properly"); + } + else + USE (TAX (u)) = true; + } + else + a68_jumps_from_procs (SUB (p)); + } +} From 9b33d117f850adcd67d5b1ed64209991224c0451 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:49:55 +0200 Subject: [PATCH 159/373] a68: parser: static scope checker Signed-off-by: Jose E. Marchesi Co-authored-by: Marcel van der Veer --- gcc/algol68/a68-parser-scope.cc | 986 ++++++++++++++++++++++++++++++++ 1 file changed, 986 insertions(+) create mode 100644 gcc/algol68/a68-parser-scope.cc diff --git a/gcc/algol68/a68-parser-scope.cc b/gcc/algol68/a68-parser-scope.cc new file mode 100644 index 000000000000..ad542ed3a150 --- /dev/null +++ b/gcc/algol68/a68-parser-scope.cc @@ -0,0 +1,986 @@ +/* Static scope checker. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +/* A static scope checker inspects the source. Note that ALGOL 68 also needs + dynamic scope checking. This phase concludes the parser. */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "options.h" + +#include "a68.h" + +typedef struct TUPLE_T TUPLE_T; +typedef struct SCOPE_T SCOPE_T; + +struct TUPLE_T +{ + int level; + bool transient; +}; + +struct SCOPE_T +{ + NODE_T *where; + TUPLE_T tuple; + SCOPE_T *next; +}; + +enum { NOT_TRANSIENT = 0, TRANSIENT }; + +static void gather_scopes_for_youngest (NODE_T *, SCOPE_T **); +static void scope_statement (NODE_T *, SCOPE_T **); +static void scope_enclosed_clause (NODE_T *, SCOPE_T **); +static void scope_formula (NODE_T *, SCOPE_T **); +static void scope_routine_text (NODE_T *, SCOPE_T **); + +/* + * Static scope checker. + */ + +/* Scope_make_tuple. */ + +static TUPLE_T +scope_make_tuple (int e, int t) +{ + static TUPLE_T z; + LEVEL (&z) = e; + TRANSIENT (&z) = t; + return z; +} + +/* Link scope information into the list. */ + +static void +scope_add (SCOPE_T **sl, NODE_T *p, TUPLE_T tup) +{ + if (sl != NO_VAR) + { + SCOPE_T *ns = (SCOPE_T *) xmalloc (sizeof (SCOPE_T)); + WHERE (ns) = p; + TUPLE (ns) = tup; + NEXT (ns) = *sl; + *sl = ns; + } +} + +/* Scope_check. */ + +static bool +scope_check (SCOPE_T *top, int mask, int dest) +{ + int errors = 0; + + /* Transient names cannot be stored. */ + if (mask & TRANSIENT) + { + for (SCOPE_T *s = top; s != NO_SCOPE; FORWARD (s)) + { + if (TRANSIENT (&TUPLE (s)) & TRANSIENT) + { + a68_error (WHERE (s), "attempt at storing a transient name"); + STATUS_SET (WHERE (s), SCOPE_ERROR_MASK); + errors++; + } + } + } + + /* Potential scope violations. */ + for (SCOPE_T *s = top; s != NO_SCOPE; FORWARD (s)) + { + if (dest < LEVEL (&TUPLE (s)) && !STATUS_TEST (WHERE (s), SCOPE_ERROR_MASK)) + { + MOID_T *ws = MOID (WHERE (s)); + + if (ws != NO_MOID) + { + if (IS_REF (ws) || IS (ws, PROC_SYMBOL) || IS (ws, FORMAT_SYMBOL) || IS (ws, UNION_SYMBOL)) + a68_warning (WHERE (s), OPT_Wscope, "M A is a potential scope violation", + MOID (WHERE (s)), ATTRIBUTE (WHERE (s))); + } + STATUS_SET (WHERE (s), SCOPE_ERROR_MASK); + errors++; + } + } + return (errors == 0); +} + +/* Scope_check_multiple. */ + +static bool +scope_check_multiple (SCOPE_T *top, int mask, SCOPE_T *dest) +{ + bool no_err = true; + + for (; dest != NO_SCOPE; FORWARD (dest)) + no_err = no_err && scope_check (top, mask, LEVEL (&TUPLE (dest))); + return no_err; +} + +/* Check_identifier_usage. */ + +static void +check_identifier_usage (TAG_T *t, NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, IDENTIFIER) && TAX (p) == t && ATTRIBUTE (MOID (t)) != PROC_SYMBOL) + a68_warning (p, OPT_Wuninitialized, "identifier S might be used uninitialised"); + check_identifier_usage (t, SUB (p)); + } +} + +/* Scope_find_youngest_outside. */ + +static TUPLE_T +scope_find_youngest_outside (SCOPE_T *s, int treshold) +{ + TUPLE_T z = scope_make_tuple (PRIMAL_SCOPE, NOT_TRANSIENT); + + for (; s != NO_SCOPE; FORWARD (s)) + { + if (LEVEL (&TUPLE (s)) > LEVEL (&z) && LEVEL (&TUPLE (s)) <= treshold) + z = TUPLE (s); + } + return z; +} + +/* Scope_find_youngest. */ + +static TUPLE_T +scope_find_youngest (SCOPE_T *s) +{ + return scope_find_youngest_outside (s, INT_MAX); +} + +/* + * Routines for determining scope of ROUTINE TEXT or FORMAT TEXT. + */ + +/* Get_declarer_elements. */ + +static void +get_declarer_elements (NODE_T *p, SCOPE_T **r, bool no_ref) +{ + if (p != NO_NODE) + { + if (IS (p, BOUNDS)) + gather_scopes_for_youngest (SUB (p), r); + else if (IS (p, INDICANT)) + { + if (MOID (p) != NO_MOID && TAX (p) != NO_TAG && HAS_ROWS (MOID (p)) && no_ref) + scope_add (r, p, scope_make_tuple (TAG_LEX_LEVEL (TAX (p)), NOT_TRANSIENT)); + } + else if (IS_REF (p)) + get_declarer_elements (NEXT (p), r, false); + else if (a68_is_one_of (p, PROC_SYMBOL, UNION_SYMBOL, STOP)) + ; + else + { + get_declarer_elements (SUB (p), r, no_ref); + get_declarer_elements (NEXT (p), r, no_ref); + } + } +} + +/* Gather_scopes_for_youngest. */ + +static void +gather_scopes_for_youngest (NODE_T *p, SCOPE_T **s) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if ((a68_is_one_of (p, ROUTINE_TEXT, FORMAT_TEXT, STOP)) + && (YOUNGEST_ENVIRON (TAX (p)) == PRIMAL_SCOPE)) + { + SCOPE_T *t = NO_SCOPE; + TUPLE_T tup; + + gather_scopes_for_youngest (SUB (p), &t); + tup = scope_find_youngest_outside (t, LEX_LEVEL (p)); + YOUNGEST_ENVIRON (TAX (p)) = LEVEL (&tup); + /* Direct link into list iso "gather_scopes_for_youngest (SUB (p), + s);". */ + if (t != NO_SCOPE) + { + SCOPE_T *u = t; + while (NEXT (u) != NO_SCOPE) { + FORWARD (u); + } + NEXT (u) = *s; + (*s) = t; + } + } + else if (a68_is_one_of (p, IDENTIFIER, OPERATOR, STOP)) + { + if (TAX (p) != NO_TAG && TAG_LEX_LEVEL (TAX (p)) != PRIMAL_SCOPE) + scope_add (s, p, scope_make_tuple (TAG_LEX_LEVEL (TAX (p)), NOT_TRANSIENT)); + } + else if (IS (p, DECLARER)) + get_declarer_elements (p, s, true); + else + gather_scopes_for_youngest (SUB (p), s); + } +} + +/* Get_youngest_environs. */ + +static void +get_youngest_environs (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (a68_is_one_of (p, ROUTINE_TEXT, FORMAT_TEXT, STOP)) + { + SCOPE_T *s = NO_SCOPE; + TUPLE_T tup; + gather_scopes_for_youngest (SUB (p), &s); + tup = scope_find_youngest_outside (s, LEX_LEVEL (p)); + YOUNGEST_ENVIRON (TAX (p)) = LEVEL (&tup); + } + else + get_youngest_environs (SUB (p)); + } +} + +/* Bind_scope_to_tag. */ + +static void +bind_scope_to_tag (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, DEFINING_IDENTIFIER) && MOID (p) == M_FORMAT) + { + if (IS (NEXT_NEXT (p), FORMAT_TEXT)) + { + SCOPE (TAX (p)) = YOUNGEST_ENVIRON (TAX (NEXT_NEXT (p))); + SCOPE_ASSIGNED (TAX (p)) = true; + } + return; + } + else if (IS (p, DEFINING_IDENTIFIER)) + { + if (IS (NEXT_NEXT (p), ROUTINE_TEXT)) + { + SCOPE (TAX (p)) = YOUNGEST_ENVIRON (TAX (NEXT_NEXT (p))); + SCOPE_ASSIGNED (TAX (p)) = true; + } + return; + } + else + bind_scope_to_tag (SUB (p)); + } +} + +/* Bind_scope_to_tags. */ + +static void +bind_scope_to_tags (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (a68_is_one_of (p, PROCEDURE_DECLARATION, IDENTITY_DECLARATION, STOP)) + bind_scope_to_tag (SUB (p)); + else + bind_scope_to_tags (SUB (p)); + } +} + +/* Scope_bounds. */ + +static void +scope_bounds (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, UNIT)) + scope_statement (p, NO_VAR); + else + scope_bounds (SUB (p)); + } +} + +/* Scope_declarer. */ + +static void +scope_declarer (NODE_T *p) +{ + if (p != NO_NODE) + { + if (IS (p, BOUNDS)) + scope_bounds (SUB (p)); + else if (IS (p, INDICANT)) + ; + else if (IS_REF (p)) + scope_declarer (NEXT (p)); + else if (a68_is_one_of (p, PROC_SYMBOL, UNION_SYMBOL, STOP)) + ; + else + { + scope_declarer (SUB (p)); + scope_declarer (NEXT (p)); + } + } +} + +/* Scope_identity_declaration. */ + +static void +scope_identity_declaration (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + scope_identity_declaration (SUB (p)); + + if (IS (p, DEFINING_IDENTIFIER)) + { + NODE_T *unit = NEXT_NEXT (p); + SCOPE_T *s = NO_SCOPE; + TUPLE_T tup; + int z = PRIMAL_SCOPE; + + if (ATTRIBUTE (MOID (TAX (p))) != PROC_SYMBOL) + check_identifier_usage (TAX (p), unit); + scope_statement (unit, &s); + (void) scope_check (s, TRANSIENT, LEX_LEVEL (p)); + tup = scope_find_youngest (s); + z = LEVEL (&tup); + if (z < LEX_LEVEL (p)) + { + SCOPE (TAX (p)) = z; + SCOPE_ASSIGNED (TAX (p)) = true; + } + return; + } + } +} + +/* Scope_variable_declaration. */ + +static void +scope_variable_declaration (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + scope_variable_declaration (SUB (p)); + if (IS (p, DECLARER)) + scope_declarer (SUB (p)); + else if (IS (p, DEFINING_IDENTIFIER)) + { + if (a68_whether (p, DEFINING_IDENTIFIER, ASSIGN_SYMBOL, UNIT, STOP)) + { + NODE_T *unit = NEXT_NEXT (p); + SCOPE_T *s = NO_SCOPE; + check_identifier_usage (TAX (p), unit); + scope_statement (unit, &s); + (void) scope_check (s, TRANSIENT, LEX_LEVEL (p)); + return; + } + } + } +} + +/* Scope_procedure_declaration. */ + +static void +scope_procedure_declaration (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + scope_procedure_declaration (SUB (p)); + + if (a68_is_one_of (p, DEFINING_IDENTIFIER, DEFINING_OPERATOR, STOP)) + { + NODE_T *unit = NEXT_NEXT (p); + SCOPE_T *s = NO_SCOPE; + + scope_statement (unit, &s); + (void) scope_check (s, NOT_TRANSIENT, LEX_LEVEL (p)); + return; + } + } +} + +/* Scope_declaration_list. */ + +static void +scope_declaration_list (NODE_T *p) +{ + if (p != NO_NODE) + { + if (IS (p, IDENTITY_DECLARATION)) + scope_identity_declaration (SUB (p)); + else if (IS (p, VARIABLE_DECLARATION)) + scope_variable_declaration (SUB (p)); + else if (IS (p, MODE_DECLARATION)) + scope_declarer (SUB (p)); + else if (IS (p, PRIORITY_DECLARATION)) + ; + else if (IS (p, PROCEDURE_DECLARATION)) + scope_procedure_declaration (SUB (p)); + else if (IS (p, PROCEDURE_VARIABLE_DECLARATION)) + scope_procedure_declaration (SUB (p)); + else if (a68_is_one_of (p, BRIEF_OPERATOR_DECLARATION, OPERATOR_DECLARATION, STOP)) + scope_procedure_declaration (SUB (p)); + else + { + scope_declaration_list (SUB (p)); + scope_declaration_list (NEXT (p)); + } + } +} + +/* Scope_arguments. */ + +static void +scope_arguments (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, UNIT)) + { + SCOPE_T *s = NO_SCOPE; + scope_statement (p, &s); + (void) scope_check (s, TRANSIENT, LEX_LEVEL (p)); + } + else + scope_arguments (SUB (p)); + } +} + +/* Is_coercion. */ + +static bool +is_coercion (NODE_T *p) +{ + if (p != NO_NODE) + { + switch (ATTRIBUTE (p)) + { + case DEPROCEDURING: + case DEREFERENCING: + case UNITING: + case ROWING: + case WIDENING: + case VOIDING: + case PROCEDURING: + return true; + default: + return false; + } + } + else + return false; +} + +/* Scope_coercion. */ + +static void +scope_coercion (NODE_T *p, SCOPE_T **s) +{ + if (is_coercion (p)) + { + if (IS (p, VOIDING)) + scope_coercion (SUB (p), NO_VAR); + else if (IS (p, DEREFERENCING)) + /* Leave this to the dynamic scope checker. */ + scope_coercion (SUB (p), NO_VAR); + else if (IS (p, DEPROCEDURING)) + scope_coercion (SUB (p), NO_VAR); + else if (IS (p, ROWING)) + { + SCOPE_T *z = NO_SCOPE; + + scope_coercion (SUB (p), &z); + (void) scope_check (z, TRANSIENT, LEX_LEVEL (p)); + if (IS_REF_FLEX (MOID (SUB (p)))) + scope_add (s, p, scope_make_tuple (LEX_LEVEL (p), TRANSIENT)); + else + scope_add (s, p, scope_make_tuple (LEX_LEVEL (p), NOT_TRANSIENT)); + } + else if (IS (p, PROCEDURING)) + { + /* Can only be a JUMP. */ + NODE_T *q = SUB_SUB (p); + if (IS (q, GOTO_SYMBOL)) + FORWARD (q); + + scope_add (s, q, scope_make_tuple (TAG_LEX_LEVEL (TAX (q)), NOT_TRANSIENT)); + } + else if (IS (p, UNITING)) + { + SCOPE_T *z = NO_SCOPE; + + scope_coercion (SUB (p), &z); + if (z != NO_SCOPE) + { + (void) scope_check (z, TRANSIENT, LEX_LEVEL (p)); + scope_add (s, p, scope_find_youngest (z)); + } + } + else + scope_coercion (SUB (p), s); + } + else + scope_statement (p, s); +} + +/* Scope_format_text. */ + +static void +scope_format_text (NODE_T *p, SCOPE_T **s) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, FORMAT_PATTERN)) + scope_enclosed_clause (SUB (NEXT_SUB (p)), s); + else if (IS (p, FORMAT_ITEM_G) && NEXT (p) != NO_NODE) + scope_enclosed_clause (SUB_NEXT (p), s); + else if (IS (p, DYNAMIC_REPLICATOR)) + scope_enclosed_clause (SUB (NEXT_SUB (p)), s); + else + scope_format_text (SUB (p), s); + } +} + +/* Scope_operand. */ + +static void +scope_operand (NODE_T *p, SCOPE_T **s) +{ + if (IS (p, MONADIC_FORMULA)) + scope_operand (NEXT_SUB (p), s); + else if (IS (p, FORMULA)) + scope_formula (p, s); + else if (IS (p, SECONDARY)) + scope_statement (SUB (p), s); +} + +/* Scope_formula. */ + +static void +scope_formula (NODE_T *p, SCOPE_T **s) +{ + NODE_T *q = SUB (p); + SCOPE_T *s2 = NO_SCOPE; + + scope_operand (q, &s2); + (void) scope_check (s2, TRANSIENT, LEX_LEVEL (p)); + if (NEXT (q) != NO_NODE) + { + SCOPE_T *s3 = NO_SCOPE; + scope_operand (NEXT_NEXT (q), &s3); + (void) scope_check (s3, TRANSIENT, LEX_LEVEL (p)); + } + (void) s; +} + +/* Scope_routine_text. */ + +static void +scope_routine_text (NODE_T *p, SCOPE_T **s) +{ + NODE_T *q = SUB (p); + NODE_T *routine = (IS (q, PARAMETER_PACK) ? NEXT (q) : q); + SCOPE_T *x = NO_SCOPE; + + scope_statement (NEXT_NEXT (routine), &x); + (void) scope_check (x, TRANSIENT, LEX_LEVEL (p)); + TUPLE_T routine_tuple = scope_make_tuple (YOUNGEST_ENVIRON (TAX (p)), NOT_TRANSIENT); + scope_add (s, p, routine_tuple); +} + +/* Scope_statement. */ + +static void +scope_statement (NODE_T *p, SCOPE_T **s) +{ + if (is_coercion (p)) + scope_coercion (p, s); + else if (a68_is_one_of (p, PRIMARY, SECONDARY, TERTIARY, UNIT, STOP)) + scope_statement (SUB (p), s); + else if (a68_is_one_of (p, NIHIL, STOP)) + scope_add (s, p, scope_make_tuple (PRIMAL_SCOPE, NOT_TRANSIENT)); + else if (IS (p, DENOTATION)) + ; + else if (IS (p, IDENTIFIER)) + { + if (IS_REF (MOID (p))) + { + if (PRIO (TAX (p)) == PARAMETER_IDENTIFIER) + scope_add (s, p, scope_make_tuple (TAG_LEX_LEVEL (TAX (p)) - 1, NOT_TRANSIENT)); + else + { + if (HEAP (TAX (p)) == HEAP_SYMBOL) + scope_add (s, p, scope_make_tuple (PRIMAL_SCOPE, NOT_TRANSIENT)); + else if (SCOPE_ASSIGNED (TAX (p))) + scope_add (s, p, scope_make_tuple (SCOPE (TAX (p)), NOT_TRANSIENT)); + else + scope_add (s, p, scope_make_tuple (TAG_LEX_LEVEL (TAX (p)), NOT_TRANSIENT)); + } + } + else if (ATTRIBUTE (MOID (p)) == PROC_SYMBOL && SCOPE_ASSIGNED (TAX (p)) == true) + scope_add (s, p, scope_make_tuple (SCOPE (TAX (p)), NOT_TRANSIENT)); + else if (MOID (p) == M_FORMAT && SCOPE_ASSIGNED (TAX (p)) == true) + scope_add (s, p, scope_make_tuple (SCOPE (TAX (p)), NOT_TRANSIENT)); + } + else if (IS (p, ENCLOSED_CLAUSE)) + scope_enclosed_clause (SUB (p), s); + else if (IS (p, CALL)) + { + SCOPE_T *x = NO_SCOPE; + + scope_statement (SUB (p), &x); + (void) scope_check (x, NOT_TRANSIENT, LEX_LEVEL (p)); + scope_arguments (NEXT_SUB (p)); + } + else if (IS (p, SLICE)) + { + SCOPE_T *x = NO_SCOPE; + MOID_T *m = MOID (SUB (p)); + + if (IS_REF (m)) + { + if (ATTRIBUTE (SUB (p)) == PRIMARY && ATTRIBUTE (SUB_SUB (p)) == SLICE) + scope_statement (SUB (p), s); + else + { + scope_statement (SUB (p), &x); + (void) scope_check (x, NOT_TRANSIENT, LEX_LEVEL (p)); + } + if (IS_FLEX (SUB (m))) + scope_add (s, SUB (p), scope_make_tuple (LEX_LEVEL (p), TRANSIENT)); + scope_bounds (SUB (NEXT_SUB (p))); + } + if (IS_REF (MOID (p))) + scope_add (s, p, scope_find_youngest (x)); + } + else if (IS (p, FORMAT_TEXT)) + { + SCOPE_T *x = NO_SCOPE; + scope_format_text (SUB (p), &x); + scope_add (s, p, scope_find_youngest (x)); + } + else if (IS (p, CAST)) + { + SCOPE_T *x = NO_SCOPE; + scope_enclosed_clause (SUB (NEXT_SUB (p)), &x); + (void) scope_check (x, NOT_TRANSIENT, LEX_LEVEL (p)); + scope_add (s, p, scope_find_youngest (x)); + } + else if (IS (p, SELECTION)) + { + SCOPE_T *ns = NO_SCOPE; + scope_statement (NEXT_SUB (p), &ns); + (void) scope_check (ns, NOT_TRANSIENT, LEX_LEVEL (p)); + if (a68_is_ref_refety_flex (MOID (NEXT_SUB (p)))) + scope_add (s, p, scope_make_tuple (LEX_LEVEL (p), TRANSIENT)); + scope_add (s, p, scope_find_youngest (ns)); + } + else if (IS (p, GENERATOR)) + { + if (IS (SUB (p), LOC_SYMBOL)) + { + if (NON_LOCAL (p) != NO_TABLE) + scope_add (s, p, scope_make_tuple (LEVEL (NON_LOCAL (p)), NOT_TRANSIENT)); + else + scope_add (s, p, scope_make_tuple (LEX_LEVEL (p), NOT_TRANSIENT)); + } + else + scope_add (s, p, scope_make_tuple (PRIMAL_SCOPE, NOT_TRANSIENT)); + scope_declarer (SUB (NEXT_SUB (p))); + } + else if (IS (p, FORMULA)) + scope_formula (p, s); + else if (IS (p, ASSIGNATION)) + { + NODE_T *unit = NEXT (NEXT_SUB (p)); + SCOPE_T *ns = NO_SCOPE, *nd = NO_SCOPE; + TUPLE_T tup; + scope_statement (SUB_SUB (p), &nd); + scope_statement (unit, &ns); + (void) scope_check_multiple (ns, TRANSIENT, nd); + tup = scope_find_youngest (nd); + scope_add (s, p, scope_make_tuple (LEVEL (&tup), NOT_TRANSIENT)); + } + else if (IS (p, ROUTINE_TEXT)) + scope_routine_text (p, s); + else if (a68_is_one_of (p, IDENTITY_RELATION, AND_FUNCTION, OR_FUNCTION, STOP)) + { + SCOPE_T *n = NO_SCOPE; + scope_statement (SUB (p), &n); + scope_statement (NEXT (NEXT_SUB (p)), &n); + (void) scope_check (n, NOT_TRANSIENT, LEX_LEVEL (p)); + } + else if (IS (p, ASSERTION)) + { + SCOPE_T *n = NO_SCOPE; + scope_enclosed_clause (SUB (NEXT_SUB (p)), &n); + (void) scope_check (n, NOT_TRANSIENT, LEX_LEVEL (p)); + } + else if (a68_is_one_of (p, JUMP, SKIP, STOP)) + { + ; + } +} + +/* Scope_statement_list. */ + +static void +scope_statement_list (NODE_T *p, SCOPE_T **s) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, UNIT)) + scope_statement (p, s); + else + scope_statement_list (SUB (p), s); + } +} + +/* Scope_serial_clause. */ + +static void +scope_serial_clause (NODE_T *p, SCOPE_T **s, bool terminator) +{ + if (p != NO_NODE) + { + if (IS (p, INITIALISER_SERIES)) + { + scope_serial_clause (SUB (p), s, false); + scope_serial_clause (NEXT (p), s, terminator); + } + else if (IS (p, DECLARATION_LIST)) + scope_declaration_list (SUB (p)); + else if (a68_is_one_of (p, LABEL, SEMI_SYMBOL, EXIT_SYMBOL, STOP)) + scope_serial_clause (NEXT (p), s, terminator); + else if (a68_is_one_of (p, SERIAL_CLAUSE, ENQUIRY_CLAUSE, STOP)) + { + if (NEXT (p) != NO_NODE) + { + int j = ATTRIBUTE (NEXT (p)); + if (j == EXIT_SYMBOL || j == END_SYMBOL || j == CLOSE_SYMBOL) + scope_serial_clause (SUB (p), s, true); + else + scope_serial_clause (SUB (p), s, false); + } + else + scope_serial_clause (SUB (p), s, true); + scope_serial_clause (NEXT (p), s, terminator); + } + else if (IS (p, LABELED_UNIT)) + scope_serial_clause (SUB (p), s, terminator); + else if (IS (p, UNIT)) + { + if (terminator) + scope_statement (p, s); + else + scope_statement (p, NO_VAR); + } + } +} + +/* Scope_closed_clause. */ + +static void +scope_closed_clause (NODE_T *p, SCOPE_T **s) +{ + if (p != NO_NODE) + { + if (IS (p, SERIAL_CLAUSE)) + scope_serial_clause (p, s, true); + else if (a68_is_one_of (p, OPEN_SYMBOL, BEGIN_SYMBOL, STOP)) + scope_closed_clause (NEXT (p), s); + } +} + +/* Scope_collateral_clause. */ + +static void +scope_collateral_clause (NODE_T *p, SCOPE_T **s) +{ + if (p != NO_NODE) + { + if (!(a68_whether (p, BEGIN_SYMBOL, END_SYMBOL, STOP) + || a68_whether (p, OPEN_SYMBOL, CLOSE_SYMBOL, STOP))) + { + scope_statement_list (p, s); + } + } +} + +/* Scope_conditional_clause. */ + +static void +scope_conditional_clause (NODE_T *p, SCOPE_T **s) +{ + scope_serial_clause (NEXT_SUB (p), NO_VAR, true); + FORWARD (p); + scope_serial_clause (NEXT_SUB (p), s, true); + if ((FORWARD (p)) != NO_NODE) + { + if (a68_is_one_of (p, ELSE_PART, CHOICE, STOP)) + scope_serial_clause (NEXT_SUB (p), s, true); + else if (a68_is_one_of (p, ELIF_PART, BRIEF_ELIF_PART, STOP)) + scope_conditional_clause (SUB (p), s); + } +} + +/* Scope_case_clause. */ + +static void +scope_case_clause (NODE_T *p, SCOPE_T **s) +{ + SCOPE_T *n = NO_SCOPE; + scope_serial_clause (NEXT_SUB (p), &n, true); + (void) scope_check (n, NOT_TRANSIENT, LEX_LEVEL (p)); + FORWARD (p); + scope_statement_list (NEXT_SUB (p), s); + if ((FORWARD (p)) != NO_NODE) + { + if (a68_is_one_of (p, OUT_PART, CHOICE, STOP)) + scope_serial_clause (NEXT_SUB (p), s, true); + else if (a68_is_one_of (p, CASE_OUSE_PART, BRIEF_OUSE_PART, STOP)) + scope_case_clause (SUB (p), s); + else if (a68_is_one_of (p, CONFORMITY_OUSE_PART, BRIEF_CONFORMITY_OUSE_PART, STOP)) + scope_case_clause (SUB (p), s); + } +} + +/* Scope_loop_clause. */ + +static void +scope_loop_clause (NODE_T *p) +{ + if (p != NO_NODE) + { + if (IS (p, FOR_PART)) + scope_loop_clause (NEXT (p)); + else if (a68_is_one_of (p, FROM_PART, BY_PART, TO_PART, STOP)) + { + scope_statement (NEXT_SUB (p), NO_VAR); + scope_loop_clause (NEXT (p)); + } + else if (IS (p, WHILE_PART)) + { + scope_serial_clause (NEXT_SUB (p), NO_VAR, true); + scope_loop_clause (NEXT (p)); + } + else if (a68_is_one_of (p, DO_PART, ALT_DO_PART, STOP)) + { + NODE_T *do_p = NEXT_SUB (p); + + if (IS (do_p, SERIAL_CLAUSE)) + scope_serial_clause (do_p, NO_VAR, true); + } + } +} + +/* Scope_enclosed_clause. */ + +static void +scope_enclosed_clause (NODE_T *p, SCOPE_T **s) +{ + if (IS (p, ENCLOSED_CLAUSE)) + scope_enclosed_clause (SUB (p), s); + else if (IS (p, CLOSED_CLAUSE)) + scope_closed_clause (SUB (p), s); + else if (a68_is_one_of (p, COLLATERAL_CLAUSE, PARALLEL_CLAUSE, STOP)) + scope_collateral_clause (SUB (p), s); + else if (IS (p, CONDITIONAL_CLAUSE)) + scope_conditional_clause (SUB (p), s); + else if (a68_is_one_of (p, CASE_CLAUSE, CONFORMITY_CLAUSE, STOP)) + scope_case_clause (SUB (p), s); + else if (IS (p, LOOP_CLAUSE)) + scope_loop_clause (SUB (p)); +} + +/* Whether a symbol table contains no (anonymous) definition. */ + +static bool +empty_table (TABLE_T * t) +{ + if (IDENTIFIERS (t) == NO_TAG) + return (OPERATORS (t) == NO_TAG && INDICANTS (t) == NO_TAG); + else if (PRIO (IDENTIFIERS (t)) == LOOP_IDENTIFIER && NEXT (IDENTIFIERS (t)) == NO_TAG) + return (OPERATORS (t) == NO_TAG && INDICANTS (t) == NO_TAG); + else if (PRIO (IDENTIFIERS (t)) == SPECIFIER_IDENTIFIER && NEXT (IDENTIFIERS (t)) == NO_TAG) + return (OPERATORS (t) == NO_TAG && INDICANTS (t) == NO_TAG); + else + return false; +} + +/* Indicate non-local environs. */ + +static void +get_non_local_environs (NODE_T *p, int max) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, ROUTINE_TEXT)) + get_non_local_environs (SUB (p), LEX_LEVEL (SUB (p))); + else if (IS (p, FORMAT_TEXT)) + get_non_local_environs (SUB (p), LEX_LEVEL (SUB (p))); + else + { + get_non_local_environs (SUB (p), max); + NON_LOCAL (p) = NO_TABLE; + if (TABLE (p) != NO_TABLE) + { + TABLE_T *q = TABLE (p); + while (q != NO_TABLE && empty_table (q) + && PREVIOUS (q) != NO_TABLE && LEVEL (PREVIOUS (q)) >= max) + { + NON_LOCAL (p) = PREVIOUS (q); + q = PREVIOUS (q); + } + } + } + } +} + +/* The static scope checker. */ + +void +a68_scope_checker (NODE_T *p) +{ + if (SUB (p)) + { + if (IS (SUB (p), PARTICULAR_PROGRAM)) + p = SUB (p); + else if (IS (SUB (p), PRELUDE_PACKET)) + { + /* XXX writeme. */ + return; + } + } + + /* Establish scopes of routine texts and format texts. */ + get_youngest_environs (p); + /* Find non-local environs. */ + get_non_local_environs (p, PRIMAL_SCOPE); + /* PROC and FORMAT identities can now be assigned a scope. */ + bind_scope_to_tags (p); + /* Now check evertyhing else. */ + scope_enclosed_clause (SUB (p), NO_VAR); +} From b95636bf3e0b5c3f5d37dd238d4cc2f4c765b40b Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:50:12 +0200 Subject: [PATCH 160/373] a68: parser: debug facilities Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-parser-debug.cc: New file. --- gcc/algol68/a68-parser-debug.cc | 255 ++++++++++++++++++++++++++++++++ 1 file changed, 255 insertions(+) create mode 100644 gcc/algol68/a68-parser-debug.cc diff --git a/gcc/algol68/a68-parser-debug.cc b/gcc/algol68/a68-parser-debug.cc new file mode 100644 index 000000000000..28646b3f31ad --- /dev/null +++ b/gcc/algol68/a68-parser-debug.cc @@ -0,0 +1,255 @@ +/* Debug facilities for the Algol 68 parser. + Copyright (C) 2025 Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#define INCLUDE_VECTOR +#include "system.h" +#include "coretypes.h" +#include "tree.h" +#include "diagnostic.h" +#include "text-art/types.h" +#include "text-art/dump.h" +#include "text-art/dump-widget-info.h" +#include "text-art/canvas.h" +#include "text-art/theme.h" +#include "text-art/tree-widget.h" + +#include "a68.h" + +/* Write a printable representation of the parse tree with top node P to the + standard output. */ + +static void +a68_dump_parse_tree_1 (NODE_T *p, const text_art::dump_widget_info &dwi, + text_art::tree_widget &widget, bool tables, bool levels) +{ + for (; p != NO_NODE; FORWARD (p)) + { + char *symbol; + if (ATTRIBUTE (p) == IDENTIFIER + || ATTRIBUTE (p) == DEFINING_IDENTIFIER + || ATTRIBUTE (p) == DEFINING_OPERATOR + || ATTRIBUTE (p) == BOLD_TAG) + symbol = xasprintf (" %s", NSYMBOL (p)); + else + symbol = xstrdup (""); + + char *tableinfo; + if (tables && TABLE (p) != NO_TABLE) + tableinfo = xasprintf (" table=%p prev=%p", + (void *) TABLE (p), + (void *) PREVIOUS (TABLE (p))); + else + tableinfo = xstrdup (""); + + char *levelsinfo; + if (levels && TABLE (p) != NO_TABLE) + levelsinfo = xasprintf (" level=%d", LEVEL (TABLE (p))); + else + levelsinfo = xstrdup (""); + + char mode[BUFFER_SIZE]; + mode[0] = '\0'; + if (MOID (p) != NO_MOID) + { + MOID_T *moid = MOID (p); + mode[0] = '\0'; + + a68_bufcat (mode, " (", 2); + if (IS (moid, SERIES_MODE)) + { + if (PACK (moid) != NO_PACK && NEXT (PACK (moid)) == NO_PACK) + a68_bufcat (mode, a68_moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p), + BUFFER_SIZE); + else + a68_bufcat (mode, a68_moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE); + } + else + a68_bufcat (mode, a68_moid_to_string (moid, MOID_ERROR_WIDTH, p), BUFFER_SIZE); + a68_bufcat (mode, ")", 2); + } + + location_t loc = a68_get_node_location (p); + std::unique_ptr cwidget + = text_art::tree_widget::from_fmt (dwi, nullptr, + "%s:%d:%d [%d] %s%s%s%s%s", + LOCATION_FILE (loc), + LOCATION_LINE (loc), + LOCATION_COLUMN (loc), + NUMBER (p), + a68_attribute_name (ATTRIBUTE (p)), + symbol, + mode, + tableinfo, + levelsinfo); + free (symbol); + free (tableinfo); + free (levelsinfo); + + a68_dump_parse_tree_1 (SUB (p), dwi, *cwidget, tables, levels); + widget.add_child (std::move (cwidget)); + } +} + +void +a68_dump_parse_tree (NODE_T *p, bool tables, bool levels) +{ + text_art::style_manager sm; + text_art::style::id_t default_style_id (sm.get_or_create_id (text_art::style ())); + text_art::ascii_theme theme; + text_art::dump_widget_info dwi (sm, theme, default_style_id); + std::unique_ptr widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "Parse Tree"); + + a68_dump_parse_tree_1 (p, dwi, *widget, tables, levels); + + text_art::canvas c (widget->to_canvas (sm)); + pretty_printer *const pp = global_dc->get_reference_printer (); + pp_clear_output_area (pp); + c.print_to_pp (pp); + printf ("%s", pp_formatted_text (pp)); +} + +/* Dump the modes in the list MOID. */ + +void +a68_dump_modes (MOID_T *moid) +{ + for (; moid != NO_MOID; FORWARD (moid)) + { + printf ("%p %s\n", (void *) moid, + a68_moid_to_string (moid, MOID_ERROR_WIDTH, NODE (moid), + true /* indicant_value */)); + } +} + +/* Dump a given MOIF. */ + +void +a68_dump_moif (MOIF_T *moif) +{ + text_art::style_manager sm; + text_art::style::id_t default_style_id (sm.get_or_create_id (text_art::style ())); + text_art::ascii_theme theme; + text_art::dump_widget_info dwi (sm, theme, default_style_id); + std::unique_ptr widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "module interface: %s", NAME (moif)); + + std::unique_ptr prelude_widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "prelude: %s", PRELUDE (moif)); + widget->add_child (std::move (prelude_widget)); + + std::unique_ptr postlude_widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "postlude: %s", POSTLUDE (moif)); + widget->add_child (std::move (postlude_widget)); + + /* Mode table. */ + std::unique_ptr modes_widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "modes"); + for (MOID_T *mode : MODES (moif)) + { + const char *asm_label = ASM_LABEL (mode); + if (asm_label == NULL) + asm_label = a68_moid_to_string (mode, 80, NO_NODE, false); + std::unique_ptr mode_widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "mode: %s: %s", + asm_label, + a68_moid_to_string (mode, 80, NO_NODE, true)); + modes_widget->add_child (std::move (mode_widget)); + } + widget->add_child (std::move (modes_widget)); + + /* Module extracts. */ + std::unique_ptr mod_extracts_widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "module extracts"); + for (EXTRACT_T *e : MODULES (moif)) + { + std::unique_ptr mod_extract_widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "module extract: %s", EXTRACT_SYMBOL (e)); + mod_extracts_widget->add_child (std::move (mod_extract_widget)); + } + widget->add_child (std::move (mod_extracts_widget)); + + /* Mode extracts. */ + std::unique_ptr mode_extracts_widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "mode extracts"); + for (EXTRACT_T *e : INDICANTS (moif)) + { + const char *asm_label = ASM_LABEL (EXTRACT_MODE (e)); + if (asm_label == NULL) + asm_label = a68_moid_to_string (EXTRACT_MODE (e), 80, NO_NODE, false); + std::unique_ptr mode_extract_widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "mode extract: %s [%s]", + EXTRACT_SYMBOL (e), asm_label); + mode_extracts_widget->add_child (std::move (mode_extract_widget)); + } + widget->add_child (std::move (mode_extracts_widget)); + + /* Priority extracts. */ + std::unique_ptr prio_extracts_widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "prio extracts"); + for (EXTRACT_T *e : PRIOS (moif)) + { + std::unique_ptr prio_extract_widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "prio extract: %s [prio: %d]", + EXTRACT_SYMBOL (e), EXTRACT_PRIO (e)); + prio_extracts_widget->add_child (std::move (prio_extract_widget)); + } + widget->add_child (std::move (prio_extracts_widget)); + + /* Identifier extracts. */ + std::unique_ptr id_extracts_widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "identifier extracts"); + for (EXTRACT_T *e : IDENTIFIERS (moif)) + { + const char *asm_label = ASM_LABEL (EXTRACT_MODE (e)); + if (asm_label == NULL) + asm_label = a68_moid_to_string (EXTRACT_MODE (e), 80, NO_NODE, false); + std::unique_ptr id_extract_widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "iden extract: %s [%s] variable=%d inproc=%d", + EXTRACT_SYMBOL (e), asm_label, + EXTRACT_VARIABLE (e), + EXTRACT_IN_PROC (e)); + id_extracts_widget->add_child (std::move (id_extract_widget)); + } + widget->add_child (std::move (id_extracts_widget)); + + /* Operator extracts. */ + std::unique_ptr op_extracts_widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "operator extracts"); + for (EXTRACT_T *e : OPERATORS (moif)) + { + const char *asm_label = ASM_LABEL (EXTRACT_MODE (e)); + if (asm_label == NULL) + asm_label = a68_moid_to_string (EXTRACT_MODE (e), 80, NO_NODE, false); + + std::unique_ptr op_extract_widget + = text_art::tree_widget::from_fmt (dwi, nullptr, "op extract: %s [%s] variable=%d inproc=%d", + EXTRACT_SYMBOL (e), asm_label, + EXTRACT_VARIABLE (e), + EXTRACT_IN_PROC (e)); + op_extracts_widget->add_child (std::move (op_extract_widget)); + } + widget->add_child (std::move (op_extracts_widget)); + + text_art::canvas c (widget->to_canvas (sm)); + pretty_printer *const pp = global_dc->get_reference_printer (); + pp_clear_output_area (pp); + c.print_to_pp (pp); + printf ("%s", pp_formatted_text (pp)); +} From ef7c6104e5afce9ad8b1112ac21875d2856e0254 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:50:32 +0200 Subject: [PATCH 161/373] a68: parser: extraction of tags from phrases Signed-off-by: Jose E. Marchesi Co-authored-by: Marcel van der Veer --- gcc/algol68/a68-parser-extract.cc | 895 ++++++++++++++++++++++++++++++ 1 file changed, 895 insertions(+) create mode 100644 gcc/algol68/a68-parser-extract.cc diff --git a/gcc/algol68/a68-parser-extract.cc b/gcc/algol68/a68-parser-extract.cc new file mode 100644 index 000000000000..e6474e9c744c --- /dev/null +++ b/gcc/algol68/a68-parser-extract.cc @@ -0,0 +1,895 @@ +/* Extract tags from phrases. + Copyright (C) 2001-2023 J. Marcel van der Veer. + Copyright (C) 2025 Jose E. Marchesi. + + Original implementation by J. Marcel van der Veer. + Adapted for GCC by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "a68.h" + +/* This is part of the bottom-up parser. Here is a set of routines that gather + definitions from phrases. This way we can apply tags before defining them. + These routines do not look very elegant as they have to scan through all kind + of symbols to find a pattern that they recognise. */ + +/* Insert alt equals symbol. */ + +static void +insert_alt_equals (NODE_T *p) +{ + NODE_T *q = a68_new_node (); + *q = *p; + INFO (q) = a68_new_node_info (); + *INFO (q) = *INFO (p); + GINFO (q) = a68_new_genie_info (); + *GINFO (q) = *GINFO (p); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + NSYMBOL (q) = TEXT (a68_add_token (&A68 (top_token), "=")); + NEXT (p) = q; + PREVIOUS (q) = p; + if (NEXT (q) != NO_NODE) + PREVIOUS (NEXT (q)) = q; +} + +/* Detect redefined keyword. */ + +static void +detect_redefined_keyword (NODE_T *p, int construct) +{ + if (p != NO_NODE && a68_whether (p, KEYWORD, EQUALS_SYMBOL, STOP)) + a68_error (p, "attempt to redefine keyword Y in A", + NSYMBOL (p), construct); +} + +/* Skip anything until a FED or ALT_ACCESS_SYMBOL is found. */ + +static NODE_T * +skip_module_text (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, FED_SYMBOL) || IS (p, ALT_ACCESS_SYMBOL)) + return p; + } + + return NO_NODE; +} + +/* Skip anything until a comma, semicolon or EXIT is found. */ + +static NODE_T * +skip_unit (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, COMMA_SYMBOL)) + return p; + else if (IS (p, SEMI_SYMBOL)) + return p; + else if (IS (p, EXIT_SYMBOL)) + return p; + } + return NO_NODE; +} + +/* Attribute of entry in symbol table. */ + +static int +find_tag_definition (TABLE_T *table, const char *name) +{ + if (table != NO_TABLE) + { + int ret = 0; + bool found = false; + for (TAG_T *s = INDICANTS (table); s != NO_TAG && !found; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + { + ret += INDICANT; + found = true; + } + } + found = false; + for (TAG_T *s = OPERATORS (table); s != NO_TAG && !found; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + { + ret += OPERATOR; + found = true; + } + } + found = false; + for (TAG_T *s = MODULES (table); s != NO_TAG && !found; FORWARD (s)) + { + if (NSYMBOL (NODE (s)) == name || strcmp (NSYMBOL (NODE (s)), name) == 0) + { + ret += MODULE_INDICANT; + found = true; + } + } + + if (ret == 0) + return find_tag_definition (PREVIOUS (table), name); + else + return ret; + } + else + return 0; +} + +/* Fill in whether bold tag is operator, indicant or module indicant. */ + +void +a68_elaborate_bold_tags (NODE_T *p) +{ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, BOLD_TAG)) + { + switch (find_tag_definition (TABLE (q), NSYMBOL (q))) + { + case 0: + a68_error (q, "tag S has not been declared properly"); + break; + case INDICANT: + ATTRIBUTE (q) = INDICANT; + break; + case OPERATOR: + ATTRIBUTE (q) = OPERATOR; + break; + case MODULE_INDICANT: + ATTRIBUTE (q) = MODULE_INDICANT; + break; + } + } + } +} + +/* Skip declarer, or argument pack and declarer. */ + +static NODE_T * +skip_pack_declarer (NODE_T *p) +{ + /* Skip () REF [] REF FLEX [] [] ... */ + while (p != NO_NODE + && (a68_is_one_of (p, SUB_SYMBOL, OPEN_SYMBOL, REF_SYMBOL, + FLEX_SYMBOL, SHORT_SYMBOL, LONG_SYMBOL, STOP))) + { + FORWARD (p); + } + + /* Skip STRUCT (), UNION () or PROC [()]. */ + if (p != NO_NODE && (a68_is_one_of (p, STRUCT_SYMBOL, UNION_SYMBOL, STOP))) + return NEXT (p); + else if (p != NO_NODE && IS (p, PROC_SYMBOL)) + return skip_pack_declarer (NEXT (p)); + else + return p; +} + +/* Extract a revelation. */ + +static void +extract_revelation (NODE_T *q, bool is_public ATTRIBUTE_UNUSED) +{ + /* Store in the symbol table. */ + TAG_T *tag = a68_add_tag (TABLE (q), MODULE_SYMBOL, q, NO_MOID, STOP); + gcc_assert (tag != NO_TAG); + EXPORTED (tag) = false; // XXX depends on PUB! + /* Import the MOIF and install it in the tag. */ + MOIF_T *moif = a68_open_packet (NSYMBOL (q)); + if (moif == NULL) + { + a68_error (q, "cannot find module Z", NSYMBOL (q)); + return; + } + MOIF (tag) = moif; // XXX add to existing list of moifs. + + /* Store all the modes from the MOIF in the moid list. + + The front-end depends on being able to compare any two modes by pointer + value. For example, the parser mode equivalence and coercion code relies + on this. The lowerer also relies on this to make sure the same lowered + trees are used for the same modes. */ + + for (MOID_T *m : MODES (moif)) + { + /* Note that m == NO_MOID if the imported mode was already known to the + compiler and has been replaced. */ + if (m != NO_MOID) + { + MOID_T *r = a68_register_extra_mode (&TOP_MOID (&A68_JOB), m); + if (r != m) + gcc_unreachable (); + } + } + + /* Store mode indicants from the MOIF in the symbol table, + and also in the moid list. */ + for (EXTRACT_T *e : INDICANTS (moif)) + { + /* Indicants stored in the indicants area of a symbol + table are expected to be INDICANT nodes originating in + parsing, with the following subtree: + + INDICANT - EQUALS_SYMBOL - DECLARER + + where MOID (DECLARER) is determined to be the mode + associated by INDICANT, or its "equivalent" mode. + Therefore we have to synthesize something like that + here, since the mode comes from a module interface and + we don't have a declarer tree for it.. */ + + /* INDICANT node. */ + NODE_T *n = a68_some_node (a68_demangle_symbol (NAME (moif), + EXTRACT_SYMBOL (e))); + /* EQUALS_SYMBOL node. */ + NEXT (n) = a68_some_node ("="); + ATTRIBUTE (NEXT (n)) = EQUALS_SYMBOL; + /* DECLARER node. */ + NEXT (NEXT (n)) = a68_some_node (""); + LINE (INFO (n)) = LINE (INFO (q)); + NCHAR_IN_LINE (n) = STRING (LINE (INFO (n))); + MOID (NEXT (NEXT (n))) = EXTRACT_MODE (e); + TABLE (n) = TABLE (q); + + /* Now add the INDICANT subtree to the symbol table of + this access clause lexical level. */ + TAG_T *tag = a68_add_tag (TABLE (q), INDICANT, n, NO_MOID, 0); + gcc_assert (tag != NO_TAG); + + /* Finally add the mode indicant to the moids list. Note + that the mode in DECLARER is associated to the + INDICANT in the table at some point later, via + EQUIVALENT. Hence the NO_MOID in the call to + a68_add_mode. */ + MOID_T *effective_mode = a68_add_mode (&TOP_MOID (&A68_JOB), INDICANT, + 0, n, NO_MOID, NO_PACK); + gcc_assert (effective_mode != NO_MOID); + } + + /* Store priorities from the MOIF. */ + for (EXTRACT_T *e : PRIOS (moif)) + { + NODE_T *n + = a68_some_node (a68_demangle_symbol (NAME (moif), + EXTRACT_SYMBOL (e))); + /* XXX sensible location somehow? */ + LINE (INFO (n)) = LINE (INFO (q)); + NCHAR_IN_LINE (n) = STRING (LINE (INFO (n))); + TABLE (n) = TABLE (q); + TAG_T *tag = a68_add_tag (TABLE (q), PRIO_SYMBOL, n, NO_MOID, + EXTRACT_PRIO (e)); + gcc_assert (tag != NO_TAG); + MOIF (tag) = moif; // XXX add to existing list of moifs. + } + + /* Store identifiers from the MOIF. */ + for (EXTRACT_T *e : IDENTIFIERS (moif)) + { + NODE_T *n + = a68_some_node (a68_demangle_symbol (NAME (moif), + EXTRACT_SYMBOL (e))); + /* XXX sensible location somehow? */ + LINE (INFO (n)) = LINE (INFO (q)); + NCHAR_IN_LINE (n) = STRING (LINE (INFO (n))); + TABLE (n) = TABLE (q); + + TAG_T *tag = a68_add_tag (TABLE (q), IDENTIFIER, + n, EXTRACT_MODE (e), NORMAL_IDENTIFIER); + gcc_assert (tag != NO_TAG); + EXTERN_SYMBOL (tag) = ggc_strdup (EXTRACT_SYMBOL (e)); + VARIABLE (tag) = VARIABLE (e); + IN_PROC (tag) = IN_PROC (e); + HEAP (tag) = STATIC_SYMBOL; + MOIF (tag) = moif; + } + + /* Store operators from the MOIF. */ + for (EXTRACT_T *e : OPERATORS (moif)) + { + NODE_T *n + = a68_some_node (a68_demangle_symbol (NAME (moif), + EXTRACT_SYMBOL (e), + true /* operator */)); + MOID (n) = EXTRACT_MODE (e); + LINE (INFO (n)) = LINE (INFO (q)); + NCHAR_IN_LINE (n) = STRING (LINE (INFO (n))); + TABLE (n) = TABLE (q); + TAG_T *tag = a68_add_tag (TABLE (q), OP_SYMBOL, + n, EXTRACT_MODE (e), STOP); + gcc_assert (tag != NO_TAG); + VARIABLE (tag) = VARIABLE (e); + IN_PROC (tag) = IN_PROC (e); + HEAP (tag) = STATIC_SYMBOL; + MOIF (tag) = moif; + EXTERN_SYMBOL (tag) = ggc_strdup (EXTRACT_SYMBOL (e)); + } +} + +/* Search [MODE|MODULE] A = .., B = .. + and ACCESS A, B, .. + and store indicants. */ + +void +a68_extract_indicants (NODE_T *p) +{ + NODE_T *q = p; + + while (q != NO_NODE) + { + if (IS (q, ACCESS_SYMBOL) || IS (q, ALT_ACCESS_SYMBOL)) + { + /* An access clause implies the declaration of module indicants, + provided they are found in a suitable packet. */ + do + { + FORWARD (q); + detect_redefined_keyword (q, MODE_DECLARATION); + if (IS (q, BOLD_TAG)) + { + extract_revelation (q, false /* is_public */); + FORWARD (q); + } + else if (a68_whether (q, PUBLIC_SYMBOL, BOLD_TAG, STOP)) + { + extract_revelation (q, true /* is_public */); + FORWARD (q); + FORWARD (q); + } + } + while (q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else if (IS (q, MODULE_SYMBOL)) + { + bool siga = true; + do + { + FORWARD (q); + detect_redefined_keyword (q, MODE_DECLARATION); + if (a68_whether (q, BOLD_TAG, EQUALS_SYMBOL, STOP)) + { + /* Store in the symbol table. + XXX also add to global list of modules? + Position of definition (q) connects to this lexical + level! */ + ATTRIBUTE (q) = DEFINING_MODULE_INDICANT; + TAG_T *tag = a68_add_tag (TABLE (p), MODULE_SYMBOL, q, NO_MOID, STOP); + gcc_assert (tag != NO_TAG); + EXPORTED (tag) = true; + FORWARD (q); + ATTRIBUTE (q) = EQUALS_SYMBOL; /* XXX why not ALT_EQUALS_SYMBOL */ + q = skip_module_text (NEXT (q)); + FORWARD (q); + } + else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else if (IS (q, MODE_SYMBOL)) + { + bool siga = true; + do + { + FORWARD (q); + detect_redefined_keyword (q, MODE_DECLARATION); + if (a68_whether (q, BOLD_TAG, EQUALS_SYMBOL, STOP)) + { + /* Store in the symbol table, but also in the moid list. + Position of definition (q) connects to this lexical + level! */ + if (a68_add_tag (TABLE (p), INDICANT, q, NO_MOID, STOP) == NO_TAG) + gcc_unreachable (); + if (a68_add_mode (&TOP_MOID (&A68_JOB), INDICANT, 0, q, NO_MOID, NO_PACK) == NO_MOID) + gcc_unreachable (); + ATTRIBUTE (q) = DEFINING_INDICANT; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + q = skip_pack_declarer (NEXT (q)); + FORWARD (q); + } + else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else + FORWARD (q); + } +} + +#define GET_PRIORITY(q, k) \ + do \ + { \ + errno=0; \ + (k) = atoi (NSYMBOL (q)); \ + if (errno != 0) { \ + a68_error ((q), "invalid priority declaration"); \ + (k) = MAX_PRIORITY; \ + } else if ((k) < 1 || (k) > MAX_PRIORITY) { \ + a68_error ((q), "invalid priority declaration"); \ + (k) = MAX_PRIORITY; \ + } \ + } \ + while (0) + +/* Search PRIO X = .., Y = .. and store priorities. */ + +void +a68_extract_priorities (NODE_T *p) +{ + NODE_T *q = p; + while (q != NO_NODE) + { + if (IS (q, PRIO_SYMBOL)) + { + bool siga = true; + do + { + FORWARD (q); + detect_redefined_keyword (q, PRIORITY_DECLARATION); + /* An operator tag like ++ or && gives strange errors so we catch + it here. */ + if (a68_whether (q, OPERATOR, OPERATOR, STOP)) + { + NODE_T *y = q; + a68_error (q, "invalid operator tag"); + ATTRIBUTE (q) = DEFINING_OPERATOR; + /* Remove one superfluous operator, and hope it was only + one. */ + NEXT (q) = NEXT_NEXT (q); + PREVIOUS (NEXT (q)) = q; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + FORWARD (q); + int k; + GET_PRIORITY (q, k); + ATTRIBUTE (q) = PRIORITY; + if (a68_add_tag (TABLE (p), PRIO_SYMBOL, y, NO_MOID, k) == NO_TAG) + gcc_unreachable (); + FORWARD (q); + } + else if (a68_whether (q, OPERATOR, EQUALS_SYMBOL, INT_DENOTATION, STOP) + || a68_whether (q, EQUALS_SYMBOL, EQUALS_SYMBOL, INT_DENOTATION, STOP)) + { + NODE_T *y = q; + ATTRIBUTE (q) = DEFINING_OPERATOR; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + FORWARD (q); + int k; + GET_PRIORITY (q, k); + ATTRIBUTE (q) = PRIORITY; + if (a68_add_tag (TABLE (p), PRIO_SYMBOL, y, NO_MOID, k) == NO_TAG) + gcc_unreachable (); + FORWARD (q); + } + else if (a68_whether (q, BOLD_TAG, IDENTIFIER, STOP)) + { + siga = false; + } + else if (a68_whether (q, BOLD_TAG, EQUALS_SYMBOL, INT_DENOTATION, STOP)) + { + NODE_T *y = q; + ATTRIBUTE (q) = DEFINING_OPERATOR; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + FORWARD (q); + int k; + GET_PRIORITY (q, k); + ATTRIBUTE (q) = PRIORITY; + if (a68_add_tag (TABLE (p), PRIO_SYMBOL, y, NO_MOID, k) == NO_TAG) + gcc_unreachable (); + FORWARD (q); + } else if (a68_whether (q, BOLD_TAG, INT_DENOTATION, STOP) + || a68_whether (q, OPERATOR, INT_DENOTATION, STOP) + || a68_whether (q, EQUALS_SYMBOL, INT_DENOTATION, STOP)) + { + /* The scanner cannot separate operator and "=" sign so we do this here. */ + int len = (int) strlen (NSYMBOL (q)); + if (len > 1 && NSYMBOL (q)[len - 1] == '=') + { + NODE_T *y = q; + char *sym = (char *) xmalloc ((size_t) (len + 1)); + a68_bufcpy (sym, NSYMBOL (q), len + 1); + sym[len - 1] = '\0'; + NSYMBOL (q) = TEXT (a68_add_token (&A68 (top_token), sym)); + free (sym); + if (len > 2 && NSYMBOL (q)[len - 2] == ':' && NSYMBOL (q)[len - 3] != '=') + a68_error (q, "probably a missing symbol near invalid operator S"); + ATTRIBUTE (q) = DEFINING_OPERATOR; + insert_alt_equals (q); + q = NEXT_NEXT (q); + int k; + GET_PRIORITY (q, k); + ATTRIBUTE (q) = PRIORITY; + if (a68_add_tag (TABLE (p), PRIO_SYMBOL, y, NO_MOID, k) == NO_TAG) + gcc_unreachable (); + FORWARD (q); + } + else + siga = false; + } + else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else + FORWARD (q); + } +} + +/* Search OP [( .. ) ..] X = .., Y = .. and store operators. */ + +void +a68_extract_operators (NODE_T *p) +{ + NODE_T *q = p; + + while (q != NO_NODE) + { + if (!IS (q, OP_SYMBOL)) + FORWARD (q); + else + { + bool siga = true; + bool in_proc = true; + /* Skip operator plan. */ + if (NEXT (q) != NO_NODE && IS (NEXT (q), OPEN_SYMBOL)) + { + q = skip_pack_declarer (NEXT (q)); + in_proc = false; + } + /* Sample operators. */ + if (q != NO_NODE) + { + do + { + FORWARD (q); + detect_redefined_keyword (q, OPERATOR_DECLARATION); + /* Unacceptable operator tags like ++ or && could give + strange errors. */ + if (a68_whether (q, OPERATOR, OPERATOR, STOP)) + { + a68_error (q, "invalid operator tag"); + ATTRIBUTE (q) = DEFINING_OPERATOR; + TAG_T *t = a68_add_tag (TABLE (p), OP_SYMBOL, q, NO_MOID, STOP); + if (t == NO_TAG) + gcc_unreachable (); + IN_PROC (t) = in_proc; + /* Remove one superfluous operator, and hope it was only one. */ + NEXT (q) = NEXT_NEXT (q); + PREVIOUS (NEXT (q)) = q; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + q = skip_unit (q); + } + else if (a68_whether (q, OPERATOR, EQUALS_SYMBOL, STOP) + || a68_whether (q, EQUALS_SYMBOL, EQUALS_SYMBOL, STOP)) + { + ATTRIBUTE (q) = DEFINING_OPERATOR; + TAG_T *t = a68_add_tag (TABLE (p), OP_SYMBOL, q, NO_MOID, STOP); + if (t == NO_TAG) + gcc_unreachable (); + IN_PROC (t) = in_proc; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + q = skip_unit (q); + } + else if (a68_whether (q, BOLD_TAG, IDENTIFIER, STOP)) + { + siga = false; + } + else if (a68_whether (q, BOLD_TAG, EQUALS_SYMBOL, STOP)) + { + ATTRIBUTE (q) = DEFINING_OPERATOR; + TAG_T *t = a68_add_tag (TABLE (p), OP_SYMBOL, q, NO_MOID, STOP); + if (t == NO_TAG) + gcc_unreachable (); + IN_PROC (t) = in_proc; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + q = skip_unit (q); + } + else if (q != NO_NODE && (a68_is_one_of (q, OPERATOR, BOLD_TAG, EQUALS_SYMBOL, STOP))) + { + /* The scanner cannot separate operator and "=" sign so + we do this here. */ + int len = (int) strlen (NSYMBOL (q)); + if (len > 1 && NSYMBOL (q)[len - 1] == '=') + { + char *sym = (char *) xmalloc ((size_t) (len + 1)); + a68_bufcpy (sym, NSYMBOL (q), len + 1); + sym[len - 1] = '\0'; + NSYMBOL (q) = TEXT (a68_add_token (&A68 (top_token), sym)); + if (len > 2 && NSYMBOL (q)[len - 2] == ':' && NSYMBOL (q)[len - 3] != '=') + a68_error (q, "probably a missing symbol near invalid operator S"); + ATTRIBUTE (q) = DEFINING_OPERATOR; + insert_alt_equals (q); + TAG_T *t = a68_add_tag (TABLE (p), OP_SYMBOL, q, NO_MOID, STOP); + if (t == NO_TAG) + gcc_unreachable (); + IN_PROC (t) = in_proc; + FORWARD (q); + q = skip_unit (q); + } + else + siga = false; + } + else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + } + } +} + +/* Search and store labels. */ + +void +a68_extract_labels (NODE_T *p, int expect) +{ + /* Only handle candidate phrases as not to search indexers!. */ + if (expect == SERIAL_CLAUSE || expect == ENQUIRY_CLAUSE || expect == SOME_CLAUSE) + { + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (a68_whether (q, IDENTIFIER, COLON_SYMBOL, STOP)) + { + TAG_T *z = a68_add_tag (TABLE (p), LABEL, q, NO_MOID, LOCAL_LABEL); + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + UNIT (z) = NO_NODE; + } + } + } +} + +/* Search MOID x = .., y = .. and store identifiers. */ + +static void +extract_identities (NODE_T *p) +{ + NODE_T *q = p; + + while (q != NO_NODE) + { + if (a68_whether (q, DECLARER, IDENTIFIER, EQUALS_SYMBOL, STOP)) + { + bool siga = true; + do + { + if (a68_whether ((FORWARD (q)), IDENTIFIER, EQUALS_SYMBOL, STOP)) + { + TAG_T *tag = a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER); + if (tag == NO_TAG) + gcc_unreachable (); + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + FORWARD (q); + ATTRIBUTE (q) = ALT_EQUALS_SYMBOL; + q = skip_unit (q); + } + else if (a68_whether (q, IDENTIFIER, ASSIGN_SYMBOL, STOP)) + { + /* Handle common error in ALGOL 68 programs. */ + a68_error (q, "mixed identity-declaration and variable-declaration"); + if (a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER) == NO_TAG) + gcc_unreachable (); + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + ATTRIBUTE (FORWARD (q)) = ALT_EQUALS_SYMBOL; + q = skip_unit (q); + } + else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else + FORWARD (q); + } +} + +/* Search MOID x [:= ..], y [:= ..] and store identifiers. */ + +static void +extract_variables (NODE_T *p) +{ + NODE_T *q = p; + + while (q != NO_NODE) + { + if (a68_whether (q, HEAP_SYMBOL, DECLARER, IDENTIFIER, STOP) + || a68_whether (q, LOC_SYMBOL, DECLARER, IDENTIFIER, STOP) + || a68_whether (q, DECLARER, IDENTIFIER, STOP)) + { + if (!IS (q, DECLARER)) + FORWARD (q); + + bool siga = true; + do + { + FORWARD (q); + if (a68_whether (q, IDENTIFIER, STOP)) + { + if (a68_whether (q, IDENTIFIER, EQUALS_SYMBOL, STOP)) + { + /* Handle common error in ALGOL 68 programs. */ + a68_error (q, "mixed identity-declaration and variable-declaration"); + ATTRIBUTE (NEXT (q)) = ASSIGN_SYMBOL; + } + TAG_T *tag = a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER); + if (tag == NO_TAG) + gcc_unreachable (); + VARIABLE (tag) = true; + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + q = skip_unit (q); + } + else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else + FORWARD (q); + } +} + +/* Search PROC x = .., y = .. and stores identifiers. */ + +static void +extract_proc_identities (NODE_T *p) +{ + NODE_T *q = p; + + while (q != NO_NODE) + { + if (a68_whether (q, PROC_SYMBOL, IDENTIFIER, EQUALS_SYMBOL, STOP)) + { + bool siga = true; + do + { + FORWARD (q); + if (a68_whether (q, IDENTIFIER, EQUALS_SYMBOL, STOP)) + { + TAG_T *t = a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER); + IN_PROC (t) = true; + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + ATTRIBUTE (FORWARD (q)) = ALT_EQUALS_SYMBOL; + q = skip_unit (q); + } + else if (a68_whether (q, IDENTIFIER, ASSIGN_SYMBOL, STOP)) + { + /* Handle common error in ALGOL 68 programs. */ + a68_error (q, "mixed identity-declaration and variable-declaration"); + if (a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER) == NO_TAG) + gcc_unreachable (); + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + ATTRIBUTE (FORWARD (q)) = ALT_EQUALS_SYMBOL; + q = skip_unit (q); + } + else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else + FORWARD (q); + } +} + +/* Search PROC x [:= ..], y [:= ..]; store identifiers. */ + +static void +extract_proc_variables (NODE_T *p) +{ + NODE_T *q = p; + + while (q != NO_NODE) + { + if (a68_whether (q, PROC_SYMBOL, IDENTIFIER, STOP)) + { + bool siga = true; + do + { + FORWARD (q); + if (a68_whether (q, IDENTIFIER, ASSIGN_SYMBOL, STOP)) + { + TAG_T *tag = a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER); + gcc_assert (tag != NO_TAG); + VARIABLE (tag) = true; + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + q = skip_unit (FORWARD (q)); + } + else if (a68_whether (q, IDENTIFIER, EQUALS_SYMBOL, STOP)) + { + /* Handle common error in ALGOL 68 programs. */ + a68_error (q, "mixed identity-declaration and variable-declaration"); + TAG_T *tag = a68_add_tag (TABLE (p), IDENTIFIER, q, NO_MOID, NORMAL_IDENTIFIER); + gcc_assert (tag != NO_TAG); + ATTRIBUTE (q) = DEFINING_IDENTIFIER; + ATTRIBUTE (FORWARD (q)) = ASSIGN_SYMBOL; + q = skip_unit (q); + } else + siga = false; + } + while (siga && q != NO_NODE && IS (q, COMMA_SYMBOL)); + } + else + FORWARD (q); + } +} + +/* Schedule gathering of definitions in a phrase. */ + +void +a68_extract_declarations (NODE_T *p) +{ + /* Get definitions so we know what is defined in this range. */ + extract_identities (p); + extract_variables (p); + extract_proc_identities (p); + extract_proc_variables (p); + /* By now we know whether "=" is an operator or not. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, EQUALS_SYMBOL)) + ATTRIBUTE (q) = OPERATOR; + else if (IS (q, ALT_EQUALS_SYMBOL)) + ATTRIBUTE (q) = EQUALS_SYMBOL; + } + + /* Get qualifiers. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (a68_whether (q, LOC_SYMBOL, DECLARER, DEFINING_IDENTIFIER, STOP)) + a68_make_sub (q, q, QUALIFIER); + if (a68_whether (q, HEAP_SYMBOL, DECLARER, DEFINING_IDENTIFIER, STOP)) + a68_make_sub (q, q, QUALIFIER); + if (a68_whether (q, LOC_SYMBOL, PROC_SYMBOL, DEFINING_IDENTIFIER, STOP)) + a68_make_sub (q, q, QUALIFIER); + if (a68_whether (q, HEAP_SYMBOL, PROC_SYMBOL, DEFINING_IDENTIFIER, STOP)) + a68_make_sub (q, q, QUALIFIER); + } + + /* Give priorities to operators. */ + for (NODE_T *q = p; q != NO_NODE; FORWARD (q)) + { + if (IS (q, OPERATOR)) + { + if (a68_find_tag_global (TABLE (q), OP_SYMBOL, NSYMBOL (q))) + { + TAG_T *s = a68_find_tag_global (TABLE (q), PRIO_SYMBOL, NSYMBOL (q)); + + if (s != NO_TAG) + PRIO (INFO (q)) = PRIO (s); + else + PRIO (INFO (q)) = 0; + } + else + { + a68_error (q, "tag S has not been declared properly"); + PRIO (INFO (q)) = 1; + } + } + } +} From 803189d9323ca641126888346241fba59a806ce0 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:50:49 +0200 Subject: [PATCH 162/373] a68: parser: dynamic stack usage in serial clauses Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-parser-serial-dsa.cc: New file. --- gcc/algol68/a68-parser-serial-dsa.cc | 114 +++++++++++++++++++++++++++ 1 file changed, 114 insertions(+) create mode 100644 gcc/algol68/a68-parser-serial-dsa.cc diff --git a/gcc/algol68/a68-parser-serial-dsa.cc b/gcc/algol68/a68-parser-serial-dsa.cc new file mode 100644 index 000000000000..b48c13da3bf6 --- /dev/null +++ b/gcc/algol68/a68-parser-serial-dsa.cc @@ -0,0 +1,114 @@ +/* Check dynamic stack usage in serial clauses. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +/* This file implements a phase that determines what serial clauses contain + phrases whose elaboration may involve dynamic stack allocation. It + annotates the SERIAL_CLAUSE parse nodes by setting the DYNAMIC_STACK_ALLOCS + flag. */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "options.h" + +#include "a68.h" + +/* Uncomment the following line for debugging traces. */ +/* #define SERIAL_DSA_DEBUG */ + +static void +serial_dsa_check_serial_clause (NODE_T *p, bool *dsa) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, GENERATOR)) + { + /* LOC generators always result in dyamic stack allocation regardless + of the mode of the allocated value. */ + if (IS (SUB (p), LOC_SYMBOL)) + { +#ifdef SERIAL_DSA_DEBUG + fprintf (stderr, "serial_dsa: %s:%d: loc generator implies DSA\n", + FILENAME (LINE (INFO (p))), + LINE_NUMBER (p)); +#endif + *dsa = true; + return; + } + } + else if (IS (p, DEFINING_IDENTIFIER)) + { + /* Variable declarations of values with sample loc generators will + result in dynamic stack allocation. + + Note that label declarations do no have a mode, so we have to + check for MOID (p). */ + + if (MOID (p) != NO_MOID && IS_REF (MOID (p))) + { + bool heap = HEAP (TAX (p)) == HEAP_SYMBOL; + if (HAS_ROWS (SUB (MOID (p))) && !heap) + { +#ifdef SERIAL_DSA_DEBUG + fprintf (stderr, + "serial_dsa: %s:%d: defining identifier %s implies DSA\n", + FILENAME (LINE (INFO (p))), + LINE_NUMBER (p), + NSYMBOL (p)); +#endif + *dsa = true; + return; + } + } + } + else + { + /* Inner serial clauses will take care of their own. Code in routine + texts will not impact the stack of the containing serial + clause. */ + if (!IS (p, SERIAL_CLAUSE) && !IS (p, ROUTINE_TEXT)) + serial_dsa_check_serial_clause (SUB (p), dsa); + } + } +} + +void +a68_serial_dsa (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + a68_serial_dsa (SUB (p)); + if (IS (p, SERIAL_CLAUSE)) + { + bool dsa = false; + serial_dsa_check_serial_clause (SUB (p), &dsa); + DYNAMIC_STACK_ALLOCS (p) = dsa; +#ifdef SERIAL_DSA_DEBUG + if (dsa) + { + fprintf (stderr, "serial_dsa: %s:%d: marking serial clause %p as DSA\n", + FILENAME (LINE (INFO (p))), + LINE_NUMBER (p), + (void *) p); + } + +#endif + } + } +} From 1730426b8a5a0afca50f09157bbd97799a95e980 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 22 Nov 2025 02:19:52 +0100 Subject: [PATCH 163/373] a68: parser: pragmats infrastructure This patch adds the infrastructure for adding handlers for pragmats, along with some intial support for the "access Module" pragmat. Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-parser-pragmat.cc: New file. --- gcc/algol68/a68-parser-pragmat.cc | 202 ++++++++++++++++++++++++++++++ 1 file changed, 202 insertions(+) create mode 100644 gcc/algol68/a68-parser-pragmat.cc diff --git a/gcc/algol68/a68-parser-pragmat.cc b/gcc/algol68/a68-parser-pragmat.cc new file mode 100644 index 000000000000..2407eaa1b721 --- /dev/null +++ b/gcc/algol68/a68-parser-pragmat.cc @@ -0,0 +1,202 @@ +/* Handling of compiler pragmats. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "a68.h" + +/* Utility macros useful for parsing pragmat contents. */ + +#define SKIP_WHITESPACES(P) \ + while (ISSPACE (*(P))) (P)++ + +#define PARSE_WORD(P,W) \ + do \ + { \ + (W) = (char *) alloca (strlen ((P))); \ + size_t i = 0; \ + while (ISALPHA (*(P))) \ + (W)[i++] = *((P)++); \ + (W)[i] = '\0'; \ + } while (0) + +/* Parse a string denotation and return its value in an allocated buffer in + *STR. It is up to the caller to dispose of the allocated memory. + + This function returns a pointer to the character following the string + denotation in P, or P in case of parse error. + + In case of parse error *STR is also set to NULL. */ + +const char * +parse_string_denotation (const char *p, char **str) +{ + const char *orig = p; + size_t i = 0; + char *s = (char *) xmalloc (2 * strlen (p)); + + if (*(p++) != '\"') + goto error; + while (*p != '\0' && *p != '\"') + { + if (*p == '\'' && *(p + 1) == '\"') + { + s[i++] = '\"'; + p += 2; + } + else + { + s[i++] = *p; + p++; + } + } + if (*p != '\"') + goto error; + + *str = s; + return p + 1; + error: + free (s); + *str = NULL; + return orig; +} + +/* PR access MODULE in "filename" PR */ + +const char * +handle_access_in_pragmat (NODE_T *p, const char *pragmat, size_t pos) +{ + const char *beginning = pragmat; + + SKIP_WHITESPACES (pragmat); + /* Parse module name. */ + char *module; + PARSE_WORD (pragmat, module); + if (*module == '\0') + { + a68_error (p, "invalid pragmat: expected module name after %"); + return NULL; + } + SKIP_WHITESPACES (pragmat); + /* Parse "in " */ + if (strncmp (pragmat, "in ", 3) != 0) + { + a68_error (p, "invalid pragmat: expected % after module name"); + return NULL; + } + pragmat += 3; + SKIP_WHITESPACES (pragmat); + /* Parse a string denotation. */ + char *filename; + pragmat = parse_string_denotation (pragmat, &filename); + if (filename == NULL) + { + size_t off = pos + pragmat - beginning; + char *found; + PARSE_WORD (pragmat, found); + a68_error_in_pragmat (p, off, + "in % pragmat, expected string, found Z", + found); + return NULL; + } + /* Add entry in the module files map. */ + const char **pmodule = A68_MODULE_FILES->get (module); + if (pmodule != NULL) + { + a68_error_in_pragmat (p, pos + pragmat - beginning, + "module Z cannot appear in multiple % pragmats", + module); + return NULL; + } + + SKIP_WHITESPACES (pragmat); + /* Skip closing PR or PRAGMAT. */ + if (NPRAGMAT_TYPE (p) == STYLE_I_PRAGMAT_SYMBOL) + pragmat += 2; + else + pragmat += 7; + + A68_MODULE_FILES->put (ggc_strdup (module), ggc_strdup (filename)); + free (filename); + return pragmat; +} + +/* Parse and action on a pragmat. */ + +void +handle_pragmat (NODE_T *p) +{ + const char *pragmat = NPRAGMAT (p); + if (pragmat != NULL + && (NPRAGMAT_TYPE (p) == STYLE_I_PRAGMAT_SYMBOL + || NPRAGMAT_TYPE (p) == BOLD_PRAGMAT_SYMBOL)) + { + /* Process pragmat commands. */ + do + { + SKIP_WHITESPACES (pragmat); + /* Skip PR or PRAGMAT. */ + if (NPRAGMAT_TYPE (p) == STYLE_I_PRAGMAT_SYMBOL) + pragmat += 2; + else + pragmat += 7; + SKIP_WHITESPACES (pragmat); + /* Get first word in pragmat and dispatch. */ + SKIP_WHITESPACES (pragmat); + char *word = (char *) alloca (strlen (pragmat)); + size_t i = 0; + while (ISALPHA (*pragmat) || *pragmat == '\n') + word[i++] = *(pragmat++); + word[i] = '\0'; + + if (strcmp (word, "access") == 0) + { + pragmat + = handle_access_in_pragmat (p, pragmat, pragmat - NPRAGMAT (p)); + if (pragmat == NULL) + break; + } + else if (strcmp (word, "include") == 0) + /* Include pragmats are handled in the scanner. */ + return; + else + { + a68_error_in_pragmat (p, pragmat - NPRAGMAT (p), + "unrecognized pragmat Z", word); + break; + } + } + while (*pragmat != '\0'); + } +} + +/* Entry point: handle all pragmats in the given parse tree. */ + +void +a68_handle_pragmats (NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + a68_handle_pragmats (SUB (p)); + handle_pragmat (p); + } +} From bb9c6fecc4bb76efa6c7548de8463b8d37272bae Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:51:29 +0200 Subject: [PATCH 164/373] a68: low: lowering entry point and misc handlers Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-low.cc: New file. * algol68/a68-low-misc.cc: Likewise. --- gcc/algol68/a68-low-misc.cc | 234 +++++ gcc/algol68/a68-low.cc | 1705 +++++++++++++++++++++++++++++++++++ 2 files changed, 1939 insertions(+) create mode 100644 gcc/algol68/a68-low-misc.cc create mode 100644 gcc/algol68/a68-low.cc diff --git a/gcc/algol68/a68-low-misc.cc b/gcc/algol68/a68-low-misc.cc new file mode 100644 index 000000000000..b1048b6b8ca8 --- /dev/null +++ b/gcc/algol68/a68-low-misc.cc @@ -0,0 +1,234 @@ +/* Lower miscellaneous tree nodes to GENERIC. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Lower an assertion. + + assertion : assert symbol, enclosed clause. +*/ + +tree +a68_lower_assertion (NODE_T *p, LOW_CTX_T ctx) +{ + if (!OPTION_ASSERT (&A68_JOB)) + return a68_get_empty(); + + /* Build the call to the assert run-time function. */ + unsigned int lineno = NUMBER (LINE (INFO (p))); + const char *filename_str = FILENAME (LINE (INFO (p))); + tree filename = build_string_literal (strlen (filename_str) + 1, + filename_str); + tree call = a68_build_libcall (A68_LIBCALL_ASSERT, + void_type_node, 2, + filename, + build_int_cst (unsigned_type_node, lineno)); + /* Check condition and call assert if required. */ + tree assertion = fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + a68_void_type, + build2_loc (a68_get_node_location (p), + TRUTH_ORIF_EXPR, + a68_int_type, + a68_lower_tree (NEXT (SUB (p)), ctx), + fold_build2 (COMPOUND_EXPR, + a68_int_type, + call, + build_int_cst (a68_int_type, 0))), + a68_get_empty ()); + TREE_SIDE_EFFECTS (assertion) = 1; + return assertion; +} + +/* Lower a jump to a label. + + jump : goto symbol, identifier; + identifier. + + A jump lowers into a ({ GOTO_EXPR; EMPTY }). */ + +tree +a68_lower_jump (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *label_identifier = SUB (p); + MOID_T *jump_mode = MOID (p); + if (!IS (label_identifier, IDENTIFIER)) + FORWARD (label_identifier); + + /* Create LABEL_DECL if necessary and chain it in both current block and bind + expression. */ + if (TAX_TREE_DECL (TAX (label_identifier)) == NULL_TREE) + { + tree label_decl = build_decl (a68_get_node_location (label_identifier), + LABEL_DECL, + a68_get_mangled_identifier (NSYMBOL (label_identifier)), + void_type_node); + TAX_TREE_DECL (TAX (label_identifier)) = label_decl; + } + + MOID (label_identifier) = M_VOID; + return fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + CTYPE (jump_mode), + fold_build1_loc (a68_get_node_location (p), + GOTO_EXPR, + void_type_node, + a68_lower_tree (label_identifier, ctx)), + a68_get_skip_tree (jump_mode)); +} + +/* Lower a parameter into a chain of PARAM_DECLs. + + parameter : declarer, identifier; + parameter, comma symbol, identifier. +*/ + +tree +a68_lower_parameter (NODE_T *p, LOW_CTX_T ctx) +{ + tree prev_parm_decls = NULL_TREE; + NODE_T *identifier = NO_NODE; + if (IS (SUB (p), PARAMETER)) + { + prev_parm_decls = a68_lower_tree (SUB (p), ctx); + identifier = NEXT (NEXT (SUB (p))); + } + else + identifier = NEXT (SUB (p)); + + /* Create the PARM_DECL. */ + tree parm_decl = build_decl (a68_get_node_location (p), + PARM_DECL, + a68_get_mangled_identifier (NSYMBOL (identifier)), + CTYPE (MOID (identifier))); + DECL_CONTEXT (parm_decl) = current_function_decl; + DECL_ARG_TYPE (parm_decl) = TREE_TYPE (parm_decl); + TAX_TREE_DECL (TAX (identifier)) = parm_decl; + + layout_decl (parm_decl, 0); + + if (prev_parm_decls != NULL) + return chainon (prev_parm_decls, parm_decl); + else + return parm_decl; +} + +/* Lower a list of parameters into a chain of PARAM_DECLs. + + parameter list : parameter; + parameter list; comma symbol; parameter. +*/ + +tree +a68_lower_parameter_list (NODE_T *p, LOW_CTX_T ctx) +{ + tree parm_decl = NULL_TREE; + tree prev_parm_decls = NULL_TREE; + if (IS (SUB (p), PARAMETER_LIST)) + { + prev_parm_decls = a68_lower_tree (SUB (p), ctx); + parm_decl = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + } + else + parm_decl = a68_lower_tree (SUB (p), ctx); + + gcc_assert (parm_decl != NULL_TREE); + if (prev_parm_decls != NULL) + return chainon (prev_parm_decls, parm_decl); + else + return parm_decl; +} + +/* Lower a parameter pack into a chain of PARAM_DECLs. + + parameter pack : open symbol, parameter list, close symbol. +*/ + +tree +a68_lower_parameter_pack (NODE_T *p, LOW_CTX_T ctx) +{ + /* Lower the contained PARAMETER_LIST. */ + return a68_lower_tree (NEXT (SUB (p)), ctx); +} + +/* Lower an applied operator. + + Applied operators lower into a function object that gets one argument in + case of monadic operators, or two arguments in case of dyadic operators. */ + +tree +a68_lower_operator (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + /* This is an user defined operator. Handle it in a similar way than applied + identifiers. */ + tree func_decl = TAX_TREE_DECL (TAX (p)); + if (func_decl == NULL_TREE) + { + bool external = (MOIF (TAX (p)) != NO_MOIF); + const char *extern_symbol = EXTERN_SYMBOL (TAX (p)); + if (IN_PROC (TAX (p))) + { + if (external) + func_decl = a68_make_proc_identity_declaration_decl (p, + NAME (MOIF (TAX (p))), + true /* indicant */, + external, + extern_symbol); + else + func_decl = a68_make_proc_identity_declaration_decl (p, + ctx.module_definition_name, + true /* indicant */); + } + else + { + if (external) + func_decl = a68_make_identity_declaration_decl (p, NAME (MOIF (TAX (p))), + true /* indicant */, external, + extern_symbol); + else + func_decl = a68_make_identity_declaration_decl (p, ctx.module_definition_name, + true /* indicant */); + } + TAX_TREE_DECL (TAX (p)) = func_decl; + } + return func_decl; +} diff --git a/gcc/algol68/a68-low.cc b/gcc/algol68/a68-low.cc new file mode 100644 index 000000000000..109620248fb1 --- /dev/null +++ b/gcc/algol68/a68-low.cc @@ -0,0 +1,1705 @@ +/* Lower the Algol 68 parse tree to GENERIC. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Return a tree with an identifier for the mangled version of a given + name. + + Publicized symbols feature the module name publishing them. + Internal symbols don't. + + Bold words, i.e. mode indicants, module indicants and operator indicants, + are mangled to upper-case. + + Tags, i.e. identifiers are mangled to lower-case. + + Monads and nomads are mangled to letter codes symbolizing the symbols: + + % (p)ercentage + ^ (c)aret + & (a)mpersand + + pl(u)s + - (m)inus + ~ (t)ilde + ! (b)ang + ? (q)uestion mark + > bi(g)ger than + < (l)ess than + / (s)lash + = (e)qual + : c(o)lon + * sta(r) + + Each letter code is followed by a single underscore character. */ + +static tree +get_mangled_identifier_or_indicant (const char *name, bool indicant, + const char *mname, bool internal, + bool numbered) +{ + /* First determine the size of the mangled symbol. */ + size_t mangled_size = strlen (name) + 1; + if (mname) + { + /* Add size for MNAME_ */ + mangled_size += strlen (mname) + 1; + if (internal) + /* Another _ */ + mangled_size += 1; + } + for (const char *p = name; *p; ++p) + { + mangled_size += 1; + if (strchr (MONADS, *p) != NULL + || strchr (NOMADS, *p) != NULL + || *p == ':') + /* Each monad or nomad requires two chars to encode. */ + mangled_size += 1; + } + + char *number_buf = NULL; + if (numbered) + { + static unsigned int cnt; + number_buf = xasprintf ("%d", cnt++); + mangled_size += strlen (number_buf); + } + + /* Now fill-in the mangled symbol. */ + char *mangled_name = (char *) alloca (mangled_size); + size_t pos = 0; + if (mname) + { + for (const char *p = mname; *p; ++p) + /* Module names are bold words. Make sure to emit them in upper-case. */ + mangled_name[pos++] = TOUPPER (*p); + mangled_name[pos++] = '_'; + if (internal) + mangled_name[pos++] = '_'; + } + + for (const char *p = name; *p; ++p) + { + if (strchr (MONADS, *p) != NULL + || strchr (NOMADS, *p) != NULL + || *p == ':') + { + char c; + switch (*p) + { + case '%': c = 'p'; break; + case '^': c = 'c'; break; + case '&': c = 'a'; break; + case '+': c = 'u'; break; + case '-': c = 'm'; break; + case '~': c = 't'; break; + case '!': c = 'b'; break; + case '?': c = 'q'; break; + case '>': c = 'g'; break; + case '<': c = 'l'; break; + case '/': c = 's'; break; + case '=': c = 'e'; break; + case ':': c = 'o'; break; + case '*': c = 'r'; break; + default: + /* Should not happen. */ + gcc_unreachable (); + } + mangled_name[pos++] = c; + mangled_name[pos++] = '_'; + } + else + { + if (indicant) + mangled_name[pos++] = TOUPPER (*p); + else + mangled_name[pos++] = TOLOWER (*p); + } + } + + if (numbered) + { + for (char *p = number_buf; *p; ++p) + mangled_name[pos++] = *p; + free (number_buf); + } + mangled_name[pos++] = '\0'; + + return get_identifier (mangled_name); +} + +tree +a68_get_mangled_identifier (const char *name, const char *mname, + bool internal, bool numbered) +{ + return get_mangled_identifier_or_indicant (name, false /* indicant */, mname, + internal, numbered); +} + +tree +a68_get_mangled_indicant (const char *name, const char *mname, + bool internal, bool numbered) +{ + return get_mangled_identifier_or_indicant (name, true /* indicant */, mname, + internal, numbered); +} + +/* Demangle a given SYMBOL. + + This function does the reverse operation than + get_mangled_identifier_or_indicant. */ + +char * +a68_demangle_symbol (const char *mname, const char *symbol, + bool is_operator) +{ + gcc_assert (strlen (symbol) >= strlen (mname) + 1); + /* First get rid of the module name and underscore. */ + symbol += strlen (mname) + 1; + /* Now demangle the rest. */ + size_t size = strlen (symbol) + 1; + char *demangled = (char *) xmalloc (size + 1); + size_t o = 0; + for (size_t i = 0; i < size; ++i) + { + if (symbol[i+1] == '_') + { + switch (symbol[i]) + { + case 'p': demangled[o++] = '+'; break; + case 'c': demangled[o++] = '^'; break; + case 'a': demangled[o++] = '&'; break; + case 'u': demangled[o++] = '+'; break; + case 'm': demangled[o++] = '-'; break; + case 't': demangled[o++] = '~'; break; + case 'b': demangled[o++] = '!'; break; + case 'q': demangled[o++] = '?'; break; + case 'g': demangled[o++] = '>'; break; + case 'l': demangled[o++] = '<'; break; + case 's': demangled[o++] = '/'; break; + case 'e': demangled[o++] = '='; break; + case 'o': demangled[o++] = ':'; break; + case 'r': demangled[o++] = '*'; break; + default: + /* Invalid mangling. */ + // XXX this should be checked at import time in extract. + gcc_unreachable (); + } + i += 1; + } + else + demangled[o++] = symbol[i]; + } + demangled[o] = '\0'; + + if (is_operator) + { + /* Remove trailing digits. */ + for (size_t i = strlen (demangled) - 1; i > 0; --i) + { + if (ISDIGIT (demangled[i])) + demangled[i] = '\0'; + else + break; + } + } + + return demangled; +} + +/* Return a tree with the EMPTY value. + + EMPTY is the only denotation of the VOID mode. It is used in unions to + denote "no value". It must have size zero, so it lowers into an empty + constructor with zero elements of type void. This is what GNU C uses to + implement the empty struct extension. */ + +tree +a68_get_empty (void) +{ + return build_constructor (a68_void_type, NULL); +} + +/* Return a tree with the yielding of SKIP of a given mode. + + SKIP stands for some value of some given mode. It shall be used only in a + context where the compiler can determine the mode. + + The particular value to which it elaborates is non-important, but this + compiler always uses the same values. See the a68_get_ref_*_tree functions + for details on what values are these. */ + +tree +a68_get_skip_tree (MOID_T *m) +{ + tree expr = NULL_TREE; + + while (EQUIVALENT (m) != NO_MOID) + m = EQUIVALENT (m); + + if (IS_INTEGRAL (m)) + expr = a68_get_int_skip_tree (m); + else if (m == M_CHAR) + expr = a68_get_char_skip_tree (); + else if (m == M_BOOL) + expr = a68_get_bool_skip_tree (); + else if (IS_REAL (m)) + expr = a68_get_real_skip_tree (m); + else if (IS_BITS (m)) + expr = a68_get_bits_skip_tree (m); + else if (IS_REF (m)) + expr = a68_get_ref_skip_tree (m); + else if (IS (m, PROC_SYMBOL)) + expr = a68_get_proc_skip_tree (m); + else if (IS_STRUCT (m)) + expr = a68_get_struct_skip_tree (m); + else if (IS_UNION (m)) + expr = a68_get_union_skip_tree (m); + else if (IS_FLEXETY_ROW (m)) + expr = a68_get_multiple_skip_tree (m); + else if (m == M_STRING) + expr = a68_get_string_skip_tree (); + else if (m == M_ROWS || IS (m, SERIES_MODE)) + { + /* XXX assert that all modes in the series are rows? */ + tree rows_type = CTYPE (M_ROWS); + tree dim_field = TYPE_FIELDS (rows_type); + tree triplets_field = TREE_CHAIN (dim_field); + tree null_pointer = build_int_cst (TREE_TYPE (triplets_field), 0); + expr = build_constructor_va (rows_type, 2, + dim_field, size_zero_node, + triplets_field, null_pointer); + } + else if (m == M_VOID || m == M_HIP) + expr = a68_get_empty (); + else + { + fatal_error (UNKNOWN_LOCATION, + "get skip tree: cannot compute SKIP for mode %s", + a68_moid_to_string (m, MOID_ERROR_WIDTH, NODE (m), true)); + gcc_unreachable (); + } + + return expr; +} + +/* Given a tree node EXP holding a value of mode M: + + *NUM_REFS is set to the number of REFs in M. + + *NUM_POINTERS is set to the number of pointers in the type of EXP that + correspond to the REFs in M. */ + +void +a68_ref_counts (tree exp, MOID_T *m, int *num_refs, int *num_pointers) +{ + /* Count REFs in M and pointers in the type of EXP. Note that VAR_DECLs + corresponding to REF PROC are of type pointer, so these should not count + for the count! */ + + /* Make sure we are accessing the real mode definition. */ + while (EQUIVALENT (m) != NO_MOID) + m = EQUIVALENT (m); + + *num_refs = 0; + *num_pointers = 0; + for (MOID_T *s = m; s != NO_MOID && IS_REF (s); s = SUB (s)) + *num_refs += 1; + for (tree p = TREE_TYPE (exp); + p != NULL_TREE && POINTER_TYPE_P (p) && TREE_CODE (TREE_TYPE (p)) != FUNCTION_TYPE; + p = TREE_TYPE (p)) + *num_pointers += 1; + + gcc_assert (*num_refs >= *num_pointers); +} + +/* The Algol 68 variable declaration + + [LOC|HEAP] AMODE foo; + + Is in principle equivalent to the identity declaration + + REF AMODE foo = [LOC|HEAP] AMODE; + + In both cases the object ascribed to the defining identifier `foo' is of + mode REF AMODE. The ascribed object is a name which is created by a + generator implied in the actual declarer in the first case, and an explicit + generator in the initialization expression in the second case. + + However, this front-end implements these two cases differently in order to + reduce the amount of both indirect addressing and of storage: + + - The variable declaration `[LOC|HEAP] AMODE foo;' lowers into a VAR_DECL + with type ATYPE provided that the generator is LOC and that it contains no + rows. Accessing it requires direct addressing. When its address is + required, an ADDR_EXPR shall be used. + + - The identity declaration `REF AMODE foo = LOC AMODE;' lowers into a + VAR_DECL with type *ATYPE. Accessing it requires indirect addressing. It + is effectively a pointer. + + This introduces the complication that an expression (the VAR_DECL) whose + type is TYPE can appear in a place where *TYPE is expected. This function, + given the required mode and an expression, adds as many ADDR_EXPR to EXPR as + necessary so the resulting value is of the required type. Other than this + nuisance, the parser guarantees that the entities have the right type at the + location they appear, so a call to a68_consolidate_ref is all must be needed + at any point in the lowering process to guarantee a valid value for the + context. + + This function expects: + - That the type of EXPR is zero or more pointers to a base type BTYPE. + - That the mode M is zero or more REFs to a base non-ref mode AMODE. + - That the number of pointers in the type of EXPR is less or equal than the + number of REFs in the mode M. + - That BTYPE and AMODE are equivalent. */ + +tree +a68_consolidate_ref (MOID_T *m, tree expr) +{ + int num_refs, num_pointers; + a68_ref_counts (expr, m, &num_refs, &num_pointers); + + /* Address EXPR as many times as necessary to match the number of REFs in the + desired mode. */ + while (num_pointers < num_refs) + { + if (TREE_CODE (expr) == COMPOUND_EXPR) + { + /* (..., x) -> (..., &x) */ + // gcc_assert (TREE_CODE (TREE_OPERAND (expr, 0)) == MODIFY_EXPR); + // gcc_assert (VAR_P (TREE_OPERAND (expr, 1))); + TREE_OPERAND (expr, 1) = a68_consolidate_ref (m, TREE_OPERAND (expr, 1)); + TREE_TYPE (expr) = TREE_TYPE (TREE_OPERAND (expr, 1)); + } + else + { + /* x -> &x */ + if (TREE_CODE (expr) == INDIRECT_REF) + /* expr is an indirection. Remove the pointer rather than adding + an addr. This avoids &* situations and marking stuff as + addressable unnecessarily. */ + expr = TREE_OPERAND (expr,0); + else + { + TREE_ADDRESSABLE (expr) = true; + expr = fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (expr)), expr); + } + } + num_pointers += 1; + } + + return expr; +} + +/* Make a declaration for an anonymous routine of mode MODE. */ + +tree +a68_make_anonymous_routine_decl (MOID_T *mode) +{ + /* The CTYPE of MODE is a pointer to a function. We need the pointed + function type for the FUNCTION_DECL. */ + tree func_type = TREE_TYPE (CTYPE (mode)); + tree func_decl = build_decl (UNKNOWN_LOCATION, + FUNCTION_DECL, + NULL_TREE /* name, set below. */, + func_type); + char *name = xasprintf ("routine%d", DECL_UID (func_decl)); + DECL_NAME (func_decl) = a68_get_mangled_identifier (name); + free (name); + DECL_EXTERNAL (func_decl) = 0; + DECL_STATIC_CHAIN (func_decl) = !a68_in_global_range (); + /* Nested functions should be addressable. + XXX this should be propagated to their containing functions, so for now + we mark them all as addressable. */ + TREE_ADDRESSABLE (func_decl) = 1; + /* A nested function is not global. */ + TREE_PUBLIC (func_decl) = a68_in_global_range (); + TREE_STATIC (func_decl) = 1; + + return func_decl; +} + +/* Make a declaration for a constant procedure or operator. */ + +tree +a68_make_proc_identity_declaration_decl (NODE_T *identifier, + const char *module_name, + bool indicant, bool external, + const char *extern_symbol) +{ + /* The CTYPE of MODE is a pointer to a function. We need the pointed + function type for the FUNCTION_DECL. */ + tree func_type = TREE_TYPE (CTYPE (MOID (identifier))); + bool public_range = PUBLIC_RANGE (TABLE (TAX (identifier))); + tree func_decl = build_decl (UNKNOWN_LOCATION, + FUNCTION_DECL, + NULL_TREE, /* name, set below. */ + func_type); + + if (public_range) + { + bool publicized = PUBLICIZED (TAX (identifier)); + + DECL_EXTERNAL (func_decl) = 0; + if (publicized) + TREE_PUBLIC (func_decl) = 1; + else + TREE_PUBLIC (func_decl) = 0; + if (indicant) + DECL_NAME (func_decl) + = a68_get_mangled_indicant (NSYMBOL (identifier), module_name, + false /* internal */, + (IS (identifier, DEFINING_OPERATOR) + || IS (identifier, OPERATOR))); + else + DECL_NAME (func_decl) + = a68_get_mangled_identifier (NSYMBOL (identifier), module_name, + false /* internal */, + (IS (identifier, DEFINING_OPERATOR) + || IS (identifier, OPERATOR))); + } + else if (external) + { + DECL_EXTERNAL (func_decl) = 1; + TREE_PUBLIC (func_decl) = 1; + DECL_NAME (func_decl) = get_identifier (extern_symbol); + } + else + { + DECL_EXTERNAL (func_decl) = 0; + DECL_STATIC_CHAIN (func_decl) = !a68_in_global_range (); + /* Nested functions should be addressable. + XXX this should be propagated to their containing functions, so for now + we mark them all as addressable. */ + TREE_ADDRESSABLE (func_decl) = 1; + /* A nested function is not global. */ + TREE_PUBLIC (func_decl) = a68_in_global_range (); + if (indicant) + DECL_NAME (func_decl) = a68_get_mangled_indicant (NSYMBOL (identifier)); + else + DECL_NAME (func_decl) = a68_get_mangled_identifier (NSYMBOL (identifier)); + } + TREE_STATIC (func_decl) = 1; + + return func_decl; +} + +/* Make a declaration for an identity declaration. */ + +tree +a68_make_identity_declaration_decl (NODE_T *identifier, + const char *module_name, + bool indicant, bool external, + const char *extern_symbol) +{ + tree type = CTYPE (MOID (identifier)); + bool public_range = PUBLIC_RANGE (TABLE (TAX (identifier))); + tree decl = build_decl (a68_get_node_location (identifier), + VAR_DECL, + NULL_TREE, /* name, set below. */ + type); + + if (public_range) + { + bool publicized = PUBLICIZED (TAX (identifier)); + + DECL_EXTERNAL (decl) = 0; + TREE_STATIC (decl) = 1; + if (publicized) + TREE_PUBLIC (decl) = 1; + else + TREE_PUBLIC (decl) = 0; + if (indicant) + DECL_NAME (decl) = a68_get_mangled_indicant (NSYMBOL (identifier), module_name, + false /* internal */, + (IS (identifier, DEFINING_OPERATOR) + || IS (identifier, OPERATOR))); + else + DECL_NAME (decl) = a68_get_mangled_identifier (NSYMBOL (identifier), module_name, + false /* internal */, + (IS (identifier, DEFINING_OPERATOR) + || IS (identifier, OPERATOR))); + } + else if (external) + { + DECL_EXTERNAL (decl) = 1; + TREE_PUBLIC (decl) = 1; + DECL_NAME (decl) = get_identifier (extern_symbol); + } + else + { + DECL_EXTERNAL (decl) = 0; + TREE_PUBLIC (decl) = 0; + DECL_NAME (decl) = a68_get_mangled_identifier (NSYMBOL (identifier)); + } + + DECL_INITIAL (decl) = a68_get_skip_tree (MOID (identifier)); + return decl; +} + +/* Make a declaration for a variable declaration. + The mode of the given identifier is expected to be a REF AMODE. */ + +tree +a68_make_variable_declaration_decl (NODE_T *identifier, + const char *module_name, + bool external, + const char *extern_symbol) +{ + gcc_assert (IS_REF (MOID (identifier))); + + MOID_T *mode = MOID (identifier); + bool use_pointer = (HEAP (TAX (identifier)) != STATIC_SYMBOL + && ((HEAP (TAX (identifier)) == HEAP_SYMBOL) + || HAS_ROWS (SUB (MOID (identifier))))); + bool public_range = PUBLIC_RANGE (TABLE (TAX (identifier))); + tree type = use_pointer ? CTYPE (mode) : CTYPE (SUB (mode)); + tree decl = build_decl (a68_get_node_location (identifier), + VAR_DECL, + NULL_TREE, /* name, set below. */ + type); + + if (public_range) + { + bool publicized = PUBLICIZED (TAX (identifier)); + + DECL_EXTERNAL (decl) = 0; + TREE_STATIC (decl) = 1; + if (publicized) + TREE_PUBLIC (decl) = 1; + else + TREE_PUBLIC (decl) = 0; + DECL_NAME (decl) = a68_get_mangled_identifier (NSYMBOL (identifier), module_name, + false /* internal */, + (IS (identifier, DEFINING_OPERATOR) + || IS (identifier, OPERATOR))); + } + else if (external) + { + DECL_EXTERNAL (decl) = 1; + TREE_PUBLIC (decl) = 1; + DECL_NAME (decl) = get_identifier (extern_symbol); + } + else + { + TREE_PUBLIC (decl) = 0; + DECL_NAME (decl) = a68_get_mangled_identifier (NSYMBOL (identifier)); + } + + DECL_INITIAL (decl) = a68_get_skip_tree (use_pointer ? mode : SUB (mode)); + return decl; +} + +/* Do a checked indirection. + + P is a tree node used for its location information. + EXP is an expression that gets indirected. + EXP_MODE is the mode of exp. */ + +tree +a68_checked_indirect_ref (NODE_T *p, tree exp, MOID_T *exp_mode) +{ + tree exp_type = TREE_TYPE (exp); + tree nil_check = NULL_TREE; + + if (OPTION_NIL_CHECKING (&A68_JOB)) + { + exp = save_expr (exp); + tree consolidated_exp = a68_consolidate_ref (exp_mode, exp); + + /* Check whether we are dereferencing NIL. */ + unsigned int lineno = NUMBER (LINE (INFO (p))); + const char *filename_str = FILENAME (LINE (INFO (p))); + tree filename = build_string_literal (strlen (filename_str) + 1, + filename_str); + tree call = a68_build_libcall (A68_LIBCALL_DEREFNIL, + void_type_node, 2, + filename, + build_int_cst (unsigned_type_node, lineno)); + call = fold_build2 (COMPOUND_EXPR, a68_bool_type, call, boolean_false_node); + nil_check = fold_build2 (NE_EXPR, exp_type, + consolidated_exp, + build_int_cst (exp_type, 0)); + nil_check = fold_build2 (TRUTH_ORIF_EXPR, exp_type, + nil_check, call); + } + + tree deref = fold_build1 (INDIRECT_REF, TREE_TYPE (exp_type), exp); + if (nil_check == NULL_TREE) + return deref; + else + return fold_build2 (COMPOUND_EXPR, TREE_TYPE (deref), + nil_check, deref); +} + +/* Deref a given expression EXP whose mode is MOID (P). + + The value to dereference always corresponds to a name, but it may consist + of: + + - Not a pointer, in which case corresponds to a name lowered to a VAR_DECL. + + - A pointer to a function, in which case corresponds to a name of mode REF + PROC, lowered to a VAR_DECL. + + - Any other pointer corresponds to a name lowered to a VAR_DECL that is a + pointer. + + In the first two cases, in both r-value and l-value situations the expected + result is achieved by just returning the value: in r-value the decl denotes + the value, in l-value the decl denotes the (direct) address of the + value. */ + +tree +a68_low_deref (tree exp, NODE_T *p) +{ + int num_refs, num_pointers; + a68_ref_counts (exp, MOID (p), &num_refs, &num_pointers); + + if (num_refs > num_pointers) + return exp; + else + { + gcc_assert (num_refs == num_pointers); + return a68_checked_indirect_ref (p, exp, MOID (p)); + } +} + +/* Get a deep-copy of a given Algol 68 value EXP. */ + +tree +a68_low_dup (tree expr, bool use_heap) +{ + tree dup = NULL_TREE; + tree type = TREE_TYPE (expr); + + /* XXX */ + use_heap = true; + + /* Determine the mode corresponding to the type of EXPR. */ + MOID_T *m = a68_type_moid (type); + gcc_assert (m != NO_MOID); + while (EQUIVALENT (m) != NO_MOID) + m = EQUIVALENT (m); + + if (A68_ROW_TYPE_P (type)) + { + /* We need to copy the elements as well as the descriptor. There is no + need to check bounds. */ + + /* Deflexe the mode as appropriate. */ + while (IS_FLEX (m)) + m = SUB (m); + gcc_assert (IS_ROW (m) || m == M_STRING); + + a68_push_range (NULL); + + /* First allocate space for the dupped elements. */ + expr = save_expr (expr); + tree elements = a68_multiple_elements (expr); + tree element_pointer_type = TREE_TYPE (elements); + tree element_type = TREE_TYPE (element_pointer_type); + tree new_elements_size = save_expr (a68_multiple_elements_size (expr)); + tree new_elements = a68_lower_tmpvar ("new_elements%", + TREE_TYPE (elements), + (use_heap + ? a68_lower_malloc (TREE_TYPE (TREE_TYPE (elements)), + new_elements_size) + : a68_lower_alloca (TREE_TYPE (TREE_TYPE (elements)), + new_elements_size))); + + /* Then copy the elements. + + If the mode of the elements stored in the multiple dont have rows, + then we can just use memcpy. Otherwise, we have to loop and recurse + to dup all the elements in the multiple one by one. + + The above applies to multiples of any number of dimensions. */ + if (m == M_STRING || !HAS_ROWS (SUB (m))) + { + a68_add_stmt (a68_lower_memcpy (new_elements, + elements, + new_elements_size)); + a68_add_stmt (new_elements); + } + else + { + /* Note that num_elems includes elements that are not accessible due + to trimming. */ + tree num_elems = a68_lower_tmpvar ("numelems%", size_type_node, + fold_build2 (TRUNC_DIV_EXPR, sizetype, + new_elements_size, + size_in_bytes (element_type))); + tree orig_elements = a68_lower_tmpvar ("orig_elements%", + element_pointer_type, elements); + tree index = a68_lower_tmpvar ("index%", size_type_node, size_zero_node); + + /* Begin of loop body. */ + a68_push_range (NULL); + + /* if (index == num_elems) break; */ + a68_add_stmt (fold_build1 (EXIT_EXPR, + void_type_node, + fold_build2 (EQ_EXPR, + size_type_node, + index, num_elems))); + /* new_elements[index] = elements[index] */ + tree offset = fold_build2 (MULT_EXPR, sizetype, + index, size_in_bytes (element_type)); + tree new_elem_lvalue = fold_build2 (MEM_REF, element_type, + fold_build2 (POINTER_PLUS_EXPR, + element_pointer_type, + new_elements, + offset), + fold_convert (element_pointer_type, + integer_zero_node)); + tree elem = fold_build2 (MEM_REF, element_type, + fold_build2 (POINTER_PLUS_EXPR, + element_pointer_type, + orig_elements, + offset), + fold_convert (element_pointer_type, + integer_zero_node)); + a68_add_stmt (fold_build2 (MODIFY_EXPR, element_type, + new_elem_lvalue, + a68_low_dup (elem, use_heap))); + /* index++ */ + a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, + size_type_node, + index, size_one_node)); + tree loop_body = a68_pop_range (); + /* End of loop body. */ + + a68_add_stmt (fold_build1 (LOOP_EXPR, + void_type_node, + loop_body)); + a68_add_stmt (new_elements); + } + + new_elements = a68_pop_range (); + TREE_TYPE (new_elements) = element_pointer_type; + + /* Now build a descriptor pointing to the dupped elements and return it. + Note that the descriptor is always allocated on the stack. */ + dup = a68_row_value_raw (type, + a68_multiple_triplets (expr), + new_elements, + new_elements_size); + } + else if (!HAS_ROWS (m)) + { + /* Non-multiple values that do not contain rows do not need to be dupped, + since they can be just moved around using the semantics of + MODIFY_EXPR. */ + dup = expr; + } + else if (A68_STRUCT_TYPE_P (type)) + { + /* Since struct value can contain multiples and unions and other values + that require deep copy, we cannot simply rely on the C semantics of a + MODIFY_EXPR. */ + tree struct_type = type; + vec *ce = NULL; + + expr = save_expr (expr); + for (tree field = TYPE_FIELDS (struct_type); + field; + field = TREE_CHAIN (field)) + { + CONSTRUCTOR_APPEND_ELT (ce, field, + a68_low_dup (fold_build3 (COMPONENT_REF, + TREE_TYPE (field), + expr, + field, + NULL_TREE), + use_heap)); + } + dup = build_constructor (struct_type, ce); + } + else if (A68_UNION_TYPE_P (type)) + { + /* We need to recurse in whatever type corresponding to the active mode + in the united value. This shall be done at run-time by using a series + of + + IF overhead IS index of mode blah in union + THEN dup = dup_type (CTYPE (mode blah in union)) + FI + */ + + MOID_T *union_mode = a68_type_moid (type); + + a68_push_range (union_mode); + dup = a68_lower_tmpvar ("dup%", type, expr); + + tree cunion_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type))); + tree field_decl = TYPE_FIELDS (cunion_type); + while (EQUIVALENT (union_mode) != NO_MOID) + union_mode = EQUIVALENT (union_mode); + for (PACK_T *pack = PACK (union_mode); pack != NO_PACK; FORWARD (pack)) + { + tree continue_label_decl = build_decl (UNKNOWN_LOCATION, + LABEL_DECL, + NULL, /* Set below. */ + void_type_node); + char *label_name = xasprintf ("continue%d%%", DECL_UID (continue_label_decl)); + DECL_NAME (continue_label_decl) = get_identifier (label_name); + free (label_name); + + a68_add_decl (continue_label_decl); + + a68_add_stmt (fold_build2 (TRUTH_ORIF_EXPR, + integer_type_node, + fold_build2 (EQ_EXPR, + integer_type_node, + a68_union_overhead (dup), + size_int (a68_united_mode_index (union_mode, MOID (pack)))), + fold_build2 (COMPOUND_EXPR, + integer_type_node, + build1 (GOTO_EXPR, void_type_node, continue_label_decl), + integer_zero_node))); + a68_add_stmt (fold_build2 (MODIFY_EXPR, type, + fold_build3 (COMPONENT_REF, + TREE_TYPE (field_decl), + a68_union_cunion (dup), + field_decl, + NULL_TREE), + a68_low_dup (fold_build3 (COMPONENT_REF, + TREE_TYPE (field_decl), + a68_union_cunion (dup), + field_decl, + NULL_TREE), + use_heap))); + a68_add_stmt (build1 (LABEL_EXPR, void_type_node, continue_label_decl)); + field_decl = TREE_CHAIN (field_decl); + } + + a68_add_stmt (dup); + dup = a68_pop_range (); + } + else + /* Not an Algol 68 value. */ + gcc_unreachable (); + + return dup; +} + +/* Lower code to ascribe the value yielded by the expression in RHS to the + defining identifier implied by the LHS, which is a VAR_DECL tree. MODE is + the mode of the value to be ascribed. */ + +tree +a68_low_ascription (MOID_T *mode, tree lhs, tree rhs) +{ + gcc_assert (VAR_P (lhs)); + + tree type = CTYPE (mode); + if (IS (mode, PROC_SYMBOL)) + { + /* A pointer to a function, or a function, is expected at the right hand + side. We need a pointer for the left hand side.. */ + if (TREE_CODE (TREE_TYPE (rhs)) == FUNCTION_TYPE) + { + type = build_pointer_type (type); + rhs = fold_build1 (ADDR_EXPR, type, rhs); + } + } + + if (HAS_ROWS (mode)) + rhs = a68_low_dup (rhs); + return fold_build2 (MODIFY_EXPR, type, lhs, rhs); +} + +/* Perform an assignation of RHS to LHS. + + MODE_RHS is the mode of the rhs. + MODE_LHS is the mode of the lhs. + + MODE_LHS shall be REF [FLEX] MODE_LHS. */ + +tree +a68_low_assignation (NODE_T *p, + tree lhs, MOID_T *mode_lhs, + tree rhs, MOID_T *mode_rhs) +{ + NODE_T *lhs_node = SUB (p); + tree assignation = NULL_TREE; + tree orig_rhs = rhs; + + if (IS_FLEXETY_ROW (mode_rhs)) + { + /* Make a deep copy of the rhs. Note that we have to use the heap + because the scope of the lhs may be older than the scope of the rhs. + XXX this can be ommitted if a68_multiple_copy_elems below supports + overlapping multiples. */ + if (HAS_ROWS (mode_rhs)) + rhs = a68_low_dup (rhs, true /* use_heap */); + rhs = save_expr (rhs); + + /* Determine whether the REF [FLEX] MODE_LHS is flexible. */ + if (SUB (mode_lhs) == M_STRING || IS_FLEX (SUB (mode_lhs))) + { + /* Assigning to a flexible name updates descriptor with new bounds + and also sets the elements to the dup of the rhs. No boundscheck + is peformed. XXX but bound checking in contained values may be + necessary, ghost elements. */ + if (POINTER_TYPE_P (TREE_TYPE (lhs)) + && TREE_TYPE (TREE_TYPE (lhs)) == TREE_TYPE (rhs)) + { + /* Make sure to not evaluate the expression yielding the pointer + more than once. */ + lhs = save_expr (lhs); + tree deref_lhs = a68_checked_indirect_ref (lhs_node, lhs, mode_lhs); + assignation = fold_build2 (COMPOUND_EXPR, + TREE_TYPE (lhs), + fold_build2 (MODIFY_EXPR, TREE_TYPE (lhs), + deref_lhs, rhs), + lhs); + } + else + { + /* The lhs is either a variable or a component ref as a l-value. It + is ok to evaluate it as an r-value as well as doing so inroduces + no side-effects. */ + assignation = fold_build2 (COMPOUND_EXPR, + TREE_TYPE (lhs), + fold_build2 (MODIFY_EXPR, TREE_TYPE (lhs), + lhs, rhs), + lhs); + } + } + else + { + /* Dereference the multiple at the left-hand side. This may require + indirection. */ + + tree effective_lhs; + if (POINTER_TYPE_P (TREE_TYPE (lhs))) + { + /* The name at the lhs is a pointer. */ + gcc_assert (TREE_TYPE (TREE_TYPE (lhs)) == TREE_TYPE (rhs)); + lhs = save_expr (lhs); + effective_lhs = a68_checked_indirect_ref (lhs_node, lhs, mode_lhs); + } + else + { + /* The name at the lhs is either a variable or a component ref as + a l-value. It is ok to evaluate it as an r-value as well as + doing so introduces no side-effects. */ + effective_lhs = lhs; + } + + /* Copy over the elements in a loop. The space occupied by the + previous elements stored in the lhs multiple will be recovered by + either stack shrinkage or garbage collected. */ + tree copy_elements = a68_multiple_copy_elems (mode_rhs, effective_lhs, rhs); + assignation = fold_build2 (COMPOUND_EXPR, + TREE_TYPE (lhs), + copy_elements, + lhs); + + /* Check the bounds of the multiple at the rhs to make sure they are + the same than the bounds of the multiple already referred by the + lhs. If the bounds don't match then emit a run-time error. */ + if (OPTION_BOUNDS_CHECKING (&A68_JOB)) + assignation = fold_build2 (COMPOUND_EXPR, + TREE_TYPE (assignation), + a68_multiple_bounds_check_equal (p, + effective_lhs, + rhs), + assignation); + + } + } + else + { + /* First make sure we got a pointer in the RHS in case it is a name. */ + rhs = a68_consolidate_ref (mode_rhs, rhs); + + /* The assignation implies copying the entire value being assigned, so + make sure we do a deep copy whenever needed. Note that we have to use + the heap because the scope of the lhs may be older than the scope of + the rhs. */ + if (HAS_ROWS (mode_rhs)) + rhs = a68_low_dup (rhs, true /* use_heap */); + + if (POINTER_TYPE_P (TREE_TYPE (lhs)) + && TREE_TYPE (TREE_TYPE (lhs)) == TREE_TYPE (rhs)) + { + /* If the left hand side is a pointer, deref it, but return the + pointer. Make sure to not evaluate the expression yielding the + pointer more than once. */ + lhs = save_expr (lhs); + tree deref_lhs = a68_checked_indirect_ref (lhs_node, lhs, mode_lhs); + assignation = fold_build2 (COMPOUND_EXPR, + TREE_TYPE (lhs), + fold_build2 (MODIFY_EXPR, TREE_TYPE (lhs), + deref_lhs, rhs), + lhs); + } + else + { + /* Otherwise the lhs is either a variable or a component ref as an + l-value. It is ok to evaluate it as an r-value as well as doing + so introduces no side-effects. */ + assignation = fold_build2 (COMPOUND_EXPR, + TREE_TYPE (lhs), + fold_build2 (MODIFY_EXPR, TREE_TYPE (lhs), + lhs, rhs), + lhs); + } + } + + /* Since it is been assigned to a name, the rhs is no longer constant. */ + if (A68_ROW_TYPE_P (TREE_TYPE (orig_rhs)) || A68_STRUCT_TYPE_P (TREE_TYPE (orig_rhs))) + TREE_CONSTANT (orig_rhs) = 0; + return assignation; +} + +/* Build a tree that copies SIZE bytes from SRC into DST. */ + +tree +a68_lower_memcpy (tree dst, tree src, tree size) +{ + return build_call_expr (builtin_decl_explicit (BUILT_IN_MEMCPY), 3, + dst, src, size); +} + +/* Build a tree that allocates SIZE bytes on the stack and returns a *TYPE + pointer to it. */ + +tree +a68_lower_alloca (tree type, tree size) +{ + tree call = builtin_decl_explicit (BUILT_IN_ALLOCA_WITH_ALIGN); + call = build_call_expr_loc (UNKNOWN_LOCATION, call, 2, + size, + size_int (TYPE_ALIGN (type))); + call = fold_convert (build_pointer_type (type), call); + return call; +} + + +/* Build a tree that allocates SIZE bytes on the heap and returns a *TYPE + pointer to it. */ + +tree +a68_lower_malloc (tree type, tree size) +{ + return fold_convert (build_pointer_type (type), + a68_build_libcall (A68_LIBCALL_MALLOC, ptr_type_node, + 1, size)); +} + +/* Build code for a temporary variable named NAME, of type TYPE and initialized + to INIT. Returns the decl node for the temporary. */ + +tree +a68_lower_tmpvar (const char *name, tree type, tree init) +{ + tree tmpvar = build_decl (UNKNOWN_LOCATION, + VAR_DECL, + get_identifier (name), + type); + DECL_ARTIFICIAL (tmpvar) = 1; + DECL_IGNORED_P (tmpvar) = 1; + a68_add_decl (tmpvar); + a68_add_decl_expr (fold_build1 (DECL_EXPR, type, tmpvar)); + a68_add_stmt (fold_build2 (INIT_EXPR, type, tmpvar, init)); + return tmpvar; +} + +/* Build a FUNC_DECL for a top-level non-public function and return it. */ + +tree +a68_low_toplevel_func_decl (const char *name, tree fntype) +{ + tree fndecl = build_decl (UNKNOWN_LOCATION, + FUNCTION_DECL, + NULL /* set below */, + fntype); + char *_name = xasprintf ("__ga68_%s%d", name, DECL_UID (fndecl)); + DECL_NAME (fndecl) = get_identifier (_name); + free (_name); + DECL_EXTERNAL (fndecl) = 0; + TREE_PUBLIC (fndecl) = 0; + TREE_STATIC (fndecl) = 1; + + return fndecl; +} + +/* Build a PARM_DECL whose context is TYPE with the given NAME. */ + +tree +a68_low_func_param (tree fndecl, const char *name, tree type) +{ + tree param = build_decl (UNKNOWN_LOCATION, PARM_DECL, + get_identifier (name), type); + DECL_CONTEXT (param) = fndecl; + DECL_ARG_TYPE (param) = TREE_TYPE (param); + layout_decl (param, 0); + return param; +} + +/* Lower revelations, to calls to either its prelude or poslude. + This function always returns NULL_TREE. */ + +static tree +lower_revelations (NODE_T *p, LOW_CTX_T ctx, bool prelude) +{ + for (; p != NO_NODE; FORWARD (p)) + { + lower_revelations (SUB (p), ctx, prelude); + if (IS (p, MODULE_INDICANT)) + { + tree decl = build_decl (a68_get_node_location (p), + FUNCTION_DECL, + NULL_TREE, /* name, set below. */ + build_function_type (void_type_node, + void_list_node)); + DECL_NAME (decl) + = a68_get_mangled_identifier (prelude ? "_prelude" : "_postlude", + NSYMBOL (p)); + DECL_EXTERNAL (decl) = 1; + TREE_PUBLIC (decl) = 1; + a68_add_decl (decl); + a68_add_stmt (build_call_expr_loc (a68_get_node_location (p), + decl, 0)); + } + } + + return NULL_TREE; +} + +/* Lower a module text. + + module text : revelation part, def part, postlude part, fed symbol ; + revelation part, def part, fed symbol ; + def part, postlude part, fed symbol ; + def part, postlude part, fed symbol. + def part : def symbol, enquiry clause. + postlude part : postlude symbol, serial clause. + + Each module text lowers to two functions which are callable from outside the + current compilation unit: + + MODULENAME__prelude + MODULENAME__postlude + + Declarations inside prelude and postlude are lowered into global decl trees. + The non-PUBlicized ones are marked as static. + + This handler always returns NULL_TREE. */ + +static tree +lower_module_text (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *def_part = (IS (SUB (p), REVELATION_PART) + ? NEXT_SUB (p) + : SUB (p)); + NODE_T *revelation_part = (IS (SUB (p), REVELATION_PART) + ? SUB (p) + : NO_NODE); + NODE_T *postlude_part = (IS (NEXT (def_part), FED_SYMBOL) + ? NO_NODE + : NEXT (def_part)); + NODE_T *prelude_enquiry = NEXT_SUB (def_part); + + /* The global sentinel of the module, initialized to 0. */ + tree sentinel_decl = build_decl (UNKNOWN_LOCATION, + VAR_DECL, NULL /* name */, + sizetype); + char *sentinel_name = xasprintf ("%s__sentinel", ctx.module_definition_name); + DECL_NAME (sentinel_decl) = get_identifier (sentinel_name); + free (sentinel_name); + TREE_PUBLIC (sentinel_decl) = 0; + TREE_STATIC (sentinel_decl) = 1; + DECL_CONTEXT (sentinel_decl) = NULL_TREE; /* File scope. */ + make_decl_rtl (sentinel_decl); + varpool_node::finalize_decl (sentinel_decl); + + /* Create the prelude function. */ + tree prelude_decl = build_decl (a68_get_node_location (def_part), + FUNCTION_DECL, + NULL_TREE, /* name, set below. */ + build_function_type (void_type_node, + void_list_node)); + DECL_NAME (prelude_decl) + = a68_get_mangled_identifier ("_prelude", + ctx.module_definition_name); + DECL_EXTERNAL (prelude_decl) = 0; + TREE_PUBLIC (prelude_decl) = 1; + TREE_STATIC (prelude_decl) = 1; + + a68_push_function_range (prelude_decl, + void_type_node /* result_type */, true /* top_level */); + { + /* Increase sentinel. */ + a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, + sizetype, + sentinel_decl, size_one_node)); + + a68_push_stmt_list (NULL); + { + a68_push_stmt_list (NULL); + { + /* Add calls to preludes of modules in REVELATION_PART. */ + lower_revelations (revelation_part, ctx, true /* prelude */); + a68_add_stmt (a68_lower_tree (prelude_enquiry, ctx)); + } + tree do_prelude = a68_pop_stmt_list (); + + a68_push_stmt_list (M_VOID); + tree do_nothing = a68_pop_stmt_list (); + + /* Do the prelude work only if sentinel is 1. */ + a68_add_stmt (fold_build3 (COND_EXPR, void_type_node, + fold_build2 (EQ_EXPR, sizetype, + sentinel_decl, size_one_node), + do_prelude, do_nothing)); + } + tree prelude_body = a68_pop_stmt_list (); + a68_pop_function_range (prelude_body); + } + + /* Create the postlude function. This is done even if the module definition + has no postlude in the source code. */ + + location_t postlude_loc = UNKNOWN_LOCATION; + if (postlude_part != NO_NODE) + postlude_loc = a68_get_node_location (postlude_part); + tree postlude_decl = build_decl (postlude_loc, + FUNCTION_DECL, + NULL_TREE, /* name, set below. */ + build_function_type (void_type_node, + void_list_node)); + DECL_NAME (postlude_decl) + = a68_get_mangled_identifier ("_postlude", + ctx.module_definition_name); + DECL_EXTERNAL (postlude_decl) = 0; + TREE_PUBLIC (postlude_decl) = 1; + TREE_STATIC (postlude_decl) = 1; + + a68_push_function_range (postlude_decl, + void_type_node /* result_type */, true /* top_level */); + { + /* Decrease sentinel. */ + a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, + sizetype, + sentinel_decl, size_one_node)); + + a68_push_stmt_list (NULL); + { + a68_push_stmt_list (NULL); + { + /* Add calls to postludes of modules in REVELATION_PART. */ + lower_revelations (revelation_part, ctx, false /* prelude */); + /* Perhaps the postlude code, if there is one. */ + NODE_T *postlude_serial = NO_NODE; + if (postlude_part != NO_NODE) + postlude_serial = NEXT_SUB (postlude_part); + if (postlude_serial != NO_NODE) + a68_add_stmt (a68_lower_tree (postlude_serial, ctx)); + } + tree do_postlude = a68_pop_stmt_list (); + + a68_push_stmt_list (M_VOID); + tree do_nothing = a68_pop_stmt_list (); + + /* Do the postlude work only if sentinel is 0. */ + a68_add_stmt (fold_build3 (COND_EXPR, void_type_node, + fold_build2 (EQ_EXPR, sizetype, + sentinel_decl, size_zero_node), + do_postlude, do_nothing)); + } + tree postlude_body = a68_pop_stmt_list (); + a68_pop_function_range (postlude_body); + } + + return NULL_TREE; +} + +/* Lower a set of module declarations. + + module declaration : module symbol, defining module, equals symbol, module text ; + module_declaration, comma symbol, defining module, + equals symbol, module text. + + Each module declaration lowers into the side-effects of emitting prelude and + postlude global functions, and emitting global declarations for the + declarations in the module definition prelude. + + This handler always returns NULL_TREE. */ + +static tree +lower_module_declaration (NODE_T *p, LOW_CTX_T ctx) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, DEFINING_MODULE_INDICANT)) + { + ctx.module_definition_name = NSYMBOL (p); + A68_MODULE_DEFINITION_DECLS->truncate (0); + vec_alloc (A68_MODULE_DEFINITION_DECLS, 16); + lower_module_text (NEXT (NEXT (p)), ctx); + for (tree d : A68_MODULE_DEFINITION_DECLS) + { + if (TREE_CODE (d) == FUNCTION_DECL) + cgraph_node::finalize_function (d, true); + else + { + rest_of_decl_compilation (d, 1, 0); + make_decl_rtl (d); + } + } + } + else + lower_module_declaration (SUB (p), ctx); + } + + return NULL_TREE; +} + +/* Lower a prelude packet. + + prelude packet : module declaration. + + This handler always returns NULL_TREE. */ + +static tree +lower_prelude_packet (NODE_T *p, LOW_CTX_T ctx) +{ + a68_lower_tree (SUB (p), ctx); + return NULL_TREE; +} + +/* Lower a particular program. + + particular program : label, enclosed clause; enclosed clause. + + This handler always returns NULL_TREE. */ + +static tree +lower_particular_program (NODE_T *p, LOW_CTX_T ctx) +{ + /* Create the main function that conforms the particular program. */ + tree main_decl = build_decl (a68_get_node_location (p), + FUNCTION_DECL, + get_identifier ("__algol68_main"), + build_function_type (void_type_node, + void_list_node)); + DECL_EXTERNAL (main_decl) = 0; + TREE_PUBLIC (main_decl) = 1; + TREE_STATIC (main_decl) = 1; + + a68_push_function_range (main_decl, + void_type_node /* result_type */); + + /* Lower the body of the function. */ + NODE_T *enclosed_clause = (IS (SUB (p), ENCLOSED_CLAUSE) + ? SUB (p) : NEXT (SUB (p))); + tree body_expr = a68_lower_tree (enclosed_clause, ctx); + a68_pop_function_range (body_expr); + return NULL_TREE; +} + +/* Lower a packet. + + packet : particular program ; prelude packet. +*/ + +static tree +lower_packet (NODE_T *p, + LOW_CTX_T ctx) +{ + return a68_lower_tree (SUB (p), ctx); +} + +/* Lower the given tree P using the given context CTX. */ + +tree +a68_lower_tree (NODE_T *p, LOW_CTX_T ctx) +{ +#if 0 + for (int i = 0; i < ctx.level; ++i) + printf (" "); + printf ("LOWER TREE: %d::%s\n", + NUMBER (p), a68_attribute_name (ATTRIBUTE (p))); +#endif + ctx.level++; + + tree res = NULL_TREE; + + if (p == NO_NODE) + gcc_unreachable (); + + switch (ATTRIBUTE (p)) + { + case PACKET: + res = lower_packet (p, ctx); + break; + break; + case PRELUDE_PACKET: + res = lower_prelude_packet (p, ctx); + break; + case MODULE_DECLARATION: + res = lower_module_declaration (p, ctx); + break; + case MODULE_TEXT: + res = lower_module_text (p, ctx); + break; + case PARTICULAR_PROGRAM: + res = lower_particular_program (p, ctx); + break; + /* Clauses */ + case ENCLOSED_CLAUSE: + res = a68_lower_enclosed_clause (p, ctx); + break; + case CLOSED_CLAUSE: + res = a68_lower_closed_clause (p, ctx); + break; + case ACCESS_CLAUSE: + res = a68_lower_access_clause (p, ctx); + break; + case PARALLEL_CLAUSE: + res = a68_lower_parallel_clause (p, ctx); + break; + case COLLATERAL_CLAUSE: + res = a68_lower_collateral_clause (p, ctx); + break; + case UNIT_LIST: + res = a68_lower_unit_list (p, ctx); + break; + case CONDITIONAL_CLAUSE: + res = a68_lower_conditional_clause (p, ctx); + break; + case ENQUIRY_CLAUSE: + res = a68_lower_enquiry_clause (p, ctx); + break; + case CASE_CLAUSE: + res = a68_lower_case_clause (p, ctx); + break; + case CONFORMITY_CLAUSE: + res = a68_lower_conformity_clause (p, ctx); + break; + case LOOP_CLAUSE: + res = a68_lower_loop_clause (p, ctx); + break; + case SERIAL_CLAUSE: + res = a68_lower_serial_clause (p, ctx); + break; + case INITIALISER_SERIES: + res = a68_lower_initialiser_series (p, ctx); + break; + case EXIT_SYMBOL: + res = a68_lower_completer (p, ctx); + break; + case LABELED_UNIT: + res = a68_lower_labeled_unit (p, ctx); + break; + case LABEL: + res = a68_lower_label (p, ctx); + break; + /* Declarations. */ + case DECLARATION_LIST: + res = a68_lower_declaration_list (p, ctx); + break; + case DECLARER: + res = a68_lower_declarer (p, ctx); + break; + case IDENTITY_DECLARATION: + res = a68_lower_identity_declaration (p, ctx); + break; + case VARIABLE_DECLARATION: + res = a68_lower_variable_declaration (p, ctx); + break; + case PROCEDURE_DECLARATION: + res = a68_lower_procedure_declaration (p, ctx); + break; + case PROCEDURE_VARIABLE_DECLARATION: + res = a68_lower_procedure_variable_declaration (p, ctx); + break; + case PRIORITY_DECLARATION: + res = a68_lower_priority_declaration (p, ctx); + break; + case BRIEF_OPERATOR_DECLARATION: + res = a68_lower_brief_operator_declaration (p, ctx); + break; + case OPERATOR_DECLARATION: + res = a68_lower_operator_declaration (p, ctx); + break; + case MODE_DECLARATION: + res = a68_lower_mode_declaration (p, ctx); + break; + /* Units. */ + case UNIT: + res = a68_lower_unit (p, ctx); + break; + case ROUTINE_TEXT: + res = a68_lower_routine_text (p, ctx); + break; + case ASSIGNATION: + res = a68_lower_assignation (p, ctx); + break; + case TERTIARY: + res = a68_lower_tertiary (p, ctx); + break; + case MONADIC_FORMULA: + res = a68_lower_monadic_formula (p, ctx); + break; + case FORMULA: + res = a68_lower_formula (p, ctx); + break; + case SECONDARY: + res = a68_lower_secondary (p, ctx); + break; + case SLICE: + res = a68_lower_slice (p, ctx); + break; + case SELECTION: + res = a68_lower_selection (p, ctx); + break; + case PRIMARY: + res = a68_lower_primary (p, ctx); + break; + case GENERATOR: + res = a68_lower_generator (p, ctx); + break; + case CALL: + res = a68_lower_call (p, ctx); + break; + case CAST: + res = a68_lower_cast (p, ctx); + break; + case AND_FUNCTION: + case OR_FUNCTION: + res = a68_lower_logic_function (p, ctx); + break; + case IDENTITY_RELATION: + res = a68_lower_identity_relation (p, ctx); + break; + case EMPTY_SYMBOL: + res = a68_lower_empty (p, ctx); + break; + case NIHIL: + res = a68_lower_nihil (p, ctx); + break; + case SKIP: + res = a68_lower_skip (p, ctx); + break; + case DENOTATION: + res = a68_lower_denotation (p, ctx); + break; + case IDENTIFIER: + res = a68_lower_identifier (p, ctx); + break; + /* Coercions. */ + case ROWING: + res = a68_lower_rowing (p, ctx); + break; + case WIDENING: + res = a68_lower_widening (p, ctx); + break; + case DEPROCEDURING: + res = a68_lower_deproceduring (p, ctx); + break; + case PROCEDURING: + res = a68_lower_proceduring (p, ctx); + break; + case VOIDING: + res = a68_lower_voiding (p, ctx); + break; + case DEREFERENCING: + res = a68_lower_dereferencing (p, ctx); + break; + /* Others. */ + case UNITING: + res = a68_lower_uniting (p, ctx); + break; + case JUMP: + res = a68_lower_jump (p, ctx); + break; + case PARAMETER: + res = a68_lower_parameter (p, ctx); + break; + case PARAMETER_LIST: + res = a68_lower_parameter_list (p, ctx); + break; + case PARAMETER_PACK: + res = a68_lower_parameter_pack (p, ctx); + break; + case OPERATOR: + res = a68_lower_operator (p, ctx); + break; + case ASSERTION: + res = a68_lower_assertion (p, ctx); + break; + case STOP: + res = NULL_TREE; + break; + default: + fatal_error (a68_get_node_location (p), "cannot lower node %s", + a68_attribute_name (ATTRIBUTE (p))); + gcc_unreachable (); + break; + } + + return res; +} + +/* Lower an Algol 68 complete parse tree to a GENERIC tree. */ + +tree +a68_lower_top_tree (NODE_T *p) +{ + LOW_CTX_T top_ctx; + + top_ctx.declarer = NULL; + top_ctx.proc_decl_identifier = NO_NODE; + top_ctx.proc_decl_operator = false; + top_ctx.level = 0; + top_ctx.module_definition_name = NULL; + vec_alloc (A68_MODULE_DEFINITION_DECLS, 16); + return a68_lower_tree (p, top_ctx); +} From 466a286c3369c7227b0bbbd2efe6c41671c58e48 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:51:55 +0200 Subject: [PATCH 165/373] a68: low: plain values Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-low-bits.cc: New file. * algol68/a68-low-bools.cc: Likewise. * algol68/a68-low-chars.cc: Likewise. * algol68/a68-low-complex.cc: Likewise. * algol68/a68-low-ints.cc: Likewise. * algol68/a68-low-procs.cc: Likewise. * algol68/a68-low-reals.cc: Likewise. * algol68/a68-low-refs.cc: Likewise. * algol68/a68-low-strings.cc: Likewise. --- gcc/algol68/a68-low-bits.cc | 297 ++++++++++++++++ gcc/algol68/a68-low-bools.cc | 77 ++++ gcc/algol68/a68-low-chars.cc | 170 +++++++++ gcc/algol68/a68-low-complex.cc | 141 ++++++++ gcc/algol68/a68-low-ints.cc | 327 +++++++++++++++++ gcc/algol68/a68-low-procs.cc | 52 +++ gcc/algol68/a68-low-reals.cc | 620 +++++++++++++++++++++++++++++++++ gcc/algol68/a68-low-refs.cc | 52 +++ gcc/algol68/a68-low-strings.cc | 399 +++++++++++++++++++++ 9 files changed, 2135 insertions(+) create mode 100644 gcc/algol68/a68-low-bits.cc create mode 100644 gcc/algol68/a68-low-bools.cc create mode 100644 gcc/algol68/a68-low-chars.cc create mode 100644 gcc/algol68/a68-low-complex.cc create mode 100644 gcc/algol68/a68-low-ints.cc create mode 100644 gcc/algol68/a68-low-procs.cc create mode 100644 gcc/algol68/a68-low-reals.cc create mode 100644 gcc/algol68/a68-low-refs.cc create mode 100644 gcc/algol68/a68-low-strings.cc diff --git a/gcc/algol68/a68-low-bits.cc b/gcc/algol68/a68-low-bits.cc new file mode 100644 index 000000000000..465969f9ade1 --- /dev/null +++ b/gcc/algol68/a68-low-bits.cc @@ -0,0 +1,297 @@ +/* Lowering routines for all things related to BITS values. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Return a tree with the yielind of SKIP for the given BITS mode. */ + +tree +a68_get_bits_skip_tree (MOID_T *m) +{ + tree type; + + if (m == M_BITS) + type = a68_bits_type; + else if (m == M_LONG_BITS) + type = a68_long_bits_type; + else if (m == M_LONG_LONG_BITS) + type = a68_long_long_bits_type; + else if (m == M_SHORT_BITS) + type = a68_short_bits_type; + else if (m == M_SHORT_SHORT_BITS) + type = a68_short_short_bits_type; + else + gcc_unreachable (); + + return build_int_cst (type, 0); +} + +/* Given a BITS type, compute the number of bits that fit in a value of that + type. The result is an INT. */ + +tree +a68_bits_width (tree type) +{ + return fold_convert (a68_int_type, TYPE_SIZE (type)); +} + +/* Given a BITS type, compute the maximum value that can be expressed with that + type. */ + +tree +a68_bits_maxbits (tree type) +{ + return fold_convert (type, TYPE_MAX_VALUE (type)); +} + +/* Given a SIZETY INT value VAL, compute and return a SIZETY BITS reflecting + its constituent bits. + + In strict Algol 68 the BIN of a negative value is BITS (SKIP). + + In GNU 68 the BIN of a negative value is the constituent bits of the two's + complement of the value. */ + +tree +a68_bits_bin (MOID_T *m, tree val) +{ + tree type = CTYPE (m); + + if (OPTION_STRICT (&A68_JOB)) + return a68_get_bits_skip_tree (m); + else + return fold_convert (type, val); +} + +/* Given a SIZETY BITS value BITS, compute and return the corresponding SIZETY + INT. + + In strict Algol 68 the ABS of a BITS value reflecting a bit pattern that + would correspond a negative integral value is INT (SKIP). + + In GNU 68 the ABS of a BITS value reflecting a bit pattern that would + correspond a negative integral value is that negative integral value. */ + +tree +a68_bits_abs (MOID_T *m, tree bits) +{ + tree type = CTYPE (m); + + if (OPTION_STRICT (&A68_JOB)) + { + tree integral_val = save_expr (fold_convert (type, bits)); + return fold_build3 (COND_EXPR, + type, + fold_build2 (LT_EXPR, type, integral_val, + build_int_cst (type, 0)), + a68_get_int_skip_tree (m), + integral_val); + } + else + return fold_convert (type, bits); +} + +/* Given a SIZETY BITS value BITS, shorten it into a SIZETY BITS whose tree + type is TYPE. */ + +tree +a68_bits_shorten (tree type, tree bits) +{ + /* This will truncate at the left, which is what is intended. */ + return fold_convert (type, bits); +} + +/* Given a SIZETY BITS value BITS, length it into a SIZETY BITS whose tree type + is TYPE. */ + +tree +a68_bits_leng (tree type, tree bits) +{ + /* This will add zeroes to the left, which is what is intended. */ + return fold_convert (type, bits); +} + +/* Given a SIZETY BITS value BITS, compute and return a new SIZETY BITS whose + bits are the logical negation of the bits of BITS. */ + +tree +a68_bits_not (tree bits) +{ + return fold_build1 (BIT_NOT_EXPR, TREE_TYPE (bits), bits); +} + +/* Given two SIZETY BITS values BITS1 and BITS2, compute and return a new + SIZETY BITS whose bits are the `and' of the bits of BITS1 and + BITS2. */ + +tree +a68_bits_and (tree bits1, tree bits2) +{ + return fold_build2 (BIT_AND_EXPR, TREE_TYPE (bits1), bits1, bits2); +} + +/* Given two SIZETY BITS values BITS1 and BITS2, compute and return a new + SIZETY BITS whose bits are the inclusive-or of the bits of BITS1 and + BITS2. */ + +tree +a68_bits_ior (tree bits1, tree bits2) +{ + return fold_build2 (BIT_IOR_EXPR, TREE_TYPE (bits1), bits1, bits2); +} + +/* Given two SIZETY BITS values BITS1 and BITS2, compute and return a new + SIZETY BITS whose bits are the exclusive-or of the bits of BITS1 and + BITS2. */ + +tree +a68_bits_xor (tree bits1, tree bits2) +{ + return fold_build2 (BIT_XOR_EXPR, TREE_TYPE (bits1), bits1, bits2); +} + +/* Given a position POS of mode INT and a BITS of mode SIZETY BITS, return a + BOOL reflecting the state of the bit occupying the position POS in BITS. + + If POS is out of range a run-time error is emitted. */ + +tree +a68_bits_elem (NODE_T *p, tree pos, tree bits) +{ + pos = save_expr (pos); + tree one = build_int_cst (TREE_TYPE (bits), 1); + + tree shift = fold_build2 (MINUS_EXPR, bitsizetype, + TYPE_SIZE (TREE_TYPE (bits)), + fold_convert (bitsizetype, pos)); + tree elem = fold_build2 (EQ_EXPR, + a68_bool_type, + fold_build2 (BIT_AND_EXPR, + TREE_TYPE (bits), + fold_build2 (RSHIFT_EXPR, + TREE_TYPE (bits), + bits, shift), + one), + one); + + /* Do bounds checking if requested. */ + if (OPTION_BOUNDS_CHECKING (&A68_JOB)) + { + unsigned int lineno = NUMBER (LINE (INFO (p))); + const char *filename_str = FILENAME (LINE (INFO (p))); + tree filename = build_string_literal (strlen (filename_str) + 1, + filename_str); + tree call = a68_build_libcall (A68_LIBCALL_BITSBOUNDSERROR, + void_type_node, 3, + filename, + build_int_cst (unsigned_type_node, lineno), + fold_convert (ssizetype, pos)); + tree check = fold_build2 (TRUTH_AND_EXPR, integer_type_node, + fold_build2 (GT_EXPR, integer_type_node, + pos, fold_convert (TREE_TYPE (pos), integer_zero_node)), + fold_build2 (LE_EXPR, integer_type_node, + fold_convert (bitsizetype, pos), + TYPE_SIZE (TREE_TYPE (bits)))); + + check = fold_build2_loc (a68_get_node_location (p), + TRUTH_ORIF_EXPR, + ssizetype, + check, + fold_build2 (COMPOUND_EXPR, a68_bool_type, + call, boolean_false_node)); + elem = fold_build2 (COMPOUND_EXPR, a68_bool_type, + check, elem); + } + + return elem; +} + +/* Given two SIZETY BITS values BITS1 and BITS2, return a BOOL value indicating + whether all the bits set in BITS1 are also set in BITS2. */ + +tree +a68_bits_subset (tree bits1, tree bits2) +{ + /* We compute this operation with `A | B == B' as specified by the Report */ + bits2 = save_expr (bits2); + return fold_build2 (EQ_EXPR, a68_bool_type, + fold_build2 (BIT_IOR_EXPR, TREE_TYPE (bits1), bits1, bits2), + bits2); +} + +/* Rotate the bits in BITS SHIFT bits to the left if SHIFT is positive, or ABS + (SHIFT) bits to the right if SHIFT is negative. + + A run-time error is raised if the count overflows the BITS value. */ + +tree +a68_bits_shift (tree shift, tree bits) +{ + shift = save_expr (shift); + bits = save_expr (bits); + return fold_build3 (COND_EXPR, + TREE_TYPE (bits), + fold_build2 (GE_EXPR, TREE_TYPE (shift), + shift, build_int_cst (TREE_TYPE (shift), 0)), + fold_build2 (LSHIFT_EXPR, TREE_TYPE (bits), + bits, shift), + fold_build2 (RSHIFT_EXPR, TREE_TYPE (bits), + bits, + fold_build1 (ABS_EXPR, TREE_TYPE (shift), shift))); +} + +/* Given two bits values, build an expression that calculates whether A = B. */ + +tree +a68_bits_eq (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b); +} + +/* Given two bits values, build an expression that calculates whether A /= + B. */ + +tree +a68_bits_ne (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b); +} diff --git a/gcc/algol68/a68-low-bools.cc b/gcc/algol68/a68-low-bools.cc new file mode 100644 index 000000000000..000e919407d9 --- /dev/null +++ b/gcc/algol68/a68-low-bools.cc @@ -0,0 +1,77 @@ +/* Lowering routines for all things related to BOOL values. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Return a tree with the yielind of SKIP of a BOOL mode. */ + +tree +a68_get_bool_skip_tree (void) +{ + return build_int_cst (a68_bool_type, 0); +} + +/* The absolute value of a BOOL is a non-zero INT for TRUE and zero for + FALSE. */ + +tree +a68_bool_abs (tree val) +{ + return fold_convert (a68_int_type, val); +} + +/* Given two boolean values, build an expression that calculates whether A = B. */ + +tree +a68_bool_eq (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b); +} + +/* Given two boolean values, build an expression that calculates whether A /= + B. */ + +tree +a68_bool_ne (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b); +} diff --git a/gcc/algol68/a68-low-chars.cc b/gcc/algol68/a68-low-chars.cc new file mode 100644 index 000000000000..244493475558 --- /dev/null +++ b/gcc/algol68/a68-low-chars.cc @@ -0,0 +1,170 @@ +/* Lowering routines for all things related to STRINGs. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Return a tree with the yielind of SKIP of a CHAR mode. */ + +tree +a68_get_char_skip_tree (void) +{ + return build_int_cst (a68_char_type, ' '); +} + +/* Return the maximum valid character code that can be stored in a CHAR. */ +tree +a68_char_max (void) +{ + /* 0x10FFFF is the maximum valid code point in Unicode. */ + return build_int_cst (a68_char_type, 0x10FFFF); +} + +/* Given an integral value, if it denotes a char code build the corresponding + CHAR. Otherwise raise a run-time error. */ + +tree +a68_char_repr (NODE_T *p, tree val) +{ + /* UCS-4 (UTF-32) encodes the Unicode code points using the identity + function. Valid code points are in the ranges [U+0000,U+D7FF] and + [U+E000,U+10FFFF]. */ + + tree c = save_expr (val); + tree val_type = TREE_TYPE (val); + + /* (c >= 0 && c < 0xd800) */ + tree range1 = fold_build2 (TRUTH_AND_EXPR, integer_type_node, + fold_build2 (GE_EXPR, integer_type_node, + c, fold_convert (val_type, integer_zero_node)), + fold_build2 (LT_EXPR, integer_type_node, + c, build_int_cst (val_type, 0xd800))); + /* (c >= 0xe000 && c < 0x110000) */ + tree range2 = fold_build2 (TRUTH_AND_EXPR, integer_type_node, + fold_build2 (GE_EXPR, integer_type_node, + c, build_int_cst (val_type, 0xe000)), + fold_build2 (LT_EXPR, integer_type_node, + c, build_int_cst (val_type, 0x110000))); + tree notvalid = fold_build1 (TRUTH_NOT_EXPR, + integer_type_node, + fold_build2 (TRUTH_OR_EXPR, integer_type_node, + range1, range2)); + + /* Call to the runtime run-time error handler. */ + unsigned int lineno = NUMBER (LINE (INFO (p))); + const char *filename_str = FILENAME (LINE (INFO (p))); + tree filename = build_string_literal (strlen (filename_str) + 1, + filename_str); + tree call = a68_build_libcall (A68_LIBCALL_INVALIDCHARERROR, + void_type_node, 3, + filename, + build_int_cst (unsigned_type_node, lineno), + fold_convert (a68_int_type, c)); + + /* Return the REPR of the given integer value, or raise run-time error. */ + return fold_build2 (COMPOUND_EXPR, a68_char_type, + fold_build3 (COND_EXPR, integer_type_node, + notvalid, + call, integer_zero_node), + fold_convert (a68_char_type, c)); +} + +/* the ABS of a CHAR is an INT containing an unique value for each permissable + char value. */ + +tree +a68_char_abs (tree val) +{ + return fold_convert (a68_int_type, val); +} + +/* Given two characters, build an expression that calculates whether A = B. */ + +tree +a68_char_eq (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b); +} + +/* Given two characters, build an expression that calculates whether A /= + B. */ + +tree +a68_char_ne (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b); +} + +/* Given two characters, build an expression that calculates + whether A < B. */ + +tree +a68_char_lt (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, LT_EXPR, boolean_type_node, a, b); +} + +/* Given two characters, build an expression that calculates + whether A <= B. */ + +tree +a68_char_le (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, LE_EXPR, boolean_type_node, a, b); +} + +/* Given two characters, build an expression that calculates + whether A > B. */ + +tree +a68_char_gt (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, GT_EXPR, boolean_type_node, a, b); +} + +/* Given two characters, build an expression that calculates + whether A >= B. */ + +tree +a68_char_ge (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, GE_EXPR, boolean_type_node, a, b); +} diff --git a/gcc/algol68/a68-low-complex.cc b/gcc/algol68/a68-low-complex.cc new file mode 100644 index 000000000000..aed1c3c3dab6 --- /dev/null +++ b/gcc/algol68/a68-low-complex.cc @@ -0,0 +1,141 @@ +/* Lowering routines for all things related to COMPL values. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Build a new COMPL value with real part RE and imaginary part IM, of mode + MODE. */ + +tree +a68_complex_i (MOID_T *mode, tree re, tree im) +{ + tree compl_type = CTYPE (mode); + + tree re_field = TYPE_FIELDS (compl_type); + tree im_field = TREE_CHAIN (re_field); + return build_constructor_va (CTYPE (mode), 2, + re_field, re, + im_field, im); +} + +/* Given a COMPL value Z, get its real part. */ + +tree +a68_complex_re (tree z) +{ + tree re_field = TYPE_FIELDS (TREE_TYPE (z)); + return fold_build3 (COMPONENT_REF, TREE_TYPE (re_field), + z, re_field, NULL_TREE); +} + +tree +a68_complex_im (tree z) +{ + tree im_field = TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (z))); + return fold_build3 (COMPONENT_REF, TREE_TYPE (im_field), + z, im_field, NULL_TREE); +} + +/* Return the conjugate of the given complex Z of mode MODE. */ + +tree +a68_complex_conj (MOID_T *mode, tree z) +{ + tree re_field = TYPE_FIELDS (TREE_TYPE (z)); + tree complex_type = build_complex_type (TREE_TYPE (re_field), false /* named */); + + z = save_expr (z); + tree complex = fold_build2 (COMPLEX_EXPR, complex_type, + a68_complex_re (z), a68_complex_im (z)); + tree conj = fold_build1 (CONJ_EXPR, TREE_TYPE (complex), complex); + + return a68_complex_i (mode, + fold_build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (z)), conj), + fold_build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (z)), conj)); +} + +/* Widen a real R to a complex of mode MODE. */ + +tree +a68_complex_widen_from_real (MOID_T *mode, tree r) +{ + tree compl_type = CTYPE (mode); + gcc_assert (compl_type != NULL_TREE); + + /* Sanity check. */ + if (mode == M_COMPLEX) + gcc_assert (TREE_TYPE (r) == a68_real_type); + else if (mode == M_LONG_COMPLEX) + gcc_assert (TREE_TYPE (r) == a68_long_real_type); + else if (mode == M_LONG_LONG_COMPLEX) + gcc_assert (TREE_TYPE (r) == a68_long_long_real_type); + else + gcc_unreachable (); + + a68_push_range (mode); + tree res = a68_lower_tmpvar ("compl%", compl_type, + a68_get_skip_tree (mode)); + + /* Look for the "re" field. */ + tree field_id = a68_get_mangled_identifier ("re"); + tree field = NULL_TREE; + for (tree f = TYPE_FIELDS (compl_type); f; f = DECL_CHAIN (f)) + { + if (field_id == DECL_NAME (f)) + { + field = f; + break; + } + } + gcc_assert (field != NULL_TREE); + + /* Set it to the given real value. */ + a68_add_stmt (fold_build2 (MODIFY_EXPR, + TREE_TYPE (r), + fold_build3 (COMPONENT_REF, + TREE_TYPE (field), + res, field, + NULL_TREE), + r)); + a68_add_stmt (res); + return a68_pop_range (); +} diff --git a/gcc/algol68/a68-low-ints.cc b/gcc/algol68/a68-low-ints.cc new file mode 100644 index 000000000000..d119de9a56bc --- /dev/null +++ b/gcc/algol68/a68-low-ints.cc @@ -0,0 +1,327 @@ +/* Lowering routines for all things related to INT values. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Return a tree with the yielind of SKIP for the given integral mode. */ + +tree +a68_get_int_skip_tree (MOID_T *m) +{ + tree type; + + if (m == M_INT) + type = a68_int_type; + else if (m == M_LONG_INT) + type = a68_long_int_type; + else if (m == M_LONG_LONG_INT) + type = a68_long_long_int_type; + else if (m == M_SHORT_INT) + type = a68_short_int_type; + else if (m == M_SHORT_SHORT_INT) + type = a68_short_short_int_type; + else + gcc_unreachable (); + + return build_int_cst (type, 0); +} + +/* Given an integral type, build the maximum value expressable in that + type. */ + +tree +a68_int_maxval (tree type) +{ + return fold_convert (type, TYPE_MAX_VALUE (type)); +} + +/* Given an integral type, build the minimum value expressable in that + type. */ + +tree +a68_int_minval (tree type) +{ + return fold_convert (type, TYPE_MIN_VALUE (type)); +} + +/* Given an integral type, build an INT with the number of decimal digits + required to represent a value of that typ, not including sign. */ + +tree +a68_int_width (tree type) +{ + /* Note that log10 (2) is ~ 0.3. + Thanks to Andrew Pinski for suggesting using this expression. */ + return fold_build2 (PLUS_EXPR, a68_int_type, + build_int_cst (a68_int_type, 1), + fold_build2 (TRUNC_DIV_EXPR, + a68_int_type, + fold_build2 (MULT_EXPR, a68_int_type, + build_int_cst (a68_int_type, TYPE_PRECISION (type)), + build_int_cst (a68_int_type, 3)), + build_int_cst (a68_int_type, 10))); +} + +/* Given an integer value VAL, return -1 if it is less than zero, 0 if it is + zero and +1 if it is bigger than zero. The built value is always of mode + M_INT. */ + +tree +a68_int_sign (tree val) +{ + tree zero = build_int_cst (TREE_TYPE (val), 0); + return fold_build3 (COND_EXPR, + a68_int_type, + fold_build2 (EQ_EXPR, integer_type_node, val, zero), + build_int_cst (a68_int_type, 0), + fold_build3 (COND_EXPR, + a68_int_type, + fold_build2 (GT_EXPR, integer_type_node, val, zero), + build_int_cst (a68_int_type, 1), + build_int_cst (a68_int_type, -1))); +} + +/* Absolute value of an integer. */ + +tree +a68_int_abs (tree val) +{ + return fold_build1 (ABS_EXPR, TREE_TYPE (val), val); +} + +/* Build the integral value lengthened from the value of VAL, from mode + FROM_MODE to mode TO_MODE. */ + +tree +a68_int_leng (MOID_T *to_mode, MOID_T *from_mode ATTRIBUTE_UNUSED, tree val) +{ + /* Lengthening can be done by just a cast. */ + return fold_convert (CTYPE (to_mode), val); +} + +/* Build the integral value that can be lengthened to the value of VAL, from + mode FROM_MODE to mode TO_MODE. + + If VAL cannot be represented in TO_MODE because it is bigger than the most + positive value representable in TO_MODE, then it is truncated to that value. + + Likewise, if VAL cannot be represented in TO_MODE because it is less than + the most negative value representable in TO_MODE, then it is truncated to + that value. */ + +tree +a68_int_shorten (MOID_T *to_mode, MOID_T *from_mode ATTRIBUTE_UNUSED, tree val) +{ + tree most_positive_value = fold_convert (CTYPE (from_mode), + a68_int_maxval (CTYPE (to_mode))); + tree most_negative_value = fold_convert (CTYPE (from_mode), + a68_int_minval (CTYPE (to_mode))); + + val = save_expr (val); + most_positive_value = save_expr (most_positive_value); + most_negative_value = save_expr (most_negative_value); + return fold_build3 (COND_EXPR, CTYPE (to_mode), + fold_build2 (GT_EXPR, a68_bool_type, val, most_positive_value), + fold_convert (CTYPE (to_mode), most_positive_value), + fold_build3 (COND_EXPR, CTYPE (to_mode), + fold_build2 (LT_EXPR, a68_bool_type, val, most_negative_value), + fold_convert (CTYPE (to_mode), most_negative_value), + fold_convert (CTYPE (to_mode), val))); +} + +/* Given two integral values of mode M, build an expression that calculates the + addition of A and B. */ + +tree +a68_int_plus (MOID_T *m, tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, PLUS_EXPR, CTYPE (m), a, b); +} + +/* Given two integral values of mode M, build an expression that calculates the + subtraction of A by B. */ + +tree +a68_int_minus (MOID_T *m, tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, MINUS_EXPR, CTYPE (m), a, b); +} + +/* Given two integral values of mode M, build an expression that calculates the + multiplication of A by B. */ + +tree +a68_int_mult (MOID_T *m, tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, MULT_EXPR, CTYPE (m), a, b); +} + +/* Given two integral values of mode M, build an expression that calculates the + division of A by B. */ + +tree +a68_int_div (MOID_T *m, tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, TRUNC_DIV_EXPR, CTYPE (m), a, b); +} + +/* Given two integral values of mode M, build an expression that calculates + whether A = B. */ + +tree +a68_int_eq (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b); +} + +/* Given two integral values of mode M, build an expression that calculates + whether A /= B. */ + +tree +a68_int_ne (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b); +} + +/* Given two integral values of mode M, build an expression that calculates + whether A < B. */ + +tree +a68_int_lt (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, LT_EXPR, boolean_type_node, a, b); +} + +/* Given two integral values of mode M, build an expression that calculates + whether A <= B. */ + +tree +a68_int_le (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, LE_EXPR, boolean_type_node, a, b); +} + +/* Given two integral values of mode M, build an expression that calculates + whether A > B. */ + +tree +a68_int_gt (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, GT_EXPR, boolean_type_node, a, b); +} + +/* Given two integral values of mode M, build an expression that calculates + whether A >= B. */ + +tree +a68_int_ge (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, GE_EXPR, boolean_type_node, a, b); +} + +/* Given two integral values of mode M, build and expression that calculates the + modulus as specified by the Revised Report: + + OP MOD = (L INT a, b) L INT: + (INT r = a - a % b * b; r < 0 | r + ABS b | r) +*/ + +tree +a68_int_mod (MOID_T *m, tree a, tree b, location_t loc) +{ + a = save_expr (a); + b = save_expr (b); + tree r = a68_int_minus (m, a, a68_int_mult (m, a68_int_div (m, a, b), b)); + + r = save_expr (r); + return fold_build3_loc (loc, COND_EXPR, CTYPE (m), + a68_int_lt (r, build_int_cst (CTYPE (m), 0)), + a68_int_plus (m, r, a68_int_abs (b)), + r); +} + +/* Given two integral values values, the first of mode M an the second of mode + INT, build an expression that calculates the exponentiation of A by B, as + specified by the Revised Report: + + OP ** = (L INT a, INT b) L INT: + (b >= 0 | L INT p := L 1; TO b DO p := p * a OD; p) +*/ + +tree +a68_int_pow (MOID_T *m, tree a, tree b, location_t loc) +{ + tree zero = build_int_cst (CTYPE (m), 0); + tree one = build_int_cst (CTYPE (m), 1); + + a = save_expr (a); + b = save_expr (fold_convert (CTYPE (m), b)); + + a68_push_range (m); + tree index = a68_lower_tmpvar ("index%", CTYPE (m), zero); + tree p = a68_lower_tmpvar ("p%", CTYPE (m), one); + + /* Begin of loop body. */ + a68_push_range (NULL); + { + /* if (index == b) break; */ + a68_add_stmt (fold_build1 (EXIT_EXPR, + void_type_node, + fold_build2 (EQ_EXPR, CTYPE (m), + index, b))); + a68_add_stmt (fold_build2 (MODIFY_EXPR, CTYPE (m), + p, a68_int_mult (m, p, a))); + + /* index++ */ + a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, CTYPE (m), + index, one)); + } + tree loop_body = a68_pop_range (); + a68_add_stmt (fold_build1 (LOOP_EXPR, + void_type_node, + loop_body)); + a68_add_stmt (p); + tree calculate_p = a68_pop_range (); + return fold_build3_loc (loc, COND_EXPR, CTYPE (m), + a68_int_ge (b, zero), + calculate_p, zero); +} diff --git a/gcc/algol68/a68-low-procs.cc b/gcc/algol68/a68-low-procs.cc new file mode 100644 index 000000000000..cc43d52aa6bf --- /dev/null +++ b/gcc/algol68/a68-low-procs.cc @@ -0,0 +1,52 @@ +/* Lowering routines for all things related to procedures. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Return a tree with the yielding of SKIP for the given procedure mode. */ + +tree +a68_get_proc_skip_tree (MOID_T *m) +{ + /* A SKIP for a procecure mode lowers to a NULL pointer to a function. */ + return build_int_cst (CTYPE (m), 0); +} diff --git a/gcc/algol68/a68-low-reals.cc b/gcc/algol68/a68-low-reals.cc new file mode 100644 index 000000000000..ab0064a4855b --- /dev/null +++ b/gcc/algol68/a68-low-reals.cc @@ -0,0 +1,620 @@ +/* Lowering routines for all things related to REAL values. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "math.h" /* For log10 */ + +#include "a68.h" + +tree +a68_get_real_skip_tree (MOID_T *m) +{ + tree int_type = NULL_TREE; + tree real_type = NULL_TREE; + + if (m == M_REAL) + { + int_type = a68_int_type; + real_type = a68_real_type; + } + else if (m == M_LONG_REAL) + { + int_type = a68_long_int_type; + real_type = a68_long_real_type; + } + else if (m == M_LONG_LONG_REAL) + { + int_type = a68_long_long_int_type; + real_type = a68_long_long_real_type; + } + else + gcc_unreachable (); + + return build_real_from_int_cst (real_type, + build_int_cst (int_type, 0)); +} + +static tree +addr_of_builtin_decl (enum built_in_function fncode) +{ + tree builtin = builtin_decl_explicit (fncode); + return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (builtin)), builtin); +} + +/* Build PI for the given real type. */ + +tree +a68_real_pi (tree type) +{ + return build_real (type, dconst_pi ()); +} + +/* Given a real type, build the maximum value expresssable with that type. */ + +tree +a68_real_maxval (tree type) +{ + REAL_VALUE_TYPE max; + real_maxval (&max, 0, TYPE_MODE (type)); + return build_real (type, max); +} + +/* Given a real type, build the minimum value expressable with that type. */ + +tree +a68_real_minval (tree type) +{ + REAL_VALUE_TYPE min; + real_maxval (&min, 1, TYPE_MODE (type)); + return build_real (type, min); +} + +/* Given a real type, build the smallest value which can be meaningfully added + to or substracted from 1. */ + +tree +a68_real_smallval (tree type) +{ + /* The smallest real value which can be meaningfully added to or subtracted + from 1. */ + const machine_mode mode = TYPE_MODE (type); + const struct real_format *fmt = REAL_MODE_FORMAT (mode); + + char buf[128]; + if (fmt->pnan < fmt->p) + snprintf (buf, sizeof (buf), "0x1p%d", fmt->emin - fmt->p); + else + snprintf (buf, sizeof (buf), "0x1p%d", 1 - fmt->p); + + REAL_VALUE_TYPE res; + real_from_string (&res, buf); + return build_real (type, res); +} + +/* Given a real type, build an INT with the number of decimal digits required + to represent a mantissa, such that a real is not reglected in comparison + with 1, not including sign. */ + +tree +a68_real_width (tree type) +{ + const machine_mode mode = TYPE_MODE (type); + const struct real_format *fmt = REAL_MODE_FORMAT (mode); + return build_int_cst (a68_int_type, fmt->p); +} + +/* Given a real type, build an INT with the number of decimal digits required + to represent a decimal exponent, such that a real can be correctly + represented, not including sign. */ + +tree +a68_real_exp_width (tree type ATTRIBUTE_UNUSED) +{ + const machine_mode mode = TYPE_MODE (type); + const struct real_format *fmt = REAL_MODE_FORMAT (mode); + const double log10_2 = .30102999566398119521; + double log10_b = log10_2; + int max_10_exp = fmt->emax * log10_b; + + return build_int_cst (a68_int_type, 1 + log10 (max_10_exp)); +} + +/* Given a real value VAL, return -1 if it is less than zero, 0 if it is zero + and +1 if it is bigger than zero. The built value is always of mode + M_INT. */ + +tree +a68_real_sign (tree val) +{ + tree zero = build_real (TREE_TYPE (val), dconst0); + return fold_build3 (COND_EXPR, + a68_int_type, + build2 (EQ_EXPR, integer_type_node, val, zero), + build_int_cst (a68_int_type, 0), + fold_build3 (COND_EXPR, + a68_int_type, + fold_build2 (GT_EXPR, integer_type_node, val, zero), + build_int_cst (a68_int_type, 1), + build_int_cst (a68_int_type, -1))); +} + +/* Absolute value of a real value. */ + +tree +a68_real_abs (tree val) +{ + return fold_build1 (ABS_EXPR, TREE_TYPE (val), val); +} + +tree +a68_real_sqrt (tree type) +{ + enum built_in_function builtin; + + if (type == float_type_node) + builtin = BUILT_IN_SQRTF; + else if (type == double_type_node) + builtin = BUILT_IN_SQRT; + else if (type == long_double_type_node) + builtin = BUILT_IN_SQRTL; + else + gcc_unreachable (); + + return addr_of_builtin_decl (builtin); +} + +tree +a68_real_tan (tree type) +{ + enum built_in_function builtin; + + if (type == float_type_node) + builtin = BUILT_IN_TANF; + else if (type == double_type_node) + builtin = BUILT_IN_TAN; + else if (type == long_double_type_node) + builtin = BUILT_IN_TANL; + else + gcc_unreachable (); + + return addr_of_builtin_decl (builtin); +} + +tree +a68_real_sin (tree type) +{ + enum built_in_function builtin; + + if (type == float_type_node) + builtin = BUILT_IN_SINF; + else if (type == double_type_node) + builtin = BUILT_IN_SIN; + else if (type == long_double_type_node) + builtin = BUILT_IN_SINL; + else + gcc_unreachable (); + + return addr_of_builtin_decl (builtin); +} + +tree +a68_real_cos (tree type) +{ + enum built_in_function builtin; + + if (type == float_type_node) + builtin = BUILT_IN_COSF; + else if (type == double_type_node) + builtin = BUILT_IN_COS; + else if (type == long_double_type_node) + builtin = BUILT_IN_COSL; + else + gcc_unreachable (); + + return addr_of_builtin_decl (builtin); +} + +tree +a68_real_acos (tree type) +{ + enum built_in_function builtin; + + if (type == float_type_node) + builtin = BUILT_IN_ACOSF; + else if (type == double_type_node) + builtin = BUILT_IN_ACOS; + else if (type == long_double_type_node) + builtin = BUILT_IN_ACOSL; + else + gcc_unreachable (); + + return addr_of_builtin_decl (builtin); +} + +tree +a68_real_asin (tree type) +{ + enum built_in_function builtin; + + if (type == float_type_node) + builtin = BUILT_IN_ASINF; + else if (type == double_type_node) + builtin = BUILT_IN_ASIN; + else if (type == long_double_type_node) + builtin = BUILT_IN_ASINL; + else + gcc_unreachable (); + + return addr_of_builtin_decl (builtin); +} + +tree +a68_real_atan (tree type) +{ + enum built_in_function builtin; + + if (type == float_type_node) + builtin = BUILT_IN_ATANF; + else if (type == double_type_node) + builtin = BUILT_IN_ATAN; + else if (type == long_double_type_node) + builtin = BUILT_IN_ATANL; + else + gcc_unreachable (); + + return addr_of_builtin_decl (builtin); +} + +tree +a68_real_ln (tree type) +{ + enum built_in_function builtin; + + if (type == float_type_node) + builtin = BUILT_IN_LOGF; + else if (type == double_type_node) + builtin = BUILT_IN_LOG; + else if (type == long_double_type_node) + builtin = BUILT_IN_LOGL; + else + gcc_unreachable (); + + return addr_of_builtin_decl (builtin); +} + +tree +a68_real_log (tree type) +{ + enum built_in_function builtin; + + if (type == float_type_node) + builtin = BUILT_IN_LOG10F; + else if (type == double_type_node) + builtin = BUILT_IN_LOG10; + else if (type == long_double_type_node) + builtin = BUILT_IN_LOG10L; + else + gcc_unreachable (); + + return addr_of_builtin_decl (builtin); +} + +tree +a68_real_exp (tree type) +{ + enum built_in_function builtin; + + if (type == float_type_node) + builtin = BUILT_IN_EXPF; + else if (type == double_type_node) + builtin = BUILT_IN_EXP; + else if (type == long_double_type_node) + builtin = BUILT_IN_EXPL; + else + gcc_unreachable (); + + return addr_of_builtin_decl (builtin); +} + +/* Build the real value lengthened from the value of VAL, from mode + FROM_MODE to mode TO_MODE. */ + +tree +a68_real_leng (MOID_T *to_mode, MOID_T *from_mode ATTRIBUTE_UNUSED, tree val) +{ + /* Lengthening can be done by just a conversion. */ + return fold_convert (CTYPE (to_mode), val); +} + +/* Build the real value that can be lengthened to the value of VAL, from mode + FROM_MODE to mode TO_MODE. + + If VAL cannot be represented in TO_MODE because it is bigger than the most + positive value representable in TO_MODE, then it is truncated to that value. + + Likewise, if VAL cannot be represented in TO_MODE because it is less than + the most negative value representable in TO_MODE, then it is truncated to + that value. */ + +tree +a68_real_shorten (MOID_T *to_mode, MOID_T *from_mode ATTRIBUTE_UNUSED, tree val) +{ + tree most_positive_value = fold_convert (CTYPE (from_mode), + a68_real_maxval (CTYPE (to_mode))); + tree most_negative_value = fold_convert (CTYPE (from_mode), + a68_real_minval (CTYPE (to_mode))); + + val = save_expr (val); + most_positive_value = save_expr (most_positive_value); + most_negative_value = save_expr (most_negative_value); + return fold_build3 (COND_EXPR, CTYPE (to_mode), + fold_build2 (GT_EXPR, a68_bool_type, val, most_positive_value), + fold_convert (CTYPE (to_mode), most_positive_value), + fold_build3 (COND_EXPR, CTYPE (to_mode), + fold_build2 (LT_EXPR, a68_bool_type, val, most_negative_value), + fold_convert (CTYPE (to_mode), most_negative_value), + fold_convert (CTYPE (to_mode), val))); +} + +/* Given a real expression VAL of mode MODE, produce an integral value which is + equal to the given real, or the next integer below (more negative than) the + given real. */ + +tree +a68_real_entier (tree val, MOID_T *to_mode, MOID_T *from_mode) +{ + tree fn = NULL_TREE; + tree to_type = CTYPE (to_mode); + + if (from_mode == M_REAL) + { + if (to_type == integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_IFLOORF); + else if (to_type == long_integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_LFLOORF); + else if (to_type == long_long_integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_LLFLOORF); + else + gcc_unreachable (); + } + else if (from_mode == M_LONG_REAL) + { + if (to_type == integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_IFLOOR); + else if (to_type == long_integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_LFLOOR); + else if (to_type == long_long_integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_LLFLOOR); + else + gcc_unreachable (); + } + else if (from_mode == M_LONG_LONG_REAL) + { + if (to_type == integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_IFLOORL); + else if (to_type == long_integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_LFLOORL); + else if (to_type == long_long_integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_LLFLOORL); + else + gcc_unreachable (); + } + else + gcc_unreachable (); + + return build_call_expr_loc (UNKNOWN_LOCATION, fn, 1, val); +} + +/* Given a real expression VAL of mode MODE, produce an integral value which is + the nearest integer to the given real. */ + +tree +a68_real_round (tree val, MOID_T *to_mode, MOID_T *from_mode) +{ + tree fn = NULL_TREE; + tree to_type = CTYPE (to_mode); + + if (from_mode == M_REAL) + { + if (to_type == integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_IROUNDF); + else if (to_type == long_integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_LROUNDF); + else if (to_type == long_long_integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_LLROUNDF); + else + gcc_unreachable (); + } + else if (from_mode == M_LONG_REAL) + { + if (to_type == integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_IROUND); + else if (to_type == long_integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_LROUND); + else if (to_type == long_long_integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_LLROUND); + else + gcc_unreachable (); + } + else if (from_mode == M_LONG_LONG_REAL) + { + if (to_type == integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_IROUNDL); + else if (to_type == long_integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_LROUNDL); + else if (to_type == long_long_integer_type_node) + fn = builtin_decl_explicit (BUILT_IN_LLROUNDL); + else + gcc_unreachable (); + } + else + gcc_unreachable (); + + return build_call_expr_loc (UNKNOWN_LOCATION, fn, 1, val); +} + + +/* Given two real values of mode M, build an expression that calculates the + addition of A and B. */ + +tree +a68_real_plus (MOID_T *m, tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, PLUS_EXPR, CTYPE (m), a, b); +} + +/* Given two real values of mode M, build an expression that calculates the + subtraction of A by B. */ + +tree +a68_real_minus (MOID_T *m, tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, MINUS_EXPR, CTYPE (m), a, b); +} + +/* Given two real values of mode M, build an expression that calculates the + multiplication of A by B. */ + +tree +a68_real_mult (MOID_T *m, tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, MULT_EXPR, CTYPE (m), a, b); +} + +/* Given two real values of mode M, build an expression that calculates the + division of A by B. */ + +tree +a68_real_div (MOID_T *m, tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, RDIV_EXPR, CTYPE (m), a, b); +} + +/* Given two real values of mode M, build an expression that calculates whether + A = B. */ + +tree +a68_real_eq (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, EQ_EXPR, boolean_type_node, a, b); +} + +/* Given two real values of mode M, build an expression that calculates whether + A /= B. */ + +tree +a68_real_ne (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, NE_EXPR, boolean_type_node, a, b); +} + +/* Given two real values of mode M, build an expression that calculates whether + A < B. */ + +tree +a68_real_lt (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, LT_EXPR, boolean_type_node, a, b); +} + +/* Given two real values of mode M, build an expression that calculates + whether A <= B. */ + +tree +a68_real_le (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, LE_EXPR, boolean_type_node, a, b); +} + +/* Given two real values of mode M, build an expression that calculates whether + A > B. */ + +tree +a68_real_gt (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, GT_EXPR, boolean_type_node, a, b); +} + +/* Given two real values of mode M, build an expression that calculates whether + A >= B. */ + +tree +a68_real_ge (tree a, tree b, location_t loc) +{ + return fold_build2_loc (loc, GE_EXPR, boolean_type_node, a, b); +} + +/* Exponentiation involving real values. + + REAL <- REAL, REAL + REAL <- REAL, INT + LONG REAL <- LONG REAL, LONG REAL + LONG REAL <- LONG REAL, INT + LONG LONG REAL <- LONG LONG REAL, LONG LONG REAL + LONG LONG REAL <- LONG LONG REAL, INT */ + +tree +a68_real_pow (MOID_T *m, MOID_T *a_mode, MOID_T *b_mode, + tree a, tree b, location_t loc) +{ + enum built_in_function built_in; + if (m == M_REAL) + { + gcc_assert (a_mode == M_REAL); + built_in = b_mode == M_REAL ? BUILT_IN_POWF : BUILT_IN_POWIF; + } + else if (m == M_LONG_REAL) + { + gcc_assert (a_mode == M_LONG_REAL); + built_in = b_mode == M_LONG_REAL ? BUILT_IN_POW : BUILT_IN_POWI; + } + else if (m == M_LONG_LONG_REAL) + { + gcc_assert (a_mode == M_LONG_LONG_REAL); + built_in = b_mode == M_LONG_LONG_REAL ? BUILT_IN_POWL : BUILT_IN_POWIL; + } + else + gcc_unreachable (); + + tree call = builtin_decl_explicit (built_in); + gcc_assert (call != NULL_TREE); + return build_call_expr_loc (loc, call, 2, a, b); +} diff --git a/gcc/algol68/a68-low-refs.cc b/gcc/algol68/a68-low-refs.cc new file mode 100644 index 000000000000..ba9987b57ed8 --- /dev/null +++ b/gcc/algol68/a68-low-refs.cc @@ -0,0 +1,52 @@ +/* Lowering routines for all things related to names. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Return a tree with the yielding of SKIP for the given name mode. */ + +tree +a68_get_ref_skip_tree (MOID_T *m) +{ + /* Build a NULL pointer. */ + return build_int_cst (CTYPE (m), 0); +} diff --git a/gcc/algol68/a68-low-strings.cc b/gcc/algol68/a68-low-strings.cc new file mode 100644 index 000000000000..f5822037e33b --- /dev/null +++ b/gcc/algol68/a68-low-strings.cc @@ -0,0 +1,399 @@ +/* Lowering routines for all things related to STRINGs. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Return a tree with the yielding of SKIP for M_STRING. */ + +tree +a68_get_string_skip_tree (void) +{ + return a68_get_multiple_skip_tree (M_FLEX_ROW_CHAR); +} + +/* Copy chars from STR to ELEMENTS starting at TO_INDEX chars in ELEMENTS. */ + +static void +copy_string (tree elements, tree to_index, tree str) +{ + tree char_pointer_type = build_pointer_type (a68_char_type); + tree num_elems + = a68_lower_tmpvar ("num_elems%", sizetype, a68_multiple_num_elems (str)); + + tree from_index + = a68_lower_tmpvar ("from_index%", sizetype, size_zero_node); + tree from_offset + = a68_lower_tmpvar ("from_offset%", sizetype, size_zero_node); + + /* Begin of loop body. */ + a68_push_range (NULL); + { + /* if (from_index == num_elems) break; */ + a68_add_stmt (fold_build1 (EXIT_EXPR, void_type_node, + fold_build2 (GE_EXPR, sizetype, + from_index, num_elems))); + + /* *(elements + to_index) = *(elements + from_index) */ + tree to_offset = fold_build2 (MULT_EXPR, sizetype, + to_index, size_in_bytes (a68_char_type)); + a68_add_stmt (fold_build2 (MODIFY_EXPR, + void_type_node, + fold_build2 (MEM_REF, a68_char_type, + fold_build2 (POINTER_PLUS_EXPR, + char_pointer_type, + elements, to_offset), + fold_convert (char_pointer_type, + integer_zero_node)), + fold_build2 (MEM_REF, a68_char_type, + fold_build2 (POINTER_PLUS_EXPR, + char_pointer_type, + a68_multiple_elements (str), + from_offset), + fold_convert (char_pointer_type, + integer_zero_node)))); + + /* from_offset = from_offset + stride */ + a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node, + from_offset, + fold_build2 (PLUS_EXPR, sizetype, + from_offset, + a68_multiple_stride (str, size_zero_node)))); + /* to_index = to_index + 1 */ + a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, sizetype, to_index, size_one_node)); + + /* from_index = from_index + 1 */ + a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, sizetype, from_index, size_one_node)); + } + + /* End of loop body. */ + tree loop_body = a68_pop_range (); + a68_add_stmt (fold_build1 (LOOP_EXPR, + void_type_node, + loop_body)); +} + +/* Given two STRINGs STR1 and STR2, allocate a new string on the stack with a + copy of the concatenated characters of the given string. */ + +tree +a68_string_concat (tree str1, tree str2) +{ + tree char_pointer_type = build_pointer_type (a68_char_type); + static tree string_concat_fndecl; + + if (string_concat_fndecl == NULL_TREE) + { + string_concat_fndecl + = a68_low_toplevel_func_decl ("string_concat", + build_function_type_list (char_pointer_type, + TREE_TYPE (str1), + TREE_TYPE (str2), + NULL_TREE)); + announce_function (string_concat_fndecl); + + tree s1 = a68_low_func_param (string_concat_fndecl, "s1", TREE_TYPE (str1)); + tree s2 = a68_low_func_param (string_concat_fndecl, "s2", TREE_TYPE (str2)); + DECL_ARGUMENTS (string_concat_fndecl) = chainon (s1, s2); + + a68_push_function_range (string_concat_fndecl, char_pointer_type, + true /* top_level */); + + tree n1 = a68_lower_tmpvar ("n1%", sizetype, a68_multiple_num_elems (s1)); + tree n2 = a68_lower_tmpvar ("n2%", sizetype, a68_multiple_num_elems (s2)); + tree num_elems = a68_lower_tmpvar ("num_elems%", sizetype, + fold_build2 (PLUS_EXPR, sizetype, n1, n2)); + + /* First allocate memory for the result string. We need enough space to + hold the elements of both strings with a stride of 1S. */ + tree char_pointer_type = build_pointer_type (a68_char_type); + tree elements_size = fold_build2 (MULT_EXPR, sizetype, + size_in_bytes (a68_char_type), + num_elems); + tree elements = a68_lower_tmpvar ("elements%", char_pointer_type, + a68_lower_malloc (a68_char_type, elements_size)); + + /* Copy elements. */ + tree to_index = a68_lower_tmpvar ("to_index%", sizetype, size_zero_node); + copy_string (elements, to_index, s1); + copy_string (elements, to_index, s2); + a68_pop_function_range (elements); + } + + /* Build the resulting multiple. */ + str1 = save_expr (str1); + str2 = save_expr (str2); + tree n1 = a68_multiple_num_elems (str1); + tree n2 = a68_multiple_num_elems (str2); + tree num_elems = save_expr (fold_build2 (PLUS_EXPR, sizetype, n1, n2)); + tree elements_size = fold_build2 (MULT_EXPR, sizetype, + size_in_bytes (a68_char_type), + num_elems); + tree lower_bound = ssize_int (1); + tree upper_bound = fold_convert (ssizetype, num_elems); + tree elements = build_call_nary (char_pointer_type, + fold_build1 (ADDR_EXPR, + build_pointer_type (TREE_TYPE (string_concat_fndecl)), + string_concat_fndecl), + 2, str1, str2); + return a68_row_value (CTYPE (M_STRING), 1 /* dim */, + elements, elements_size, + &lower_bound, &upper_bound); +} + +/* Given a STRING STR and an INT FACTOR, return STRING concatenated to itself + FACTOR - 1 times. + + Negative values of FACTOR are interpreted as zero. */ + +tree +a68_string_mult (tree str, tree factor) +{ + a68_push_range (M_STRING); + + str = save_expr (str); + tree ssize_one_node = ssize_int (1); + tree res = a68_lower_tmpvar ("res%", CTYPE (M_STRING), str); + tree index = a68_lower_tmpvar ("index%", ssizetype, ssize_one_node); + + /* Begin of loop body. */ + a68_push_range (NULL); + + /* if (index == FACTOR) break; */ + a68_add_stmt (fold_build1 (EXIT_EXPR, + void_type_node, + fold_build2 (GE_EXPR, ssizetype, + index, + fold_convert (ssizetype, factor)))); + + /* res += str */ + a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (res), + res, + a68_string_concat (res, str))); + + /* index++ */ + a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, + ssizetype, + index, ssize_one_node)); + tree loop_body = a68_pop_range (); + /* End of loop body. */ + a68_add_stmt (fold_build1 (LOOP_EXPR, + void_type_node, + loop_body)); + a68_add_stmt (res); + return a68_pop_range (); +} + +/* Given a CHAR C, build a string whose contents are just that CHAR. */ + +tree +a68_string_from_char (tree c) +{ + tree lower_bound = ssize_int (1); + tree upper_bound = lower_bound; + tree char_pointer_type = build_pointer_type (a68_char_type); + + a68_push_range (M_STRING); + + tree elements = a68_lower_tmpvar ("elements%", char_pointer_type, + a68_lower_malloc (a68_char_type, + size_one_node)); + a68_add_stmt (fold_build2 (MODIFY_EXPR, + void_type_node, + fold_build1 (INDIRECT_REF, a68_char_type, elements), + c)); + a68_add_stmt (a68_row_value (CTYPE (M_STRING), 1 /* dim */, + elements, + size_in_bytes (a68_char_type), + &lower_bound, &upper_bound)); + return a68_pop_range (); +} + +/* Compare the two given strings lexicographically and return -1 (less than), 0 + (equal to) or 1 (bigger than) reflecting the result of the comparison. */ + +tree +a68_string_cmp (tree s1, tree s2) +{ + s1 = save_expr (s1); + tree s1_elems = a68_multiple_elements (s1); + tree s1_len = a68_multiple_num_elems (s1); + tree s1_stride = a68_multiple_stride (s1, size_zero_node); + + s2 = save_expr (s2); + tree s2_elems = a68_multiple_elements (s2); + tree s2_len = a68_multiple_num_elems (s2); + tree s2_stride = a68_multiple_stride (s2, size_zero_node); + + return a68_build_libcall (A68_LIBCALL_U32_CMP2, + a68_int_type, 6, + s1_elems, s1_len, s1_stride, + s2_elems, s2_len, s2_stride); +} + +/* Return a newly allocated UTF-8 string resulting from processing the string + breaks in STR. This function assumes the passed string is well-formed (the + scanner is in charge of seeing that is true) and just ICEs if it is not. + NODE is used as the location for diagnostics in case the string breaks + contain some invalid data. */ + +char * +a68_string_process_breaks (NODE_T *node, const char *str) +{ + size_t len = 0; + char *res = NULL; + + /* First calculate the size of the resulting string. */ + for (const char *p = str; *p != '\0';) + { + if (*p == '\'') + { + switch (p[1]) + { + case '\'': + case 'n': + case 'f': + case 'r': + case 't': + len += 1; + p += 2; + break; + case '(': + p += 2; + while (1) + { + if (p[0] == ')') + { + p++; + break; + } + else if (p[0] == ',' || ISSPACE (p[0])) + { + p++; + continue; + } + + /* An Unicode codepoint encoded in UTF-8 occupies at most six + octets. */ + len += 6; + p += (p[0] == 'u' ? 5 : 9); + } + break; + default: + gcc_unreachable (); + } + } + else + { + len += 1; + p += 1; + } + } + + /* Now and allocate it, adding space for a trailing NULL. */ + res = (char *) xmalloc (len + 1); + + /* Finally fill it with the result of expanding all the string breaks. */ + size_t offset = 0; + for (const char *p = str; *p != '\0';) + { + if (*p == '\'') + { + switch (p[1]) + { + case '\'': res[offset] = '\''; p += 2; offset += 1; break; + case 'n': res[offset] = '\n'; p += 2; offset += 1; break; + case 't': res[offset] = '\t'; p += 2; offset += 1; break; + case 'r': res[offset] = '\r'; p += 2; offset += 1; break; + case 'f': res[offset] = '\f'; p += 2; offset += 1; break; + case '(': + { + p += 2; + while (1) + { + if (p[0] == ')') + { + p++; + break; + } + else if (p[0] == ',' || ISSPACE (p[0])) + { + p++; + continue; + } + + /* Skip the u or U. */ + gcc_assert (p[0] == 'u' || p[0] == 'U'); + p++; + + const char *begin = p; + char *end; + int64_t codepoint = strtol (p, &end, 16); + gcc_assert (end > p); + p = end; + /* Append the UTF-8 encoding of the obtained codepoint to + the `res' string. */ + int n = a68_u8_uctomb ((uint8_t *) res + offset, codepoint, 6); + if (n < 0) + { + char *start = CHAR_IN_LINE (INFO (node)) + (begin - str); + a68_scan_error (LINE (INFO (node)), start, + "invalid Unicode codepoint in string literal"); + } + + offset += n; + } + break; + } + default: gcc_unreachable (); + } + } + else + { + res[offset] = *p; + offset += 1; + p += 1; + } + } + res[offset] = '\0'; + + return res; +} From 0defb7f15ee668b6e68e92316a78ff74eb0430d5 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:52:14 +0200 Subject: [PATCH 166/373] a68: low: stowed values Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-low-multiples.cc: New file. * algol68/a68-low-structs.cc: Likewise. * algol68/a68-low-unions.cc: Likewise. --- gcc/algol68/a68-low-multiples.cc | 1097 ++++++++++++++++++++++++++++++ gcc/algol68/a68-low-structs.cc | 63 ++ gcc/algol68/a68-low-unions.cc | 279 ++++++++ 3 files changed, 1439 insertions(+) create mode 100644 gcc/algol68/a68-low-multiples.cc create mode 100644 gcc/algol68/a68-low-structs.cc create mode 100644 gcc/algol68/a68-low-unions.cc diff --git a/gcc/algol68/a68-low-multiples.cc b/gcc/algol68/a68-low-multiples.cc new file mode 100644 index 000000000000..ce5996c9249a --- /dev/null +++ b/gcc/algol68/a68-low-multiples.cc @@ -0,0 +1,1097 @@ +/* Lowering routines for all things related to multiples. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Algol 68 multiples are multi-dimensional and dynamically sized. They have a + static part and a dynamic part. The static part is conformed by a + "descriptor", which contains information about each of the dimensions, and a + pointer to the actual elements stored in the multiple. The dynamic part are + the elements, which are stored in column order. Both the descriptor and the + elements may reside on the stack, data section, or the heap. The mode of a + multiple is a "row". + + Schematically, the descriptor contains: + + triplets% + lb% ub% stride% + ... + elements% + elements_size% + + Where elements_size% is the size of the buffer pointed by elements%, in + bytes. + + There is a triplet per dimension in the multiple. The number of dimensions + in a row mode is static and is determined at compile-time. + + The infomation stored for each triplet is: + + lb% is the lower bound of the dimension. + ub% is the upper bound of the dimension. + stride% is the stride of the dimension. + + The stride of each dimension is the number of bytes to skip in order to + access the next element in that dimension. They express the layout of the + multiple in memory. + + Algol 68 multi-dimensional multiples are stored in row-major (generalized, + lexicographical) order: + + [1:3,1:2]AMODE = ((e1, e2, e3), + (e4, e5, e6)) + + is stored as: + + 1 2 3 + 1 e1 e2 e3 | stride 2S -> stride 1S + 2 e4 e5 e6 v + + Where S is the size in bytes of a single element. That means that for two + dimensional multiples, the column stride is always 1S and the row stride is + the column size. + + In general, given a mode with number of elements N1, N2, N3, ...: + + [N1,N2,N3...,Nn]AMODE + + the strides of the dimensions are: + + S1 = N2 * S2 + S2 = N3 * S3 + S3 = N4 * S4 + ... + Si = N1 * N2 * ... * Ni-1 + + Indexing is then performed by a dot-product of an element coordinate and the + strides: + + (i1,i2,i3) . (S1,S2,S3) = offset + i1*S1 + i2*S2 + i3*S3 = index in elements array. + + Note that the number of elements in each dimension can be easily derived + from the bounds and there is no need to store them explicitly, save for + performance reasons. Descriptors are bulky enough and often they they are + stored on the stack, so we prefer to pay in performance and save in + storage. */ + +/* Return a tree with the yielding of SKIP for the given row mode, a + multiple. */ + +tree +a68_get_multiple_skip_tree (MOID_T *m) +{ + tree res = NULL_TREE; + int dim = DIM (m); + tree *lower_bounds = (tree *) xmalloc (sizeof (tree) * dim); + tree *upper_bounds = (tree *) xmalloc (sizeof (tree) * dim); + tree ssize_one_node = fold_convert (ssizetype, size_one_node); + tree ssize_zero_node = fold_convert (ssizetype, size_zero_node); + for (int i = 0; i < dim; ++i) + { + lower_bounds[i] = ssize_one_node; + upper_bounds[i] = ssize_zero_node; + } + res = a68_row_value (CTYPE (m), dim, + build_int_cst (build_pointer_type (void_type_node), 0), + size_zero_node, /* elements_size */ + lower_bounds, upper_bounds); + free (lower_bounds); + free (upper_bounds); + return res; +} + +/* Return the number of dimensions of the multiple EXP as an integer + constant. */ + +tree +a68_multiple_dimensions (tree exp) +{ + gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp))); + + /* triplets% is the first field in the descriptor. */ + tree triplets_field = TYPE_FIELDS (TREE_TYPE (exp)); + return array_type_nelts_top (TREE_TYPE (triplets_field)); +} + +/* Return an expression that evaluates to the total number of elements stored + in a multiple as a sizetype. */ + +tree +a68_multiple_num_elems (tree exp) +{ + /* We have to calculate the number of elements based on the dimension + triplets in the array type. The number of dimensions is known at compile + time, so we don't really need a loop. */ + + tree num_dimensions_tree = a68_multiple_dimensions (exp); + gcc_assert (TREE_CODE (num_dimensions_tree) == INTEGER_CST); + int num_dimensions = tree_to_shwi (num_dimensions_tree); + + tree size = NULL_TREE; + for (int dim = 0; dim < num_dimensions; ++dim) + { + tree size_dim = size_int (dim); + tree lower_bound = a68_multiple_lower_bound (exp, size_dim); + tree upper_bound = a68_multiple_upper_bound (exp, size_dim); + tree dim_size = fold_build2 (PLUS_EXPR, sizetype, + fold_convert (sizetype, fold_build2 (MINUS_EXPR, + ssizetype, + upper_bound, + lower_bound)), + size_one_node); + + if (size == NULL_TREE) + size = dim_size; + else + size = fold_build2 (MULT_EXPR, sizetype, size, dim_size); + } + + return size; +} + +/* Return a size expression that evaluates to the total size, in bytes, of the + elements stored in the multiple. */ + +tree +a68_multiple_elements_size (tree exp) +{ + tree type = TREE_TYPE (exp); + gcc_assert (A68_ROW_TYPE_P (type)); + + /* elements_size% is the third field in the descriptor. */ + tree elements_size_field = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (type))); + return fold_build3 (COMPONENT_REF, TREE_TYPE (elements_size_field), + exp, elements_size_field, NULL_TREE); +} + +/* Return the triplet for dimension DIM in the multiple EXP. */ + +static tree +multiple_triplet (tree exp, tree dim) +{ + gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp))); + + /* triplets% is the first field in the descriptor. */ + tree triplets_field = TYPE_FIELDS (TREE_TYPE (exp)); + tree triplets = fold_build3 (COMPONENT_REF, + TREE_TYPE (triplets_field), + exp, + triplets_field, + NULL_TREE); + + /* Get the triplet for the given dimension. */ + return build4 (ARRAY_REF, + TREE_TYPE (TREE_TYPE (triplets)), + triplets, + dim, + NULL_TREE, + NULL_TREE); +} + +/* Return the lower bound of dimension DIM of the multiple EXP. The returned + value is a ssizetype. */ + +tree +a68_multiple_lower_bound (tree exp, tree dim) +{ + gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp))); + + /* lb% is the first field in the triplet. */ + tree triplet = multiple_triplet (exp, dim); + tree lower_bound_field = TYPE_FIELDS (TREE_TYPE (triplet)); + return fold_build3 (COMPONENT_REF, + TREE_TYPE (lower_bound_field), + triplet, + lower_bound_field, + NULL_TREE); +} + +/* Return an expression that sets the lower bound of dimension DIM of the + multiple EXP to BOUND. */ + +tree +a68_multiple_set_lower_bound (tree exp, tree dim, tree bound) +{ + gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp))); + return fold_build2 (MODIFY_EXPR, + TREE_TYPE (bound), + a68_multiple_lower_bound (exp, dim), + bound); +} + +/* Return the upper bound of dimension DIM of the multiple EXP. The returned + value is a ssizetype. */ + +tree +a68_multiple_upper_bound (tree exp, tree dim) +{ + gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp))); + + /* ub% is the second field in the triplet. */ + tree triplet = multiple_triplet (exp, dim); + tree upper_bound_field = TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (triplet))); + return fold_build3 (COMPONENT_REF, + TREE_TYPE (upper_bound_field), + triplet, + upper_bound_field, + NULL_TREE); +} + +/* Return an expression that sets the upper bound of dimension DIM of the + multiple EXP to BOUND. */ + +tree +a68_multiple_set_upper_bound (tree exp, tree dim, tree bound) +{ + gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp))); + return fold_build2 (MODIFY_EXPR, + TREE_TYPE (bound), + a68_multiple_upper_bound (exp, dim), + bound); +} + +/* Return the stride of dimension DIM of the multiple EXP. */ + +tree +a68_multiple_stride (tree exp, tree dim) +{ + gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp))); + + /* stride% is the third field in the triplet. */ + tree triplet = multiple_triplet (exp, dim); + tree stride_field = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (triplet)))); + return fold_build3 (COMPONENT_REF, + TREE_TYPE (stride_field), + triplet, + stride_field, + NULL_TREE); +} + +/* Return an expression that sets the stride of dimension DIM of the multiple + EXP to STRIDE. + + STRIDE must be a sizetype. */ + +tree +a68_multiple_set_stride (tree exp, tree dim, tree stride) +{ + gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp))); + return fold_build2 (MODIFY_EXPR, + TREE_TYPE (stride), + a68_multiple_stride (exp, dim), + stride); +} + +/* Return the triplets of the multiple EXP. */ + +tree +a68_multiple_triplets (tree exp) +{ + gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp))); + + /* triplets% is the first field in the descriptor. */ + tree triplets_field = TYPE_FIELDS (TREE_TYPE (exp)); + return fold_build3 (COMPONENT_REF, + TREE_TYPE (triplets_field), + exp, + triplets_field, + NULL_TREE); +} + +/* Return the pointer to the elements of the multiple EXP. */ + +tree +a68_multiple_elements (tree exp) +{ + gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (exp))); + + /* elements% is the second field in the descriptor. */ + tree elements_field = TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))); + return fold_build3 (COMPONENT_REF, + TREE_TYPE (elements_field), + exp, + elements_field, + NULL_TREE); +} + +/* Return an expression that sets the elements% field of EXP to ELEMENTS. */ + +tree +a68_multiple_set_elements (tree exp, tree elements) +{ + /* elements% is the second field in the descriptor. */ + tree elements_field = TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))); + return fold_build2 (MODIFY_EXPR, + TREE_TYPE (elements_field), + fold_build3 (COMPONENT_REF, + TREE_TYPE (elements_field), + exp, + elements_field, + NULL_TREE), + elements); +} + +/* Return an expression that sets the elements_size% field of EXP to + ELEMENTS_SIZE, which must be a sizetype. */ + +tree +a68_multiple_set_elements_size (tree exp, tree elements_size) +{ + /* elements_size% is the third field in the descriptor. */ + tree elements_size_field = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp)))); + return fold_build2 (MODIFY_EXPR, + TREE_TYPE (elements_size_field), + fold_build3 (COMPONENT_REF, + TREE_TYPE (elements_size_field), + exp, + elements_size_field, + NULL_TREE), + elements_size); +} + +/* Given two arrays of LOWER_BOUNDs and UPPER_BOUNDs corresponding to DIM + dimensions of a multiple of type TYPE, fill in the strides in STRIDES, which + is assumed to be a buffer big enough to hold DIM tree nodes. The bounds + shall be of type ssizetype, and the calculated strides are of type sizetype, + i.e. unsigned. */ + +void +a68_multiple_compute_strides (tree type, size_t dim, + tree *lower_bounds, tree *upper_bounds, + tree *strides) +{ + tree stride = size_in_bytes (a68_row_elements_type (type)); + for (ssize_t i = dim - 1; i >= 0; --i) + { + strides[i] = stride; + + /* Calculate the stride for the previous dimension. */ + tree dim_num_elems + = save_expr (fold_build2 (PLUS_EXPR, + sizetype, + fold_convert (sizetype, + fold_build2 (MINUS_EXPR, ssizetype, + upper_bounds[i], lower_bounds[i])), + size_one_node)); + stride = fold_build2 (MULT_EXPR, sizetype, stride, dim_num_elems); + } +} + +/* Return a constructor for a multiple of row type TYPE, using TRIPLETS and + ELEMENTS. ELEMENTS_SIZE is the size in bytes of the memory pointed by + ELEMENTS. */ + +tree +a68_row_value_raw (tree type, tree triplets, + tree elements, tree elements_size) +{ + tree triplets_field; + tree elements_field; + tree elements_size_field; + vec *ce = NULL; + + gcc_assert (A68_ROW_TYPE_P (type)); + triplets_field = TYPE_FIELDS (type); + elements_field = TREE_CHAIN (triplets_field); + elements_size_field = TREE_CHAIN (elements_field); + CONSTRUCTOR_APPEND_ELT (ce, triplets_field, triplets); + CONSTRUCTOR_APPEND_ELT (ce, elements_field, + fold_build1 (CONVERT_EXPR ,TREE_TYPE (elements_field), elements)); + CONSTRUCTOR_APPEND_ELT (ce, elements_size_field, elements_size); + return build_constructor (type, ce); +} + +/* Return a constructor for a multiple of row type TYPE, of DIM dimensions and + pointing to ELEMENTS. + + ELEMENTS_SIZE contains the size in bytes of the memory pointed by ELEMENTS. + + *LOWER_BOUND and *UPPER_BOUND are the bounds for the DIM dimensions. +*/ + +tree +a68_row_value (tree type, size_t dim, + tree elements, tree elements_size, + tree *lower_bound, tree *upper_bound) +{ + tree triplets_field; + tree elements_field; + tree elements_size_field; + vec *ce = NULL; + + gcc_assert (A68_ROW_TYPE_P (type)); + triplets_field = TYPE_FIELDS (type); + elements_field = TREE_CHAIN (triplets_field); + elements_size_field = TREE_CHAIN (elements_field); + + tree triplet_type = TREE_TYPE (TREE_TYPE (triplets_field)); + tree lower_bound_field = TYPE_FIELDS (triplet_type); + tree upper_bound_field = TREE_CHAIN (TYPE_FIELDS (triplet_type)); + tree stride_field = TREE_CHAIN (TREE_CHAIN (TYPE_FIELDS (triplet_type))); + + /* Calculate strides. */ + tree *strides = (tree *) xmalloc (sizeof (tree) * dim); + a68_multiple_compute_strides (type, dim, lower_bound, upper_bound, strides); + + vec *triplets_ce = NULL; + for (size_t i = 0; i < dim; ++i) + { + CONSTRUCTOR_APPEND_ELT (triplets_ce, + size_int (i), + build_constructor_va (triplet_type, + 3, + lower_bound_field, lower_bound[i], + upper_bound_field, upper_bound[i], + stride_field, strides[i])); + } + free (strides); + CONSTRUCTOR_APPEND_ELT (ce, triplets_field, + build_constructor (TREE_TYPE (triplets_field), triplets_ce)); + CONSTRUCTOR_APPEND_ELT (ce, elements_field, + fold_build1 (CONVERT_EXPR, TREE_TYPE (elements_field), elements)); + CONSTRUCTOR_APPEND_ELT (ce, elements_size_field, + elements_size ? elements_size : size_zero_node); + tree multiple = build_constructor (type, ce); + return multiple; +} + +/* Build a tree to slice a multiple given a set of indexes. + + P is the tree node corresponding to the slice. It is used as the source of + location information. + + MULTIPLE is the multiple value being sliced. If SLICING_NAME is true, it + means the slicing operation is for a name and therefore it must yield a + name. + + INDEXES is a list of NUM_INDEXES indexes, which are units. + NUM_INDEXES must match the dimension of the multiple. */ + +tree +a68_multiple_slice (NODE_T *p, + tree multiple, bool slicing_name, + int num_indexes, tree *indexes) +{ + tree slice = NULL_TREE; + tree bounds_check = NULL_TREE; + + multiple = save_expr (multiple); + tree index = NULL_TREE; + for (int idx = 0; idx < num_indexes; ++idx) + { + tree lower_bound = a68_multiple_lower_bound (multiple, size_int (idx)); + tree index_expr = save_expr (indexes[idx]); + + /* Do run-time bound checking if requested. */ + if (OPTION_BOUNDS_CHECKING (&A68_JOB)) + { + tree upper_bound = a68_multiple_upper_bound (multiple, size_int (idx)); + unsigned int lineno = NUMBER (LINE (INFO (p))); + const char *filename_str = FILENAME (LINE (INFO (p))); + tree filename = build_string_literal (strlen (filename_str) + 1, + filename_str); + tree call = a68_build_libcall (A68_LIBCALL_ARRAYBOUNDS, + void_type_node, 5, + filename, + build_int_cst (unsigned_type_node, lineno), + fold_convert (ssizetype, index_expr), + fold_convert (ssizetype, lower_bound), + fold_convert (ssizetype, upper_bound)); + call = fold_build2 (COMPOUND_EXPR, a68_bool_type, call, boolean_false_node); + + /* If LB > UB, the dimension contains no elements. + Otherwise, it must hold IDX >= LB && IDX <= UB */ + tree dim_bounds_check = fold_build2 (TRUTH_AND_EXPR, sizetype, + fold_build2 (LE_EXPR, ssizetype, + lower_bound, upper_bound), + fold_build2 (TRUTH_AND_EXPR, + boolean_type_node, + fold_build2 (GE_EXPR, ssizetype, + fold_convert (ssizetype, + index_expr), + lower_bound), + fold_build2 (LE_EXPR, ssizetype, + fold_convert (ssizetype, + index_expr), + upper_bound))); + dim_bounds_check = fold_build2_loc (a68_get_node_location (p), + TRUTH_ORIF_EXPR, + ssizetype, + dim_bounds_check, call); + + /* bounds_check_ok || call_runtime_error */ + if (bounds_check == NULL_TREE) + bounds_check = dim_bounds_check; + else + bounds_check = fold_build2 (TRUTH_ANDIF_EXPR, + ssizetype, + bounds_check, + dim_bounds_check); + } + + /* Now add the effect of this dimension's subscript in the index. Note + that the stride is expressed in bytes. */ + tree stride = a68_multiple_stride (multiple, size_int (idx)); + tree adjusted_index + = fold_convert (sizetype, fold_build2 (MINUS_EXPR, ssizetype, + fold_convert (ssizetype, index_expr), + lower_bound)); + tree term = fold_build2 (MULT_EXPR, sizetype, + adjusted_index, stride); + if (index == NULL_TREE) + index = term; + else + index = fold_build2 (PLUS_EXPR, sizetype, + index, term); + } + + tree elements = a68_multiple_elements (multiple); + tree element_pointer_type = TREE_TYPE (elements); + tree element_type = TREE_TYPE (element_pointer_type); + + /* Now refer to the indexed element. In case we are slicing a ref to a + multiple, return the address of the element and not the element + itself. */ + tree element_address = fold_build2 (POINTER_PLUS_EXPR, + element_pointer_type, + elements, + index); + if (slicing_name) + slice = element_address; + else + slice = fold_build2 (MEM_REF, + element_type, + fold_build2 (POINTER_PLUS_EXPR, + element_pointer_type, + elements, + index), + fold_convert (element_pointer_type, + integer_zero_node)); + + /* Prepend bounds checking code if necessary. */ + if (bounds_check != NULL_TREE) + { + slice = fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (slice), + bounds_check, + slice); + } + + return slice; +} + +/* Auxiliary routine for a68_multiple_copy_elemens. */ + +static tree +copy_multiple_dimension_elems (size_t dim, size_t num_dimensions, + tree to, tree from, + tree to_elements, tree from_elements, + tree *to_offset, tree *from_offset, + tree *indexes) +{ + tree element_pointer_type = TREE_TYPE (from_elements); + tree element_type = TREE_TYPE (element_pointer_type); + tree upb = a68_multiple_upper_bound (from, size_int (dim)); + + char *name = xasprintf ("r%ld%%", dim); + indexes[dim] = a68_lower_tmpvar (name, ssizetype, + a68_multiple_lower_bound (from, + size_int (dim))); + free (name); + + /* Loop body. */ + a68_push_range (NULL); + { + /* if (indexes[dim] > upb) break; */ + a68_add_stmt (fold_build1 (EXIT_EXPR, void_type_node, + fold_build2 (GT_EXPR, size_type_node, + indexes[dim], upb))); + + /* Add this dimension's contribution to the offsets. */ + tree index = fold_convert (sizetype, + fold_build2 (MINUS_EXPR, ssizetype, + upb, indexes[dim])); + *to_offset = fold_build2 (PLUS_EXPR, sizetype, + *to_offset, + fold_build2 (MULT_EXPR, sizetype, + index, + a68_multiple_stride (to, size_int (dim)))); + *from_offset = fold_build2 (PLUS_EXPR, sizetype, + *from_offset, + fold_build2 (MULT_EXPR, sizetype, + index, + a68_multiple_stride (from, size_int (dim)))); + + if (dim == num_dimensions - 1) + { + /* Most inner loop, copy one element. */ + + tree to_off = a68_lower_tmpvar ("to_offset%", sizetype, *to_offset); + tree from_off = a68_lower_tmpvar ("from_offset%", sizetype, *from_offset); + + tree to_elem = fold_build2 (MEM_REF, + element_type, + fold_build2 (POINTER_PLUS_EXPR, + element_pointer_type, + to_elements, + to_off), + fold_convert (element_pointer_type, + integer_zero_node)); + tree from_elem = fold_build2 (MEM_REF, + element_type, + fold_build2 (POINTER_PLUS_EXPR, + element_pointer_type, + from_elements, + from_off), + fold_convert (element_pointer_type, + integer_zero_node)); + + /* XXX + if may_overlap then modify only if dst_offset < src_offset */ + a68_add_stmt (fold_build2 (MODIFY_EXPR, element_type, + to_elem, from_elem)); + } + else + { + a68_add_stmt (copy_multiple_dimension_elems (dim + 1, num_dimensions, + to, from, + to_elements, from_elements, + to_offset, from_offset, + indexes)); + } + + /* indexes[dim]++ */ + a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, ssizetype, + indexes[dim], ssize_int (1))); + } + tree loop_body = a68_pop_range (); + + return fold_build1 (LOOP_EXPR, void_type_node, loop_body); +} + +/* Copy the elements of a given multiple (string) FROM to the multiple (string) + TO. + + The dimensions and bounds of both multiples are supposed to match, and they + are supposed to not be flat. + + XXX simple cases with same strides may be done with a memcpy. + XXX compile this into a support routine to reduce code size. */ + +tree +a68_multiple_copy_elems (MOID_T *mode, tree to, tree from) +{ + gcc_assert (A68_ROW_TYPE_P (TREE_TYPE (to)) + && A68_ROW_TYPE_P (TREE_TYPE (from))); + + /* Deflex modes as needed and determine dimension. */ + if (IS_FLEX (mode)) + mode = SUB (mode); + int num_dimensions = (mode == M_STRING ? 1 : DIM (mode)); + + a68_push_range (NULL); + to = a68_lower_tmpvar ("to%", TREE_TYPE (to), to); + from = a68_lower_tmpvar ("from%", TREE_TYPE (from), from); + tree from_elements = a68_multiple_elements (from); + tree element_pointer_type = TREE_TYPE (from_elements); + from_elements = a68_lower_tmpvar ("from_elements%", element_pointer_type, + from_elements); + tree to_elements = a68_lower_tmpvar ("to_elements%", element_pointer_type, + a68_multiple_elements (to)); + + tree *indexes = (tree *) xmalloc (num_dimensions * sizeof (tree)); + tree to_offset = size_zero_node; + tree from_offset = size_zero_node; + a68_add_stmt (copy_multiple_dimension_elems (0 /* dim */, num_dimensions, + to, from, + to_elements, from_elements, + &to_offset, &from_offset, + indexes)); + free (indexes); + return a68_pop_range (); +} + +/* Given a rows type, return the number of dimensions. */ + +tree +a68_rows_dim (tree exp) +{ + gcc_assert (A68_ROWS_TYPE_P (TREE_TYPE (exp))); + + /* dim% is the first field in the rows struct. */ + tree dim_field = TYPE_FIELDS (TREE_TYPE (exp)); + return fold_build3 (COMPONENT_REF, + TREE_TYPE (dim_field), + exp, + dim_field, + NULL_TREE); +} + +/* Given a multiple value, create a rows value reflecting the multiple's + dimensions and triplets. */ + +tree +a68_rows_value (tree multiple) +{ + tree rows_type = CTYPE (M_ROWS); + tree dim_field = TYPE_FIELDS (rows_type); + tree triplets_field = TREE_CHAIN (dim_field); + + tree dimensions = save_expr (a68_multiple_dimensions (multiple)); + tree triplets = fold_build1 (ADDR_EXPR, TREE_TYPE (triplets_field), + a68_multiple_triplets (multiple)); + return build_constructor_va (rows_type, 2, + dim_field, dimensions, + triplets_field, triplets); +} + +/* Given a rows value and a dimension number, return the upper bound or the + lower of the given dimension. The returned bound is a ssizetype. + + DIM must be a sizetype. */ + +static tree +rows_lower_or_upper_bound (tree rows, tree dim, bool upper) +{ + tree rows_type = TREE_TYPE (rows); + tree triplet_type = a68_triplet_type (); + tree triplet_pointer_type = build_pointer_type (triplet_type); + tree triplet_lb_field = TYPE_FIELDS (triplet_type); + tree triplet_ub_field = TREE_CHAIN (TYPE_FIELDS (triplet_type)); + tree triplets_field = TREE_CHAIN (TYPE_FIELDS (rows_type)); + tree triplets = fold_build3 (COMPONENT_REF, triplet_pointer_type, + rows, triplets_field, NULL_TREE); + tree triplet_offset = fold_build2 (MULT_EXPR, sizetype, + dim, + size_in_bytes (triplet_type)); + tree bound = fold_build3 (COMPONENT_REF, ssizetype, + fold_build1 (INDIRECT_REF, triplet_type, + fold_build2 (POINTER_PLUS_EXPR, + triplet_pointer_type, + triplets, + triplet_offset)), + upper ? triplet_ub_field : triplet_lb_field, + NULL_TREE); + + return bound; +} + +/* Return the lower bound of dimension DIM of ROWS. */ + +tree +a68_rows_lower_bound (tree rows, tree dim) +{ + return rows_lower_or_upper_bound (rows, dim, false); +} + +/* Return the upper bound of dimension DIM of ROWS. */ + +tree +a68_rows_upper_bound (tree rows, tree dim) +{ + return rows_lower_or_upper_bound (rows, dim, true); +} + +/* Return a tree that checks that a given INDEX is correct given a multiple's + bounds in a given rank DIM. + + If UPPER_BOUND is true then INDEX shall be less or equal than the multiple's + upper bound. Otherwise INDEX shall be bigger or equal than the multiple's + lower bound. + + If the condition above doesn't hold then a call to a run-time function is + performed: if UPPER_BOUND is true then ARRAYUPPERBOUND is called. Otherwise + ARRAYLOWERBOUND is called. */ + +tree +a68_multiple_single_bound_check (NODE_T *p, tree dim, + tree multiple, tree index, bool upper_bound) +{ + index = save_expr (index); + multiple = save_expr (multiple); + + tree bound = (upper_bound + ? a68_multiple_upper_bound (multiple, dim) + : a68_multiple_lower_bound (multiple, dim)); + a68_libcall_fn libcall = (upper_bound + ? A68_LIBCALL_ARRAYUPPERBOUND + : A68_LIBCALL_ARRAYLOWERBOUND); + + /* Build the call to ARRAY*BOUNDS. */ + unsigned int lineno = NUMBER (LINE (INFO (p))); + const char *filename_str = FILENAME (LINE (INFO (p))); + tree filename = build_string_literal (strlen (filename_str) + 1, + filename_str); + tree call = a68_build_libcall (libcall, + void_type_node, 4, + filename, + build_int_cst (unsigned_type_node, lineno), + fold_convert (ssizetype, index), + fold_convert (ssizetype, bound)); + call = fold_build2 (COMPOUND_EXPR, a68_bool_type, call, boolean_false_node); + + tree bounds_check = fold_build2 (upper_bound ? LE_EXPR : GE_EXPR, + ssizetype, + fold_convert (ssizetype, index), + bound); + return fold_build2_loc (a68_get_node_location (p), + TRUTH_ORIF_EXPR, + ssizetype, + bounds_check, call); +} + +/* Return a tree that checks whether the given DIM is a valid dimension/rank of + a boundable object with dimension BOUNDABLE_DIM. If the provided DIM is not + a valid dimention then a call to the run-time function ARRAYDIM is + performed. + + BOUNDABLE_DIM and DIM must be of type sizetype. They are both one-based. + + The parse tree node P is used as the source for the filename and line number + passed to the run-time function. */ + +static tree +a68_boundable_dim_check (NODE_T *p, tree boundable_dim, tree dim) +{ + boundable_dim = save_expr (boundable_dim); + dim = save_expr (dim); + + /* Build the call to ARRAYDIM. */ + unsigned int lineno = NUMBER (LINE (INFO (p))); + const char *filename_str = FILENAME (LINE (INFO (p))); + tree filename = build_string_literal (strlen (filename_str) + 1, + filename_str); + tree call = a68_build_libcall (A68_LIBCALL_ARRAYDIM, + void_type_node, 4, + filename, + build_int_cst (unsigned_type_node, lineno), + boundable_dim, dim); + call = fold_build2 (COMPOUND_EXPR, a68_bool_type, call, boolean_false_node); + + tree dim_check = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, + fold_build2 (GT_EXPR, boolean_type_node, dim, size_zero_node), + fold_build2 (LE_EXPR, boolean_type_node, dim, boundable_dim)); + return fold_build2_loc (a68_get_node_location (p), + TRUTH_ORIF_EXPR, + ssizetype, + dim_check, call); +} + +/* Return a tree that checks whether the given DIM is a valid dimension/rank of + the given rows value ROWS. + + DIM is a sizetype. + The parse tree node P is used as the source for the filename and line + number. */ + +tree +a68_rows_dim_check (NODE_T *p, tree rows, tree dim) +{ + return a68_boundable_dim_check (p, a68_rows_dim (rows), dim); +} + +/* Return a tree that checks whether the given DIM is a valid dimension/rank of + the given multiple value MULTIPLE. + + DIM is a sizetype. + The parse tree node P is used as the source for the filename and line + number. */ + +tree +a68_multiple_dim_check (NODE_T *p, tree multiple, tree dim) +{ + return a68_boundable_dim_check (p, a68_multiple_dimensions (multiple), dim); +} + +/* Return a tree that checks whether the given INDEX falls within the bounds of + MULTIPLE in the rank DIM. If the provided index is out of bounds then a + call to the run-time function ARRAYBOUNDS is performed. + + DIM must be a sizetype. + MULTIPLE must be a multiple value. + INDEX must be a ssizetype. + + The parse tree node P is used as the source for the filename and line number + passed to the run-time function. */ + +tree +a68_multiple_bounds_check (NODE_T *p, tree dim, + tree multiple, tree index) +{ + index = save_expr (index); + multiple = save_expr (multiple); + + tree upper_bound = a68_multiple_upper_bound (multiple, dim); + tree lower_bound = a68_multiple_lower_bound (multiple, dim); + + /* Build the call to ARRAYBOUNDS. */ + unsigned int lineno = NUMBER (LINE (INFO (p))); + const char *filename_str = FILENAME (LINE (INFO (p))); + tree filename = build_string_literal (strlen (filename_str) + 1, + filename_str); + tree call = a68_build_libcall (A68_LIBCALL_ARRAYBOUNDS, + void_type_node, 5, + filename, + build_int_cst (unsigned_type_node, lineno), + fold_convert (ssizetype, index), + fold_convert (ssizetype, lower_bound), + fold_convert (ssizetype, upper_bound)); + call = fold_build2 (COMPOUND_EXPR, a68_bool_type, call, boolean_false_node); + + /* If LB > UB, the dimension contains no elements. + Otherwise, it must hold IDX >= LB && IDX <= UB */ + tree bounds_check = fold_build2 (TRUTH_AND_EXPR, sizetype, + fold_build2 (LE_EXPR, ssizetype, + lower_bound, upper_bound), + fold_build2 (TRUTH_AND_EXPR, + boolean_type_node, + fold_build2 (GE_EXPR, ssizetype, + fold_convert (ssizetype, + index), + lower_bound), + fold_build2 (LE_EXPR, ssizetype, + fold_convert (ssizetype, + index), + upper_bound))); + return fold_build2_loc (a68_get_node_location (p), + TRUTH_ORIF_EXPR, + ssizetype, + bounds_check, call); +} + +/* Emit a run-time error if the bounds of M1 and M2 are not the same. Both + multiples are assumed to have the same type and therefore feature the same + number of dimensions. */ + +tree +a68_multiple_bounds_check_equal (NODE_T *p, tree m1, tree m2) +{ + m1 = save_expr (m1); + m2 = save_expr (m2); + + /* First determine the rank of the multiples and check they match. */ + tree m1_dimensions = a68_multiple_dimensions (m1); + tree m2_dimensions = a68_multiple_dimensions (m2); + gcc_assert (TREE_CODE (m1_dimensions) == INTEGER_CST + && TREE_CODE (m2_dimensions) == INTEGER_CST); + + int dim1 = tree_to_shwi (m1_dimensions); + int dim2 = tree_to_shwi (m2_dimensions); + gcc_assert (dim1 == dim2); + + a68_push_range (NULL /* VOID */); + + /* For each dimension, check that bounds are the same in both multiples. */ + int i; + for (i = 0; i < dim1; ++i) + { + tree dim_tree = build_int_cst (ssizetype, i); + tree dim_plus_one = fold_build2 (PLUS_EXPR, ssizetype, + dim_tree, + fold_convert (ssizetype, size_one_node)); + + tree lb1 = save_expr (a68_multiple_lower_bound (m1, dim_tree)); + tree lb2 = save_expr (a68_multiple_lower_bound (m2, dim_tree)); + + tree ub1 = save_expr (a68_multiple_upper_bound (m1, dim_tree)); + tree ub2 = save_expr (a68_multiple_upper_bound (m2, dim_tree)); + + tree bounds_equal = fold_build2 (TRUTH_AND_EXPR, + boolean_type_node, + fold_build2 (EQ_EXPR, boolean_type_node, + lb1, lb2), + fold_build2 (EQ_EXPR, boolean_type_node, + ub1, ub2)); + + unsigned int lineno = NUMBER (LINE (INFO (p))); + const char *filename_str = FILENAME (LINE (INFO (p))); + tree filename = build_string_literal (strlen (filename_str) + 1, + filename_str); + tree call = a68_build_libcall (A68_LIBCALL_ARRAYBOUNDSMISMATCH, + void_type_node, 7, + filename, + build_int_cst (unsigned_type_node, lineno), + dim_plus_one, + lb1, ub1, lb2, ub2); + call = fold_build2 (COMPOUND_EXPR, boolean_type_node, call, boolean_false_node); + + tree check = fold_build2_loc (a68_get_node_location (p), + TRUTH_ORIF_EXPR, boolean_type_node, + bounds_equal, + call); + a68_add_stmt (check); + } + + return a68_pop_range (); +} + +/* Allocate a multiple on the heap. + + M is the mode the multiple to allocate. + DIM is the number of dimensions of the multiple. + ELEMS is a pointer to the elements of the multiple. + ELEMS_SIZE is the size in bytes of ELEMS. + *LOWER_BOUND and *UPPER_BOUND are the bounds for the DIM dimensions. */ + +tree +a68_row_malloc (tree type, int dim, tree elems, tree elems_size, + tree *lower_bound, tree *upper_bound) +{ + tree ptr_to_type = build_pointer_type (type); + + a68_push_range (NULL); + + /* Allocate space for the descriptor. */ + tree ptr_to_multiple = a68_lower_tmpvar ("ptr_to_multiple%", ptr_to_type, + a68_lower_malloc (type, size_in_bytes (type))); + tree multiple = a68_row_value (type, dim, + elems, elems_size, + lower_bound, upper_bound); + a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node, + fold_build1 (INDIRECT_REF, type, ptr_to_multiple), + multiple)); + a68_add_stmt (ptr_to_multiple); + tree res = a68_pop_range (); + TREE_TYPE (res) = ptr_to_type; + return res; +} diff --git a/gcc/algol68/a68-low-structs.cc b/gcc/algol68/a68-low-structs.cc new file mode 100644 index 000000000000..12bb6192fb43 --- /dev/null +++ b/gcc/algol68/a68-low-structs.cc @@ -0,0 +1,63 @@ +/* Lowering routines for all things related to structs. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Return a tree with the yielding of SKIP for the given structured mode. */ + +tree +a68_get_struct_skip_tree (MOID_T *m) +{ + /* Build a constructor that assigns SKIPs to each field in the struct + type. */ + + vec *ve = NULL; + tree field = TYPE_FIELDS (CTYPE (m)); + for (PACK_T *elem = PACK (m); elem; FORWARD (elem)) + { + gcc_assert (field != NULL_TREE); + CONSTRUCTOR_APPEND_ELT (ve, field, a68_get_skip_tree (MOID (elem))); + field = DECL_CHAIN (field); + } + + return build_constructor (CTYPE (m), ve); +} diff --git a/gcc/algol68/a68-low-unions.cc b/gcc/algol68/a68-low-unions.cc new file mode 100644 index 000000000000..f775877f3271 --- /dev/null +++ b/gcc/algol68/a68-low-unions.cc @@ -0,0 +1,279 @@ +/* Lowering routines for all things related to unions. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Algol 68 unions are implemented in this front-end as a data structure + consisting of an overhead followed by a value: + + overhead% + value% + + Where overhead% is an index that identifies the kind of object currently + united, and value% is a GENERIC union. The value currently united in the + union is the overhead%-th field in value%. + + At the language level there are no values of union modes in Algol 68. All + values are built from either SKIP (for uninitialized UNION values) or as the + result of an uniting coercion. */ + +/* Given an union mode P and a mode Q, return whether Q is a mode in P. */ + +bool +a68_union_contains_mode (MOID_T *p, MOID_T *q) +{ + while (EQUIVALENT (p) != NO_MOID) + p = EQUIVALENT (p); + + for (PACK_T *pack = PACK (p); pack != NO_PACK; FORWARD (pack)) + { + MOID_T *m = MOID (pack); + + if (a68_is_equal_modes (q, m, SAFE_DEFLEXING) + || (m == M_STRING && IS_ROW (q) && SUB (q) == M_CHAR) + || (q == M_STRING && IS_ROW (m) && SUB (m) == M_CHAR)) + return true; + } + + return false; +} + +/* Given an union mode P and a mode Q, return an integer with the index of the + occurrence of Q in P. */ + +int +a68_united_mode_index (MOID_T *p, MOID_T *q) +{ + int ret = 0; + while (EQUIVALENT (p) != NO_MOID) + p = EQUIVALENT (p); + for (PACK_T *pack = PACK (p); pack != NO_PACK; FORWARD (pack)) + { + MOID_T *m = MOID (pack); + + if (a68_is_equal_modes (q, m, SAFE_DEFLEXING) + || (m == M_STRING && IS_ROW (q) && SUB (q) == M_CHAR) + || (q == M_STRING && IS_ROW (m) && SUB (m) == M_CHAR)) + return ret; + ret += 1; + } + + /* Not found. Shouldn't happen. */ + gcc_unreachable (); + return 0; +} + +/* Given two united modes FROM and TO, and an overhead FROM_OVERHEAD in mode + FROM, return the corresponding overhead in mode TO. + + This function assumes that the mode with FROM_OVERHEAD in mode FROM exists + in TO. */ + +tree +a68_union_translate_overhead (MOID_T *from, tree from_overhead, + MOID_T *to) +{ + /* Note that the initialization value for to_overhead should never be used. + XXX perhaps translate it to a run-time call to abort/compiler-error. */ + tree to_overhead = size_int (0); + + from_overhead = save_expr (from_overhead); + + int i = 0; + for (PACK_T *pack = PACK (from); pack != NO_PACK; FORWARD (pack), ++i) + { + MOID_T *mode = MOID (pack); + + if (a68_union_contains_mode (to, mode)) + { + to_overhead = fold_build3 (COND_EXPR, sizetype, + fold_build2 (EQ_EXPR, boolean_type_node, + from_overhead, + size_int (i)), + size_int (a68_united_mode_index (to, mode)), + to_overhead); + } + } + + return to_overhead; +} + +/* Get the overhead of a given united value EXP. */ + +tree +a68_union_overhead (tree exp) +{ + tree type = TREE_TYPE (exp); + tree overhead_field = TYPE_FIELDS (type); + return fold_build3 (COMPONENT_REF, + TREE_TYPE (overhead_field), + exp, + overhead_field, + NULL_TREE); +} + +/* Set the overhead of a given united value EXP to OVERHEAD. */ + +tree +a68_union_set_overhead (tree exp, tree overhead) +{ + tree type = TREE_TYPE (exp); + tree overhead_field = TYPE_FIELDS (type); + return fold_build2 (MODIFY_EXPR, + TREE_TYPE (overhead), + fold_build3 (COMPONENT_REF, + TREE_TYPE (overhead_field), + exp, + overhead_field, + NULL_TREE), + overhead); +} + +/* Get the cunion in the given union EXP. */ + +tree +a68_union_cunion (tree exp) +{ + tree type = TREE_TYPE (exp); + tree value_field = TREE_CHAIN (TYPE_FIELDS (type)); + return fold_build3 (COMPONENT_REF, + TREE_TYPE (value_field), + exp, + value_field, + NULL_TREE); +} + +/* Build a SKIP value for a given union mode M. + + The SKIP value computed is: + + overhead% refers to the first united mode in the union + value% is the SKIP for the first united mode in the union +*/ + +tree +a68_get_union_skip_tree (MOID_T *m) +{ + tree type = CTYPE (m); + tree overhead_field = TYPE_FIELDS (type); + tree value_field = TREE_CHAIN (TYPE_FIELDS (type)); + + /* Overhead selects the first union alternative. */ + tree overhead = size_zero_node; + /* First union alternative. + + Note that the first union alternative corresponds to the last alternative + in the mode as written in the source program. */ + tree value_type = TREE_TYPE (value_field); + tree first_alternative_field = TYPE_FIELDS (value_type); + tree value = build_constructor_va (TREE_TYPE (value_field), + 1, + first_alternative_field, + a68_get_skip_tree (MOID (PACK (m)))); + return build_constructor_va (CTYPE (m), + 2, + overhead_field, overhead, + value_field, value); +} + +/* Return the alternative (value) at the index INDEX in the united value + EXP. */ + +tree +a68_union_alternative (tree exp, int index) +{ + tree type = TREE_TYPE (exp); + tree value_field = TREE_CHAIN (TYPE_FIELDS (type)); + tree value = fold_build3 (COMPONENT_REF, + TREE_TYPE (value_field), + exp, + value_field, + NULL_TREE); + + /* Get the current alternative in the value union. */ + tree value_type = TREE_TYPE (value_field); + tree alternative_field = TYPE_FIELDS (value_type); + for (int i = 0; i < index; ++i) + { + gcc_assert (TREE_CHAIN (alternative_field)); + alternative_field = TREE_CHAIN (alternative_field); + } + + /* Get the current alternative from the value. */ + return fold_build3 (COMPONENT_REF, + TREE_TYPE (alternative_field), + value, + alternative_field, + NULL_TREE); +} + +/* Return a constructor for an union of mode MODE, holding the value in EXP + which is of mode EXP_MODE. */ + +tree +a68_union_value (MOID_T *mode, tree exp, MOID_T *exp_mode) +{ + tree type = CTYPE (mode); + tree overhead_field = TYPE_FIELDS (type); + tree value_field = TREE_CHAIN (TYPE_FIELDS (type)); + + int alternative_index = a68_united_mode_index (mode, exp_mode); + tree overhead = build_int_cst (sizetype, alternative_index); + + /* Get the field for the alternative corresponding to alternative_index. */ + tree value_type = TREE_TYPE (value_field); + tree alternative_field = TYPE_FIELDS (value_type); + for (int i = 0; i < alternative_index; ++i) + { + gcc_assert (TREE_CHAIN (alternative_field)); + alternative_field = TREE_CHAIN (alternative_field); + } + + tree value = build_constructor_va (TREE_TYPE (value_field), + 1, + alternative_field, + a68_consolidate_ref (exp_mode, exp)); + return build_constructor_va (type, + 2, + overhead_field, overhead, + value_field, value); +} From d27b9ed9c7508bac187776e21a675a8b537a7282 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:52:33 +0200 Subject: [PATCH 167/373] a68: low: standard prelude Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-low-posix.cc: New file. * algol68/a68-low-prelude.cc: Likewise. --- gcc/algol68/a68-low-posix.cc | 559 ++++++++ gcc/algol68/a68-low-prelude.cc | 2193 ++++++++++++++++++++++++++++++++ 2 files changed, 2752 insertions(+) create mode 100644 gcc/algol68/a68-low-posix.cc create mode 100644 gcc/algol68/a68-low-prelude.cc diff --git a/gcc/algol68/a68-low-posix.cc b/gcc/algol68/a68-low-posix.cc new file mode 100644 index 000000000000..6b6ae76cf375 --- /dev/null +++ b/gcc/algol68/a68-low-posix.cc @@ -0,0 +1,559 @@ +/* Lowering routines for the POSIX prelude. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Set the exit status of the running process, to be returned to the OS upon + exit. */ + +tree +a68_posix_setexitstatus (void) +{ + return a68_get_libcall (A68_LIBCALL_SET_EXIT_STATUS); +} + +/* Number of command line arguments passed to the program. */ + +tree +a68_posix_argc (void) +{ + return a68_get_libcall (A68_LIBCALL_POSIX_ARGC); +} + +/* Gets the Nth command line argument passed to the program. If N is out of + range the result is an empty string. */ + +tree +a68_posix_argv (void) +{ + static tree argv_fndecl; + + if (argv_fndecl == NULL_TREE) + { + argv_fndecl + = a68_low_toplevel_func_decl ("argv", + build_function_type_list (CTYPE (M_STRING), + a68_int_type, + NULL_TREE)); + announce_function (argv_fndecl); + + tree param = a68_low_func_param (argv_fndecl, "n", a68_int_type); + DECL_ARGUMENTS (argv_fndecl) = param; + + a68_push_function_range (argv_fndecl, CTYPE (M_STRING), + true /* top_level */); + + a68_push_range (M_STRING); + tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0)); + TREE_ADDRESSABLE (len) = 1; + + tree ptrtochar_type = build_pointer_type (a68_char_type); + tree elems = a68_lower_tmpvar ("elems%", ptrtochar_type, + a68_build_libcall (A68_LIBCALL_POSIX_ARGV, + ptrtochar_type, 2, + param, + fold_build1 (ADDR_EXPR, build_pointer_type (sizetype), + len))); + tree lower_bound = ssize_int (1); + tree upper_bound = fold_convert (ssizetype, len); + tree elems_size = fold_build2 (MULT_EXPR, sizetype, + len, + size_in_bytes (a68_char_type)); + a68_add_stmt (a68_row_value (CTYPE (M_STRING), 1 /* dim */, + elems, elems_size, + &lower_bound, &upper_bound)); + tree body = a68_pop_range (); + a68_pop_function_range (body); + } + + return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (argv_fndecl)), + argv_fndecl); +} + +/* Gets the value of an environment variable, or an empty string if the + variable is not set. */ + +tree +a68_posix_getenv (void) +{ + static tree getenv_fndecl; + + if (getenv_fndecl == NULL_TREE) + { + getenv_fndecl + = a68_low_toplevel_func_decl ("getenv", + build_function_type_list (CTYPE (M_STRING), + CTYPE (M_STRING), + NULL_TREE)); + announce_function (getenv_fndecl); + + tree param = a68_low_func_param (getenv_fndecl, "varname", CTYPE (M_STRING)); + DECL_ARGUMENTS (getenv_fndecl) = param; + + a68_push_function_range (getenv_fndecl, CTYPE (M_STRING), + true /* top_level */); + + a68_push_range (M_STRING); + + tree varname = a68_lower_tmpvar ("varname%", CTYPE (M_STRING), + param); + + tree ptrtochar_type = build_pointer_type (a68_char_type); + tree convelems = a68_lower_tmpvar ("convelems%", ptrtochar_type, + build_int_cst (ptrtochar_type, 0)); + TREE_ADDRESSABLE (convelems) = 1; + tree convelemslen = a68_lower_tmpvar ("convelemslen%", sizetype, + size_int (0)); + TREE_ADDRESSABLE (convelemslen) = 1; + + tree call = a68_build_libcall (A68_LIBCALL_POSIX_GETENV, + void_type_node, 5, + a68_multiple_elements (varname), + a68_multiple_num_elems (varname), + a68_multiple_stride (varname, size_zero_node), + fold_build1 (ADDR_EXPR, build_pointer_type (ptrtochar_type), + convelems), + fold_build1 (ADDR_EXPR, build_pointer_type (sizetype), + convelemslen)); + a68_add_stmt (call); + tree lower_bound = ssize_int (1); + tree upper_bound = fold_convert (ssizetype, convelemslen); + tree convelems_size = fold_build2 (MULT_EXPR, sizetype, + convelemslen, + size_in_bytes (a68_char_type)); + a68_add_stmt (a68_row_value (CTYPE (M_STRING), 1 /* dim */, + convelems, convelems_size, + &lower_bound, &upper_bound)); + tree body = a68_pop_range (); + a68_pop_function_range (body); + } + + return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (getenv_fndecl)), + getenv_fndecl); +} + +tree +a68_posix_putchar (void) +{ + return a68_get_libcall (A68_LIBCALL_POSIX_PUTCHAR); +} + +tree +a68_posix_puts (void) +{ + static tree puts_fndecl; + + if (puts_fndecl == NULL_TREE) + { + puts_fndecl + = a68_low_toplevel_func_decl ("puts", + build_function_type_list (void_type_node, + CTYPE (M_STRING), + NULL_TREE)); + announce_function (puts_fndecl); + + tree param = a68_low_func_param (puts_fndecl, "str", CTYPE (M_STRING)); + DECL_ARGUMENTS (puts_fndecl) = param; + + a68_push_function_range (puts_fndecl, void_type_node, + true /* top_level */); + + tree call = a68_build_libcall (A68_LIBCALL_POSIX_PUTS, + void_type_node, 3, + a68_multiple_elements (param), + a68_multiple_num_elems (param), + a68_multiple_stride (param, size_zero_node)); + a68_pop_function_range (call); + } + + return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (puts_fndecl)), + puts_fndecl); +} + +tree +a68_posix_fconnect (void) +{ + static tree fconnect_fndecl; + + if (fconnect_fndecl == NULL_TREE) + { + fconnect_fndecl + = a68_low_toplevel_func_decl ("fconnect", + build_function_type_list (a68_int_type, + CTYPE (M_STRING), + a68_bits_type, + NULL_TREE)); + announce_function (fconnect_fndecl); + + tree host = a68_low_func_param (fconnect_fndecl, "host", CTYPE (M_STRING)); + tree port = a68_low_func_param (fconnect_fndecl, "port", a68_int_type); + DECL_ARGUMENTS (fconnect_fndecl) = chainon (host, port); + + a68_push_function_range (fconnect_fndecl, a68_int_type, + true /* top_level */); + + + tree body = a68_build_libcall (A68_LIBCALL_POSIX_FCONNECT, + a68_int_type, 4, + a68_multiple_elements (host), + a68_multiple_num_elems (host), + a68_multiple_stride (host, size_zero_node), + port); + a68_pop_function_range (body); + } + + return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fconnect_fndecl)), + fconnect_fndecl); +} + +tree +a68_posix_fcreate (void) +{ + static tree fcreate_fndecl; + + if (fcreate_fndecl == NULL_TREE) + { + fcreate_fndecl + = a68_low_toplevel_func_decl ("fcreate", + build_function_type_list (a68_int_type, + CTYPE (M_STRING), + a68_bits_type, + NULL_TREE)); + announce_function (fcreate_fndecl); + + tree pathname = a68_low_func_param (fcreate_fndecl, "pathname", CTYPE (M_STRING)); + tree mode = a68_low_func_param (fcreate_fndecl, "mode", a68_int_type); + DECL_ARGUMENTS (fcreate_fndecl) = chainon (pathname, mode); + + a68_push_function_range (fcreate_fndecl, a68_int_type, + true /* top_level */); + + + tree body = a68_build_libcall (A68_LIBCALL_POSIX_FCREATE, + a68_int_type, 4, + a68_multiple_elements (pathname), + a68_multiple_num_elems (pathname), + a68_multiple_stride (pathname, size_zero_node), + mode); + a68_pop_function_range (body); + } + + return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fcreate_fndecl)), + fcreate_fndecl); +} + +tree +a68_posix_fopen (void) +{ + static tree fopen_fndecl; + + if (fopen_fndecl == NULL_TREE) + { + fopen_fndecl + = a68_low_toplevel_func_decl ("fopen", + build_function_type_list (a68_int_type, + CTYPE (M_STRING), + a68_bits_type, + NULL_TREE)); + announce_function (fopen_fndecl); + + tree pathname = a68_low_func_param (fopen_fndecl, "pathname", CTYPE (M_STRING)); + tree flags = a68_low_func_param (fopen_fndecl, "flags", a68_int_type); + DECL_ARGUMENTS (fopen_fndecl) = chainon (pathname, flags); + + a68_push_function_range (fopen_fndecl, a68_int_type, + true /* top_level */); + + + tree body = a68_build_libcall (A68_LIBCALL_POSIX_FOPEN, + a68_int_type, 4, + a68_multiple_elements (pathname), + a68_multiple_num_elems (pathname), + a68_multiple_stride (pathname, size_zero_node), + flags); + a68_pop_function_range (body); + } + + return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fopen_fndecl)), + fopen_fndecl); +} + +tree +a68_posix_fclose (void) +{ + return a68_get_libcall (A68_LIBCALL_POSIX_FCLOSE); +} + +tree +a68_posix_fsize (void) +{ + return a68_get_libcall (A68_LIBCALL_POSIX_FSIZE); +} + +tree +a68_posix_lseek (void) +{ + return a68_get_libcall (A68_LIBCALL_POSIX_LSEEK); +} + +tree +a68_posix_errno (void) +{ + return a68_get_libcall (A68_LIBCALL_POSIX_ERRNO); +} + +tree +a68_posix_perror (void) +{ + static tree perror_fndecl; + + if (perror_fndecl == NULL_TREE) + { + perror_fndecl + = a68_low_toplevel_func_decl ("perror", + build_function_type_list (void_type_node, + CTYPE (M_STRING), + NULL_TREE)); + announce_function (perror_fndecl); + + tree str = a68_low_func_param (perror_fndecl, "str", CTYPE (M_STRING)); + DECL_ARGUMENTS (perror_fndecl) = str; + + a68_push_function_range (perror_fndecl, void_type_node, + true /* top_level */); + + tree body = a68_build_libcall (A68_LIBCALL_POSIX_PERROR, + a68_int_type, 3, + a68_multiple_elements (str), + a68_multiple_num_elems (str), + a68_multiple_stride (str, size_zero_node)); + a68_pop_function_range (body); + } + + return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (perror_fndecl)), + perror_fndecl); +} + +tree +a68_posix_strerror (void) +{ + static tree strerror_fndecl; + + if (strerror_fndecl == NULL_TREE) + { + strerror_fndecl + = a68_low_toplevel_func_decl ("strerror", + build_function_type_list (CTYPE (M_STRING), + a68_int_type, + NULL_TREE)); + announce_function (strerror_fndecl); + + tree errnum = a68_low_func_param (strerror_fndecl, "errnum", a68_int_type); + DECL_ARGUMENTS (strerror_fndecl) = errnum; + + a68_push_function_range (strerror_fndecl, CTYPE (M_STRING), + true /* top_level */); + + tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0)); + TREE_ADDRESSABLE (len) = 1; + + tree call = a68_build_libcall (A68_LIBCALL_POSIX_STRERROR, + void_type_node, 2, + errnum, + fold_build1 (ADDR_EXPR, build_pointer_type (sizetype), len)); + tree elems = a68_lower_tmpvar ("elems%", build_pointer_type (a68_char_type), call); + + tree lower_bound = ssize_int (1); + tree upper_bound = fold_convert (ssizetype, len); + tree elems_size = fold_build2 (MULT_EXPR, sizetype, + len, size_in_bytes (a68_char_type)); + + tree body = a68_row_value (CTYPE (M_STRING), 1 /* dim */, + elems, elems_size, + &lower_bound, &upper_bound); + a68_pop_function_range (body); + } + + return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (strerror_fndecl)), + strerror_fndecl); +} + +tree +a68_posix_getchar (void) +{ + return a68_get_libcall (A68_LIBCALL_POSIX_GETCHAR); +} + +tree +a68_posix_fgetc (void) +{ + return a68_get_libcall (A68_LIBCALL_POSIX_FGETC); +} + +tree +a68_posix_fputc (void) +{ + return a68_get_libcall (A68_LIBCALL_POSIX_FPUTC); +} + +tree +a68_posix_fputs (void) +{ + static tree fputs_fndecl; + + if (fputs_fndecl == NULL_TREE) + { + fputs_fndecl + = a68_low_toplevel_func_decl ("fputs", + build_function_type_list (a68_int_type, + a68_int_type, + CTYPE (M_STRING), + NULL_TREE)); + announce_function (fputs_fndecl); + + tree fd = a68_low_func_param (fputs_fndecl, "fd", a68_int_type); + tree str = a68_low_func_param (fputs_fndecl, "str", CTYPE (M_STRING)); + DECL_ARGUMENTS (fputs_fndecl) = chainon (fd, str); + + a68_push_function_range (fputs_fndecl, a68_int_type, + true /* top_level */); + + + tree body = a68_build_libcall (A68_LIBCALL_POSIX_FPUTS, + a68_int_type, 4, + fd, + a68_multiple_elements (str), + a68_multiple_num_elems (str), + a68_multiple_stride (str, size_zero_node)); + a68_pop_function_range (body); + } + + return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fputs_fndecl)), + fputs_fndecl); +} + +tree +a68_posix_fgets (void) +{ + static tree fgets_fndecl; + + if (fgets_fndecl == NULL_TREE) + { + fgets_fndecl + = a68_low_toplevel_func_decl ("fgets", + build_function_type_list (CTYPE (M_REF_STRING), + a68_int_type, + a68_int_type, + NULL_TREE)); + announce_function (fgets_fndecl); + + tree fd = a68_low_func_param (fgets_fndecl, "fd", a68_int_type); + tree n = a68_low_func_param (fgets_fndecl, "n", a68_int_type); + DECL_ARGUMENTS (fgets_fndecl) = chainon (fd, n); + + a68_push_function_range (fgets_fndecl, CTYPE (M_REF_STRING), + true /* top_level */); + + tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0)); + TREE_ADDRESSABLE (len) = 1; + + tree call = a68_build_libcall (A68_LIBCALL_POSIX_FGETS, + CTYPE (M_REF_STRING), 3, + fd, n, + fold_build1 (ADDR_EXPR, build_pointer_type (sizetype), len)); + tree elems = a68_lower_tmpvar ("elems%", build_pointer_type (a68_char_type), call); + + tree lower_bound = ssize_int (1); + tree upper_bound = fold_convert (ssizetype, len); + tree elems_size = fold_build2 (MULT_EXPR, sizetype, + len, size_in_bytes (a68_char_type)); + tree body = a68_row_malloc (CTYPE (M_STRING), 1 /* dim */, + elems, elems_size, + &lower_bound, &upper_bound); + a68_pop_function_range (body); + } + + return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (fgets_fndecl)), + fgets_fndecl); +} + +tree +a68_posix_gets (void) +{ + static tree gets_fndecl; + + if (gets_fndecl == NULL_TREE) + { + gets_fndecl + = a68_low_toplevel_func_decl ("gets", + build_function_type_list (CTYPE (M_REF_STRING), + a68_int_type, + NULL_TREE)); + announce_function (gets_fndecl); + + tree n = a68_low_func_param (gets_fndecl, "n", a68_int_type); + DECL_ARGUMENTS (gets_fndecl) = n; + + a68_push_function_range (gets_fndecl, CTYPE (M_REF_STRING), + true /* top_level */); + + tree len = a68_lower_tmpvar ("len%", sizetype, size_int (0)); + TREE_ADDRESSABLE (len) = 1; + + tree call = a68_build_libcall (A68_LIBCALL_POSIX_GETS, + CTYPE (M_REF_STRING), 2, + n, fold_build1 (ADDR_EXPR, build_pointer_type (sizetype), len)); + tree elems = a68_lower_tmpvar ("elems%", build_pointer_type (a68_char_type), call); + + tree lower_bound = ssize_int (1); + tree upper_bound = fold_convert (ssizetype, len); + tree elems_size = fold_build2 (MULT_EXPR, sizetype, + len, size_in_bytes (a68_char_type)); + tree body = a68_row_malloc (CTYPE (M_STRING), 1 /* dim */, + elems, elems_size, + &lower_bound, &upper_bound); + a68_pop_function_range (body); + } + + return fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (gets_fndecl)), + gets_fndecl); +} diff --git a/gcc/algol68/a68-low-prelude.cc b/gcc/algol68/a68-low-prelude.cc new file mode 100644 index 000000000000..55c0895bec52 --- /dev/null +++ b/gcc/algol68/a68-low-prelude.cc @@ -0,0 +1,2193 @@ +/* Lower Algol 68 pre-defined operators and procedures. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "convert.h" + +#include "a68.h" + +/* The following handlers are for lowing the entities defined in + a68-parser-prelude.c. */ + +tree +a68_lower_unimplemented (NODE_T *p, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + fatal_error (a68_get_node_location (p), + "no lowering routine installed for construct. jemarch has been lazy"); +} + +tree +a68_lower_charabs2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op = a68_lower_tree (NEXT (SUB (p)), ctx); + return a68_char_abs (op); +} + +tree +a68_lower_boolabs2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op = a68_lower_tree (NEXT (SUB (p)), ctx); + return a68_bool_abs (op); +} + +tree +a68_lower_intabs2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op = a68_lower_tree (NEXT (SUB (p)), ctx); + return a68_int_abs (op); +} + +tree +a68_lower_realabs2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op = a68_lower_tree (NEXT (SUB (p)), ctx); + return a68_real_abs (op); +} + +tree +a68_lower_confirm2 (NODE_T *p, LOW_CTX_T ctx) +{ + /* Used to implement monadic +. */ + return a68_lower_tree (NEXT (SUB (p)), ctx); +} + +tree +a68_lower_negate2 (NODE_T *p, LOW_CTX_T ctx) +{ + return fold_build1_loc (a68_get_node_location (p), + NEGATE_EXPR, + CTYPE (MOID (p)), + a68_lower_tree (NEXT (SUB (p)), ctx)); +} + +/* Lower an ENTIER standard monadic operator. */ + +tree +a68_lower_entier2 (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *op = NEXT (SUB (p)); + return a68_real_entier (a68_lower_tree (op, ctx), MOID (p), MOID (op)); +} + +/* Lower a ROUND standard monadic operator. + + This operator gets a LONGSETY REAL and produces a LONGSETY INT which is the + nearest integer to the given real. */ + +tree +a68_lower_round2 (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *op = NEXT (SUB (p)); + return a68_real_round (a68_lower_tree (op, ctx), MOID (p), MOID (op)); +} + +tree +a68_lower_not2 (NODE_T *p, LOW_CTX_T ctx) +{ + return fold_build1_loc (a68_get_node_location (p), + TRUTH_NOT_EXPR, + CTYPE (MOID (p)), + a68_lower_tree (NEXT (SUB (p)), ctx)); +} + +tree +a68_lower_and3 (NODE_T *p, LOW_CTX_T ctx) +{ + return fold_build2_loc (a68_get_node_location (p), + TRUTH_AND_EXPR, + CTYPE (MOID (p)), + a68_lower_tree (SUB (p), ctx), + a68_lower_tree (NEXT (NEXT (SUB (p))), ctx)); +} + +tree +a68_lower_or3 (NODE_T *p, LOW_CTX_T ctx) +{ + return fold_build2_loc (a68_get_node_location (p), + TRUTH_OR_EXPR, + CTYPE (MOID (p)), + a68_lower_tree (SUB (p), ctx), + a68_lower_tree (NEXT (NEXT (SUB (p))), ctx)); +} + +tree +a68_lower_xor3 (NODE_T *p, LOW_CTX_T ctx) +{ + return fold_build2_loc (a68_get_node_location (p), + TRUTH_XOR_EXPR, + CTYPE (MOID (p)), + a68_lower_tree (SUB (p), ctx), + a68_lower_tree (NEXT (NEXT (SUB (p))), ctx)); +} + +tree +a68_lower_plus_int (NODE_T *p, LOW_CTX_T ctx) +{ + MOID_T *m = MOID (p); + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_int_plus (m, op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_plus_real (NODE_T *p, LOW_CTX_T ctx) +{ + MOID_T *m = MOID (p); + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_real_plus (m, op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_minus_int (NODE_T *p, LOW_CTX_T ctx) +{ + MOID_T *m = MOID (p); + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_int_minus (m, op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_minus_real (NODE_T *p, LOW_CTX_T ctx) +{ + MOID_T *m = MOID (p); + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_real_minus (m, op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_mult_int (NODE_T *p, LOW_CTX_T ctx) +{ + MOID_T *m = MOID (p); + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_int_mult (m, op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_mult_real (NODE_T *p, LOW_CTX_T ctx) +{ + MOID_T *m = MOID (p); + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_real_mult (m, op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_multab3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree lhs = a68_lower_tree (SUB (p), ctx); + lhs = a68_consolidate_ref (MOID (SUB (p)), lhs); + lhs = save_expr (lhs); + NODE_T *rhs_node = NEXT (NEXT (SUB (p))); + tree rhs = a68_lower_tree (rhs_node, ctx); + tree operation = fold_build2_loc (a68_get_node_location (p), + MULT_EXPR, + TREE_TYPE (rhs), + a68_low_deref (lhs, SUB (p)), + rhs); + + return fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (lhs), + a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)), + lhs); +} + +tree +a68_lower_over3 (NODE_T *p, LOW_CTX_T ctx) +{ + MOID_T *m = MOID (p); + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_int_div (m, op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_mod3 (NODE_T *p, LOW_CTX_T ctx) +{ + MOID_T *m = MOID (p); + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_int_mod (m, op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_div3 (NODE_T *p, LOW_CTX_T ctx) +{ + return a68_real_div (MOID (p), + a68_lower_tree (SUB (p), ctx), + a68_lower_tree (NEXT (NEXT (SUB (p))), ctx), + a68_get_node_location (p)); +} + +tree +a68_lower_rdiv3 (NODE_T *p, LOW_CTX_T ctx) +{ + return a68_real_div (MOID (p), + fold_build1 (FLOAT_EXPR, CTYPE (MOID (p)), + a68_lower_tree (SUB (p), ctx)), + fold_build1 (FLOAT_EXPR, CTYPE (MOID (p)), + a68_lower_tree (NEXT (NEXT (SUB (p))), ctx)), + a68_get_node_location (p)); +} + +tree +a68_lower_int_eq3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_int_eq (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_int_ne3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_int_ne (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_int_lt3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_int_lt (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_int_le3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_int_le (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_int_gt3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_int_gt (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_int_ge3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_int_ge (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_real_eq3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_real_eq (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_real_ne3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_real_ne (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_real_lt3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_real_lt (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_real_le3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_real_le (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_real_gt3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_real_gt (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_real_ge3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_real_ge (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_char_eq3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_char_eq (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_char_ne3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_char_ne (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_char_lt3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_char_lt (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_char_le3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_char_le (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_char_gt3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_char_gt (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_char_ge3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_char_ge (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_bool_eq3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_bool_eq (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_bool_ne3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_bool_ne (op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_sign2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op = a68_lower_tree (NEXT (SUB (p)), ctx); + return a68_int_sign (op); +} + +tree +a68_lower_realsign2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op = a68_lower_tree (NEXT (SUB (p)), ctx); + return a68_real_sign (op); +} + +tree +a68_lower_plusab3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree lhs = a68_lower_tree (SUB (p), ctx); + lhs = a68_consolidate_ref (MOID (SUB (p)), lhs); + lhs = save_expr (lhs); + NODE_T *rhs_node = NEXT (NEXT (SUB (p))); + tree rhs = a68_lower_tree (rhs_node, ctx); + tree operation = fold_build2_loc (a68_get_node_location (p), + PLUS_EXPR, + TREE_TYPE (rhs), + a68_low_deref (lhs, SUB (p)), + rhs); + + return fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (lhs), + a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)), + lhs); +} + +tree +a68_lower_minusab3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree lhs = a68_lower_tree (SUB (p), ctx); + lhs = a68_consolidate_ref (MOID (SUB (p)), lhs); + lhs = save_expr (lhs); + NODE_T *rhs_node = NEXT (NEXT (SUB (p))); + tree rhs = a68_lower_tree (rhs_node, ctx); + tree operation = fold_build2_loc (a68_get_node_location (p), + MINUS_EXPR, + TREE_TYPE (rhs), + a68_low_deref (lhs, SUB (p)), + rhs); + + return fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (lhs), + a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)), + lhs); +} + +tree +a68_lower_overab3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree lhs = a68_lower_tree (SUB (p), ctx); + lhs = a68_consolidate_ref (MOID (SUB (p)), lhs); + lhs = save_expr (lhs); + NODE_T *rhs_node = NEXT (NEXT (SUB (p))); + tree rhs = a68_lower_tree (rhs_node, ctx); + tree operation = fold_build2_loc (a68_get_node_location (p), + TRUNC_DIV_EXPR, + TREE_TYPE (rhs), + a68_low_deref (lhs, SUB (p)), + rhs); + + return fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (lhs), + a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)), + lhs); +} + +tree +a68_lower_modab3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree lhs = a68_lower_tree (SUB (p), ctx); + lhs = a68_consolidate_ref (MOID (SUB (p)), lhs); + lhs = save_expr (lhs); + NODE_T *rhs_node = NEXT (NEXT (SUB (p))); + tree rhs = a68_lower_tree (rhs_node, ctx); + tree operation = fold_build2_loc (a68_get_node_location (p), + TRUNC_MOD_EXPR, + TREE_TYPE (rhs), + a68_low_deref (lhs, SUB (p)), + rhs); + + return fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (lhs), + a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)), + lhs); +} + +tree +a68_lower_divab3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree lhs = a68_lower_tree (SUB (p), ctx); + lhs = a68_consolidate_ref (MOID (SUB (p)), lhs); + lhs = save_expr (lhs); + NODE_T *rhs_node = NEXT (NEXT (SUB (p))); + tree rhs = a68_lower_tree (rhs_node, ctx); + tree operation = fold_build2_loc (a68_get_node_location (p), + RDIV_EXPR, + TREE_TYPE (rhs), + a68_low_deref (lhs, SUB (p)), + rhs); + + return fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (lhs), + a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)), + lhs); +} + +/* UPB comes in two flavors. + + The unary operator returns the upper bound of the first dimension of the + operand multple. + + The binary operator returns the upper bound of the given dimension of the + operand multiple. The dimension is one-based. If the specified dimension + is out of bounds then an a run-time error is raised. */ + +static tree +upb (NODE_T *p, tree boundable, tree dim) +{ + boundable = save_expr (boundable); + dim = save_expr (dim); + + /* BOUNDABLE can be a multiple or a ROWS. */ + tree zero_based_dim + = save_expr (fold_build2 (MINUS_EXPR, TREE_TYPE (dim), dim, size_one_node)); + tree type = TREE_TYPE (boundable); + if (A68_ROW_TYPE_P (type)) + { + return fold_build2 (COMPOUND_EXPR, ssizetype, + a68_multiple_dim_check (p, boundable, dim), + a68_multiple_upper_bound (boundable, zero_based_dim)); + } + else if (A68_ROWS_TYPE_P (type)) + { + return fold_build2 (COMPOUND_EXPR, ssizetype, + a68_rows_dim_check (p, boundable, dim), + a68_rows_upper_bound (boundable, zero_based_dim)); + } + else + gcc_unreachable (); +} + +tree +a68_lower_upb2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree multiple = a68_lower_tree (NEXT (SUB (p)), ctx); + return fold_convert (CTYPE (MOID (p)), upb (p, multiple, size_one_node)); +} + +tree +a68_lower_upb3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree dim = fold_convert (sizetype, a68_lower_tree (SUB (p), ctx)); + tree multiple = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return fold_convert (CTYPE (MOID (p)), upb (p, multiple, dim)); +} + +/* LWB comes in two flavors. + + The unary operator returns the lower bound of the first dimension of the + operand multple. + + The binary operator returns the lower bound of the given dimension of the + operand multiple. The dimension is one-based. If the specified dimension + is out of bounds then an a run-time error is raised. */ + +static tree +lwb (NODE_T *p, tree boundable, tree dim) +{ + boundable = save_expr (boundable); + dim = save_expr (dim); + + /* BOUNDABLE can be a multiple or an union whose all alternatives yield a + multiple. */ + tree zero_based_dim + = save_expr (fold_build2 (MINUS_EXPR, TREE_TYPE (dim), dim, size_one_node)); + tree type = TREE_TYPE (boundable); + if (A68_ROW_TYPE_P (type)) + { + return fold_build2 (COMPOUND_EXPR, ssizetype, + a68_multiple_dim_check (p, boundable, dim), + a68_multiple_lower_bound (boundable, zero_based_dim)); + } + else if (A68_ROWS_TYPE_P (type)) + { + return fold_build2 (COMPOUND_EXPR, ssizetype, + a68_rows_dim_check (p, boundable, dim), + a68_rows_lower_bound (boundable, zero_based_dim)); + } + else + gcc_unreachable (); +} + +tree +a68_lower_lwb2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree multiple = a68_lower_tree (NEXT (SUB (p)), ctx); + return fold_convert (CTYPE (MOID (p)), lwb (p, multiple, size_one_node)); +} + +tree +a68_lower_lwb3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree dim = fold_convert (sizetype, a68_lower_tree (SUB (p), ctx)); + tree multiple = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return fold_convert (CTYPE (MOID (p)), lwb (p, multiple, dim)); +} + +/* ELEMS comes in two flavors. + + The unary operator returns the number of elements in the first dimension of + the operand multple. + + DIM must be a size. + + The binary operator returns the number of elements in the given dimension of the + operand multiple. The dimension is one-based. If the specified dimension + is out of bounds then an a run-time error is raised. */ + +static tree +elems (NODE_T *p, tree boundable, tree dim) +{ + dim = save_expr (dim); + + /* BOUNDABLE can be a multiple or a ROWS. */ + tree type = TREE_TYPE (boundable); + + /* Make DIM zero-based. */ + tree dim_minus_one + = fold_build2 (MINUS_EXPR, TREE_TYPE (dim), dim, size_one_node); + + boundable = save_expr (boundable); + tree upper_bound = NULL_TREE; + tree lower_bound = NULL_TREE; + tree check_dimension = NULL_TREE; + if (A68_ROW_TYPE_P (type)) + { + upper_bound = a68_multiple_upper_bound (boundable, dim_minus_one); + lower_bound = a68_multiple_lower_bound (boundable, dim_minus_one); + check_dimension = a68_multiple_dim_check (p, boundable, dim); + } + else if (A68_ROWS_TYPE_P (type)) + { + upper_bound = a68_rows_upper_bound (boundable, dim_minus_one); + lower_bound = a68_rows_lower_bound (boundable, dim_minus_one); + check_dimension = a68_rows_dim_check (p, boundable, dim); + } + else + gcc_unreachable (); + + upper_bound = save_expr (upper_bound); + lower_bound = save_expr (lower_bound); + + tree non_flat = fold_build2 (PLUS_EXPR, + sizetype, + fold_convert (sizetype, + fold_build2 (MINUS_EXPR, ssizetype, + upper_bound, lower_bound)), + size_one_node); + + tree elems = fold_build3 (COND_EXPR, sizetype, + fold_build2 (LT_EXPR, boolean_type_node, + upper_bound, lower_bound), + size_zero_node, + non_flat); + + if (OPTION_BOUNDS_CHECKING (&A68_JOB)) + elems = fold_build2 (COMPOUND_EXPR, sizetype, + check_dimension, + elems); + + return elems; +} + +tree +a68_lower_elems2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree multiple = a68_lower_tree (NEXT (SUB (p)), ctx); + return fold_convert (CTYPE (MOID (p)), elems (p, multiple, size_one_node)); +} + +tree +a68_lower_elems3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree dim = fold_convert (sizetype, a68_lower_tree (SUB (p), ctx)); + tree multiple = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return fold_convert (CTYPE (MOID (p)), elems (p, multiple, dim)); +} + +tree +a68_lower_pow_int (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_int_pow (MOID (p), op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_pow_real (NODE_T *p, LOW_CTX_T ctx) +{ + MOID_T *mode = MOID (p); + MOID_T *op1_mode = MOID (SUB (p)); + MOID_T *op2_mode = MOID (NEXT (NEXT (SUB (p)))); + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_real_pow (mode, op1_mode, op2_mode, + op1, op2, a68_get_node_location (p)); +} + +tree +a68_lower_odd2 (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *op = NEXT (SUB (p)); + + return fold_build2_loc (a68_get_node_location (p), + EQ_EXPR, + a68_bool_type, + fold_build2 (BIT_AND_EXPR, + CTYPE (MOID (op)), + a68_lower_tree (op, ctx), + build_int_cst (CTYPE (MOID (op)), 1)), + build_int_cst (CTYPE (MOID (op)), 1)); +} + +tree +a68_lower_string_eq3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + tree cmp = a68_string_cmp (op1, op2); + + return fold_build2_loc (a68_get_node_location (p), + EQ_EXPR, + a68_bool_type, + cmp, + build_int_cst (a68_int_type, 0)); +} + +tree +a68_lower_string_ne3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + tree cmp = a68_string_cmp (op1, op2); + + return fold_build2_loc (a68_get_node_location (p), + NE_EXPR, + a68_bool_type, + cmp, + build_int_cst (a68_int_type, 0)); +} + +tree +a68_lower_string_lt3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + tree cmp = a68_string_cmp (op1, op2); + + return fold_build2_loc (a68_get_node_location (p), + LT_EXPR, + a68_bool_type, + cmp, + build_int_cst (a68_int_type, 0)); +} + +tree +a68_lower_string_le3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + tree cmp = a68_string_cmp (op1, op2); + + return fold_build2_loc (a68_get_node_location (p), + LE_EXPR, + a68_bool_type, + cmp, + build_int_cst (a68_int_type, 0)); +} + +tree +a68_lower_string_gt3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + tree cmp = a68_string_cmp (op1, op2); + + return fold_build2_loc (a68_get_node_location (p), + GT_EXPR, + a68_bool_type, + cmp, + build_int_cst (a68_int_type, 0)); +} + +tree +a68_lower_string_ge3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + tree cmp = a68_string_cmp (op1, op2); + + return fold_build2_loc (a68_get_node_location (p), + GE_EXPR, + a68_bool_type, + cmp, + build_int_cst (a68_int_type, 0)); +} + +tree +a68_lower_string_plus3 (NODE_T *p, LOW_CTX_T ctx) +{ + return a68_string_concat (a68_lower_tree (SUB (p), ctx), + a68_lower_tree (NEXT (NEXT (SUB (p))), ctx)); +} + +tree +a68_lower_string_plusab3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree lhs = a68_lower_tree (SUB (p), ctx); + lhs = a68_consolidate_ref (MOID (SUB (p)), lhs); + lhs = save_expr (lhs); + NODE_T *rhs_node = NEXT (NEXT (SUB (p))); + tree rhs = a68_lower_tree (rhs_node, ctx); + tree operation = a68_string_concat (a68_low_deref (lhs, SUB (p)), rhs); + + return fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (lhs), + a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)), + lhs); +} + +tree +a68_lower_string_plusto3 (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *lhs_node = NEXT (NEXT (SUB (p))); + tree lhs = a68_lower_tree (lhs_node, ctx); + lhs = a68_consolidate_ref (MOID (lhs_node), lhs); + lhs = save_expr (lhs); + MOID_T *lhs_mode = MOID (lhs_node); + NODE_T *rhs_node = SUB (p); + tree rhs = a68_lower_tree (rhs_node, ctx); + tree operation = a68_string_concat (rhs, a68_low_deref (lhs, NEXT (NEXT (SUB (p))))); + + return fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (lhs), + a68_low_assignation (p, lhs, lhs_mode, + operation, MOID (rhs_node)), + lhs); +} + +tree +a68_lower_repr2 (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *op = NEXT (SUB (p)); + return a68_char_repr (op, a68_lower_tree (op, ctx)); +} + +tree +a68_lower_char_plus3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + return a68_string_concat (a68_string_from_char (op1), + a68_string_from_char (op2)); +} + +tree +a68_lower_char_mult3 (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *n1 = SUB (p); + NODE_T *n2 = NEXT (NEXT (SUB (p))); + + if (MOID (n1) == M_INT) + { + gcc_assert (MOID (n2) == M_STRING || MOID (n2) == M_ROW_CHAR); + return a68_string_mult (a68_string_from_char (a68_lower_tree (n2, ctx)), + a68_lower_tree (n1, ctx)); + } + else + { + gcc_assert (MOID (n1) == M_CHAR); + gcc_assert (MOID (n2) == M_INT); + return a68_string_mult (a68_string_from_char (a68_lower_tree (n1, ctx)), + a68_lower_tree (n2, ctx)); + } +} + +tree +a68_lower_string_mult3 (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *n1 = SUB (p); + NODE_T *n2 = NEXT (NEXT (SUB (p))); + + if (MOID (n1) == M_INT) + { + gcc_assert (MOID (n2) == M_STRING || MOID (n2) == M_ROW_CHAR); + return a68_string_mult (a68_lower_tree (n2, ctx), + a68_lower_tree (n1, ctx)); + } + else + { + gcc_assert (MOID (n1) == M_STRING || MOID (n1) == M_ROW_CHAR); + gcc_assert (MOID (n2) == M_INT); + return a68_string_mult (a68_lower_tree (n1, ctx), + a68_lower_tree (n2, ctx)); + } +} + +tree +a68_lower_string_multab3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree lhs = a68_lower_tree (SUB (p), ctx); + lhs = a68_consolidate_ref (MOID (SUB (p)), lhs); + lhs = save_expr (lhs); + NODE_T *rhs_node = NEXT (NEXT (SUB (p))); + tree rhs = a68_lower_tree (rhs_node, ctx); + tree operation = a68_string_mult (a68_low_deref (lhs, SUB (p)), rhs); + + return fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (lhs), + a68_low_assignation (p, lhs, MOID (SUB (p)), operation, MOID (rhs_node)), + lhs); +} + +/* SIZETY BITS operators. */ + +tree +a68_lower_bin2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op = a68_lower_tree (NEXT (SUB (p)), ctx); + return a68_bits_bin (MOID (p), op); +} + +tree +a68_lower_bitabs2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op = a68_lower_tree (NEXT (SUB (p)), ctx); + return a68_bits_abs (MOID (p), op); +} + +tree +a68_lower_bitleng2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op = a68_lower_tree (NEXT (SUB (p)), ctx); + return a68_bits_leng (CTYPE (MOID (p)), op); +} + +tree +a68_lower_bitshorten2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op = a68_lower_tree (NEXT (SUB (p)), ctx); + return a68_bits_shorten (CTYPE (MOID (p)), op); +} + +tree +a68_lower_bitnot2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op = a68_lower_tree (NEXT (SUB (p)), ctx); + return a68_bits_not (op); +} + +tree +a68_lower_bitand3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_bits_and (op1, op2); +} + +tree +a68_lower_bitior3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_bits_ior (op1, op2); +} + +tree +a68_lower_bitxor3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_bits_xor (op1, op2); +} + +tree +a68_lower_shl3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree bits = a68_lower_tree (SUB (p), ctx); + tree shift = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_bits_shift (shift, bits); +} + +tree +a68_lower_shr3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree bits = a68_lower_tree (SUB (p), ctx); + tree shift = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_bits_shift (fold_build1 (NEGATE_EXPR, + TREE_TYPE (shift), shift), + bits); +} + +tree +a68_lower_bitelem3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree pos = a68_lower_tree (SUB (p), ctx); + tree bits = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_bits_elem (p, pos, bits); +} + +tree +a68_lower_bit_eq3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_bits_eq (op1, op2); +} + +tree +a68_lower_bit_ne3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_bits_ne (op1, op2); +} + +tree +a68_lower_bit_le3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_bits_subset (op1, op2); +} + +tree +a68_lower_bit_ge3 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + return a68_bits_subset (op2, op1); +} + +/* Environment enquiries. */ + +tree +a68_lower_maxint (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_int_maxval (CTYPE (MOID (p))); +} + +tree +a68_lower_minint (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_int_minval (CTYPE (MOID (p))); +} + +tree +a68_lower_maxbits (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_bits_maxbits (CTYPE (MOID (p))); +} + +tree +a68_lower_maxreal (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_real_maxval (CTYPE (MOID (p))); +} + +tree +a68_lower_minreal (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_real_minval (CTYPE (MOID (p))); +} + +tree +a68_lower_smallreal (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_real_smallval (CTYPE (MOID (p))); +} + +tree +a68_lower_bitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_bits_width (a68_bits_type); +} + +tree +a68_lower_longbitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_bits_width (a68_long_bits_type); +} + +tree +a68_lower_longlongbitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_bits_width (a68_long_long_bits_type); +} + +tree +a68_lower_shortbitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_bits_width (a68_short_bits_type); +} + +tree +a68_lower_shortshortbitswidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_bits_width (a68_short_short_bits_type); +} + +tree +a68_lower_intwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_int_width (a68_int_type); +} + +tree +a68_lower_longintwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_int_width (a68_long_int_type); +} + +tree +a68_lower_longlongintwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_int_width (a68_long_long_int_type); +} + +tree +a68_lower_shortintwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_int_width (a68_short_int_type); +} + +tree +a68_lower_shortshortintwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_int_width (a68_short_short_int_type); +} + +tree +a68_lower_realwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_real_width (a68_real_type); +} + +tree +a68_lower_longrealwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_real_width (a68_long_real_type); +} + +tree +a68_lower_longlongrealwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_real_width (a68_long_long_real_type); +} + +tree +a68_lower_expwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_real_exp_width (a68_real_type); +} + +tree +a68_lower_longexpwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_real_exp_width (a68_long_real_type); +} + +tree +a68_lower_longlongexpwidth (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_real_exp_width (a68_long_long_real_type); +} + +tree +a68_lower_pi (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_real_pi (CTYPE (MOID (p))); +} + +tree +a68_lower_nullcharacter (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + static tree null_character = NULL_TREE; + + if (null_character == NULL_TREE) + null_character = build_int_cst (a68_char_type, 0); + return null_character; +} + +tree +a68_lower_flip (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + static tree flip = NULL_TREE; + + if (flip == NULL_TREE) + flip = build_int_cst (a68_char_type, 84); /* T */ + return flip; +} + +tree +a68_lower_eofchar (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + static tree eofchar = NULL_TREE; + + if (eofchar == NULL_TREE) + eofchar = build_int_cst (a68_char_type, -1); + return eofchar; +} + +tree +a68_lower_replacementchar (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + static tree replacementchar = NULL_TREE; + + if (replacementchar == NULL_TREE) + replacementchar = build_int_cst (a68_char_type, 0xfffd); + return replacementchar; +} + +tree +a68_lower_flop (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + static tree flop = NULL_TREE; + + if (flop == NULL_TREE) + flop = build_int_cst (a68_char_type, 70); /* F */ + return flop; +} + +tree +a68_lower_errorchar (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + static tree errorchar = NULL_TREE; + + if (errorchar == NULL_TREE) + errorchar = build_int_cst (a68_char_type, 42); /* * */ + return errorchar; +} + +tree +a68_lower_blank (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + static tree blank = NULL_TREE; + + if (blank == NULL_TREE) + blank = build_int_cst (a68_char_type, 32); + return blank; +} + +tree +a68_lower_intlengths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + HOST_WIDE_INT int_size = int_size_in_bytes (a68_int_type); + HOST_WIDE_INT long_int_size = int_size_in_bytes (a68_long_int_type); + HOST_WIDE_INT long_long_int_size = int_size_in_bytes (a68_long_long_int_type); + + gcc_assert (int_size != -1); + gcc_assert (long_int_size != -1); + gcc_assert (long_long_int_size != -1); + + int lengths = 1; + if (long_long_int_size != long_int_size) + lengths++; + if (long_int_size != int_size) + lengths++; + + return build_int_cst (CTYPE (MOID (p)), lengths); +} + +tree +a68_lower_intshorths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + HOST_WIDE_INT int_size = int_size_in_bytes (a68_int_type); + HOST_WIDE_INT short_int_size = int_size_in_bytes (a68_short_int_type); + HOST_WIDE_INT short_short_int_size = int_size_in_bytes (a68_short_short_int_type); + + gcc_assert (int_size != -1); + gcc_assert (short_int_size != -1); + gcc_assert (short_short_int_size != -1); + + int shorths = 1; + if (short_short_int_size != short_int_size) + shorths++; + if (short_int_size != int_size) + shorths++; + + return build_int_cst (CTYPE (MOID (p)), shorths); +} + +tree +a68_lower_bitslengths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + HOST_WIDE_INT bits_size = int_size_in_bytes (a68_bits_type); + HOST_WIDE_INT long_bits_size = int_size_in_bytes (a68_long_bits_type); + HOST_WIDE_INT long_long_bits_size = int_size_in_bytes (a68_long_long_bits_type); + + gcc_assert (bits_size != -1); + gcc_assert (long_bits_size != -1); + gcc_assert (long_long_bits_size != -1); + + int lengths = 1; + if (long_long_bits_size != long_bits_size) + lengths++; + if (long_bits_size != bits_size) + lengths++; + + return build_int_cst (CTYPE (MOID (p)), lengths); +} + +tree +a68_lower_bitsshorths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + HOST_WIDE_INT bits_size = int_size_in_bytes (a68_bits_type); + HOST_WIDE_INT short_bits_size = int_size_in_bytes (a68_short_bits_type); + HOST_WIDE_INT short_short_bits_size = int_size_in_bytes (a68_short_short_bits_type); + + gcc_assert (bits_size != -1); + gcc_assert (short_bits_size != -1); + gcc_assert (short_short_bits_size != -1); + + int shorths = 1; + if (short_short_bits_size != short_bits_size) + shorths++; + if (short_bits_size != bits_size) + shorths++; + + return build_int_cst (CTYPE (MOID (p)), shorths); +} + +tree +a68_lower_reallengths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + HOST_WIDE_INT real_size = int_size_in_bytes (a68_real_type); + HOST_WIDE_INT long_real_size = int_size_in_bytes (a68_long_real_type); + HOST_WIDE_INT long_long_real_size = int_size_in_bytes (a68_long_long_real_type); + + gcc_assert (real_size != -1); + gcc_assert (long_real_size != -1); + gcc_assert (long_long_real_size != -1); + + int lengths = 1; + if (long_long_real_size != long_real_size) + lengths++; + if (long_real_size != real_size) + lengths++; + + return build_int_cst (CTYPE (MOID (p)), lengths); +} + +tree +a68_lower_realshorths (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return build_int_cst (CTYPE (MOID (p)), 1); +} + +tree +a68_lower_infinity (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return build_real (CTYPE (MOID (p)), dconstinf); +} + +tree +a68_lower_minusinfinity (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return build_real (CTYPE (MOID (p)), dconstninf); +} + +tree +a68_lower_maxabschar (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_char_max (); +} + +tree +a68_lower_sqrt (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_sqrt (a68_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_sqrt (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_sqrt (a68_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_long_sqrt (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_sqrt (a68_long_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_tan (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_tan (a68_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_tan (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_tan (a68_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_long_tan (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_tan (a68_long_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_sin (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_sin (a68_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_sin (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_sin (a68_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_long_sin (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_sin (a68_long_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_cos (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_cos (a68_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_cos (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_cos (a68_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_long_cos (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_cos (a68_long_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_acos (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_acos (a68_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_acos (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_acos (a68_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_long_acos (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_acos (a68_long_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_asin (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_asin (a68_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_asin (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_asin (a68_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_long_asin (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_asin (a68_long_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_atan (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_atan (a68_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_atan (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_atan (a68_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_long_atan (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_atan (a68_long_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_ln (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_ln (a68_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_ln (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_ln (a68_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_long_ln (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_ln (a68_long_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_log (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_log (a68_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_log (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_log (a68_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_long_log (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_log (a68_long_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_exp (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_exp (a68_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_exp (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_exp (a68_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_long_long_exp (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_real_exp (a68_long_long_real_type); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_reali (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + tree t = a68_complex_i (M_COMPLEX, op1, op2); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_longreali (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + tree t = a68_complex_i (M_LONG_COMPLEX, op1, op2); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_longlongreali (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + tree t = a68_complex_i (M_LONG_LONG_COMPLEX, op1, op2); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_inti (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + tree t = a68_complex_i (M_COMPLEX, + convert_to_real (a68_real_type, op1), + convert_to_real (a68_real_type, op2)); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_longinti (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + tree t= a68_complex_i (M_LONG_COMPLEX, + convert_to_real (a68_long_real_type, op1), + convert_to_real (a68_long_real_type, op2)); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_longlonginti (NODE_T *p, LOW_CTX_T ctx) +{ + tree op1 = a68_lower_tree (SUB (p), ctx); + tree op2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + tree t = a68_complex_i (M_LONG_LONG_COMPLEX, + convert_to_real (a68_long_long_real_type, op1), + convert_to_real (a68_long_long_real_type, op2)); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_re2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op = a68_lower_tree (NEXT (SUB (p)), ctx); + tree t = a68_complex_re (op); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_im2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op = a68_lower_tree (NEXT (SUB (p)), ctx); + tree t = a68_complex_im (op); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_conj2 (NODE_T *p, LOW_CTX_T ctx) +{ + tree op = a68_lower_tree (NEXT (SUB (p)), ctx); + return a68_complex_conj (MOID (p), op); +} + +tree +a68_lower_shortenint2 (NODE_T *p, LOW_CTX_T ctx) +{ + return a68_int_shorten (MOID (p), MOID (NEXT (SUB (p))), + a68_lower_tree (NEXT (SUB (p)), ctx)); +} + +tree +a68_lower_lengint2 (NODE_T *p, LOW_CTX_T ctx) +{ + return a68_int_leng (MOID (p), MOID (NEXT (SUB (p))), + a68_lower_tree (NEXT (SUB (p)), ctx)); +} + +tree +a68_lower_shortenreal2 (NODE_T *p, LOW_CTX_T ctx) +{ + return a68_real_shorten (MOID (p), MOID (NEXT (SUB (p))), + a68_lower_tree (NEXT (SUB (p)), ctx)); +} + +tree +a68_lower_lengreal2 (NODE_T *p, LOW_CTX_T ctx) +{ + return a68_real_leng (MOID (p), MOID (NEXT (SUB (p))), + a68_lower_tree (NEXT (SUB (p)), ctx)); +} + +tree +a68_lower_random (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_get_libcall (A68_LIBCALL_RANDOM); +} + +tree +a68_lower_longrandom (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + /* Note we dont build a call because this will get deprocedured in case it is + actually called. */ + return a68_get_libcall (A68_LIBCALL_LONGRANDOM); +} + +tree +a68_lower_longlongrandom (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_get_libcall (A68_LIBCALL_LONGLONGRANDOM); +} + +/********* POSIX prelude. ***************/ + +tree +a68_lower_setexitstatus (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_setexitstatus (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixargc (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_argc (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixargv (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_argv (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixgetenv (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_getenv (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixputchar (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_putchar (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixputs (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_puts (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixfconnect (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_fconnect (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixfopen (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_fopen (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixfcreate (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_fcreate (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixfclose (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_fclose (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixfsize (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_fsize (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixlseek (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_lseek (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixseekcur (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return build_int_cst (a68_int_type, 0); +} + +tree +a68_lower_posixseekend (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return build_int_cst (a68_int_type, 1); +} + +tree +a68_lower_posixseekset (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return build_int_cst (a68_int_type, 2); +} + +tree +a68_lower_posixstdinfiledes (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return build_int_cst (a68_int_type, 0); +} + +tree +a68_lower_posixstdoutfiledes (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return build_int_cst (a68_int_type, 1); +} + +tree +a68_lower_posixstderrfiledes (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return build_int_cst (a68_int_type, 2); +} + +tree +a68_lower_posixfileodefault (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + /* Please keep in sync with libga68/ga68-posix.c */ + return build_int_cst (a68_bits_type, 0x99999999); +} + +tree +a68_lower_posixfileordwr (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + /* Please keep in sync with libga68/ga68-posix.c */ + return build_int_cst (a68_bits_type, 0x2); +} + +tree +a68_lower_posixfileordonly (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + /* Please keep in sync with libga68/ga68-posix.c */ + return build_int_cst (a68_bits_type, 0x0); +} + +tree +a68_lower_posixfileowronly (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + /* Please keep in sync with libga68/ga68-posix.c */ + return build_int_cst (a68_bits_type, 0x1); +} + +tree +a68_lower_posixfileotrunc (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + /* Please keep in sync with libga68/ga68-posix.c */ + return build_int_cst (a68_bits_type, 0x8); +} + +tree +a68_lower_posixerrno (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_errno (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixperror (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_perror (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixstrerror (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_strerror (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixfputc (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_fputc (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixfputs (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_fputs (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixgetchar (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_getchar (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + + +tree +a68_lower_posixfgetc (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_fgetc (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixgets (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_gets (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} + +tree +a68_lower_posixfgets (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree t = a68_posix_fgets (); + if (CAN_HAVE_LOCATION_P (t)) + SET_EXPR_LOCATION (t, a68_get_node_location (p)); + return t; +} From f3051813b8362043ab7e2a349c88230b728d4621 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:52:52 +0200 Subject: [PATCH 168/373] a68: low: clauses and declarations Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-low-clauses.cc: New file. * algol68/a68-low-decls.cc: Likewise. --- gcc/algol68/a68-low-clauses.cc | 1480 ++++++++++++++++++++++++++++++++ gcc/algol68/a68-low-decls.cc | 696 +++++++++++++++ 2 files changed, 2176 insertions(+) create mode 100644 gcc/algol68/a68-low-clauses.cc create mode 100644 gcc/algol68/a68-low-decls.cc diff --git a/gcc/algol68/a68-low-clauses.cc b/gcc/algol68/a68-low-clauses.cc new file mode 100644 index 000000000000..77e07b1121b1 --- /dev/null +++ b/gcc/algol68/a68-low-clauses.cc @@ -0,0 +1,1480 @@ +/* Lower clauses to GENERIC. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Given a serial_clause node P, return whether it performs dynamic stack + allocations. + + This function allocates for the fact that the bottom-up parser generates + successively nested serial clauses like + + SERIAL_CLAUSE + SERIAL_CLAUSE + ... + + the outer of which corresponds to a single serial clause in the source code, + but it is the inner ones annotated by the dsa pass. */ + +static bool +serial_clause_dsa (NODE_T *p) +{ + NODE_T *s = NEXT (SUB (p)); + + for (s = p; SUB (s) && IS (s, SERIAL_CLAUSE); s = SUB (s)) + { + if (DYNAMIC_STACK_ALLOCS (s)) + return true; + } + + return false; +} + +/* Lower one or more labels. + + label : defining identifier, colon symbol; + label, defining identifier, colon symbol; + + A label lowers into a LABEL_EXPR and the declaration of a LABEL_DECL in the + current block and bind. Lists of labels get returned in nested compound + expressions. */ + +tree +a68_lower_label (NODE_T *p, LOW_CTX_T ctx) +{ + tree expr = NULL_TREE; + + if (IS (SUB (p), LABEL)) + expr = a68_lower_tree (SUB (p), ctx); + + NODE_T *defining_identifier; + + if (IS (SUB (p), DEFINING_IDENTIFIER)) + defining_identifier = SUB (p); + else + { + gcc_assert (IS (NEXT (SUB (p)), DEFINING_IDENTIFIER)); + defining_identifier = NEXT (SUB (p)); + } + + /* Create LABEL_DECL if necessary. */ + tree label_decl = TAX_TREE_DECL (TAX (defining_identifier)); + if (label_decl == NULL_TREE) + { + label_decl = build_decl (a68_get_node_location (defining_identifier), + LABEL_DECL, + a68_get_mangled_identifier (NSYMBOL (defining_identifier)), + void_type_node); + TAX_TREE_DECL (TAX (defining_identifier)) = label_decl; + } + + a68_add_decl (label_decl); + + /* Return the accummulated LABEL_EXPRs. */ + tree label_expr = build1 (LABEL_EXPR, void_type_node, label_decl); + if (expr) + return fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + void_type_node, + expr, label_expr); + else + return label_expr; +} + +/* Lower a labeled unit. + + labeled unit : label, unit. + + Lower the label, then the unit. Return them in a compound expression. */ + +tree +a68_lower_labeled_unit (NODE_T *p, LOW_CTX_T ctx) +{ + tree label_expr = a68_lower_tree (SUB (p), ctx); + tree unit_expr = a68_lower_tree (NEXT (SUB (p)), ctx); + + return fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (unit_expr), + label_expr, unit_expr); +} + +/* Lower a completer. + + exit_symbol + + This handler replaces the last expression in stmt_list with a statement + assigning it to the clause result of the current serial clause, then jump to + the exit label of the current serial clause. Note that a completer is a + separator so stmt_list contains at least one expression at this point. Note + that a completer can only appear inside a serial clause. + + This function always returns NULL_TREE, so the traversing code shall always + be careful to travese on these nodes explicitly and ignore the returned + value. */ + +tree +a68_lower_completer (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + a68_add_completer (); + return NULL_TREE; +} + +/* Lower an initialiser series. + + Parse tree: + + initialiser series : serial clause, semi symbol, declaration list; + initialiser series, declaration list; + initialiser series, semi symbol, unit; + initialiser series, semi symbol, labeled unit; + initialiser series, semi symbol, declaration list. + + GENERIC: + + Traverse subtree adding units and labels to STMT_LIST, and declarations to + BLOCK. + + This function always returns NULL_TREE, so the traversing code shall always + be careful to travese on these nodes explicitly and ignore the returned + value. */ + +tree +a68_lower_initialiser_series (NODE_T *p, LOW_CTX_T ctx) +{ + for (NODE_T *s = SUB (p); s != NO_NODE; FORWARD (s)) + { + if (!IS (s, SEMI_SYMBOL)) + a68_add_stmt (a68_lower_tree (s, ctx)); + } + return NULL_TREE; +} + +/* Lower a serial clause. + + serial clause : labeled unit; + unit; + serial clause, semi symbol, unit; + serial clause, exit symbol, labeled unit; + serial clause, semi_symbol, declaration list; + initialiser series, semi symbol, unit; + initialiser series, semi symbol, labeled unit. + + Ranges: + + serial-clause + ------------- R1 + + See the function body to see the lowering actions. + + This function always returns NULL_TREE, so the traversing code shall always + be careful to travese on these nodes explicitly and ignore the returned + value. */ + +tree +a68_lower_serial_clause (NODE_T *p, LOW_CTX_T ctx) +{ + if (IS (SUB (p), SERIAL_CLAUSE)) + { + /* Traverse down for side-effects. */ + (void) a68_lower_tree (SUB (p), ctx); + + if (IS (NEXT (SUB (p)), EXIT_SYMBOL)) + { + /* Traverse the completer for side-effects. This turns the last + expression in the current statements list into an assignment. */ + (void) a68_lower_tree (NEXT (SUB (p)), ctx); + /* Now append the result of the labeled unit to the current + statements list. */ + a68_add_stmt (a68_lower_tree (NEXT (NEXT (SUB (p))), ctx)); + } + else + { + /* Append the result of either the unit or the declarations list in + the current statements list. */ + a68_add_stmt (a68_lower_tree (NEXT (NEXT (SUB (p))), ctx)); + } + } + else if (IS (SUB (p), INITIALISER_SERIES)) + { + /* Traverse down for side-effects. */ + (void) a68_lower_tree (SUB (p), ctx); + + /* Append the result of either the unit or the declarations list in the + current statements list. */ + a68_add_stmt (a68_lower_tree (NEXT (NEXT (SUB (p))), ctx)); + } + else + { + /* Append the result of either the unit or labeled unit in the current + statements list. */ + a68_add_stmt (a68_lower_tree (SUB (p), ctx)); + } + + return NULL_TREE; +} + +/* Lower a loop clause. + + loop clause : for part, from part, by part, to part, while part, alt do part; + for part, from part, by part, while part, alt do part; + for part, from part, while part, alt do part; + for part, by part, to part, while part, alt do part; + for part, by part, to part, while part, alt do part; + for part, by part, while part, alt do part; + for part, while part, alt do part; + for part, from part, by part, to part, alt do part; + for part, from part, by part, alt do part; + for part, from part, alt do part; + for part, by part, to part, alt do part; + for part, by part, alt do part; + for part, to part, alt do part, + for part, alt do part; + from part, by part, to part, while part, alt do part; + from part, by part, while aprt, alt do part; + from part, to part, while aprt, alt do part; + from part, while part, alt do part; + from part, by part, to part, alt do part; + from part, by part, alt do part; + from part, to part, alt do part; + from part, alt do part; + by part, to part, while part, alt do part; + by part, while part, alt do part; + by part, to part, alt do part; + by part, alt do part; + to part, while part, alt do part; + to part, alt do part; + while part, alt do part; + do part. +*/ + +tree +a68_lower_loop_clause (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + NODE_T *s = SUB (p); + bool while_part = false; + bool has_iterator = false; + tree iterator = NULL_TREE; + tree while_condition = NULL_TREE; + tree do_part = NULL_TREE; + tree from_part = NULL_TREE; + tree by_part = NULL_TREE; + tree to_part = NULL_TREE; + tree overflow = NULL_TREE; + NODE_T *iterator_defining_identifier = NO_NODE; + + if (IS (s, FOR_PART)) + { + /* Get the defining identifier. */ + iterator_defining_identifier = NEXT (SUB (s)); + has_iterator = true; + FORWARD (s); + } + + if (IS (s, FROM_PART)) + { + /* Lower the unit. */ + from_part = a68_lower_tree (NEXT (SUB (s)), ctx); + has_iterator = true; + FORWARD (s); + } + + if (IS (s, BY_PART)) + { + /* Lower the unit. */ + by_part = a68_lower_tree (NEXT (SUB (s)), ctx); + has_iterator = true; + FORWARD (s); + } + + if (IS (s, TO_PART)) + { + /* Lower the unit. */ + to_part = a68_lower_tree (NEXT (SUB (s)), ctx); + has_iterator = true; + FORWARD (s); + } + + if (has_iterator) + { + /* Introduce a range that spans until the end of the loop clause. */ + a68_push_range (M_VOID); + + /* Compute some defaults for not specified loop parts. Note that to_part + defaults to max_int or min_int depending on the signedness of + by_part. */ + if (from_part == NULL_TREE) + from_part = integer_one_node; + if (by_part == NULL_TREE) + by_part = integer_one_node; + if (to_part == NULL_TREE) + { + to_part = fold_build3 (COND_EXPR, + a68_bool_type, + fold_build2 (LT_EXPR, a68_int_type, by_part, + build_int_cst (a68_int_type, 0)), + a68_int_minval (a68_int_type), + a68_int_maxval (a68_int_type)); + } + + /* If the user has specified an explicit iterator in the form of a + defining-identifier in a for-part, use it as the name in the iterator + declaration and install the resulting declaration in the taxes table + in order for applied identifiers in the rest of the loop to find it. + Otherwise, the iterator is not directly accessible by the + programmer. */ + const char *iterator_name = (iterator_defining_identifier == NO_NODE + ? "iterator%" + : NSYMBOL (iterator_defining_identifier)); + iterator = a68_lower_tmpvar (iterator_name, a68_int_type, from_part); + if (iterator_defining_identifier != NO_NODE) + TAX_TREE_DECL (TAX (iterator_defining_identifier)) = iterator; + + /* The from_part and to_part expressions shall be evaluated once and once + only. The expression for from_part is evaluated only once in the + initialization expression for iterator% above, but we need to put + to_part in a temporary since it is used in the loop body. */ + to_part = a68_lower_tmpvar ("to_part%", TREE_TYPE (to_part), to_part); + + /* We need to detect overflow/underflow of the iterator. */ + overflow = a68_lower_tmpvar ("overflow%", boolean_type_node, + boolean_false_node); + } + + if (IS (s, WHILE_PART)) + { + while_part = true; + /* Introduce a range that spans until the end of the loop clause. */ + a68_push_range (M_VOID); + /* Process the enquiry clause, which yields a BOOL. */ + a68_push_stmt_list (M_BOOL); + (void) a68_lower_tree (NEXT (SUB (s)), ctx); + while_condition = a68_pop_stmt_list (); + FORWARD (s); + } + + /* DO part. */ + gcc_assert (IS (s, ALT_DO_PART) || IS (s, DO_PART)); + + /* Build the loop's body. */ + a68_push_range (NULL); + { + /* First lower the loop exit condition. */ + if (has_iterator || while_part) + { + tree exit_condition = NULL_TREE; + /* IF overflow OREL (by_part < 0 THEN iterator < to_part ELSE iterator > to_part) FI */ + if (has_iterator) + exit_condition = fold_build2 (TRUTH_ORIF_EXPR, boolean_type_node, + overflow, + fold_build3 (COND_EXPR, + a68_bool_type, + fold_build2 (LT_EXPR, a68_int_type, by_part, + build_int_cst (a68_int_type, 0)), + fold_build2 (LT_EXPR, a68_int_type, + iterator, to_part), + fold_build2 (GT_EXPR, a68_int_type, + iterator, to_part))); + /* NOT while_condition */ + if (while_part) + { + tree while_exit_condition = fold_build1 (TRUTH_NOT_EXPR, + a68_bool_type, + while_condition); + if (has_iterator) + exit_condition = fold_build2 (TRUTH_ORIF_EXPR, a68_bool_type, + exit_condition, while_exit_condition); + else + exit_condition = while_exit_condition; + } + + if (exit_condition != NULL_TREE) + a68_add_stmt (fold_build1 (EXIT_EXPR, void_type_node, exit_condition)); + } + + /* Serial clauses in DO .. OD do not yield any value. */ + bool dsa = serial_clause_dsa (NEXT (SUB (s))); + bool local = NON_LOCAL (NEXT (SUB (s))) == NO_TABLE; + a68_push_serial_clause_range (M_VOID, dsa && local); + (void) a68_lower_tree (NEXT (SUB (s)), ctx); + do_part = a68_pop_serial_clause_range (); + a68_add_stmt (do_part); + + if (has_iterator) + { + /* Increment the iterator by BY_PART. Detect overflow. + Given a + b = sum, overflows = ((~((a) ^ (b)) & ((a) ^ (sum))) < 0) + See OVERFLOW_SUM_SIGN in double-int.cc for an explanation + of this formula. + */ + tree type = TREE_TYPE (iterator); + tree a = iterator; + tree b = save_expr (by_part); + tree sum = fold_build2 (PLUS_EXPR, type, a, b); + a68_add_stmt (fold_build2 (MODIFY_EXPR, boolean_type_node, + overflow, + fold_build2 (LT_EXPR, boolean_type_node, + fold_build2 (BIT_AND_EXPR, type, + fold_build1 (BIT_NOT_EXPR, type, + fold_build2 (BIT_XOR_EXPR, type, + a, b)), + fold_build2 (BIT_XOR_EXPR, type, + a, sum)), + build_int_cst (a68_int_type, 0)))); + a68_add_stmt (fold_build2 (MODIFY_EXPR, type, iterator, sum)); + } + } + tree loop_body = a68_pop_range (); + + /* Finally build the LOOP_EXPR and exit the introduced ranges. */ + tree loop_clause = fold_build1_loc (a68_get_node_location (p), + LOOP_EXPR, a68_void_type, loop_body); + if (while_part) + { + a68_add_stmt (loop_clause); + loop_clause = a68_pop_range (); + } + if (has_iterator) + { + a68_add_stmt (loop_clause); + loop_clause = a68_pop_range (); + } + + return loop_clause; +} + +/* Lower a conformity clause. + + conformity clause : case part, conformity in part, out part, esac symbol; + case part, conformity in part, esac symbol; + case part, conformity in part, conformity ouse part; + open part, conformity choice, choice, close symbol; + open part, conformity choice, close symbol; + open part, conformity choice, brief conformity ouse part. + + conformity choice : then bar symbol, specified unit list; + then bar symbol, specified unit. + + specified unit list : specified unit list, comma symbol, specified unit; + specified unit list, specified unit. + + specified unit : specifier, colon symbol, unit. + + specifier : open symbol, declarer, identifier, close symbol; + open symbol, declarer, close symbol; + open symbol, void symbol, close symbol. +*/ + +static void +lower_unite_case_unit (NODE_T *p, + tree enquiry, MOID_T *enquiry_mode, + tree result, tree exit_label, LOW_CTX_T ctx) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, SPECIFIER)) + { + MOID_T *spec_moid = MOID (NEXT (SUB (p))); + NODE_T *spec_identifier = NEXT (NEXT (SUB (p))); + NODE_T *spec_unit = NEXT (NEXT (p)); + const char *specifier_identifier_name = NULL; + if (IS (spec_identifier, IDENTIFIER)) + specifier_identifier_name = NSYMBOL (spec_identifier); + + tree overhead = a68_union_overhead (enquiry); + tree spec_value = NULL_TREE; + tree entry_selected = NULL_TREE; + if (IS_UNION (spec_moid)) + { + /* The spec_moid is an united mode, which must be unitable to the + enquiry_mode. */ + gcc_assert (a68_is_unitable (spec_moid, enquiry_mode, + SAFE_DEFLEXING)); + + /* Build the entry_selected expression. + + For each mode in spec_moid, determine the corresponding index + in enquiry_mode and add a check for it to the expression. */ + for (PACK_T *pack = PACK (spec_moid); pack != NO_PACK; FORWARD (pack)) + { + int index = a68_united_mode_index (enquiry_mode, MOID (pack)); + tree expr = fold_build2 (EQ_EXPR, + boolean_type_node, + overhead, + build_int_cst (TREE_TYPE (overhead), index)); + if (entry_selected == NULL_TREE) + entry_selected = expr; + else + entry_selected = fold_build2 (TRUTH_OR_EXPR, + boolean_type_node, + entry_selected, + expr); + } + + /* The spec_value is an union of mode spec_moid, with the + overhead translated from enquiry_mode. */ + tree spec_overhead + = a68_union_translate_overhead (enquiry_mode, overhead, spec_moid); + a68_push_range (spec_moid); + spec_value = a68_lower_tmpvar ("spec_value%", + CTYPE (spec_moid), + a68_get_skip_tree (spec_moid)); + a68_add_stmt (a68_union_set_overhead (spec_value, spec_overhead)); + tree from_cunion = a68_union_cunion (enquiry); + tree to_cunion = a68_union_cunion (spec_value); + a68_add_stmt (a68_lower_memcpy (fold_build1 (ADDR_EXPR, + build_pointer_type (TREE_TYPE (to_cunion)), + to_cunion), + fold_build1 (ADDR_EXPR, + build_pointer_type (TREE_TYPE (from_cunion)), + from_cunion), + size_in_bytes (TREE_TYPE (to_cunion)))); + a68_add_stmt (spec_value); + spec_value = a68_pop_range (); + } + else + { + int index = a68_united_mode_index (enquiry_mode, spec_moid); + spec_value = a68_union_alternative (enquiry, index); + entry_selected = fold_build2 (EQ_EXPR, + TREE_TYPE (overhead), + overhead, + build_int_cst (TREE_TYPE (overhead), index)); + } + + a68_push_range (M_VOID); + { + /* If the enquiry value is ascribed to an identifier in the case + entry then create a suitable declaration and turn the identifier + into a defining identifier. */ + if (specifier_identifier_name) + { + tree united_value = a68_lower_tmpvar (specifier_identifier_name, + CTYPE (spec_moid), spec_value); + TAX_TREE_DECL (TAX (spec_identifier)) = united_value; + } + + /* Set result% to the lowering of the unit and jump to the end of + the enquiry clause. */ + a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (result), + result, a68_lower_tree (spec_unit, ctx))); + a68_add_stmt (fold_build1 (GOTO_EXPR, + void_type_node, + exit_label)); + a68_add_stmt (a68_get_skip_tree (M_VOID)); + } + tree process_entry = a68_pop_range (); + + /* IF index = overhead THEN process entry FI */ + a68_add_stmt (fold_build3 (COND_EXPR, + a68_void_type, + entry_selected, + process_entry, + a68_get_skip_tree (M_VOID))); + + FORWARD (p); /* Skip specifier. */ + FORWARD (p); /* Skip unit. */ + /* The unit is skipped in the for loop post-action. */ + } + else + lower_unite_case_unit (SUB (p), + enquiry, enquiry_mode, + result, exit_label, ctx); + } +} + +tree +a68_lower_conformity_clause (NODE_T *p, LOW_CTX_T ctx) +{ + MOID_T *conformity_clause_mode = MOID (p); + + /* CASE or OUSE. */ + NODE_T *s = SUB (p); + NODE_T *enquiry_node = NEXT (SUB (s)); + MOID_T *enquiry_mode = MOID (SUB (s)); + + /* Push a binding environment for the enquiry clause. */ + a68_push_range (conformity_clause_mode); + + /* Process the enquiry clause and put the resulting value in enquiry%. */ + a68_push_stmt_list (enquiry_mode); + (void) a68_lower_tree (enquiry_node, ctx); + tree enquiry = a68_lower_tmpvar ("enquiry%", + CTYPE (enquiry_mode), + a68_pop_stmt_list ()); + + /* Create a decl for result%. */ + tree result = a68_lower_tmpvar ("result%", + CTYPE (conformity_clause_mode), + a68_get_skip_tree (conformity_clause_mode)); + + /* Create an exit label. */ + tree exit_label = build_decl (UNKNOWN_LOCATION, + LABEL_DECL, + get_identifier ("exit_label%"), + void_type_node); + DECL_CONTEXT (exit_label) = a68_range_context (); + a68_add_decl (exit_label); + a68_add_decl_expr (fold_build1 (DECL_EXPR, TREE_TYPE (exit_label), exit_label)); + + /* IN. */ + FORWARD (s); + lower_unite_case_unit (NEXT (SUB (s)), + enquiry, enquiry_mode, + result, exit_label, ctx); + + /* OUT. */ + FORWARD (s); + switch (ATTRIBUTE (s)) + { + case CHOICE: + case OUT_PART: + { + bool dsa = serial_clause_dsa (NEXT (SUB (s))); + bool local = NON_LOCAL (NEXT (SUB (s))) == NO_TABLE; + a68_push_serial_clause_range (conformity_clause_mode, dsa && local); + + (void) a68_lower_tree (NEXT (SUB (s)), ctx); + a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (result), + result, a68_pop_serial_clause_range ())); + a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label)); + break; + } + case CLOSE_SYMBOL: + case ESAC_SYMBOL: + a68_add_stmt (fold_build2 (MODIFY_EXPR, + TREE_TYPE (result), + result, + a68_get_skip_tree (conformity_clause_mode))); + a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label)); + break; + default: + /* Recurse. + + Note that the parser guarantees that the embedded CASE clause is a + conformity clause, and that its mode is the same than the containing + clause, but it doesn't annotate the mode in the tree node so we have + to do it here. */ + MOID (s) = conformity_clause_mode; + a68_add_stmt (fold_build2 (MODIFY_EXPR, + TREE_TYPE (result), + result, + a68_lower_conformity_clause (s, ctx))); + a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label)); + break; + } + + /* ESAC */ + a68_add_stmt (build1 (LABEL_EXPR, void_type_node, exit_label)); + a68_add_stmt (result); + return a68_pop_range (); +} + +/* Lower a case clause. + + case clause : open part, case choice clause, choice, close symbol; + open part, case choice clause, close symbol; + open part, case shoice clause, brief ouse part; + case part, case in part, out part, esac symbol; + case part, case in part, esac symbol; + case part, case in part, case ouse part; +*/ + +static void +lower_int_case_unit (NODE_T *p, + tree enquiry, MOID_T *enquiry_mode, + tree result, tree exit_label, int *count, + LOW_CTX_T ctx) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, UNIT)) + { + a68_push_range (M_VOID); + { + /* Set result% to the lowering of the unit and jump to the end of + the enquiry clause. */ + a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (result), + result, a68_lower_tree (p, ctx))); + a68_add_stmt (fold_build1 (GOTO_EXPR, + void_type_node, + exit_label)); + a68_add_stmt (a68_get_skip_tree (M_VOID)); + } + tree process_entry = a68_pop_range (); + + /* IF count = enquiry THEN process entry FI */ + a68_add_stmt (fold_build3 (COND_EXPR, + a68_void_type, + fold_build2 (EQ_EXPR, + TREE_TYPE (enquiry), + enquiry, + build_int_cst (TREE_TYPE (enquiry), *count)), + process_entry, + a68_get_skip_tree (M_VOID))); + *count += 1; + } + else + lower_int_case_unit (SUB (p), + enquiry, enquiry_mode, + result, exit_label, count, ctx); + } +} + +tree +a68_lower_case_clause (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + MOID_T *case_clause_mode = MOID (p); + + /* CASE or OUSE */ + NODE_T *s = SUB (p); + NODE_T *enquiry_node = NEXT (SUB (s)); + MOID_T *enquiry_mode = M_INT; + + /* Push a bingding environment fo the case clause. */ + a68_push_range (case_clause_mode); + + /* Process the enquiry clause and put the result value in enquiry%. */ + a68_push_stmt_list (enquiry_mode); + (void) a68_lower_tree (enquiry_node, ctx); + tree enquiry = a68_lower_tmpvar ("enquiry%", + CTYPE (enquiry_mode), + a68_pop_stmt_list ()); + /* Create a decl for result%. */ + tree result = a68_lower_tmpvar ("result%", + CTYPE (case_clause_mode), + a68_get_skip_tree (case_clause_mode)); + + /* Create an exit label. */ + tree exit_label = build_decl (UNKNOWN_LOCATION, + LABEL_DECL, + get_identifier ("exit_label%"), + void_type_node); + DECL_CONTEXT (exit_label) = a68_range_context (); + a68_add_decl (exit_label); + a68_add_decl_expr (fold_build1 (DECL_EXPR, TREE_TYPE (exit_label), exit_label)); + + /* IN. */ + FORWARD (s); + int count = 1; + lower_int_case_unit (NEXT (SUB (s)), + enquiry, enquiry_mode, + result, exit_label, &count, ctx); + + /* OUT. */ + FORWARD (s); + switch (ATTRIBUTE (s)) + { + case CHOICE: + case OUT_PART: + { + bool dsa = serial_clause_dsa (NEXT (SUB (s))); + bool local = NON_LOCAL (NEXT (SUB (s))) == NO_TABLE; + a68_push_serial_clause_range (case_clause_mode, dsa && local); + + (void) a68_lower_tree (NEXT (SUB (s)), ctx); + a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (result), + result, a68_pop_serial_clause_range ())); + a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label)); + break; + } + case CLOSE_SYMBOL: + case ESAC_SYMBOL: + a68_add_stmt (fold_build2 (MODIFY_EXPR, + TREE_TYPE (result), + result, + a68_get_skip_tree (case_clause_mode))); + a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label)); + break; + default: + /* Recurse. + + Note that the parser guarantees that the embedded CASE clause has the + same mode than the containing clause, but it doesn't annotate the OUSE + node with its mode so we have to do it here. */ + MOID (s) = case_clause_mode; + a68_add_stmt (fold_build2 (MODIFY_EXPR, + TREE_TYPE (result), + result, + a68_lower_case_clause (s, ctx))); + a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, exit_label)); + break; + } + + /* ESAC */ + a68_add_stmt (build1 (LABEL_EXPR, void_type_node, exit_label)); + a68_add_stmt (result); + return a68_pop_range (); +} + +/* Lower an enquiry clause. + + enquiry clause : unit; + enquiry clause, semi symbol, unit; + enquiry clause, comma symbol, unit; + initialiser series, semi symbol, unit. + + The units and declarations in the enquiry clause get lowered into + expressions and declaration nodes which are added to the current serial + clause. + + This function always returns NULL_TREE, so the traversing code shall always + be careful to travese on these nodes explicitly and ignore the returned + value. */ + +tree +a68_lower_enquiry_clause (NODE_T *p, LOW_CTX_T ctx) +{ + if (IS (SUB (p), UNIT)) + { + a68_add_stmt (a68_lower_tree (SUB (p), ctx)); + } + else if (IS (SUB (p), ENQUIRY_CLAUSE)) + { + (void) a68_lower_tree (SUB (p), ctx); + gcc_assert (IS (NEXT (NEXT (SUB (p))), UNIT)); + a68_add_stmt (a68_lower_tree (NEXT (NEXT (SUB (p))), ctx)); + } + else + { + gcc_assert (IS (SUB (p), INITIALISER_SERIES)); + gcc_assert (IS (NEXT (NEXT (SUB (p))), UNIT)); + (void) a68_lower_tree (SUB (p), ctx); + a68_add_stmt (a68_lower_tree (NEXT (NEXT (SUB (p))), ctx)); + } + + return NULL_TREE; +} + +/* Lower a conditional clause. + + conditional clause : open part, choice, choice, close symbol; + open part, choice, close symbol; + open part, choice, brief elif part; + if part, then part, else part, fi symbol; + if part, then part, elif part; + if part, then part, fi symbol. + + if part : if symbol, enquiry clause; + if symbol, initialiser series. + + then part : then symbol, serial clause; + then symbol, initialiser series. + + elif part : elif if part, then part, else part, fi symbol; + elif if part, then part, fi symbol; + elif if part, then part, elif part. + + else part : else symbol, serial clause; + else symbol, initialiser series. + + elif if part : elif symbol, enquiry clause. + + open part : open symbol, enquiry clause. + + choice : then bar symbol, serial clause; + then bar symbol initialiser series. + + brief elif part : else open part, choice, choice, close symbol; + else open part, choice, close symbol; + else open part, choice, bief elif part. + + else open part : else bar symbol, enquiry clause; + else bar symbol, initialiser series. + + Ranges: + + IF enquiry-clause THEN expr ELSE expr FI + --- R2 ---- R3 + ---------------------------------------- R1 + + The conditional clause lowers into: + + BIND_EXPR + BIND_EXPR_VARS -> delcls in enquiry clause. + BIND_EXPR_BODY + STMT_LIST + enquiry% = ...; + COND_EXPR (enquiry%, then_expr, else_expr) */ + +tree +a68_lower_conditional_clause (NODE_T *p, LOW_CTX_T ctx) +{ + tree then_expr = NULL_TREE; + tree else_expr = NULL_TREE; + + MOID_T *conditional_clause_mode = MOID (p); + MOID_T *effective_rows_mode = NO_MOID; + bool is_rows = false; + + /* Push a binding environment for the conditional. */ + a68_push_range (is_rows ? effective_rows_mode : conditional_clause_mode); + + /* Create a decl for %enquiry and add it to the bind's declaration chain. */ + tree enquiry_decl = build_decl (UNKNOWN_LOCATION, + VAR_DECL, + NULL, /* Set below. */ + a68_bool_type); + char *enquiry_name = xasprintf ("enquiry%d%%", DECL_UID(enquiry_decl)); + DECL_NAME (enquiry_decl) = get_identifier (enquiry_name); + free (enquiry_name); + DECL_INITIAL (enquiry_decl) = a68_get_skip_tree (M_BOOL); + a68_add_decl (enquiry_decl); + + /* Add a DECL_EXPR for enquiry_decl% */ + a68_add_stmt (fold_build1 (DECL_EXPR, a68_bool_type, enquiry_decl)); + + /* IF or ELIF part. */ + NODE_T *s = SUB (p); + + /* Process the enquiry clause. */ + (void) a68_lower_tree (NEXT (SUB (s)), ctx); + + /* Assignation enquiry% = .. expr .. + Note that since no completers are allowed in enquiry clauses, + the last statement in the statement list has to be the unit + yielding the boolean value. */ + tree_stmt_iterator si = tsi_last (a68_range_stmt_list ()); + gcc_assert (TREE_TYPE (tsi_stmt (si)) != void_type_node); + a68_add_stmt (fold_build2 (MODIFY_EXPR, a68_bool_type, enquiry_decl, tsi_stmt (si))); + tsi_delink (&si); + + /* THEN part. */ + FORWARD (s); + bool dsa = serial_clause_dsa (NEXT (SUB (s))); + bool local = NON_LOCAL (NEXT (SUB (s))) == NO_TABLE; + a68_push_serial_clause_range (is_rows ? effective_rows_mode : conditional_clause_mode, + dsa && local); + (void) a68_lower_tree (NEXT (SUB (s)), ctx); + then_expr = a68_pop_serial_clause_range (); + + /* ELSE part */ + FORWARD (s); + switch (ATTRIBUTE (s)) + { + case CHOICE: + case ELSE_PART: + { + bool dsa = serial_clause_dsa (NEXT (SUB (s))); + bool local = NON_LOCAL (NEXT (SUB (s))) == NO_TABLE; + a68_push_serial_clause_range (is_rows ? effective_rows_mode : conditional_clause_mode, + dsa && local); + (void) a68_lower_tree (NEXT (SUB (s)), ctx); + else_expr = a68_pop_serial_clause_range (); + break; + } + case CLOSE_SYMBOL: + case FI_SYMBOL: + { + else_expr = a68_get_skip_tree (is_rows ? effective_rows_mode : conditional_clause_mode); + break; + } + default: + { + /* ELIF part. Recurse. */ + MOID (s) = conditional_clause_mode; + else_expr = a68_lower_conditional_clause (s, ctx); + } + } + + /* Build the conditional clause's COND_EXPR. */ + a68_add_stmt (fold_build3_loc (a68_get_node_location (p), + COND_EXPR, + CTYPE (is_rows ? effective_rows_mode : conditional_clause_mode), + enquiry_decl, + then_expr, else_expr)); + + return a68_pop_range (); +} + +/* Lower a comma separated list of zero, two, or more units + + unit list : unit list, comma symbol, unit; + unit list, unit. + + The list of units lowers into appending the units into the current + statements list. + + This function always returns NULL_TREE, so the traversing code shall always + be careful to traverse on these nodes explicitly and ignore the returned + value. */ + +tree +a68_lower_unit_list (NODE_T *p, LOW_CTX_T ctx) +{ + if (IS (SUB (p), UNIT_LIST)) + (void) a68_lower_tree (SUB (p), ctx); + + for (NODE_T *s = SUB (p); s != NO_NODE; FORWARD (s)) + { + if (IS (s, UNIT)) + a68_add_stmt (a68_lower_tree (s, ctx)); + } + + return NULL_TREE; +} + +/* Lower a collateral clause. + + collateral clause : open symbol, unit list, close symbol; + open symbol, close symbol; + begin symbol, unit list, end symbol; + begin symbol, end symbol. + + An empty collateral clause lowers into EMPTY. */ + +tree +a68_lower_collateral_clause (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + bool clause_is_empty = (ATTRIBUTE (NEXT (SUB (p))) != UNIT_LIST); + MOID_T *mode = MOID (p); + + /* Lower the constituent units into a statements list. */ + a68_push_stmt_list (mode); + if (!clause_is_empty) + (void) a68_lower_tree (NEXT (SUB (p)), ctx); + tree units = a68_pop_stmt_list (); + + /* The collateral clause lowers to different constructions depending on its + nature. */ + if (mode == M_VOID) + { + /* A VOID-collateral-clause lowers into a STMT_LIST containing all + the units. Since there cannot be declarations in a collateral + clause, there is no need to introduce a new binding scope. Note + that for now we are not really elaborating collaterally, but + sequentially. */ + return units; + } + else if (IS_FLEXETY_ROW (mode) || mode == M_STRING) + { + if (mode == M_STRING) + mode = M_FLEX_ROW_CHAR; + + /* This is a row display. It lowers to a multiple. */ + tree row_type = CTYPE (mode); + size_t dim = DIM (DEFLEX (mode)); + + if (clause_is_empty) + { + /* The clause is empty. This lowers into a multiple with DIM + dimension, each dimension having bounds of 1:0, and no + elements. */ + tree element_pointer_type = a68_row_elements_pointer_type (row_type); + tree multiple_elements = build_int_cst (element_pointer_type, 0); + tree multiple_elements_size = size_zero_node; + + tree *lower_bounds = (tree *) xmalloc (sizeof (tree) * dim); + tree *upper_bounds = (tree *) xmalloc (sizeof (tree) * dim); + tree ssize_one_node = fold_convert (ssizetype, size_one_node); + tree ssize_zero_node = fold_convert (ssizetype, size_zero_node); + for (size_t d = 0; d < dim; ++d) + { + lower_bounds[d] = ssize_one_node; + upper_bounds[d] = ssize_zero_node; + } + + tree row = a68_row_value (row_type, dim, + multiple_elements, + multiple_elements_size, + lower_bounds, upper_bounds); + TREE_CONSTANT (row) = 1; + free (lower_bounds); + free (upper_bounds); + return row; + } + + if (dim == 1) + { + /* Create a constructor with the multiple's elements. */ + vec *ve = NULL; + int num_units = 0; + for (tree_stmt_iterator si = tsi_start (units); !tsi_end_p (si); tsi_next (&si)) + { + tree unit = tsi_stmt (si); + if (A68_TYPE_HAS_ROWS_P (TREE_TYPE (unit))) + unit = a68_low_dup (unit); + CONSTRUCTOR_APPEND_ELT (ve, size_int (num_units), unit); + num_units += 1; + } + + tree element_pointer_type = a68_row_elements_pointer_type (row_type); + tree array_constructor_type = build_array_type (TREE_TYPE (element_pointer_type), + build_index_type (size_int (num_units - 1))); + tree array_constructor = build_constructor (array_constructor_type, ve); + tree multiple_elements = fold_build1 (ADDR_EXPR, + element_pointer_type, + array_constructor); + tree elements_type = TREE_TYPE (element_pointer_type); + tree multiple_elements_size = fold_build2 (MULT_EXPR, sizetype, + size_int (num_units), + size_in_bytes (elements_type)); + tree lower_bound = fold_convert (ssizetype, size_one_node); + tree upper_bound = ssize_int (num_units); + tree row = a68_row_value (row_type, dim, + multiple_elements, + multiple_elements_size, + &lower_bound, &upper_bound); + return row; + } + else + { + gcc_assert (dim > 1); + + /* The units in the collateral clause are multiples, whose elements + are to be copied consecutively in a new multiple. The descriptor + of this multiple is constructed as follows: + + The first dimension is: + + - The lower bound is 1. + - The upper bound is the number of sub-multiples processed + here. + - The stride is the number of elements in each sub-multiple + multiplied by the element size. + + Subsequent dimensions are taken from the first inner multiple. + All descriptors of the inner multiples shall be equal. This is + checked at run-time, and in case of discrepancy a run-time error + is emitted. + + Let's see an example. Suppose in the stmt-list we have: + + (1, 2, 3) + {triplets: {lb: 1 ub: 3 stride: 1S} elements: {1, 2, 3}} + (4, 5, 6) + {triplets: {lb: 1 ub: 3 stride: 1S} elements: {4, 5, 6}} + + The resulting multiple would be: + + ((1, 2, 3), (4, 5, 6)) + {triplets: {{lb: 1 ub: 2 stride: 3S}, {lb: 1 ub: 3 stride: 1S}} + elements: {1, 2, 3, 4, 5, 6}} */ + + tree *lower_bounds = (tree *) xmalloc (sizeof (tree) * dim); + tree *upper_bounds = (tree *) xmalloc (sizeof (tree) * dim); + size_t num_units = 0; + + for (tree_stmt_iterator si = tsi_start (units); !tsi_end_p (si); tsi_next (&si)) + num_units++; + + a68_push_range (mode); + + /* Process each sub-multiple. The first sub-multiple establishes the + bounds that all subsequent sub-multiples shall match. */ + tree multiple_elements = NULL_TREE; + tree multiple_elements_size = NULL_TREE; + tree sub_multiple = NULL_TREE; + // tree sub_multiple_lb = NULL_TREE; + // tree sub_multiple_ub = NULL_TREE; + // tree sub_multiple_stride = NULL_TREE; + tree index = a68_lower_tmpvar ("index%", sizetype, size_zero_node); + for (tree_stmt_iterator si = tsi_start (units); !tsi_end_p (si); tsi_next (&si)) + { + if (sub_multiple == NULL) + sub_multiple = a68_lower_tmpvar ("sub_multiple%", + TREE_TYPE (tsi_stmt (si)), + tsi_stmt (si)); + else + a68_add_stmt (fold_build2 (MODIFY_EXPR, + TREE_TYPE (tsi_stmt (si)), + sub_multiple, + tsi_stmt (si))); + + if (si == tsi_start (units)) + { +#if 0 + tree ssize_zero_node = fold_convert (ssizetype, size_zero_node); + /* The first sub-multiple establishes the bounds that all + subsequent sub-multiples shall match. */ + sub_multiple_lb = a68_lower_tmpvar ("sub_multiple_lb%", + ssizetype, + a68_multiple_lower_bound (sub_multiple, + ssize_zero_node)); + sub_multiple_ub = a68_lower_tmpvar ("sub_multiple_ub%", + ssizetype, + a68_multiple_upper_bound (sub_multiple, + ssize_zero_node)); + sub_multiple_stride = a68_lower_tmpvar ("sub_multiple_stride%", + sizetype, + a68_multiple_stride (sub_multiple, + size_zero_node)); +#endif + /* Now we have enough information to calculate the size of + the elements of the new multiple and allocate + multiple_elements. */ + tree sub_multiple_elements = a68_multiple_elements (sub_multiple); + tree elements_pointer_type = TREE_TYPE (sub_multiple_elements); + tree elements_type = TREE_TYPE (elements_pointer_type); + multiple_elements_size = fold_build2 (MULT_EXPR, sizetype, + size_int (num_units), + size_in_bytes (elements_type)); + multiple_elements_size = fold_build2 (MULT_EXPR, sizetype, + multiple_elements_size, + a68_multiple_num_elems (sub_multiple)); + multiple_elements = a68_lower_tmpvar ("multiple_elements%", + elements_pointer_type, + a68_lower_alloca (elements_type, + multiple_elements_size)); + + /* We can also now calculate the bounds of the new multiple. + The top-level triplet has lower bound 1, upper bound is + num_units, and stride is the number of elements in each + sub-multiple multiplied by the element size. Bounds for + the subsequent DIM-1 dimensions are copied from the + sub-multiple's descriptor. */ + lower_bounds[0] = fold_convert (ssizetype, size_one_node); + upper_bounds[0] = ssize_int (num_units); + for (size_t d = 1; d < dim; ++d) + { + lower_bounds[d] = a68_multiple_lower_bound (sub_multiple, + ssize_int (d - 1)); + upper_bounds[d] = a68_multiple_upper_bound (sub_multiple, + ssize_int (d - 1)); + } + } + else + { + /* Check bounds of this sub-multiple. Note that this is + always done at run-time, since the interpretation of a row + display depens on the target type, whether it is a row row + or a row of rows, for example. */ + // XXX use sub_multiple_lb, sub_multiple_ub and sub_multiple_stride + } + + /* Copy the elements of a copy of the sub-multiple in the + elements of the multiple. */ + tree sub_multiple_elements = a68_multiple_elements (sub_multiple); + // XXX should we make a copy of the sub_multiple_elements here? + // We DO need to iterate slicing, because of strides: if + // the sub_multiple is a trimmer. + sub_multiple_elements = sub_multiple_elements; + tree sub_multiple_elements_type = TREE_TYPE (sub_multiple_elements); + tree sub_multiple_num_elems = a68_multiple_num_elems (sub_multiple); + tree sub_multiple_element_type = TREE_TYPE (sub_multiple_elements_type); + tree sub_multiple_elements_size = fold_build2 (MULT_EXPR, sizetype, + sub_multiple_num_elems, + size_in_bytes (sub_multiple_element_type)); + + /* memcpy (multiple_elements[index], sub_multiple_elements) */ + a68_add_stmt (a68_lower_memcpy (fold_build2 (POINTER_PLUS_EXPR, + sub_multiple_elements_type, + multiple_elements, + index), + sub_multiple_elements, + sub_multiple_elements_size)); + /* index += sub_multiple_elements_size */ + a68_add_stmt (fold_build2 (MODIFY_EXPR, sizetype, + index, + fold_build2 (PLUS_EXPR, sizetype, + index, sub_multiple_elements_size))); + } + + tree multiple = a68_lower_tmpvar ("multiple%", + row_type, + a68_row_value (row_type, dim, + multiple_elements, + multiple_elements_size, + lower_bounds, upper_bounds)); + free (lower_bounds); + free (upper_bounds); + + /* Yield the multiple. */ + a68_add_stmt (multiple); + return a68_pop_range (); + } + } + else if (IS_STRUCT (mode)) + { + /* This is a struct display. There are as many units in the clause as + fields in the struct type. Build a constructor with the values for + the fields. */ + vec *ve = NULL; + tree_stmt_iterator si = tsi_start (units); + for (tree f = TYPE_FIELDS (CTYPE (mode)); f; f = DECL_CHAIN (f)) + { + tree v = tsi_stmt (si); + gcc_assert (v != NULL_TREE); + v = a68_consolidate_ref (a68_type_moid (TREE_TYPE (f)) ,v); + CONSTRUCTOR_APPEND_ELT (ve, f, v); + tsi_next (&si); + } + tree ctor = build_constructor (CTYPE (mode), ve); + return ctor; + } + else + gcc_unreachable (); +} + +/* Lower a parallel clause. + + parallel clause : par symbol, collateral clause. +*/ + +tree +a68_lower_parallel_clause (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + /* XXX For now treat like a VOID collateral clause. */ + return a68_lower_tree (NEXT (SUB (p)), ctx); +} + +/* Lower a closed clause. + + closed clause : open symbol, serial clause, close symbol; + open symbol, initialiser series, close symbol; + begin symbol, serial clause, end symbol; + begin symbol, initialiser series, end symbol; + + This function returns a BIND_EXPR. */ + +tree +a68_lower_closed_clause (NODE_T *p, LOW_CTX_T ctx) +{ + /* Determine the mode of the closed clause. */ + MOID_T *clause_mode = MOID (p); + gcc_assert (clause_mode != NO_MOID); + gcc_assert (CTYPE (clause_mode) != NULL_TREE); + + /* Lower the enclosed serial clause. + + Note that a serial clause can be nested right inside another, and in that + case the range we are pushing corresponds to all of them, so we have to + keep this into account when determining whether using a DSA serial + range. */ + + bool dsa = serial_clause_dsa (NEXT (SUB (p))); + bool local = NON_LOCAL (NEXT (SUB (p))) == NO_TABLE; + a68_push_serial_clause_range (clause_mode, dsa && local); + (void) a68_lower_tree (NEXT (SUB (p)), ctx); + return a68_pop_serial_clause_range (); +} + +/* Lower an access clause. + + access clause : access symbol, joined module indication sequence, + enclosed clause. +*/ + +tree +a68_lower_access_clause (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *controlled_clause = NEXT (NEXT_SUB (p)); + + a68_push_range (MOID (p)); + + /* Call preludes of all ACCESSed modules. */ + for (NODE_T *q = SUB (p); q != NO_NODE; FORWARD (q)) + { + if (IS (q, MODULE_INDICANT)) + { + TAG_T *tag = a68_find_tag_global (TABLE (q), MODULE_SYMBOL, NSYMBOL (q)); + gcc_assert (tag != NO_TAG); + MOIF_T *moif = MOIF (tag); + gcc_assert (moif != NO_MOIF); + const char *prelude = PRELUDE (moif); + + tree prelude_decl = build_decl (UNKNOWN_LOCATION, FUNCTION_DECL, + get_identifier (prelude), + build_function_type_list (void_type_node, + void_type_node, + NULL_TREE)); + DECL_EXTERNAL (prelude_decl) = 1; + TREE_PUBLIC (prelude_decl) = 1; + a68_add_decl (prelude_decl); + a68_add_stmt (build_call_expr_loc (a68_get_node_location (q), + prelude_decl, 0)); + } + } + + /* Now the controlled clause. */ + tree controlled_clause_tree = a68_lower_tree (controlled_clause, ctx); + tree tmp = a68_lower_tmpvar ("accessed_clause_result%", + TREE_TYPE (controlled_clause_tree), + controlled_clause_tree); + + /* Call postludes of all ACCESSed modules. */ + for (NODE_T *q = SUB (p); q != NO_NODE; FORWARD (q)) + { + if (IS (q, MODULE_INDICANT)) + { + TAG_T *tag = a68_find_tag_global (TABLE (q), MODULE_SYMBOL, NSYMBOL (q)); + gcc_assert (tag != NO_TAG); + MOIF_T *moif = MOIF (tag); + gcc_assert (moif != NO_MOIF); + const char *postlude = POSTLUDE (moif); + + tree postlude_decl = build_decl (UNKNOWN_LOCATION, FUNCTION_DECL, + get_identifier (postlude), + build_function_type_list (void_type_node, + void_type_node, + NULL_TREE)); + DECL_EXTERNAL (postlude_decl) = 1; + TREE_PUBLIC (postlude_decl) = 1; + a68_add_decl (postlude_decl); + a68_add_stmt (build_call_expr_loc (a68_get_node_location (q), + postlude_decl, 0)); + } + } + + a68_add_stmt (tmp); + return a68_pop_range (); +} + +tree a68_lower_access_clauses (NODE_T *p, LOW_CTX_T ctx); + +/* Lower an enclosed clause. + + enclosed clause : parallel clause; closed clause; + collateral clause; conditional clause; + case clause; conformity clause; + loop clause ; access clause. +*/ + +tree +a68_lower_enclosed_clause (NODE_T *p, LOW_CTX_T ctx) +{ + return a68_lower_tree (SUB (p), ctx); +} diff --git a/gcc/algol68/a68-low-decls.cc b/gcc/algol68/a68-low-decls.cc new file mode 100644 index 000000000000..74a93f71dde8 --- /dev/null +++ b/gcc/algol68/a68-low-decls.cc @@ -0,0 +1,696 @@ +/* Lower mode, identity and variable declarations to GENERIC. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Lower one or more mode declarations. + + mode declaration : mode symbol, defining indicant, + equals symbol, declarer; + mode symbol, defining indicant, + equals symbol, void symbol; + mode declaration, comma symbol, + defining indicant, equals symbol, declarer; + mode declaration, comma symbol, + defining indicant, equals symbol, void symbol. + + Each mode declaration lowers into a TYPE_DECL, which are chained in the + current block. This function returns void_node. + + Note that the defining indicant is already annotated with the declared mode + so there is no need to go hunting for the declarer in the subtree. */ + +tree +a68_lower_mode_declaration (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *defining_indicant = NO_NODE; + + if (IS (SUB (p), MODE_DECLARATION)) + { + a68_lower_tree (SUB (p), ctx); + defining_indicant = NEXT (NEXT (SUB (p))); + } + else + { + gcc_assert (IS (SUB (p), MODE_SYMBOL)); + defining_indicant = NEXT (SUB (p)); + } + + /* Create a TYPE_DECL declaration for the defined mode and chain it in the + current block. */ + tree ctype = CTYPE (MOID (defining_indicant)); + tree decl_name = a68_get_mangled_indicant (NSYMBOL (defining_indicant), + ctx.module_definition_name); + tree decl = build_decl (a68_get_node_location (p), + TYPE_DECL, decl_name, ctype); + SET_DECL_ASSEMBLER_NAME (decl, decl_name); + TREE_PUBLIC (decl) = 1; + TYPE_CONTEXT (ctype) = DECL_CONTEXT (decl); + TYPE_NAME (ctype) = decl; + TYPE_STUB_DECL (ctype) = decl; + a68_add_decl (decl); + + return void_node; +} + +/* Lower one or more variable declarations. + + variable declaration : qualifier, declarer, defining identifier, + assign symbol, unit; + qualifier, declarer, defining identiifer; + qualifier, declarer, defining identifier; + declarer, defining identifier, assign symbol, unit; + declarer, defining identifier; + variable declaration, comma symbol, + defining identifier, assign symbol, unit; + variable declaration, comma symbol, + defining identifier; + + Each variable declaration lowers into a VAR_DECL, which are chained in the + current block. This function also returns an expression with code to + initialize the variable in case there is an initializer. + + If the variable declaration implies a LOC generator then the VAR_DECL for REF + AMODE declares a value of type CTYPE (AMODE). This is an optimization in + order to avoid indirect addressing. If the variable declaration implies a + HEAP generator, however, then the VAR_DECL declares a value of type pointer + to CTYPE (AMODE0. In this later case no optimization is possible and it has + exactly the same effect than an identity declaration `REF AMODE + defining_identifier = HEAP AMODE'. + + Note that the defining identifier is annotated with its mode, so there is no + need to go hunting for the declarer in the subtree. */ + +tree +a68_lower_variable_declaration (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *defining_identifier, *unit; + NODE_T *declarer = NO_NODE; + + tree sub_expr = NULL_TREE; + + if (IS (SUB (p), VARIABLE_DECLARATION)) + { + LOW_CTX_T new_ctx = ctx; + new_ctx.declarer = &declarer; + sub_expr = a68_lower_tree (SUB (p), new_ctx); + defining_identifier = NEXT (NEXT (SUB (p))); + } + else if (IS (SUB (p), QUALIFIER)) + { + /* The qualifier determines what kind of generator is used in the + variable declaration. This is already annotated in the tax entry for + the definining identifier. */ + declarer = NEXT (SUB (p)); + defining_identifier = NEXT (NEXT (SUB (p))); + } + else if (IS (SUB (p), DECLARER)) + { + declarer = SUB (p); + defining_identifier = NEXT (SUB (p)); + } + else + gcc_unreachable (); + + /* Communicate declarer upward. */ + if (ctx.declarer != NULL) + *ctx.declarer = declarer; + + /* See if this variable declaration features an initializing unit. */ + if (NEXT (defining_identifier) != NO_NODE) + { + gcc_assert (NEXT (defining_identifier) + && IS (NEXT (defining_identifier), ASSIGN_SYMBOL) + && NEXT (NEXT (defining_identifier))); + unit = NEXT (NEXT (defining_identifier)); + } + else + unit = NO_NODE; + + /* If not done already by an applied identifier in lower_identifier, create a + declaration for the defined entity and chain it in the current block. The + declaration has an initial value of SKIP. */ + tree var_decl = TAX_TREE_DECL (TAX (defining_identifier)); + if (var_decl == NULL_TREE) + { + var_decl = a68_make_variable_declaration_decl (defining_identifier, + ctx.module_definition_name); + TAX_TREE_DECL (TAX (defining_identifier)) = var_decl; + } + + /* If the variable declaration is in a public range then add the declaration + to the publicized declarations list. Otherwise chain the declaration in + the proper block and bind it. */ + if (PUBLIC_RANGE (TABLE (TAX (defining_identifier)))) + vec_safe_push (A68_MODULE_DEFINITION_DECLS, var_decl); + else + a68_add_decl (var_decl); + + /* Add a decl_expr in the current range. */ + a68_add_decl_expr (fold_build1_loc (a68_get_node_location (p), + DECL_EXPR, + TREE_TYPE (var_decl), + var_decl)); + + tree expr = NULL_TREE; + + /* Allocate memory for the declared variables. + + This is done differently depending on the sample generator used in the + variable declaration, be it explicit or the default LOC. + + If the LOC generator is used and the value has no rows, it means it + doesnt' need a dynamic part and the var_decl created above is not a + pointer. So the memory has been allocated already and there is nothing + else to do at this point. + + If the HEAP generator is used, or if the generated value has rows, it + means the var_decl created above is a pointer. We need to run a generator + to get the memory with descriptors filled in. Note that we cannot set the + pointer as the initial of the var_decl because the bouns in the actual + declarer shall be elaborated at the point of the code where the + declaration appears, not at the beginning of its reach. Note that the + mode of the declarer will be always a REF, since this is a varaible + declaration: the referred mode is what we pass to the a68_low_generator. + + If the STATIC generator is used, the var_decl created above is not a + pointer. The static part of the value has been already allocated, and if + the value needs a dynamic part (i.e. if it has rows) then it is allocated + using the heap. Note how we allocate the whole value (including the + static part) and then we copy if over the var_decl. */ + + if (HEAP (TAX (defining_identifier)) == STATIC_SYMBOL) + { + if (HAS_ROWS (SUB (MOID (defining_identifier)))) + { + expr = fold_build2 (MODIFY_EXPR, TREE_TYPE (var_decl), + var_decl, + fold_build1 (INDIRECT_REF, + TREE_TYPE (var_decl), + a68_low_generator (declarer, + SUB (MOID (declarer)), + true /* heap */, + ctx))); + } + } + else + { + bool heap = HEAP (TAX (defining_identifier)) == HEAP_SYMBOL; + if (heap || HAS_ROWS (SUB (MOID (defining_identifier)))) + { + gcc_assert(IS_REF (MOID (declarer))); + expr = fold_build2 (MODIFY_EXPR, TREE_TYPE (var_decl), + var_decl, + a68_low_generator (declarer, + SUB (MOID (declarer)), + heap, ctx)); + } + } + + if (unit != NO_NODE) + { + tree rhs = a68_lower_tree (unit, ctx); + tree assignation = a68_low_assignation (p, + var_decl, MOID (defining_identifier), + rhs, MOID (unit)); + if (expr != NULL_TREE) + expr = fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (assignation), + expr, assignation); + else + expr = assignation; + } + + /* Tail in a compound expression with sub declarations, if any. */ + if (sub_expr != NULL_TREE) + { + if (expr != NULL_TREE) + expr = fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (var_decl), + sub_expr, + expr); + else + expr = sub_expr; + } + + return expr; +} + +/* Lower one or more identity declarations. + + identity declaration : declarer, defining identifier, + equals symbol, unit; + identity declaration, comma symbol, + defining identifier, equals symbol, unit; + + Each identity declaration lowers into a declaration. + + VAR_DECL with both TREE_CONSTANT and TREE_READONLY set. Note that we cannot + use CONST_DECL because of two reasons. First, CONST_DECL only works for + scalar modes. Second, since Algol 68 allows usage of identifiers before + they get declared, each declaration adds a declaration with a SKIP initial + value, and also an assignation of the value at the declaration point. This + function also returns an expression with code to initialize the declared + constant. */ + +tree +a68_lower_identity_declaration (NODE_T *p, LOW_CTX_T ctx) +{ + tree unit_tree = NULL_TREE; + tree sub_expr = NULL_TREE; + + /* Note that the formal declarer in the construct is not used. This is + because it is already reflected in the mode of the identity + declaration. */ + + NODE_T *defining_identifier; + if (IS (SUB (p), IDENTITY_DECLARATION)) + { + sub_expr = a68_lower_tree (SUB (p), ctx); + defining_identifier = NEXT (NEXT (SUB (p))); + } + else if (IS (SUB (p), DECLARER)) + { + defining_identifier = NEXT (SUB (p)); + } + else + gcc_unreachable (); + + NODE_T *unit = NEXT (NEXT (defining_identifier)); + + /* If not done already by an applied identifier in lower_identifier, create a + declaration for the defined entity and chain it in the current block. The + declaration has an initial value of SKIP. */ + tree id_decl = TAX_TREE_DECL (TAX (defining_identifier)); + if (id_decl == NULL_TREE) + { + id_decl = a68_make_identity_declaration_decl (defining_identifier, + ctx.module_definition_name); + TAX_TREE_DECL (TAX (defining_identifier)) = id_decl; + } + + /* If the identity declaration is in a public range then add the declaration + to the publicized declarations list. Otherwise chain the declaration in + the proper block and bind it. */ + if (PUBLIC_RANGE (TABLE (TAX (defining_identifier)))) + vec_safe_push (A68_MODULE_DEFINITION_DECLS, id_decl); + else + a68_add_decl (id_decl); + + /* Prepare the DECL_EXPR. */ + a68_add_decl_expr (fold_build1_loc (a68_get_node_location (p), + DECL_EXPR, + TREE_TYPE (id_decl), + id_decl)); + + unit_tree = a68_lower_tree (unit, ctx); + unit_tree = a68_consolidate_ref (MOID (unit), unit_tree); + tree expr = a68_low_ascription (MOID (defining_identifier), + id_decl, unit_tree); + + /* If the ascribed value is constant, mark the declaration as constant. */ + TREE_CONSTANT (id_decl) = TREE_CONSTANT (unit_tree); + + /* Tail in a compound expression with sub declarations, if any. */ + if (sub_expr != NULL_TREE) + { + if (expr != NULL_TREE) + expr = fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (id_decl), + sub_expr, + expr); + else + expr = sub_expr; + } + + return expr; +} + +/* Lower a declarer. + + declarer : indicant; + longety, indicant; + shortety, indicant; + flex symbol, declarer; + flex symbol, bounds, declarer; + flex symbol, formal bounds, declarer; + bounds, declarer; + formal bounds, declarer; + ref symbol, declarer; + struct symbol, structure pack; + union symbol, union pack; + proc symbol, declarer; + proc symbol, formal declarers, declarer; + proc symbol, formal declarers, void symbol; + + + This handler lowes a DECLARER tree into an expression that evaluates to the + size of the actual declarer. Note that this is a self-contained handler and + it does traverse the sub-tree on its own. */ + +tree +a68_lower_declarer (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + gcc_unreachable (); +} + +/* Lower a declaration list. + + declaration list : mode declaration; + priority declaration; + brief operator declaration; + operator declaration; + identity declaration; + procedure declaration; + procedure variable declaration; + variable declaration; + environ name; + declaration list, comma symbol, declaration list; + + Process the subtree, which produces declarations associated with the current + context and which get added to the current block. The list of declarations + gets returned in nested compound expressions. */ + +tree +a68_lower_declaration_list (NODE_T *p, LOW_CTX_T ctx) +{ + if (IS (SUB (p), DECLARATION_LIST)) + { + tree left = a68_lower_tree (SUB (p), ctx); + tree right = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + /* The trees `left' and `right' may be NULL_TREE if the declarations + under them didn't have an initializing expression. In that case, + replace them by nops which are removed at fold time. This is ugly, + but works. */ + if (left == NULL_TREE) + left = integer_zero_node; + if (right == NULL_TREE) + right = integer_zero_node; + + return fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + void_type_node, + left, right); + } + else + return a68_lower_tree (SUB (p), ctx); +} + +/* Lower a procedure declaration. + + procedure declaration : proc symbol, defining identifier, assign symbol, routine text; + procedure declaration, comma symbol, + defining identifier, equals symbol, routine text. + + Each procedure declaration lowers into a declaration. */ + +tree +a68_lower_procedure_declaration (NODE_T *p, LOW_CTX_T ctx) +{ + tree sub_func_decl = NULL_TREE; + NODE_T *defining_identifier; + if (IS (SUB (p), PROCEDURE_DECLARATION)) + { + sub_func_decl = a68_lower_tree (SUB (p), ctx); + defining_identifier = NEXT (NEXT (SUB (p))); + } + else if (IS (SUB (p), PROC_SYMBOL)) + { + defining_identifier = NEXT (SUB (p)); + } + else + gcc_unreachable (); + + NODE_T *routine_text = NEXT (NEXT (defining_identifier)); + + /* Lower the routine text to get a function decl. */ + ctx.proc_decl_identifier = defining_identifier; + ctx.proc_decl_operator = false; + tree func_decl = a68_lower_tree (routine_text, ctx); + + /* Tail in a compound expression with sub declarations, if any. */ + if (sub_func_decl != NULL_TREE) + { + if (func_decl != NULL_TREE) + func_decl = fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (func_decl), + sub_func_decl, + func_decl); + else + func_decl = sub_func_decl; + } + + return func_decl; +} + +/* Lower a procedure variable declaration. + + procedure variable declaration + : proc symbol, defining identifier, assign symbol, routine text; + qualifier, proc symbol, defining identifier, assign symbol, routine text; + procedure variable declaration, comma symbol, defining identiier, assign symbol, routine text. + + This lowers into the declaration of a VAR_DECL which is a pointer to the + free standing routine yielded by the routine text. */ + +tree +a68_lower_procedure_variable_declaration (NODE_T *p, LOW_CTX_T ctx) +{ + tree sub_decl = NULL_TREE; + NODE_T *defining_identifier; + if (IS (SUB (p), PROCEDURE_VARIABLE_DECLARATION)) + { + sub_decl = a68_lower_tree (SUB (p), ctx); + defining_identifier = NEXT (NEXT (SUB (p))); + } + else if (IS (SUB (p), PROC_SYMBOL)) + defining_identifier = NEXT (SUB (p)); + else if (IS (SUB (p), QUALIFIER)) + /* The qualifier determines what kind of generator is used in the variable + declaration. This is already annotated in the tax entry for the + definining identifier. */ + defining_identifier = NEXT (NEXT (SUB (p))); + else + gcc_unreachable (); + NODE_T *routine_text = NEXT (NEXT (defining_identifier)); + + /* The routine text lowers into a pointer to function. */ + ctx.proc_decl_identifier = NO_NODE; + ctx.proc_decl_operator = false; + tree routine = a68_lower_tree (routine_text, ctx); + + /* Create a declaration for the proc variable, if that hasn't been done + already. */ + tree decl = TAX_TREE_DECL (TAX (defining_identifier)); + if (decl == NULL_TREE) + { + decl = a68_make_variable_declaration_decl (defining_identifier, + ctx.module_definition_name); + TAX_TREE_DECL (TAX (defining_identifier)) = decl; + } + + /* If the variable declaration is in a public range then add the declaration + to the publicized declarations list. Otherwise chain the declaration in + the proper block and bind it. */ + if (PUBLIC_RANGE (TABLE (TAX (defining_identifier)))) + vec_safe_push (A68_MODULE_DEFINITION_DECLS, decl); + else + a68_add_decl (decl); + + /* Add a decl_expr in the current range. */ + a68_add_decl_expr (fold_build1_loc (a68_get_node_location (p), + DECL_EXPR, + TREE_TYPE (decl), + decl)); + /* Initialize. + + If the variable is heap allocated then the var_decl created above is a + pointer. We don't allocate the actual function on the heap, because the + scope of procedures is not global. */ + bool heap = HEAP (TAX (defining_identifier)) == HEAP_SYMBOL; + a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (decl), decl, + heap ? fold_build1 (ADDR_EXPR, TREE_TYPE (decl), + routine) : routine)); + + /* Tail in a compound expression with sub declarations, if any. */ + if (sub_decl != NULL_TREE) + { + if (decl != NULL_TREE) + decl = fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (decl), + sub_decl, + decl); + else + decl = sub_decl; + } + + return decl; +} + +/* Lower a priority declaration. + + This lowers to nothing. Operator priority is fully handled by the parser in + order to decide which operator declaration corresponds to each applied + operator. */ + +tree +a68_lower_priority_declaration (NODE_T *p ATTRIBUTE_UNUSED, + LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return NULL_TREE; +} + +/* Lower a brief operator declaration. + + brief operator declaration + : op symbol, defining operator, equals symbol, routine text; + brief operator declaration, comma symbol, defining operator, equals symbol, routine text. + + The declarations low in a series of FUNCTION_DECLs, one per declared + operator. */ + +tree +a68_lower_brief_operator_declaration (NODE_T *p, LOW_CTX_T ctx) +{ + tree sub_func_decl = NULL_TREE; + NODE_T *defining_operator; + + if (IS (SUB (p), BRIEF_OPERATOR_DECLARATION)) + { + sub_func_decl = a68_lower_tree (SUB (p), ctx); + defining_operator = NEXT (NEXT (SUB (p))); + } + else + defining_operator = NEXT (SUB (p)); + NODE_T *routine_text = NEXT (NEXT (defining_operator)); + + /* Lower the routine text to get a function decl. */ + ctx.proc_decl_identifier = defining_operator; + ctx.proc_decl_operator = true; + tree func_decl = a68_lower_tree (routine_text, ctx); + + /* Tail in a compound expression with sub declarations, if any. */ + if (sub_func_decl != NULL_TREE) + { + if (func_decl != NULL_TREE) + func_decl = fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (func_decl), + sub_func_decl, + func_decl); + else + func_decl = sub_func_decl; + } + + return func_decl; +} + +/* Lower an operator declaration. + + operator declaration : operator plan, defining operator, equals symbol, unit; + operator declaration, comma symbol, defining operator, equals symbol, unit. + + Each operator declaration lowers into a declaration. */ + +tree +a68_lower_operator_declaration (NODE_T *p, LOW_CTX_T ctx) +{ + tree sub_op_decl = NULL_TREE; + NODE_T *defining_operator; + + if (IS (SUB (p), OPERATOR_DECLARATION)) + { + sub_op_decl = a68_lower_tree (SUB (p), ctx); + defining_operator = NEXT (NEXT (SUB (p))); + } + else + defining_operator = NEXT (SUB (p)); + NODE_T *unit = NEXT (NEXT (defining_operator)); + + tree op_decl = TAX_TREE_DECL (TAX (defining_operator)); + if (op_decl == NULL_TREE) + { + op_decl = a68_make_identity_declaration_decl (defining_operator, + ctx.module_definition_name, + true /* indicant */); + TAX_TREE_DECL (TAX (defining_operator)) = op_decl; + } + + /* If the identity declaration is in a public range then add the declaration + to the publicized declarations list. Otherwise chain the declaration in + the proper block and bind it. */ + if (PUBLIC_RANGE (TABLE (TAX (defining_operator)))) + vec_safe_push (A68_MODULE_DEFINITION_DECLS, op_decl); + else + a68_add_decl (op_decl); + + /* Prepare the DECL_EXPR. */ + a68_add_decl_expr (fold_build1_loc (a68_get_node_location (p), + DECL_EXPR, + TREE_TYPE (op_decl), + op_decl)); + /* Initialize. */ + a68_add_stmt (fold_build2 (MODIFY_EXPR, TREE_TYPE (op_decl), op_decl, + a68_lower_tree (unit, ctx))); + + /* Tail in a compound expression with sub declarations, if any. */ + if (sub_op_decl != NULL_TREE) + { + if (op_decl != NULL_TREE) + op_decl = fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + TREE_TYPE (op_decl), + sub_op_decl, + op_decl); + else + op_decl = sub_op_decl; + } + + return op_decl; +} From 28b80fb7626b6977e837f32aa707bfa9b5d1649d Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:53:12 +0200 Subject: [PATCH 169/373] a68: low: runtime Libcalls for operations implemented in the run-time environment. Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-low-runtime.cc: New file. * algol68/a68-low-runtime.def: Likewise. --- gcc/algol68/a68-low-runtime.cc | 225 ++++++++++++++++++++++++++++++++ gcc/algol68/a68-low-runtime.def | 92 +++++++++++++ 2 files changed, 317 insertions(+) create mode 100644 gcc/algol68/a68-low-runtime.cc create mode 100644 gcc/algol68/a68-low-runtime.def diff --git a/gcc/algol68/a68-low-runtime.cc b/gcc/algol68/a68-low-runtime.cc new file mode 100644 index 000000000000..4ea93e991e10 --- /dev/null +++ b/gcc/algol68/a68-low-runtime.cc @@ -0,0 +1,225 @@ +/* Libcalls to Algol 68 run-time functions. + Copyright (C) 2006-2025 Free Software Foundation, Inc. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + Adapted from gcc/d/runtime.cc. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* The lowering pass may generate expressions to call various runtime library + functions. Most of these functions are implemented in libga68. This file + provides facilities to compile libcalls to runtime functions. The file + a68-low-runtime.def contains a database of available runtime library + functions. */ + +enum a68_libcall_type +{ + LCT_VOID, + LCT_CHAR, + LCT_CONSTCHARPTR, + LCT_VOIDPTR, + LCT_UNISTR, + LCT_UNISTRPTR, + LCT_SIZE, + LCT_SSIZE, + LCT_SIZEPTR, + LCT_UINT, + LCT_INT, + LCT_LONGLONGINT, + LCT_FLOAT, + LCT_DOUBLE, + LCT_LONGDOUBLE, + LCT_END +}; + +/* An array of all types that are used by the runtime functions we need. */ + +static tree libcall_types[LCT_END]; + +/* Internal list of library functions. */ + +static tree libcall_decls[A68_LIBCALL_LAST]; + +/* Return the TREE type that is described by TYPE. */ + +static tree +get_libcall_type (a68_libcall_type type) +{ + if (libcall_types[type]) + return libcall_types[type]; + + if (type == LCT_VOID) + libcall_types[type] = void_type_node; + else if (type == LCT_CHAR) + libcall_types[type] = uint32_type_node; + else if (type == LCT_CONSTCHARPTR) + libcall_types[type] = build_pointer_type (build_qualified_type (char_type_node, + TYPE_QUAL_CONST)); + else if (type == LCT_VOIDPTR) + libcall_types[type] = ptr_type_node; + else if (type == LCT_UNISTR) + libcall_types[type] = build_pointer_type (a68_char_type); + else if (type == LCT_UNISTRPTR) + libcall_types[type] = build_pointer_type (build_pointer_type (a68_char_type)); + else if (type == LCT_SIZE) + libcall_types[type] = sizetype; + else if (type == LCT_SSIZE) + libcall_types[type] = ssizetype; + else if (type == LCT_SIZEPTR) + libcall_types[type] = build_pointer_type (sizetype); + else if (type == LCT_UINT) + libcall_types[type] = unsigned_type_node; + else if (type == LCT_INT) + libcall_types[type] = integer_type_node; + else if (type == LCT_LONGLONGINT) + libcall_types[type] = long_long_integer_type_node; + else if (type == LCT_FLOAT) + libcall_types[type] = float_type_node; + else if (type == LCT_DOUBLE) + libcall_types[type] = double_type_node; + else if (type == LCT_LONGDOUBLE) + libcall_types[type] = long_double_type_node; + else + gcc_unreachable (); + + return libcall_types[type]; +} + +/* Build and return a function declaration named NAME. The RETURN_TYPE is the + type returned, FLAGS are the expression call flags, and NPARAMS is the + number of arguments, the types of which are provided in `...'. */ + +static tree +build_libcall_decl (const char *name, a68_libcall_type return_type, + int flags, int nparams, ...) +{ + tree *args = XALLOCAVEC (tree, nparams); + bool varargs = false; + tree fntype; + + /* Add parameter types, using `void' as the last parameter type + to mean this function accepts a variable list of arguments. */ + va_list ap; + va_start (ap, nparams); + + for (int i = 0; i < nparams; i++) + { + a68_libcall_type ptype = (a68_libcall_type) va_arg (ap, int); + tree type = get_libcall_type (ptype); + + if (type == void_type_node) + { + varargs = true; + nparams = i; + } + else + args[i] = type; + } + + va_end (ap); + + /* Build the function. */ + tree tret = get_libcall_type (return_type); + if (varargs) + fntype = build_varargs_function_type_array (tret, nparams, args); + else + fntype = build_function_type_array (tret, nparams, args); + + tree decl = build_decl (UNKNOWN_LOCATION, FUNCTION_DECL, + get_identifier (name), fntype); + DECL_EXTERNAL (decl) = 1; + TREE_PUBLIC (decl) = 1; + DECL_ARTIFICIAL (decl) = 1; + DECL_VISIBILITY (decl) = VISIBILITY_DEFAULT; + DECL_VISIBILITY_SPECIFIED (decl) = 1; + + /* Set any attributes on the function, such as malloc or noreturn. */ + set_call_expr_flags (decl, flags); + return decl; +} + +/* Return or create the runtime library function declaration for LIBCALL. + Library functions are generated as needed. This could probably be changed + in the future to be done in the compiler init stage, like GCC builtin trees + are. */ + +tree +a68_get_libcall (a68_libcall_fn libcall) +{ + if (libcall_decls[libcall]) + return libcall_decls[libcall]; + + switch (libcall) + { +#define DEF_A68_RUNTIME(CODE, NAME, TYPE, PARAMS, FLAGS) \ + case A68_LIBCALL_ ## CODE: \ + libcall_decls[libcall] = build_libcall_decl (NAME, TYPE, FLAGS, PARAMS); \ + break; +#include "a68-low-runtime.def" +#undef DEF_A68_RUNTIME + default: + gcc_unreachable (); + } + + return libcall_decls[libcall]; +} + +/* Generate a call to LIBCALL, returning the result as TYPE. NARGS is the + number of call arguments, the expressions of which are provided in `...'. + This does not perform conversions or promotions on the arguments. */ + +tree +a68_build_libcall (a68_libcall_fn libcall, tree type ATTRIBUTE_UNUSED, + int nargs, ...) +{ + /* Build the call expression to the runtime function. */ + tree decl = a68_get_libcall (libcall); + tree *args = XALLOCAVEC (tree, nargs); + va_list ap; + + va_start (ap, nargs); + for (int i = 0; i < nargs; i++) + args[i] = va_arg (ap, tree); + va_end (ap); + + tree result = build_call_expr_loc_array (input_location, decl, nargs, args); + + /* Assumes caller knows what it is doing. */ + return result; +} diff --git a/gcc/algol68/a68-low-runtime.def b/gcc/algol68/a68-low-runtime.def new file mode 100644 index 000000000000..04cca03ca51b --- /dev/null +++ b/gcc/algol68/a68-low-runtime.def @@ -0,0 +1,92 @@ +/* a68-low-runtime.def -- Definitions for Algol 68 runtime functions. + Copyright (C) 2025 Jose E. Marchesi. + +GCC is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +GCC is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GCC; see the file COPYING3. If not see +. */ + +/* Helper macros for parameter building. */ +#define P0() 0 +#define P1(T1) 1, LCT_ ## T1 +#define P2(T1, T2) \ + 2, LCT_ ## T1, LCT_ ## T2 +#define P3(T1, T2, T3) \ + 3, LCT_ ## T1, LCT_ ## T2, LCT_ ## T3 +#define P4(T1, T2, T3, T4) \ + 4, LCT_ ## T1, LCT_ ## T2, LCT_ ## T3, LCT_ ## T4 +#define P5(T1, T2, T3, T4, T5) \ + 5, LCT_ ## T1, LCT_ ## T2, LCT_ ## T3, LCT_ ## T4, LCT_ ## T5 +#define P6(T1, T2, T3, T4, T5, T6) \ + 6, LCT_ ## T1, LCT_ ## T2, LCT_ ## T3, LCT_ ## T4, LCT_ ## T5, LCT_ ## T6 +#define P7(T1, T2, T3, T4, T5, T6, T7) \ + 7, LCT_ ## T1, LCT_ ## T2, LCT_ ## T3, LCT_ ## T4, LCT_ ## T5, LCT_ ## T6, LCT_ ## T7 +#define RT(T1) LCT_ ## T1 + +/* Algol 68 runtime library functions. */ + +/* DEF_A68_RUNTIME (CODE, NAME, TYPE, PARAMS, FLAGS) + CODE The enum code used to refer to this function. + NAME The name of this function as a string. + FLAGS ECF flags to describe attributes of the function. + + Used for declaring functions that are called by generated code. */ + +DEF_A68_RUNTIME (ASSERT, "_libga68_assert", RT(VOID), P2(CONSTCHARPTR, UINT), ECF_NORETURN) +DEF_A68_RUNTIME (SET_EXIT_STATUS, "_libga68_set_exit_status", RT(VOID), P1(INT), 0) +DEF_A68_RUNTIME (MALLOC, "_libga68_malloc", RT(VOIDPTR), P1(SIZE), ECF_NOTHROW | ECF_LEAF | ECF_MALLOC) +DEF_A68_RUNTIME (DEREFNIL, "_libga68_derefnil", RT(VOID), P2(CONSTCHARPTR, UINT), ECF_NORETURN) +DEF_A68_RUNTIME (UNREACHABLE, "_libga68_unreachable", RT(VOID), P2(CONSTCHARPTR, UINT), ECF_NORETURN) +DEF_A68_RUNTIME (INVALIDCHARERROR, "_libga68_invalidcharerror", RT(VOID), P3(CONSTCHARPTR,UINT,INT), ECF_NORETURN) +DEF_A68_RUNTIME (BITSBOUNDSERROR, "_libga68_bitsboundserror", RT(VOID), P3(CONSTCHARPTR,UINT,SSIZE), ECF_NORETURN) +DEF_A68_RUNTIME (ARRAYLOWERBOUND, "_libga68_lower_bound", RT(VOID), + P4(CONSTCHARPTR, UINT, SSIZE, SSIZE), ECF_NORETURN) +DEF_A68_RUNTIME (ARRAYUPPERBOUND, "_libga68_upper_bound", RT(VOID), + P4(CONSTCHARPTR, UINT, SSIZE, SSIZE), ECF_NORETURN) +DEF_A68_RUNTIME (ARRAYBOUNDS, "_libga68_bounds", RT(VOID), + P5(CONSTCHARPTR, UINT, SSIZE, SSIZE, SSIZE), ECF_NORETURN) +DEF_A68_RUNTIME (ARRAYBOUNDSMISMATCH, "_libga68_bounds_mismatch", RT(VOID), + P7(CONSTCHARPTR, UINT, SIZE, SSIZE, SSIZE, SSIZE, SSIZE), ECF_NORETURN) +DEF_A68_RUNTIME (ARRAYDIM, "_libga68_dim", RT(VOID), + P4(CONSTCHARPTR, UINT, SIZE, SIZE), ECF_NORETURN) +DEF_A68_RUNTIME (RANDOM, "_libga68_random", RT(FLOAT), P0(), 0) +DEF_A68_RUNTIME (LONGRANDOM, "_libga68_longrandom", RT(DOUBLE), P0(), 0) +DEF_A68_RUNTIME (LONGLONGRANDOM, "_libga68_longlongrandom", RT(LONGDOUBLE), P0(), 0) +DEF_A68_RUNTIME (POSIX_FCONNECT, "_libga68_posixfconnect", RT(INT), P4(UNISTRPTR,SIZE,SIZE,INT), 0) +DEF_A68_RUNTIME (POSIX_FOPEN, "_libga68_posixfopen", RT(INT), P4(UNISTRPTR,SIZE,SIZE,UINT), 0) +DEF_A68_RUNTIME (POSIX_FCREATE, "_libga68_posixcreat", RT(INT), P4(UNISTRPTR,SIZE,SIZE,UINT), 0) +DEF_A68_RUNTIME (POSIX_FCLOSE, "_libga68_posixclose", RT(INT), P0(), 0) +DEF_A68_RUNTIME (POSIX_FSIZE, "_libga68_posixfsize", RT(LONGLONGINT), P1(INT), 0) +DEF_A68_RUNTIME (POSIX_ARGC, "_libga68_posixargc", RT(INT), P0(), 0) +DEF_A68_RUNTIME (POSIX_ARGV, "_libga68_posixargv", RT(UNISTRPTR), P2(INT, SIZEPTR), 0) +DEF_A68_RUNTIME (POSIX_PUTCHAR, "_libga68_posixputchar", RT(CHAR), P1(CHAR), 0) +DEF_A68_RUNTIME (POSIX_FPUTC, "_libga68_posixfputc", RT(CHAR), P2(INT,CHAR), 0) +DEF_A68_RUNTIME (POSIX_PUTS, "_libga68_posixputs", RT(VOID), P3(UNISTR,SIZE,SIZE), 0) +DEF_A68_RUNTIME (POSIX_FPUTS, "_libga68_posixfputs", RT(INT), P4(INT,UNISTRPTR,SIZE,SIZE), 0) +DEF_A68_RUNTIME (POSIX_GETCHAR, "_libga68_posixgetchar", RT(CHAR), P0(), 0) +DEF_A68_RUNTIME (POSIX_FGETC, "_libga68_posixfgetc", RT(CHAR), P1(INT), 0) +DEF_A68_RUNTIME (POSIX_GETS, "_libga68_posixgets", RT(UNISTRPTR), P2(INT,SIZEPTR), 0) +DEF_A68_RUNTIME (POSIX_FGETS, "_libga68_posixfgets", RT(UNISTRPTR), P3(INT,INT,SIZEPTR), 0) +DEF_A68_RUNTIME (POSIX_GETENV, "_libga68_posixgetenv", RT(VOID), P5(UNISTR,SIZE,SIZE,UNISTRPTR,SIZEPTR), 0) +DEF_A68_RUNTIME (POSIX_ERRNO, "_libga68_posixerrno", RT(INT), P0(), 0) +DEF_A68_RUNTIME (POSIX_PERROR, "_libga68_posixperror", RT(VOID), P3(UNISTR,SIZE,SIZE), 0) +DEF_A68_RUNTIME (POSIX_STRERROR, "_libga68_posixstrerror", RT(UNISTRPTR), P2(INT, SIZEPTR), 0) +DEF_A68_RUNTIME (POSIX_LSEEK, "_libga68_posixlseek", RT(LONGLONGINT), P3(INT,LONGLONGINT,INT), 0) +DEF_A68_RUNTIME (U32_CMP2, "_libga68_u32_cmp2", RT(INT), P6(UNISTR, SIZE, SIZE, UNISTR, SIZE, SIZE), 0) + +#undef P0 +#undef P1 +#undef P2 +#undef P3 +#undef P4 +#undef P5 +#undef RT From a520f145947fbd5e89b48966080fa98d0532f27b Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:53:33 +0200 Subject: [PATCH 170/373] a68: low: builtins Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-low-builtins.cc: New file. --- gcc/algol68/a68-low-builtins.cc | 533 ++++++++++++++++++++++++++++++++ 1 file changed, 533 insertions(+) create mode 100644 gcc/algol68/a68-low-builtins.cc diff --git a/gcc/algol68/a68-low-builtins.cc b/gcc/algol68/a68-low-builtins.cc new file mode 100644 index 000000000000..eabf7b348359 --- /dev/null +++ b/gcc/algol68/a68-low-builtins.cc @@ -0,0 +1,533 @@ +/* GCC built-ins support for Algol 68. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Define a built-in function. */ + +static void +local_define_builtin (const char *name, tree type, enum built_in_function code, + const char *library_name, int ecf_flags) +{ + tree decl; + + decl = add_builtin_function (name, type, code, BUILT_IN_NORMAL, + library_name, NULL_TREE); + set_call_expr_flags (decl, ecf_flags); + set_builtin_decl (code, decl, true); +} + +/* Install the GCC built-ins so the front-end can use them. */ + +void +a68_install_builtins (void) +{ + if (!builtin_decl_explicit_p (BUILT_IN_IROUNDF)) + { + tree ftype = build_function_type_list (integer_type_node, + float_type_node, + NULL_TREE); + local_define_builtin ("__builtin_iroundf", ftype, BUILT_IN_IROUNDF, + "iroundf", ECF_CONST | ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LROUNDF)) + { + tree ftype = build_function_type_list (long_integer_type_node, + float_type_node, + NULL_TREE); + local_define_builtin ("__builtin_lroundf", ftype, BUILT_IN_LROUNDF, + "lroundf", ECF_CONST | ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LLROUNDF)) + { + tree ftype = build_function_type_list (long_long_integer_type_node, + float_type_node, + NULL_TREE); + local_define_builtin ("__builtin_llroundf", ftype, BUILT_IN_LLROUNDF, + "llroundf", ECF_CONST | ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_IROUND)) + { + tree ftype = build_function_type_list (integer_type_node, + double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_iround", ftype, BUILT_IN_IROUND, + "iround", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LROUND)) + { + tree ftype = build_function_type_list (long_integer_type_node, + double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_lround", ftype, BUILT_IN_LROUND, + "lround", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LLROUND)) + { + tree ftype = build_function_type_list (long_long_integer_type_node, + double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_llround", ftype, BUILT_IN_LLROUND, + "llround", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_IROUNDL)) + { + tree ftype = build_function_type_list (integer_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_iroundl", ftype, BUILT_IN_IROUNDL, + "iroundl", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LROUNDL)) + { + tree ftype = build_function_type_list (long_integer_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_lroundl", ftype, BUILT_IN_LROUNDL, + "lroundl", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LLROUNDL)) + { + tree ftype = build_function_type_list (long_long_integer_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_llroundl", ftype, BUILT_IN_LLROUNDL, + "llroundl", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_IFLOORF)) + { + tree ftype = build_function_type_list (integer_type_node, + float_type_node, + NULL_TREE); + local_define_builtin ("__builtin_ifloorf", ftype, BUILT_IN_IFLOORF, + "ifloorf", ECF_CONST | ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LFLOORF)) + { + tree ftype = build_function_type_list (long_integer_type_node, + float_type_node, + NULL_TREE); + local_define_builtin ("__builtin_lfloorf", ftype, BUILT_IN_LFLOORF, + "lfloorf", ECF_CONST | ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LLFLOORF)) + { + tree ftype = build_function_type_list (long_long_integer_type_node, + float_type_node, + NULL_TREE); + local_define_builtin ("__builtin_llfloorf", ftype, BUILT_IN_LLFLOORF, + "llfloorf", ECF_CONST | ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_IFLOOR)) + { + tree ftype = build_function_type_list (integer_type_node, + double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_ifloor", ftype, BUILT_IN_IFLOOR, + "ifloor", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LFLOOR)) + { + tree ftype = build_function_type_list (long_integer_type_node, + double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_lfloor", ftype, BUILT_IN_LFLOOR, + "lfloor", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LLFLOOR)) + { + tree ftype = build_function_type_list (long_long_integer_type_node, + double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_llfloor", ftype, BUILT_IN_LLFLOOR, + "llfloor", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_IFLOORL)) + { + tree ftype = build_function_type_list (integer_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_ifloorl", ftype, BUILT_IN_IFLOORL, + "ifloorl", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LFLOORL)) + { + tree ftype = build_function_type_list (long_integer_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_lfloorl", ftype, BUILT_IN_LFLOORL, + "lfloorl", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LLFLOORL)) + { + tree ftype = build_function_type_list (long_long_integer_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_llfloorl", ftype, BUILT_IN_LLFLOORL, + "llfloorl", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_POWF)) + { + tree ftype = build_function_type_list (float_type_node, + float_type_node, float_type_node, + NULL_TREE); + local_define_builtin ("__builtin_powf", ftype, BUILT_IN_POWF, + "powf", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_POWIF)) + { + tree ftype = build_function_type_list (float_type_node, + float_type_node, integer_type_node, + NULL_TREE); + local_define_builtin ("__builtin_powif", ftype, BUILT_IN_POWIF, + "powif", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_POW)) + { + tree ftype = build_function_type_list (double_type_node, + double_type_node, double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_pow", ftype, BUILT_IN_POW, + "pow", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_POWI)) + { + tree ftype = build_function_type_list (double_type_node, + double_type_node, integer_type_node, + NULL_TREE); + local_define_builtin ("__builtin_powi", ftype, BUILT_IN_POWI, + "powi", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_POWL)) + { + tree ftype = build_function_type_list (long_double_type_node, + long_double_type_node, long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_powl", ftype, BUILT_IN_POWL, + "powl", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_POWIL)) + { + tree ftype = build_function_type_list (long_double_type_node, + long_double_type_node, integer_type_node, + NULL_TREE); + local_define_builtin ("__builtin_powil", ftype, BUILT_IN_POWIL, + "powil", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_CALLOC)) + { + tree ftype = build_function_type_list (ptr_type_node, + size_type_node, size_type_node, NULL_TREE); + local_define_builtin ("__builtin_calloc", ftype, BUILT_IN_CALLOC, + "calloc", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_MEMCPY)) + { + tree ftype = build_function_type_list (ptr_type_node, + ptr_type_node, const_ptr_type_node, size_type_node, + NULL_TREE); + local_define_builtin ("__builtin_memcpy", ftype, BUILT_IN_MEMSET, + "memcpy", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_MEMSET)) + { + tree ftype = build_function_type_list (ptr_type_node, + ptr_type_node, integer_type_node, size_type_node, + NULL_TREE); + local_define_builtin ("__builtin_memset", ftype, BUILT_IN_MEMSET, + "memset", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_SQRTF)) + { + tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE); + local_define_builtin ("__builtin_sqrtf", ftype, BUILT_IN_SQRTF, + "sqrtf", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_SQRT)) + { + tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE); + local_define_builtin ("__builtin_sqrt", ftype, BUILT_IN_SQRT, + "sqrt", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_SQRTL)) + { + tree ftype = build_function_type_list (long_double_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_sqrtl", ftype, BUILT_IN_SQRTL, + "sqrtl", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_TANF)) + { + tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE); + local_define_builtin ("__builtin_tanf", ftype, BUILT_IN_TANF, + "tanf", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_TAN)) + { + tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE); + local_define_builtin ("__builtin_tan", ftype, BUILT_IN_TAN, + "tan", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_TANL)) + { + tree ftype = build_function_type_list (long_double_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_tanl", ftype, BUILT_IN_TANL, + "tanl", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_SINF)) + { + tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE); + local_define_builtin ("__builtin_sinf", ftype, BUILT_IN_SINF, + "sinf", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_SIN)) + { + tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE); + local_define_builtin ("__builtin_sin", ftype, BUILT_IN_SIN, + "sin", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_SINL)) + { + tree ftype = build_function_type_list (long_double_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_sinl", ftype, BUILT_IN_SINL, + "sinl", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_COSF)) + { + tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE); + local_define_builtin ("__builtin_cosf", ftype, BUILT_IN_COSF, + "cosf", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_COS)) + { + tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE); + local_define_builtin ("__builtin_cos", ftype, BUILT_IN_COS, + "cos", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_COSL)) + { + tree ftype = build_function_type_list (long_double_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_cosl", ftype, BUILT_IN_COSL, + "cosl", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_ACOSF)) + { + tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE); + local_define_builtin ("__builtin_acosf", ftype, BUILT_IN_ACOSF, + "acosf", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_ACOS)) + { + tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE); + local_define_builtin ("__builtin_acos", ftype, BUILT_IN_ACOS, + "acos", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_ACOSL)) + { + tree ftype = build_function_type_list (long_double_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_acosl", ftype, BUILT_IN_ACOSL, + "acosl", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_ASINF)) + { + tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE); + local_define_builtin ("__builtin_asinf", ftype, BUILT_IN_ASINF, + "asinf", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_ASIN)) + { + tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE); + local_define_builtin ("__builtin_asin", ftype, BUILT_IN_ASIN, + "asin", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_ASINL)) + { + tree ftype = build_function_type_list (long_double_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_asinl", ftype, BUILT_IN_ASINL, + "asinl", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_ATANF)) + { + tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE); + local_define_builtin ("__builtin_atanf", ftype, BUILT_IN_ATANF, + "atanf", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_ATAN)) + { + tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE); + local_define_builtin ("__builtin_atan", ftype, BUILT_IN_ATAN, + "atan", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_ATANL)) + { + tree ftype = build_function_type_list (long_double_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_atanl", ftype, BUILT_IN_ATANL, + "atanl", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LOGF)) + { + tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE); + local_define_builtin ("__builtin_logf", ftype, BUILT_IN_LOGF, + "logf", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LOG)) + { + tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE); + local_define_builtin ("__builtin_log", ftype, BUILT_IN_LOG, + "log", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LOGL)) + { + tree ftype = build_function_type_list (long_double_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_logl", ftype, BUILT_IN_LOGL, + "logl", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LOG10F)) + { + tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE); + local_define_builtin ("__builtin_log10f", ftype, BUILT_IN_LOG10F, + "log10f", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LOG10)) + { + tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE); + local_define_builtin ("__builtin_log10", ftype, BUILT_IN_LOG10, + "log10", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_LOG10L)) + { + tree ftype = build_function_type_list (long_double_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_log10l", ftype, BUILT_IN_LOG10L, + "log10l", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_EXPF)) + { + tree ftype = build_function_type_list (float_type_node, float_type_node, NULL_TREE); + local_define_builtin ("__builtin_expf", ftype, BUILT_IN_EXPF, + "expf", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_EXP)) + { + tree ftype = build_function_type_list (double_type_node, double_type_node, NULL_TREE); + local_define_builtin ("__builtin_exp", ftype, BUILT_IN_EXP, + "exp", ECF_NOTHROW | ECF_LEAF); + } + + if (!builtin_decl_explicit_p (BUILT_IN_EXPL)) + { + tree ftype = build_function_type_list (long_double_type_node, + long_double_type_node, + NULL_TREE); + local_define_builtin ("__builtin_expl", ftype, BUILT_IN_EXPL, + "expl", ECF_NOTHROW | ECF_LEAF); + } +} From dc2759b1a924a3365558b9e71da3d9e0c678bd74 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:53:49 +0200 Subject: [PATCH 171/373] a68: low: ranges Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-low-ranges.cc: New file. --- gcc/algol68/a68-low-ranges.cc | 699 ++++++++++++++++++++++++++++++++++ 1 file changed, 699 insertions(+) create mode 100644 gcc/algol68/a68-low-ranges.cc diff --git a/gcc/algol68/a68-low-ranges.cc b/gcc/algol68/a68-low-ranges.cc new file mode 100644 index 000000000000..9a2008aa571b --- /dev/null +++ b/gcc/algol68/a68-low-ranges.cc @@ -0,0 +1,699 @@ +/* Management of ranges in the Algol 68 front-end. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" +#include "tree-nested.h" + +#include "a68.h" + +/* Many Algol 68 constructions introduce a new range of definitions. This is + the case of clauses and of routine definitions. The stack of ranges at any + point in the program determines the "nest" of the constructions declared in + the program. This nest carries a record of all the declarations forming the + environment in which that construct is to be interpreted. + + This file contains a manager of ranges of which we allocate one for each + range inducing construct. The top-level range corresponds to the primal + environment. + + The ranges are used by the lowering code in order to create GCC tree BLOCK + nodes, and also to keep track of the set of declarations and of statements + being added by the current serial clause. */ + +struct GTY (()) range +{ + /* Whether this range entry doesn't introduce a lexical frame. Declarations + and decl_exprs get added to the nearst enclosing range that is not + frameless. */ + bool frameless; + + /* A chain of _DECL nodes for all variables, constants, functions, + and typedef types. These are in the reverse of the order supplied. */ + tree names; + + /* A statements list of DECL_EXPR nodes for all the declarations in the + range. These are prepended to the statements list when the range is + closed. */ + tree decl_exprs; + + /* The context of the range, either a function declaration or a translation + unit. */ + tree context; + + /* The range below this one. */ + struct range *next; + + /* Statement list. */ + tree stmt_list; + + /* List of blocks to which the block created for this range is the + superblock. */ + tree blocks; + + /* Mode associated with the range. For serial clauses, this is the mode of + the value yielded by the clause. */ + MOID_T *mode; + + /* If not TREE_NULL, then the range corresponds to a function, which can be + either nested or defined at top-level. */ + tree fndecl; + bool top_level_function; + + /* The following fields are used by ranges introduced by serial + clauses. */ + bool save_restore_stack; + bool has_completers; + tree clause_result_decl; + tree clause_exit_label_decl; + tree clause_stack_save_decl; +}; + +/* Global and current ranges. */ + +static GTY (()) struct range *global_range; +static GTY (()) struct range *current_range; + +/* Create a new range and push it in the list. */ + +static struct range * +new_range (void) +{ + struct range *range = ggc_alloc (); + + range->frameless = false; + range->names = NULL; + range->decl_exprs = alloc_stmt_list (); + range->context = NULL; + range->next = NULL; + range->blocks = NULL_TREE; + range->stmt_list = alloc_stmt_list (); + range->fndecl = NULL_TREE; + range->top_level_function = false; + range->save_restore_stack = false; + range->has_completers = false; + range->clause_result_decl = NULL_TREE; + range->clause_exit_label_decl = NULL_TREE; + range->clause_stack_save_decl = NULL_TREE; + range->mode = NO_MOID; + return range; +} + +/* Push a new frameless range. */ + +void +a68_push_stmt_list (MOID_T *mode) +{ + a68_push_range (mode); + current_range->frameless = true; +} + +/* Pop a frameless range. */ + +tree +a68_pop_stmt_list (void) +{ + /* This will result into a stmt list. */ + tree res = a68_pop_range (); + gcc_assert (TREE_CODE (res) == STATEMENT_LIST); + return res; +} + +/* Push a new range. */ + +void +a68_push_range (MOID_T *mode) +{ + struct range *range = new_range (); + if (current_range) + range->context = current_range->context; + range->next = current_range; + range->mode = mode; + current_range = range; +} + +/* Pop a range, with a finalizer. + + Return a BIND_EXPR, a statement list or a TRY_FINALLY_EXPR. */ + +tree +a68_pop_range_with_finalizer (tree finalizer) +{ + tree range = a68_pop_range (); + return fold_build2 (TRY_FINALLY_EXPR, TREE_TYPE (range), + range, finalizer); +} + +/* Pop a range. Return either a BIND_EXPR or a statements list. */ + +tree +a68_pop_range (void) +{ + struct range *range = current_range; + current_range = range->next; + tree type = (range->mode == NULL ? void_type_node : CTYPE (range->mode)); + + /* If TYPE is a pointer type and the last expression in the statement list is + a variable of the type pointed by TYPE then take its address. */ + tree_stmt_iterator i = tsi_last (range->stmt_list); + if (POINTER_TYPE_P (type) && TREE_TYPE (type) == TREE_TYPE (tsi_stmt (i))) + { + append_to_statement_list_force (a68_consolidate_ref (range->mode, tsi_stmt (i)), + &range->stmt_list); + tsi_delink (&i); + } + + tree clause = NULL_TREE; + if (range->frameless) + clause = range->stmt_list; + else + { + /* Create a block and set its declarations and supercontext. */ + tree block = make_node (BLOCK); + BLOCK_VARS (block) = range->names; + BLOCK_SUBBLOCKS (block) = range->blocks; + + /* In each subblock, record that this is its superior. */ + for (tree t = range->blocks; t; t = BLOCK_CHAIN (t)) + BLOCK_SUPERCONTEXT (t) = block; + + if (range->fndecl) + { + BLOCK_SUPERCONTEXT (block) = range->fndecl; + DECL_INITIAL (range->fndecl) = block; + } + else + { + current_range->blocks + = block_chainon (current_range->blocks, block); + } + + TREE_USED (block) = true; + + /* Create a BIND if the range contains declarations. Otherwise just + use the statements list. */ + clause = range->stmt_list; + if (range->names != NULL_TREE) + { + clause = build3 (BIND_EXPR, + type, + range->names, + range->stmt_list, + block); + TREE_SIDE_EFFECTS (clause) = 1; + BIND_EXPR_VARS (clause) = BLOCK_VARS (block); + } + + /* Prepend the decl_exprs to the range's statements list. */ + tree_stmt_iterator q = tsi_start (range->stmt_list); + tsi_link_before (&q, range->decl_exprs, TSI_SAME_STMT); + } + + /* Set the type of the stmt_list. */ + TREE_TYPE (range->stmt_list) = type; + TREE_SIDE_EFFECTS (range->stmt_list) = 1; + + return clause; +} + +/* Add a new expression to the current range. */ + +void +a68_add_stmt (tree exp) +{ + if (exp == void_node) + /* This may result from a mode declaration. */ + return; + gcc_assert (current_range != NULL); + append_to_statement_list_force (exp, + ¤t_range->stmt_list); +} + +/* Add a new declaration to the current range. */ + +void +a68_add_decl (tree decl) +{ + gcc_assert (current_range != NULL); + struct range *range = current_range; + + /* Search for the right frame where to add the declaration. */ + while (range->frameless) + { + gcc_assert (range->next != NULL); + range = range->next; + } + + tree n = range->names; + while (n != decl && n != NULL) + n = TREE_CHAIN (n); + if (n != decl) + { + if (decl != current_function_decl) + DECL_CONTEXT (decl) = range->context; + /* Note this list needs to be in reverse order for compatibility with + GCC. */ + TREE_CHAIN (decl) = range->names; + range->names = decl; + } +} + +/* Add a new declaration expr to the current range. */ + +void +a68_add_decl_expr (tree decl_expr) +{ + gcc_assert (current_range != NULL); + struct range *range = current_range; + + /* Search for the right frame where to add the declaration expr. */ + while (range->frameless) + { + gcc_assert (range->next != NULL); + range = range->next; + } + + append_to_statement_list_force (decl_expr, &range->decl_exprs); +} + +/* Add a completer in the current range. */ + +void +a68_add_completer (void) +{ + struct range *range = current_range; + + /* The last statement in the statements list is either a single unit or a + labeled unit, i.e a COMPOUND_EXPR whose first expression is a label and + second expression is the unit. Consolidate the unit within the labeled + unit to a ref. */ + tree_stmt_iterator i = tsi_last (range->stmt_list); + tree last_expr = tsi_stmt (i); + + if (TREE_CODE (last_expr) == COMPOUND_EXPR + && TREE_CODE (TREE_OPERAND (last_expr, 0)) == LABEL_EXPR) + { + TREE_OPERAND (last_expr, 1) = a68_consolidate_ref (range->mode, + TREE_OPERAND (last_expr, 1)); + TREE_TYPE (last_expr) = TREE_TYPE (TREE_OPERAND (last_expr, 1)); + } + else + last_expr = a68_consolidate_ref (range->mode, last_expr); + + /* Now assign the labeled unit to the clause result decl then jump to the end + of the serial clause. */ + append_to_statement_list_force (fold_build2 (MODIFY_EXPR, + void_type_node, + range->clause_result_decl, + last_expr), + &range->stmt_list); + tsi_delink (&i); + append_to_statement_list_force (fold_build1 (GOTO_EXPR, void_type_node, + range->clause_exit_label_decl), + &range->stmt_list); + range->has_completers = true; +} + +/* Get the context of the current range. */ + +tree +a68_range_context (void) +{ + gcc_assert (current_range != NULL); + return current_range->context; +} + +/* Get the list of declarations in the current range. */ + +tree +a68_range_names (void) +{ + struct range *range = current_range; + + while (range->frameless && range->next != NULL) + range = range->next; + + if (range != NULL) + return range->names; + else + return NULL_TREE; +} + +/* Get the statements list of the current range. */ + +tree +a68_range_stmt_list (void) +{ + gcc_assert (current_range != NULL); + return current_range->stmt_list; +} + +/* Push a range for a function. */ + +void +a68_push_function_range (tree fndecl, tree result_type, + bool top_level) +{ + a68_push_range (NULL /* VOID */); + current_range->fndecl = fndecl; + current_range->top_level_function = top_level; + current_range->context = fndecl; + + /* Setup the result declaration. */ + tree resdecl = build_decl (UNKNOWN_LOCATION, + RESULT_DECL, + get_identifier ("resdecl%"), + result_type); + DECL_ARTIFICIAL (resdecl) = 1; + DECL_IGNORED_P (resdecl) = 1; + DECL_CONTEXT (resdecl) = fndecl; + DECL_RESULT (fndecl) = resdecl; + rest_of_decl_compilation (fndecl, 1, 0); + make_decl_rtl (fndecl); + allocate_struct_function (fndecl, false); + + /* Let GCC know the current scope is this function. */ + current_function_decl = fndecl; +} + +/* Pop a range for a function. */ + +void +a68_pop_function_range (tree body) +{ + tree fndecl = current_range->fndecl; + bool top_level = current_range->top_level_function; + + if (TREE_TYPE (DECL_RESULT (fndecl)) == void_type_node) + { + a68_add_stmt (body); + } + else + { + /* Append the return statement. + Note that this does the copy of the returned value. */ + tree return_stmt = fold_build1 (RETURN_EXPR, + void_type_node, + fold_build2 (MODIFY_EXPR, + TREE_TYPE (DECL_RESULT (fndecl)), + DECL_RESULT (fndecl), + a68_low_dup (body, true /* use_heap */))); + a68_add_stmt (return_stmt); + } + + /* Set the body of the function. */ + DECL_SAVED_TREE (fndecl) = a68_pop_range (); + + /* Output the GENERIC tree for the function.. */ + dump_function (TDI_original, fndecl); + /* This compiles the function all the way to assembler language output. + Nested functions are finalized when the containing top-level function is + finalized. */ + if (top_level || a68_in_global_range ()) + cgraph_node::finalize_function (fndecl, true); + else + /* Register this function with cgraph just far enough to get it added to + our parent's nested function list. */ + (void) cgraph_node::get_create (fndecl); + + /* Let GCC know the current scope has changed. */ + current_function_decl = NULL_TREE; + for (struct range *r = current_range; r; r = r->next) + { + if (r->fndecl != NULL_TREE) + current_function_decl = r->fndecl; + } +} + +/* Push a range for a serial clause. + + label1: BIND_EXPR_BODY (STATEMENT_LIST ( + expr1; label1, + expr2 expr1, + exit label2: clause_result = expr2, + expr3; goto exit_label, + expr4 label2, + exit label3: expr3, + expr5 clause_result = expr4, + goto exit_label, + label3, + clause_result = expr5, + exit_label, + clause_result)) */ + +void +a68_push_serial_clause_range (MOID_T *clause_mode, + bool save_restore_stack) +{ + /* Get the type of the enclosing clause. */ + tree clause_type = CTYPE (clause_mode); + + /* If the serial clause has declarations that involve dynamic allocation, and + the environ it establishes is local, then save the stack pointer. */ + if (save_restore_stack) + { + a68_push_range (clause_mode); + current_range->save_restore_stack = true; + + tree outer_clause_result_decl = build_decl (UNKNOWN_LOCATION, + VAR_DECL, + NULL, /* Set below. */ + clause_type); + char *outer_clause_result_name = xasprintf ("outer_clause_result%d%%", + DECL_UID (outer_clause_result_decl)); + DECL_NAME (outer_clause_result_decl) = get_identifier (outer_clause_result_name); + free (outer_clause_result_name); + current_range->clause_result_decl = outer_clause_result_decl; + a68_add_decl (outer_clause_result_decl); + + /* Variable used to save the stack pointer. */ + tree stack_save_decl = build_decl (UNKNOWN_LOCATION, + VAR_DECL, + get_identifier ("stack_save%"), + build_pointer_type (char_type_node)); + current_range->clause_stack_save_decl = stack_save_decl; + a68_add_decl (stack_save_decl); + a68_add_stmt (fold_build1 (DECL_EXPR, + TREE_TYPE (stack_save_decl), + stack_save_decl)); + + /* Save stack pointer. */ + tree call = builtin_decl_implicit (BUILT_IN_STACK_SAVE); + call = build_call_expr_loc (UNKNOWN_LOCATION, call, 0); + a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node, + stack_save_decl, call)); + } + + /* Push a new range. */ + a68_push_range (clause_mode); + current_range->save_restore_stack = save_restore_stack; + + /* Create a decl for clause_result with the right type and add it to the + block's declaration list. */ + tree clause_result_decl = build_decl (UNKNOWN_LOCATION, + VAR_DECL, + NULL, /* Set below. */ + clause_type); + char *clause_result_name = xasprintf ("clause_result%d%%", DECL_UID (clause_result_decl)); + DECL_NAME (clause_result_decl) = get_identifier (clause_result_name); + // free (clause_result_name); + DECL_INITIAL (clause_result_decl) = a68_get_skip_tree (clause_mode); + DECL_CONTEXT (clause_result_decl) = current_range->context; + current_range->clause_result_decl = clause_result_decl; + + /* Create a decl for the clause's exit label. */ + tree clause_exit_label_decl = build_decl (UNKNOWN_LOCATION, + LABEL_DECL, + NULL, /* Set below. */ + void_type_node); + char *exit_label_name = xasprintf ("clause_exit_label%d%%", DECL_UID (clause_exit_label_decl)); + DECL_NAME (clause_exit_label_decl) = get_identifier (exit_label_name); + free (exit_label_name); + DECL_CONTEXT (clause_exit_label_decl) = current_range->context; + current_range->clause_exit_label_decl = clause_exit_label_decl; +} + +/* Pop a range for a serial clause and return the resulting bind + expression. */ + +tree +a68_pop_serial_clause_range (void) +{ + struct range *range = current_range; + MOID_T *clause_mode = range->mode; + tree clause_type = CTYPE (clause_mode); + + /* The last expression in the statements list is either a single unit or a + labeled unit. Consolidate it to a ref if required by the mode of the + serial clause. */ + { + tree_stmt_iterator si = tsi_last (range->stmt_list); + tree last_expr = tsi_stmt (si); + if (TREE_CODE (last_expr) == COMPOUND_EXPR + && TREE_CODE (TREE_OPERAND (last_expr, 0)) == LABEL_EXPR) + { + TREE_OPERAND (last_expr, 1) = a68_consolidate_ref (range->mode, + TREE_OPERAND (last_expr, 1)); + TREE_TYPE (last_expr) = TREE_TYPE (TREE_OPERAND (last_expr, 1)); + } + else + last_expr = a68_consolidate_ref (range->mode, last_expr); + a68_add_stmt (last_expr); + tsi_delink (&si); + } + + /* If the serial clause has completers, we have to make use of the + clause_result% and clause_exit_label% mechanism to assure the statements + list has a single exit at the end. */ + if (range->has_completers) + { + /* First prepend EXPR_DECL expressions for clause_result% and + clause_exit_label% */ + { + tree_stmt_iterator si = tsi_start (range->stmt_list); + tsi_link_before (&si, + fold_build1 (DECL_EXPR, + TREE_TYPE (range->clause_result_decl), + range->clause_result_decl), + TSI_CONTINUE_LINKING); + tsi_link_before (&si, + fold_build1 (DECL_EXPR, + TREE_TYPE (range->clause_exit_label_decl), + range->clause_exit_label_decl), + TSI_CONTINUE_LINKING); + } + + /* Then turn the last expression in stmt_list to an assignment to + clause_result_decl%, but don't bother if it has been voided. */ + if (clause_type != a68_void_type) + { + tree_stmt_iterator si = tsi_last (range->stmt_list); + tree last_expr = tsi_stmt (si); + + a68_add_stmt (build2 (MODIFY_EXPR, + clause_type, + range->clause_result_decl, + last_expr)); + tsi_delink (&si); + } + + a68_add_decl (range->clause_result_decl); + a68_add_decl (range->clause_exit_label_decl); + + /* Finally append the exit label and last expression with + result_decl. */ + a68_add_stmt (build1 (LABEL_EXPR, void_type_node, range->clause_exit_label_decl)); + a68_add_stmt (build1 (NON_LVALUE_EXPR, clause_type, range->clause_result_decl)); + } + + /* Check that the type of the last statement in the statements list is the + same than the type corresponding to the clause mode. */ + { + tree_stmt_iterator si = tsi_last (range->stmt_list); + if (TREE_TYPE (tsi_stmt (si)) != clause_type + /* But NIL can appear in a context expecting VOID with no widening. */ + && !(clause_type == a68_void_type + && POINTER_TYPE_P (TREE_TYPE (tsi_stmt (si))) + && TREE_CODE (tsi_stmt (si)) == INTEGER_CST + && tree_to_shwi (tsi_stmt (si)) == 0) + /* And any row type is valid when M_ROWS is expected. */ + && !(A68_ROWS_TYPE_P (clause_type) + && A68_ROWS_TYPE_P (TREE_TYPE (tsi_stmt (si)))) + /* Do not rely on comparing pointer types, as the equality fails in + that case. We need a better way of comparing types, either using + TYPE_CANONICAL or caching. */ + && !(POINTER_TYPE_P (TREE_TYPE (tsi_stmt (si))) && POINTER_TYPE_P (clause_type))) + { + printf ("last statement:\n"); + debug_tree (tsi_stmt (si)); + printf ("expected type:\n"); + debug_tree (clause_type); + gcc_unreachable (); + } + } + + /* If the serial clause has declarations that involve dynamic allocation, and + the environ it establishes is local, then restore the stack pointer. */ + if (range->save_restore_stack) + { + /* Turn last expression of inner clause into a modify statement. This + may involve a copy. This can be omitted if the serial clause yields + void. */ + if (clause_type != a68_void_type) + { + tree_stmt_iterator si = tsi_last (range->stmt_list); + tree last_expr = tsi_stmt (si); + + a68_add_stmt (build2 (MODIFY_EXPR, + clause_type, + range->next->clause_result_decl, + a68_low_dup (last_expr))); + tsi_delink (&si); + } + + /* Finish inner clause, restoring stack pointer on finalizing. */ + tree restore_sp = builtin_decl_implicit (BUILT_IN_STACK_RESTORE); + restore_sp = build_call_expr_loc (UNKNOWN_LOCATION, restore_sp, 1, + current_range->next->clause_stack_save_decl); + a68_add_stmt (a68_pop_range_with_finalizer (restore_sp)); + /* The result value is now in clause_result_decl. */ + a68_add_stmt (build1 (NON_LVALUE_EXPR, clause_type, + current_range->clause_result_decl)); + } + + return a68_pop_range (); +} + +/* Whether the current range is the global range. */ + +bool +a68_in_global_range (void) +{ + return current_range == global_range; +} + +/* Initialize ranges. */ + +void +a68_init_ranges (void) +{ + global_range = new_range (); + global_range->context = build_translation_unit_decl (NULL); + current_range = global_range; +} + +#include "gt-algol68-a68-low-ranges.h" From 85811069bfb1d451fa5956a37868c4b8aeeae259 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:54:10 +0200 Subject: [PATCH 172/373] a68: low: units and coercions Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-low-coercions.cc: New file. * algol68/a68-low-generator.cc: Likewise. * algol68/a68-low-units.cc: Likewise. --- gcc/algol68/a68-low-coercions.cc | 471 +++++++++++ gcc/algol68/a68-low-generator.cc | 533 +++++++++++++ gcc/algol68/a68-low-units.cc | 1253 ++++++++++++++++++++++++++++++ 3 files changed, 2257 insertions(+) create mode 100644 gcc/algol68/a68-low-coercions.cc create mode 100644 gcc/algol68/a68-low-generator.cc create mode 100644 gcc/algol68/a68-low-units.cc diff --git a/gcc/algol68/a68-low-coercions.cc b/gcc/algol68/a68-low-coercions.cc new file mode 100644 index 000000000000..b9e1acee9ce8 --- /dev/null +++ b/gcc/algol68/a68-low-coercions.cc @@ -0,0 +1,471 @@ +/* Lower Algol 68 coercions to GENERIC. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Lower a dereferencing coercion. */ +tree +a68_lower_dereferencing (NODE_T *p, LOW_CTX_T ctx) +{ + return a68_low_deref (a68_lower_tree (SUB (p), ctx), SUB (p)); +} + +/* Lower an uniting coercion. */ + +tree +a68_lower_uniting (NODE_T *p, LOW_CTX_T ctx) +{ + tree coercend_tree = a68_lower_tree (SUB (p), ctx); + + if (MOID (p) == M_ROWS) + { + /* ROWS is a mode to which any ROW mode can be strongly coerced. It is + used as the mode of the second operand of the ELEMS, LWB and UPB + operators. The coercion is expressed in the parse tree via uniting. + This results in replacing the multiple with a "rows" value that + contains dimension and bounds information. */ + if (A68_ROW_TYPE_P (TREE_TYPE (coercend_tree))) + return a68_rows_value (coercend_tree); + else if (A68_UNION_TYPE_P (TREE_TYPE (coercend_tree))) + { + /* coercend_tree is expanded more than once below. */ + coercend_tree = save_expr (coercend_tree); + + /* Union of row modes. We should create a rows value for the currently + selected value. */ + a68_push_range (M_ROWS); + tree done_label = build_decl (UNKNOWN_LOCATION, + LABEL_DECL, + get_identifier ("done_label%"), + void_type_node); + DECL_CONTEXT (done_label) = a68_range_context (); + a68_add_decl (done_label); + a68_add_decl_expr (fold_build1 (DECL_EXPR, TREE_TYPE (done_label), done_label)); + tree rows = a68_lower_tmpvar ("rows%", CTYPE (M_ROWS), + a68_get_skip_tree (M_ROWS)); + tree coercend_overhead = a68_union_overhead (coercend_tree); + tree overhead = a68_lower_tmpvar ("overhead%", TREE_TYPE (coercend_overhead), + coercend_overhead); + int field_index = 0; + for (tree field = TYPE_FIELDS (TREE_TYPE (a68_union_cunion (coercend_tree))); + field; + field = DECL_CHAIN (field)) + { + a68_push_range (M_VOID); + { + /* Set rows% to the rows value computed from coercend_tree.FIELD, + which is of some multiple type. */ + a68_add_stmt (fold_build2 (MODIFY_EXPR, CTYPE (M_ROWS), + rows, + a68_rows_value (a68_union_alternative (coercend_tree, + field_index)))); + a68_add_stmt (fold_build1 (GOTO_EXPR, void_type_node, done_label)); + a68_add_stmt (a68_get_skip_tree (M_VOID)); + } + tree process_entry = a68_pop_range (); + + /* IF overhead = field_index THEN rows% = rows_from_multiple FI */ + a68_add_stmt (fold_build3 (COND_EXPR, + a68_void_type, + fold_build2 (EQ_EXPR, + TREE_TYPE (overhead), + overhead, + build_int_cst (TREE_TYPE (overhead), field_index)), + process_entry, + a68_get_skip_tree (M_VOID))); + field_index += 1; + } + + /* This should not be reached. Emit run-time error. */ + { + unsigned int lineno = NUMBER (LINE (INFO (p))); + const char *filename_str = FILENAME (LINE (INFO (p))); + tree filename = build_string_literal (strlen (filename_str) + 1, + filename_str); + tree call = a68_build_libcall (A68_LIBCALL_UNREACHABLE, + void_type_node, 2, + filename, + build_int_cst (unsigned_type_node, lineno)); + a68_add_stmt (call); + } + + a68_add_stmt (build1 (LABEL_EXPR, void_type_node, done_label)); + a68_add_stmt (rows); + return a68_pop_range (); + } + else + { + debug_tree (TREE_TYPE (coercend_tree)); + gcc_assert (A68_ROWS_TYPE_P (TREE_TYPE (coercend_tree))); + return coercend_tree; + } + } + else if (IS_UNION (MOID (SUB (p)))) + { + /* We have to extract the value of the coercend union. */ + a68_push_range (MOID (p)); + { + MOID_T *coercend_mode = MOID (SUB (p)); + MOID_T *coercee_mode = MOID (p); + + /* Temporaries for the coercend's components. */ + tree coercend = a68_lower_tmpvar ("coercend%", TREE_TYPE (coercend_tree), coercend_tree); + tree cval = a68_union_cunion (coercend); + tree coverhead = a68_union_overhead (coercend); + tree coercend_value = a68_lower_tmpvar ("coercend_value%", TREE_TYPE (cval), cval); + tree coercend_overhead = a68_lower_tmpvar ("coercend_overhead%", sizetype, coverhead); + + /* Create the coercee. */ + tree coercee = a68_lower_tmpvar ("coercee%", + CTYPE (MOID (p)), + a68_get_skip_tree (MOID (p))); + tree coercee_value = a68_union_cunion (coercee); + + /* First translate overhead. This is crude, but it works. */ + int idx = 0; + tree coercee_overhead = size_zero_node; + while (EQUIVALENT (coercend_mode) != NO_MOID) + coercend_mode = EQUIVALENT (coercend_mode); + for (PACK_T *pack = PACK (coercend_mode); pack != NO_PACK; FORWARD (pack)) + { + coercee_overhead = fold_build3 (COND_EXPR, + sizetype, + fold_build2 (EQ_EXPR, + sizetype, + coercend_overhead, + size_int (idx)), + size_int (a68_united_mode_index (coercee_mode, MOID (pack))), + coercee_overhead); + idx++; + } + a68_add_stmt (a68_union_set_overhead (coercee, coercee_overhead)); + + /* Now copy over the value. This of course relies on the fact the + value of the coercend is smaller or of the same size than the value + of the built union. */ + a68_add_stmt (a68_lower_memcpy (fold_build1 (ADDR_EXPR, + build_pointer_type (TREE_TYPE (coercee_value)), + coercee_value), + fold_build1 (ADDR_EXPR, + build_pointer_type (TREE_TYPE (coercend_value)), + coercend_value), + size_in_bytes (TREE_TYPE (coercend_value)))); + a68_add_stmt (coercee); + } + return a68_pop_range (); + } + else + { + /* Produce a united mode one of whose component modes is the mode of the + coercend. */ + return a68_union_value (MOID (p), coercend_tree, MOID (SUB (p))); + } +} + +/* Lower a rowing coercion. */ + +tree +a68_lower_rowing (NODE_T *p, LOW_CTX_T ctx) +{ + MOID_T *mode = MOID (p); + bool did_deref = false; + + /* If the primary is a REF, we need to dereference it to get the referred + value. */ + tree primary = NULL_TREE; + tree orig_primary = NULL_TREE; + MOID_T *target_mode = NO_MOID; + if (IS_REF (mode)) + { + gcc_assert (IS_REF (MOID (SUB (p)))); + did_deref = true; + target_mode = SUB (mode); + + a68_push_range (mode); + /* Note that we have to consolidate because we need a pointer to compare + to NIL below. */ + orig_primary = a68_lower_tmpvar ("orig_primary%", + CTYPE (MOID (SUB (p))), + a68_consolidate_ref (MOID (SUB (p)), + a68_lower_tree (SUB (p), ctx))); + primary = a68_low_deref (orig_primary, SUB (p)); + } + else + { + target_mode = mode; + primary = a68_lower_tree (SUB (p), ctx); + /* The primary gets expanded more than once below. */ + primary = save_expr (primary); + } + + /* Perform the rowing in the primary. */ + tree ssize_one_node = fold_convert (ssizetype, size_one_node); + tree rowed_primary = NULL_TREE; + if (DIM (DEFLEX (target_mode)) >= 2) + { + /* []A -> [,]A */ + + /* First determine the number of dimensions of the resulting + multiple. */ + tree primary_dimensions = a68_multiple_dimensions (primary); + gcc_assert (TREE_CODE (primary_dimensions) == INTEGER_CST); + int dim = tree_to_shwi (primary_dimensions) + 1; + + /* Compute bounds. */ + tree *lower_bounds = (tree *) xmalloc (sizeof (tree) * dim); + tree *upper_bounds = (tree *) xmalloc (sizeof (tree) * dim); + + lower_bounds[0] = ssize_one_node; + upper_bounds[0] = ssize_one_node; + for (int d = 1; d < dim; ++d) + { + lower_bounds[d] = a68_multiple_lower_bound (primary, ssize_int (d - 1)); + upper_bounds[d] = a68_multiple_upper_bound (primary, ssize_int (d - 1)); + } + + rowed_primary = a68_row_value (CTYPE (target_mode), dim, + a68_multiple_elements (primary), + a68_multiple_elements_size (primary), + lower_bounds, upper_bounds); + free (lower_bounds); + free (upper_bounds); + } + else + { + /* A -> []A */ + tree row_type = CTYPE (target_mode); + tree lower_bound = ssize_one_node; + tree upper_bound = ssize_one_node; + tree elements = (did_deref + ? orig_primary + : fold_build1 (ADDR_EXPR, + build_pointer_type (TREE_TYPE (primary)), + build_constructor_va (build_array_type (TREE_TYPE (primary), + build_index_type (size_zero_node)), + 1, size_zero_node, primary))); + tree elements_type = a68_row_elements_type (row_type); + tree elements_size = size_in_bytes (elements_type); + rowed_primary = a68_row_value (row_type, 1, + elements, elements_size, + &lower_bound, &upper_bound); + } + + /* Build a ref if we rowed a ref. */ + if (did_deref) + { + tree pointer_type = build_pointer_type (TREE_TYPE (rowed_primary)); + rowed_primary = fold_build1 (ADDR_EXPR, pointer_type, rowed_primary); + /* Rowing NIL yields NIL. */ + rowed_primary = fold_build3_loc (a68_get_node_location (p), + COND_EXPR, + pointer_type, + fold_build2 (EQ_EXPR, + pointer_type, + fold_convert (pointer_type, orig_primary), + build_int_cst (pointer_type, 0)), + build_int_cst (pointer_type, 0), + rowed_primary); + a68_add_stmt (rowed_primary); + rowed_primary = a68_pop_range (); + } + + return rowed_primary; +} + +/* Lower a widening coercion. + + Widening allows the following conversions of mode: + + LONGSETY INT to LONGSETY REAL + LONGSETY REAL to LONGSETY COMPL + LONGSETY BITS to []BOOL + LONGSETY BYTES to []CHAR */ + +tree +a68_lower_widening (NODE_T *p, LOW_CTX_T ctx) +{ + if (MOID (p) == M_REAL + || MOID (p) == M_LONG_REAL + || MOID (p) == M_LONG_LONG_REAL) + { + return convert_to_real (CTYPE (MOID (p)), a68_lower_tree (SUB (p), ctx)); + } + if (MOID (p) == M_COMPLEX + || MOID (p) == M_LONG_COMPLEX + || MOID (p) == M_LONG_LONG_COMPLEX) + { + return a68_complex_widen_from_real (MOID (p), + a68_lower_tree (SUB (p), ctx)); + } + else if (MOID (p) == M_ROW_BOOL) + { + /* Widen a LONGSETY BITS to a row of BOOLs. */ + tree coercend = a68_lower_tree (SUB (p), ctx); + tree coercend_type = TREE_TYPE (coercend); + HOST_WIDE_INT bits_size = int_size_in_bytes (coercend_type); + gcc_assert (bits_size != -1); + bits_size = bits_size * 8; + + tree pointer_to_bool_type = build_pointer_type (a68_bool_type); + a68_push_range (M_ROW_BOOL); + /* First allocate space for the elements. */ + tree elements = a68_lower_tmpvar ("elements%", + pointer_to_bool_type, + a68_lower_alloca (a68_bool_type, + fold_build2 (MULT_EXPR, + sizetype, + size_int (bits_size), + size_in_bytes (a68_bool_type)))); + + /* Set the elements, each element is a BOOL which is TRUE if the + corresponding bit in the coercend is set, FALSE otherwise. */ + tree coercend_one_node = build_int_cst (coercend_type, 1); + coercend = save_expr (coercend); + for (HOST_WIDE_INT bit = 0; bit < bits_size; ++bit) + { + tree offset = fold_build2 (MULT_EXPR, sizetype, + size_int (bit), size_in_bytes (a68_bool_type)); + tree bit_set = fold_convert (a68_bool_type, + fold_build2 (BIT_AND_EXPR, coercend_type, + fold_build2 (RSHIFT_EXPR, coercend_type, + coercend, + build_int_cst (coercend_type, + bits_size - 1 - bit)), + coercend_one_node)); + + a68_add_stmt (fold_build2 (MODIFY_EXPR, + a68_bool_type, + fold_build2 (MEM_REF, + a68_bool_type, + fold_build2 (POINTER_PLUS_EXPR, + pointer_to_bool_type, + elements, + offset), + fold_convert (pointer_to_bool_type, + integer_zero_node)), + bit_set)); + } + + /* Create multiple. */ + tree lower_bound = ssize_int (1); + tree upper_bound = ssize_int (bits_size); + tree elements_size = fold_build2 (MULT_EXPR, sizetype, + size_int (bits_size), + size_in_bytes (a68_bool_type)); + tree multiple = a68_row_value (CTYPE (M_ROW_BOOL), 1 /* dim */, + elements, elements_size, + &lower_bound, &upper_bound); + a68_add_stmt (multiple); + return a68_pop_range (); + } + else + { + fatal_error (a68_get_node_location (p), + "cannot do widening from %s to %s", + a68_moid_to_string (MOID (SUB (p)), MOID_ERROR_WIDTH, SUB (p)), + a68_moid_to_string (MOID (p), MOID_ERROR_WIDTH, p)); + gcc_unreachable (); + } +} + +/* Lower a voiding coercion. + + The voiding lowers into a compound expression with the voided expression + (for side-effects) and returns EMPTY. */ + +tree +a68_lower_voiding (NODE_T *p, LOW_CTX_T ctx) +{ + return fold_build2_loc (a68_get_node_location (p), + COMPOUND_EXPR, + a68_void_type, + a68_lower_tree (SUB (p), ctx), + a68_get_empty ()); +} + +/* Lower a proceduring coercion. + + proceduring : jump. + + In the Revised language only jump statements can be procedured. The + coercion results in a new function whose body is the jump instruction. */ + +tree +a68_lower_proceduring (NODE_T *p, LOW_CTX_T ctx) +{ + tree jump = a68_lower_tree (SUB (p), ctx); + + tree procedured_goto = a68_make_anonymous_routine_decl (MOID (p)); + a68_add_decl (procedured_goto); + a68_add_decl_expr (fold_build1_loc (a68_get_node_location (p), + DECL_EXPR, + TREE_TYPE (procedured_goto), + procedured_goto)); + announce_function (procedured_goto); + + a68_push_function_range (procedured_goto, CTYPE (SUB (MOID (p)))); + a68_pop_function_range (jump); + return fold_build1 (ADDR_EXPR, + build_pointer_type (TREE_TYPE (procedured_goto)), + procedured_goto); +} + +/* Lower a deproceduring coercion. + The deproceduring lowers into a call expression. */ + +tree +a68_lower_deproceduring (NODE_T *p, LOW_CTX_T ctx) +{ + tree func = a68_lower_tree (SUB (p), ctx); + + if (POINTER_TYPE_P (TREE_TYPE (func))) + { + if (TREE_CODE (func) == ADDR_EXPR) + func = TREE_OPERAND (func, 0); + else + func = fold_build1 (INDIRECT_REF, + TREE_TYPE (TREE_TYPE (func)), + func); + } + + return build_call_expr_loc (a68_get_node_location (p), func, 0); +} diff --git a/gcc/algol68/a68-low-generator.cc b/gcc/algol68/a68-low-generator.cc new file mode 100644 index 000000000000..5c4d65569b37 --- /dev/null +++ b/gcc/algol68/a68-low-generator.cc @@ -0,0 +1,533 @@ +/* Lower generators. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + + +typedef tree (*allocator_t) (tree, tree); + +/* Lower to code that fill in BOUNDS and elements pointers in the given buffer + pointed by BUFFER at offset OFFSET according to the mode MODE, and evals to + BUFFER. */ + +static tree +fill_in_buffer (tree buffer, tree offset, tree_stmt_iterator *bounds, MOID_T *m, + allocator_t allocator) +{ + tree filler = NULL_TREE; + tree type = CTYPE (m); + tree pointer_type = build_pointer_type (type); + + a68_push_stmt_list (M_VOID); + + if (m == M_INT || m == M_BOOL || m == M_CHAR || m == M_REAL || IS_REF (m)) + { + tree val_address = fold_build2 (POINTER_PLUS_EXPR, pointer_type, buffer, offset); + tree init_val = a68_get_skip_tree (m); + tree modify = fold_build2 (MODIFY_EXPR, + type, + fold_build1 (INDIRECT_REF, type, val_address), + init_val); + a68_add_stmt (modify); + } + else if (!HAS_ROWS (m)) + { + /* This mode has no rows. We can just fill in with zeroes, which + translates into SKIP values for all possibly contained types. */ + tree call = builtin_decl_explicit (BUILT_IN_MEMSET); + call = build_call_expr_loc (UNKNOWN_LOCATION, call, 3, + buffer, + integer_zero_node, + fold_convert (sizetype, size_in_bytes (CTYPE (m)))); + a68_add_stmt (call); + } + else if (m == M_STRING) + { + /* Strings are rows but handled especially as they are created empty and + don't feature bounds in the formal declarer. */ + + /* First the descriptor. */ + tree pointer_byte_size = size_int (POINTER_SIZE / BITS_PER_UNIT); + tree lb_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset); + a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node, + fold_build1 (INDIRECT_REF, ssizetype, lb_address), + ssize_int (1))); + offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size); + tree ub_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset); + a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node, + fold_build1 (INDIRECT_REF, ssizetype, ub_address), + ssize_int (0))); + offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size); + tree stride_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset); + a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node, + fold_build1 (INDIRECT_REF, sizetype, stride_address), + size_in_bytes (a68_char_type))); + + /* The data is an empty string, i.e NULL. */ + offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size); + tree elems_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset); + a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node, + fold_build1 (INDIRECT_REF, build_pointer_type (a68_char_type), + elems_address), + build_int_cst (build_pointer_type (a68_char_type), 0))); + + /* The size of the elements is zero. */ + offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size); + tree elems_size_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset); + a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node, + fold_build1 (INDIRECT_REF, build_pointer_type (a68_char_type), + elems_size_address), + size_zero_node)); + } + else if (A68_ROW_TYPE_P (type)) + { + /* If the row mode is flexible we can deflex it now: these also must have + bounds specified for them, with the only exception of strings/flexible + rows of chars, which are handled above. Note we cannot use DEFLEXED + here because that contains the fully deflexed mode. For example, + DEFLEXED returns [][]INT for FLEX[]FLEX[]INT, and we want []FLEX[]INT + instead. */ + if (IS_FLEX (m)) + m = SUB (m); + + /* Consume two bounds from BOUNDS for each dimension and patch them at + their right offsets. Note that we have to process from upper + dimension to lower dimension so we can calculate the stride as we + go. */ + size_t dim = DIM (m); + + /* Collect lower and upper bounds and calculate the number of elements of + the multiple. */ + tree *lower_bounds = (tree *) xmalloc (sizeof (tree) * dim); + tree *upper_bounds = (tree *) xmalloc (sizeof (tree) * dim); + tree num_elems = NULL_TREE; + for (size_t i = 0; i < dim; ++i) + { + /* Note we have to convert the bounds from CTYPE(M_INT) to + ssizetype. */ + lower_bounds[i] = fold_convert (ssizetype, save_expr (tsi_stmt (*bounds))); + tsi_next (bounds); + upper_bounds[i] = fold_convert (ssizetype, save_expr (tsi_stmt (*bounds))); + tsi_next (bounds); + + tree dim_num_elems + = fold_build2 (PLUS_EXPR, sizetype, + fold_convert (sizetype, + fold_build2 (MINUS_EXPR, ssizetype, + upper_bounds[i], lower_bounds[i])), + size_one_node); + dim_num_elems = fold_build3 (COND_EXPR, + sizetype, + fold_build2 (LT_EXPR, ssizetype, + upper_bounds[i], lower_bounds[i]), + size_zero_node, + dim_num_elems); + if (num_elems == NULL_TREE) + num_elems = dim_num_elems; + else + num_elems = fold_build2 (MULT_EXPR, sizetype, num_elems, dim_num_elems); + } + + /* Calculate strides. */ + tree *strides = (tree *) xmalloc (sizeof (tree) * dim); + a68_multiple_compute_strides (type, dim, lower_bounds, upper_bounds, strides); + + /* Now emit instructions to patch the bounds and strides. */ + tree pointer_byte_size = size_int (POINTER_SIZE / BITS_PER_UNIT); + for (size_t i = 0; i < dim; ++i) + { + /* Lower bound. */ + tree lb_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset); + a68_add_stmt (fold_build2 (MODIFY_EXPR, + void_type_node, + fold_build1 (INDIRECT_REF, ssizetype, lb_address), + lower_bounds[i])); + /* Upper bound. */ + offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size); + tree ub_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset); + a68_add_stmt (fold_build2 (MODIFY_EXPR, + void_type_node, + fold_build1 (INDIRECT_REF, ssizetype, ub_address), + upper_bounds[i])); + /* Stride. */ + offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size); + tree stride_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset); + a68_add_stmt (fold_build2 (MODIFY_EXPR, + void_type_node, + fold_build1 (INDIRECT_REF, sizetype, stride_address), + strides[i])); + offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size); + } + free (lower_bounds); + free (upper_bounds); + free (strides); + + /* Now allocate space for the elements. */ + MOID_T *elem_mode = SUB (m); + tree elem_size = fold_convert (sizetype, size_in_bytes (CTYPE (elem_mode))); + tree elems_size = save_expr (fold_build2 (MULT_EXPR, sizetype, elem_size, num_elems)); + tree elemsptr = (*allocator) (CTYPE (elem_mode), elems_size); + elemsptr = save_expr (elemsptr); + + /* And initialize them. */ + if (elem_mode == M_INT || elem_mode == M_BOOL || elem_mode == M_CHAR + || elem_mode == M_REAL || IS_REF (elem_mode)) + { + /* Memsetting the buffer with either zeroes or ones satisfies the + SKIP value for these modes. */ + tree call = builtin_decl_explicit (BUILT_IN_MEMSET); + call = build_call_expr_loc (UNKNOWN_LOCATION, call, 3, + elemsptr, + integer_zero_node, + elems_size); + a68_add_stmt (call); + } + else + { + /* Recurse in a loop to fill in elements. */ + a68_push_range (NULL); + tree num_elems_var = a68_lower_tmpvar ("numelems%", size_type_node, + num_elems); + tree index = a68_lower_tmpvar ("index%", size_type_node, size_zero_node); + tree elems_var = a68_lower_tmpvar ("elems%", TREE_TYPE (elemsptr), + elemsptr); + tree elem_offset = a68_lower_tmpvar ("elem_offset%", size_type_node, + size_zero_node); + + /* Begin of loop body. */ + a68_push_range (NULL); + a68_add_stmt (fold_build1 (EXIT_EXPR, + void_type_node, + fold_build2 (EQ_EXPR, + size_type_node, + index, num_elems_var))); + a68_add_stmt (fill_in_buffer (elems_var, elem_offset, bounds, elem_mode, + allocator)); + /* Increase elem_offset */ + a68_add_stmt (fold_build2 (MODIFY_EXPR, sizetype, + elem_offset, + fold_build2 (PLUS_EXPR, sizetype, + elem_offset, elem_size))); + /* index++ */ + a68_add_stmt (fold_build2 (POSTINCREMENT_EXPR, + size_type_node, + index, size_one_node)); + tree loop_body = a68_pop_range (); + /* End of loop body. */ + a68_add_stmt (fold_build1 (LOOP_EXPR, + void_type_node, + loop_body)); + a68_add_stmt (a68_pop_range ()); + } + + /* Patch the elements% field. */ + tree elems_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset); + a68_add_stmt (fold_build2 (MODIFY_EXPR, + void_type_node, + fold_build1 (INDIRECT_REF, + build_pointer_type (CTYPE (elem_mode)), elems_address), + elemsptr)); + /* Patch the elements_size% field. */ + offset = fold_build2 (PLUS_EXPR, sizetype, offset, pointer_byte_size); + tree elems_size_address = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset); + a68_add_stmt (fold_build2 (MODIFY_EXPR, + void_type_node, + fold_build1 (INDIRECT_REF, + sizetype, + elems_size_address), + elems_size)); + } + else if (A68_STRUCT_TYPE_P (type)) + { + /* Initialize the struct's fields in the allocated buffer. */ + tree base = a68_lower_tmpvar ("base%", TREE_TYPE (buffer), + fold_build2 (POINTER_PLUS_EXPR, + TREE_TYPE (buffer), + buffer, offset)); + PACK_T *field_pack = PACK (m); + for (tree field = TYPE_FIELDS (type); field; field = TREE_CHAIN (field)) + { + gcc_assert (COMPLETE_TYPE_P (TREE_TYPE (field))); + // printf ("BYTE_POSITION\n"); + // debug_tree (byte_position (field)); + a68_add_stmt (fill_in_buffer (base, byte_position (field), + bounds, MOID (field_pack), allocator)); + FORWARD (field_pack); + } + } + else if (A68_UNION_TYPE_P (type)) + { + /* Union values are initialized with an overhead of (sizetype) -1, which + means it is not initialized. Note that row declarers in united modes + are formal declarers, so they never contribute bounds. */ + tree overhead_address + = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), buffer, offset); + tree uninitialized = fold_convert (sizetype, build_minus_one_cst (ssizetype)); + a68_add_stmt (fold_build2 (MODIFY_EXPR, void_type_node, + fold_build1 (INDIRECT_REF, sizetype, overhead_address), + uninitialized)); +#if 0 + /* Set the rest of the union with zeroes. */ + tree value_address + = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (buffer), + buffer, + fold_build2 (PLUS_EXPR, sizetype, offset, size_in_bytes (sizetype))); + + tree value_field = TREE_CHAIN (TYPE_FIELDS (type)); + tree call = builtin_decl_explicit (BUILT_IN_MEMSET); + call = build_call_expr_loc (UNKNOWN_LOCATION, call, 3, + value_address, + integer_zero_node, + size_in_bytes (TREE_TYPE (value_field))); + a68_add_stmt (call); +#endif + } + else + gcc_unreachable (); + + a68_add_stmt (buffer); + filler = a68_pop_stmt_list (); + TREE_TYPE (filler) = pointer_type; + return filler; +} + +/* Lower to code that generates storage for a value of mode M, using bounds + from BOUNDS. */ + +static tree +gen_mode (MOID_T *m, tree_stmt_iterator *bounds, allocator_t allocator) +{ + /* Allocate space for the value and fill it. */ + tree buffer = (*allocator) (CTYPE (m), size_in_bytes (CTYPE (m))); + buffer = save_expr (buffer); + return fill_in_buffer (buffer, size_zero_node, bounds, m, allocator); +} + +/* Collect row bounds from BOUNDS. + Lower bounds are optional, and if not found they default to 1. */ + +static void +collect_bounds (NODE_T *p, LOW_CTX_T ctx) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, BOUNDS_LIST)) + collect_bounds (SUB (p), ctx); + else if (IS (p, BOUND)) + collect_bounds (SUB (p), ctx); + else if (IS (p, UNIT)) + { + /* First the lower bound. */ + tree lower_bound; + if (NEXT (p) != NO_NODE && IS (NEXT (p), COLON_SYMBOL)) + { + lower_bound = a68_lower_tree (p, ctx); + p = NEXT_NEXT (p); + } + else + /* Default lower bound. */ + lower_bound = integer_one_node; + + /* Now the upper bound. */ + tree upper_bound = a68_lower_tree (p, ctx); + + /* See the comment for collect_declarer_bounds for an explanation for + the usage of save_expr here. */ + a68_add_stmt (save_expr (lower_bound)); + a68_add_stmt (save_expr (upper_bound)); + } + } +} + +/* Append all the bounds found in the given declarer in the current statements + list. */ + +static void +collect_declarer_bounds_1 (NODE_T *p, LOW_CTX_T ctx) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, BOUNDS)) + collect_bounds (SUB (p), ctx); + else if (IS (p, INDICANT) && IS_LITERALLY (p, "STRING")) + return; + else if (IS (p, INDICANT)) + { + if (TAX (p) != NO_TAG && HAS_ROWS (MOID (TAX (p)))) + /* Continue from definition at MODE A = .... */ + collect_declarer_bounds_1 (NEXT_NEXT (NODE (TAX (p))), ctx); + } + else if (IS (p, DECLARER) + && (IS_UNION (MOID (p)) || !HAS_ROWS (MOID (p)))) + return; + else + collect_declarer_bounds_1 (SUB (p), ctx); + } +} + +/* Given a declarer node, return a statements list with all the expressions of + the bounds within it. + + Note that the language rules mandates that the bounds expression shall be + evaluated just once even when they are used by several generators, such as + in + + [n +:= 1]real a, b; + + Therefore the expressions are saved in save_exprs and the statements list + is cached in the CDECL field of the parse tree node. */ + +static tree +collect_declarer_bounds (NODE_T *p, LOW_CTX_T ctx) +{ + if (CDECL (p) == NULL_TREE) + { + a68_push_stmt_list (M_VOID); + collect_declarer_bounds_1 (SUB (p), ctx); + CDECL (p) = a68_pop_stmt_list (); + } + + return CDECL (p); +} + +/* Low the elaboration of a generator. + + The lowered code evaluates to a pointer. + + DECLARER is the actual declarer passed to the generator. + + MODE is the mode of the value to generate. + + HEAP is true if we are lowering a heap generator, false if we are lowering a + LOC generator. */ + +tree +a68_low_generator (NODE_T *declarer, + MOID_T *mode, + bool heap, LOW_CTX_T ctx) +{ + /* If the declarer is a mode indicant which has a recursive definition then + we need to lower to a function which gets immediately called rather than + an expression, to handle the recursivity. In that case, though, we need + to always heap allocated memory for obvious reasons, which sucks, but such + is life. */ + + if (IS (SUB (declarer), INDICANT) && TAX (SUB (declarer)) != NO_TAG + && IS_RECURSIVE (TAX (SUB (declarer)))) + { + if (TAX_TREE_DECL (TAX (SUB (declarer))) != NULL_TREE) + { + /* This is a recursive mode indicant. Just call the function. */ + return save_expr (build_call_expr_loc (a68_get_node_location (SUB (declarer)), + TAX_TREE_DECL (TAX (SUB (declarer))), + 0)); + } + + tree ret_type = build_pointer_type (CTYPE (mode)); + tree func_decl = build_decl (a68_get_node_location (declarer), + FUNCTION_DECL, + NULL_TREE /* name, set below */, + build_function_type (ret_type, void_list_node)); + char *name = xasprintf ("genroutine%d", DECL_UID (func_decl)); + DECL_NAME (func_decl) = a68_get_mangled_identifier (name); + free (name); + DECL_EXTERNAL (func_decl) = 0; + DECL_STATIC_CHAIN (func_decl) = !a68_in_global_range (); + TREE_ADDRESSABLE (func_decl) = 1; + TREE_PUBLIC (func_decl) = a68_in_global_range (); + TREE_STATIC (func_decl) = 1; + TAX_TREE_DECL (TAX (SUB (declarer))) = func_decl; + + a68_add_decl (func_decl); + a68_add_decl_expr (fold_build1_loc (a68_get_node_location (declarer), + DECL_EXPR, + TREE_TYPE (func_decl), + func_decl)); + announce_function (func_decl); + a68_push_function_range (func_decl, ret_type); + + /* Collect bounds from declarer. */ + tree bounds = collect_declarer_bounds (declarer, ctx); + + /* Allocate and initialize a memory buffer for a value of mode MODE with + bounds in BOUNDS. */ + tree_stmt_iterator bounds_iter = tsi_start (bounds); + tree gen = gen_mode (mode, &bounds_iter, a68_lower_malloc); + a68_pop_function_range (gen); + /* Avoid this generator function, which uses the global lexical + environment, to be reused in other contexts. */ + TAX_TREE_DECL (TAX (SUB (declarer))) = NULL_TREE; + return save_expr (build_call_expr_loc (a68_get_node_location (declarer), + func_decl, 0)); + } + else + { + /* Collect bounds from declarer. */ + tree bounds = collect_declarer_bounds (declarer, ctx); + + /* Allocate and initialize a memory buffer for a value of mode MODE with + bounds in BOUNDS. */ + tree_stmt_iterator bounds_iter = tsi_start (bounds); + tree gen = gen_mode (mode, &bounds_iter, + heap ? a68_lower_malloc : a68_lower_alloca); + return gen; + } +} + +/* Allocate storage for a value of mode M. + NBOUNDS is the number of bounds in BOUNDS. */ + +tree +a68_low_gen (MOID_T *m, size_t nbounds, tree *bounds, bool use_heap) +{ + /* First collect bounds from BOUNDS into a statements list, which is what + gen_mode expects. */ + tree bounds_list = alloc_stmt_list (); + for (size_t i = 0; i < nbounds; ++i) + append_to_statement_list_force (bounds[i], &bounds_list); + allocator_t allocator = use_heap ? a68_lower_malloc : a68_lower_alloca; + + tree_stmt_iterator q = tsi_start (bounds_list); + tree ret = gen_mode (m, &q, allocator); + free_stmt_list (bounds_list); + return ret; +} diff --git a/gcc/algol68/a68-low-units.cc b/gcc/algol68/a68-low-units.cc new file mode 100644 index 000000000000..9802468873b2 --- /dev/null +++ b/gcc/algol68/a68-low-units.cc @@ -0,0 +1,1253 @@ +/* Lower units to GENERIC. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "cgraph.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "tree-iterator.h" +#include "stringpool.h" +#include "print-tree.h" +#include "gimplify.h" +#include "dumpfile.h" +#include "convert.h" + +#include "a68.h" + +/* Note that enclosed clauses, which are units, are handled in + a68-low-clauses. */ + +/* Lower an applied identifier. + + This lowers into the declaration of the referred identifier. The + declaration of the identifier should now be available in the symbol table + entry for the identifier. */ + +tree +a68_lower_identifier (NODE_T *p, LOW_CTX_T ctx) +{ + if (TAG_TABLE (TAX (p)) == A68_STANDENV) + { + /* This identifier is defined in the standard prelude. Use its lowering + handler. */ + LOWERER_T lowerer = LOWERER (TAX (p)); + return (*lowerer) (p, ctx); + } + else + { + tree id_decl = TAX_TREE_DECL (TAX (p)); + + if (id_decl == NULL_TREE) + { + /* This is an applied identifier used before the corresponding defining + identifier gets defined in either an identity declaration or a + variable declaration. Create the declaration and install it in the + symbol table. The declaration itself, declaration expr and + initialization assignment for the declaration will be emitted by the + corresponding declaration lowering handler. Note that the defining + identifier (and therefore the declaration associated with this applied + identifier) may be in an outer lexical block. */ + + if (IS (MOID (p), PROC_SYMBOL)) + { + bool external = (MOIF (TAX (p)) != NO_MOIF); + const char *extern_symbol = EXTERN_SYMBOL (TAX (p)); + if (VARIABLE (TAX (p))) + { + if (external) + id_decl + = a68_make_variable_declaration_decl (p, NAME (MOIF (TAX (p))), external, + extern_symbol); + else + id_decl + = a68_make_variable_declaration_decl (p, ctx.module_definition_name); + } + else if (IN_PROC (TAX (p))) + { + if (external) + id_decl + = a68_make_proc_identity_declaration_decl (p, NAME (MOIF (TAX (p))), + false /* indicant */, + external, + extern_symbol); + else + id_decl + = a68_make_proc_identity_declaration_decl (p, ctx.module_definition_name); + } + else + { + if (external) + id_decl + = a68_make_identity_declaration_decl (p, NAME (MOIF (TAX (p))), + false /* indicant */, + external, extern_symbol); + else + id_decl + = a68_make_identity_declaration_decl (p, ctx.module_definition_name); + } + } + else + { + bool external = (MOIF (TAX (p)) != NO_MOIF); + const char *extern_symbol = EXTERN_SYMBOL (TAX (p)); + if (VARIABLE (TAX (p))) + { + if (external) + id_decl + = a68_make_variable_declaration_decl (p, NAME (MOIF (TAX (p))), external, + extern_symbol); + else + id_decl + = a68_make_variable_declaration_decl (p, ctx.module_definition_name); + } + else + { + if (external) + id_decl + = a68_make_identity_declaration_decl (p, NAME (MOIF (TAX (p))), + false /* indicant */, external, + extern_symbol); + else + id_decl + = a68_make_identity_declaration_decl (p, ctx.module_definition_name); + } + } + + TAX_TREE_DECL (TAX (p)) = id_decl; + } + + /* If the identifier refers to a FUNCTION_DECL, this means the declaration + was made by a procecure-identity-dclaration. The applied identifier in + that case refers to the address of the corresponding function. */ + if (TREE_CODE (id_decl) == FUNCTION_DECL) + return fold_build1 (ADDR_EXPR, + build_pointer_type (TREE_TYPE (id_decl)), + id_decl); + else + return id_decl; + } +} + +/* Lower a string denotation. + + String denotations are of mode []CHAR, and lower into a multiple with a + single dimension, and with the following characteristics: + + - The lower bound of dimension 0 is 1. + - The upper bound of dimension 0 is strlen (NSYMBOL (p)). + - The stride of dimension 0 is 0. + - The pointed elements are a buffer of CHARs allocated in the stack. */ + +tree +a68_lower_string_denotation (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + /* First process string breaks. */ + char *str = a68_string_process_breaks (p, NSYMBOL (p)); + + /* Build a multiple of UCS-4 CHARs from the resulting UTF-8 string. */ + size_t ucslen; + uint32_t *ucsbuf = a68_u8_to_u32 ((const uint8_t *) str, strlen (str), + NULL, &ucslen); + free (str); + tree string_literal = build_string_literal (ucslen * sizeof (uint32_t), + (char *) ucsbuf, a68_char_type); + tree elements = string_literal; + tree lower_bound = fold_convert (ssizetype, size_one_node); + tree upper_bound = ssize_int (ucslen); + tree elements_size = fold_build2 (MULT_EXPR, sizetype, + size_int (ucslen), + size_in_bytes (a68_char_type)); + tree multiple = a68_row_value (CTYPE (M_ROW_CHAR), 1, + elements, elements_size, + &lower_bound, &upper_bound); + TREE_CONSTANT (multiple) = true; + free (ucsbuf); + return multiple; +} + +/* Lower denotation. + + denotation : int denotation; real denotation; bits denotation; + row char denotation; + true symbol; false symbol; + empty symbol; + longety, int denotation; + longety, real denotation; + longety, bits denotation; + shortety, int denotation; + shortety, real denotation; + shortety, bits denotation. + + Denotations lower into GENERIC cst expressions. */ + +tree +a68_lower_denotation (NODE_T *p, LOW_CTX_T ctx) +{ + MOID_T *moid = MOID (p); + + if (moid == M_VOID) + /* EMPTY */ + return a68_lower_empty (p, ctx); + else if (moid == M_BOOL) + /* TRUE or FALSE. */ + return (NSYMBOL (p)[0] == 'T') ? boolean_true_node : boolean_false_node; + else if (moid == M_CHAR) + { + char *s = a68_string_process_breaks (p, NSYMBOL (p)); + uint32_t ucs; + int length = a68_u8_mbtouc (&ucs, (const uint8_t *) s, 1); + gcc_assert (length == 1); + free (s); + return build_int_cst (a68_char_type, ucs); + } + else if (moid == M_ROW_CHAR) + return a68_lower_string_denotation (p, ctx); + else if (moid == M_INT + || moid == M_LONG_INT + || moid == M_LONG_LONG_INT + || moid == M_SHORT_INT + || moid == M_SHORT_SHORT_INT) + { + /* SIZETY INT */ + tree type; + char *end; + NODE_T *s = NO_NODE; + if (IS (SUB (p), LONGETY) || IS (SUB (p), SHORTETY)) + s = NEXT (SUB (p)); + else + s = SUB (p); + + type = CTYPE (moid); + int64_t val = strtol (NSYMBOL (s), &end, 10); + gcc_assert (end[0] == '\0'); + return build_int_cst (type, val); + } + if (moid == M_BITS + || moid == M_LONG_BITS + || moid == M_LONG_LONG_BITS + || moid == M_SHORT_BITS + || moid == M_SHORT_SHORT_BITS) + { + /* SIZETY BITS */ + + tree type; + char *end; + NODE_T *s = NO_NODE; + if (IS (SUB (p), LONGETY) || IS (SUB (p), SHORTETY)) + s = NEXT (SUB (p)); + else + s = SUB (p); + + type = CTYPE (moid); + int64_t radix = strtol (NSYMBOL (s), &end, 10); + gcc_assert (end != NSYMBOL (s) && *end == 'r'); + end++; + int64_t val = strtol (end, &end, radix); + gcc_assert (end[0] == '\0'); + return build_int_cst (type, val); + } + else if (moid == M_REAL + || moid == M_LONG_REAL + || moid == M_LONG_LONG_REAL) + { + /* SIZETY INT */ + tree type; + NODE_T *s = NO_NODE; + if (IS (SUB (p), LONGETY) || IS (SUB (p), SHORTETY)) + s = NEXT (SUB (p)); + else + s = SUB (p); + + if (moid == M_REAL) + type = float_type_node; + else if (moid == M_LONG_REAL) + type = double_type_node; + else if (moid == M_LONG_LONG_REAL) + type = long_double_type_node; + else + gcc_unreachable (); + + REAL_VALUE_TYPE val; + real_from_string (&val, NSYMBOL (s)); + return build_real (type, val); + } + + gcc_unreachable (); + return NULL_TREE; +} + +/* Lower SKIP. + + skip +*/ + +tree +a68_lower_skip (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_get_skip_tree (MOID (p)); +} + +/* Lower NIHIL. + + nihil : nil. + + NIL stands for a name referring to no value and which must be + distinguishable from any other name. It is of mode REF AMODE. NIL is never + subject to coercion and it may only occur where the context is strong, + i.e. where AMODE is known at compile-time. + + It lowers to a pointer to AMODE with value 0. */ + +tree +a68_lower_nihil (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + tree type = CTYPE (MOID (p)); + + gcc_assert (type == a68_void_type || POINTER_TYPE_P (type)); + if (type == a68_void_type) + return a68_lower_empty (p, ctx); + else + return build_int_cst (type, 0); +} + +/* Lower EMPTY. */ + +tree +a68_lower_empty (NODE_T *p ATTRIBUTE_UNUSED, LOW_CTX_T ctx ATTRIBUTE_UNUSED) +{ + return a68_get_empty (); +} + +/* Lower an identity relation. + + identity relation : tertiary, is symbol, tertiary; + tertiary, isnt symbol, tertiary. + + An identity relation determines whether two name values are the same. It + lowers into EQ_EXPR in case of IS and into NE_EXPR in case of ISNT. */ + +tree +a68_lower_identity_relation (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *lhs = SUB (p); + NODE_T *oper = NEXT (lhs); + NODE_T *rhs = NEXT (oper); + + /* Consolidate arguments to make sure we are comparing pointers in the + r-value context of the EQ_EXPR or NE_EXPR operation below. */ + tree op1 = a68_consolidate_ref (MOID (lhs), a68_lower_tree (lhs, ctx)); + tree op2 = a68_consolidate_ref (MOID (rhs), a68_lower_tree (rhs, ctx)); + + tree_code code; + if (IS (oper, IS_SYMBOL)) + code = EQ_EXPR; + else if (IS (oper, ISNT_SYMBOL)) + code = NE_EXPR; + else + gcc_unreachable (); + + return fold_build2_loc (a68_get_node_location (p), + code, boolean_type_node, op1, op2); +} + +/* Lower AND_FUNCTION and OR_FUNCTION. + + and function : tertiary, andf symbol, tertiary. + or function : tertiary, orf_symbol, tertiary. + + These are pseudo-operators that are used to implement short-circuits + evaluation of logical expressions. + + These pseudo-operators lower into TRUTH_ANDIF_EXPR or TRUTH_ORIF_EXPR, + respectively. */ + +tree +a68_lower_logic_function (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *lhs = SUB (p); + NODE_T *oper = NEXT (lhs); + NODE_T *rhs = NEXT (oper); + + tree op1 = a68_lower_tree (lhs, ctx); + tree op2 = a68_lower_tree (rhs, ctx); + + tree_code code; + if (IS (oper, ANDF_SYMBOL)) + code = TRUTH_ANDIF_EXPR; + else if (IS (oper, ORF_SYMBOL)) + code = TRUTH_ORIF_EXPR; + else + gcc_unreachable (); + + return fold_build2_loc (a68_get_node_location (p), + code, boolean_type_node, op1, op2); +} + +/* Lower a primary. + + primary : identifier; denotation; cast; enclosed clause; format text. + + The primary lowers into some GENERIC expression. */ + +tree +a68_lower_primary (NODE_T *p, LOW_CTX_T ctx) +{ + return a68_lower_tree (SUB (p), ctx); +} + +/* Lower a cast. + + cast : declarer, enclosed clause; + void symbol, enclosed clause. + + A cast establishes a strong context with some required mode. This context + allows coercions to be applied, and these coercions have been inserted in + the parse tree by the parser. */ + +tree +a68_lower_cast (NODE_T *p, LOW_CTX_T ctx) +{ + return a68_lower_tree (NEXT (SUB (p)), ctx); +} + +/* Lower a slice. + + slice : MULTIPLE INDEXER + + Slicing a multiple may result in either an element of the multiple, if the + operation is indexing, or another multiple, if the operation is a + trimming. */ + +static void +lower_subscript_for_indexes (NODE_T *p, LOW_CTX_T ctx) +{ + for (; p != NO_NODE; FORWARD (p)) + { + switch (ATTRIBUTE (p)) + { + case TRIMMER: + /* Because of ANNOTATION (indexer) == SLICE */ + gcc_unreachable (); + break; + case UNIT: + a68_add_stmt (a68_lower_tree (p, ctx)); + break; + case GENERIC_ARGUMENT: + case GENERIC_ARGUMENT_LIST: + lower_subscript_for_indexes (SUB (p), ctx); + break; + default: + break; + } + } +} + +static void +lower_subscript_for_trimmers (NODE_T *p, LOW_CTX_T ctx, + tree multiple, tree new_multiple, + int *dim, int *new_dim, + tree elements_pointer_type) +{ + /* new.elements := multiple.elements; + FOR dim TO num dimensions + DO CO t[dim] is either a subscript i or a trimmer i : j @ k CO + new.elements +:= i * multiple.strides[dim]; + IF t[dim] is a trimmer + THEN INT d := ( k is absent | 1 | multiple.lb[dim] - k ); + new.lb[dim] := multiple.lb[dim] - d; + new.ub[dim] := multiple.ub[dim] - d; + new.strides[dim] := multiple.strides[dim] + FI + OD + */ + + for (; p != NO_NODE; FORWARD (p)) + { + switch (ATTRIBUTE (p)) + { + case UNIT: + { + tree unit = save_expr (fold_convert (ssizetype, a68_lower_tree (p, ctx))); + tree new_elements = a68_multiple_elements (new_multiple); + tree size_dim = size_int (*dim); + tree dim_lower_bound = save_expr (a68_multiple_lower_bound (multiple, size_dim)); + tree stride = save_expr (a68_multiple_stride (multiple, size_dim)); + + /* Validate bounds. */ + if (OPTION_BOUNDS_CHECKING (&A68_JOB)) + a68_add_stmt (a68_multiple_bounds_check (p, size_dim, multiple, unit)); + + /* new_elements += i * strides[dim] */ + tree offset = fold_build2 (MULT_EXPR, sizetype, + fold_convert (sizetype, fold_build2 (MINUS_EXPR, ssizetype, + unit, dim_lower_bound)), + stride); + + offset = save_expr (offset); + new_elements = fold_build2 (POINTER_PLUS_EXPR, + elements_pointer_type, + new_elements, + offset); + a68_add_stmt (a68_multiple_set_elements (new_multiple, new_elements)); + + /* elements_size -= i * strides[dim] */ + tree elements_size = a68_multiple_elements_size (new_multiple); + elements_size = fold_build2 (MINUS_EXPR, sizetype, + elements_size, offset); + a68_add_stmt (a68_multiple_set_elements_size (new_multiple, elements_size)); + + *dim += 1; + break; + } + case TRIMMER: + { + /* First collect components from the trimmer. */ + tree size_dim = size_int (*dim); + tree dim_lower_bound = save_expr (a68_multiple_lower_bound (multiple, size_dim)); + tree lower_bound = dim_lower_bound; + tree upper_bound = save_expr (a68_multiple_upper_bound (multiple, size_dim)); + tree at = ssize_int (1); + + NODE_T *q = SUB (p); + if (q != NO_NODE) + { + if (IS (q, AT_SYMBOL)) + { + /* Both bounds are implicit. */ + at = save_expr (fold_convert (ssizetype, a68_lower_tree (NEXT (q), ctx))); + } + else if (IS (q, COLON_SYMBOL)) + { + /* Lower bound is implicit. */ + FORWARD (q); + if (IS (q, AT_SYMBOL)) + { + /* Upper bound is implicit, AT specified. */ + gcc_assert (IS (q, AT_SYMBOL)); + at = save_expr (fold_convert (ssizetype, a68_lower_tree (NEXT (q), ctx))); + } + else + { + upper_bound + = save_expr (fold_convert (ssizetype, a68_lower_tree (q, ctx))); + FORWARD (q); + if (q != NO_NODE) + { + gcc_assert (IS (q, AT_SYMBOL)); + at = save_expr (fold_convert (ssizetype, a68_lower_tree (NEXT (q), ctx))); + } + } + } + else + { + /* Lower bound is explicit. */ + lower_bound = fold_convert (ssizetype, a68_lower_tree (q, ctx)); + FORWARD (q); + gcc_assert (IS (q, COLON_SYMBOL)); + FORWARD (q); + if (q != NO_NODE) + { + if (IS (q, AT_SYMBOL)) + at = save_expr (fold_convert (ssizetype, a68_lower_tree (NEXT (q), ctx))); + else + { + upper_bound + = save_expr (fold_convert (ssizetype, a68_lower_tree (q, ctx))); + FORWARD (q); + if (q != NO_NODE && IS (q, AT_SYMBOL)) + at = + save_expr (fold_convert (ssizetype, a68_lower_tree (NEXT (q), ctx))); + } + } + } + } + + /* Time for some bounds checking. + + Note that in trimmers, given the current dimension's bounds + (L,U), we cannot simply do the check: + + L <= lower_bound <= U + L <= upper_bound <= U + + This is because the multiple may be flat, and the dimension may + have bounds such like U < L. In that case, the expressions + above would always eval to false for any lower_bound and + upper_bound. + + So we check for this instead: + + L <= lower_bound AND upper_bound <= U + + This allows to trim a "flat dimension" using a trimmer where + upper_bound < lower_bound. The result is, of course, another + "flat dimension" in the multiple result of the trimming. */ + + if (OPTION_BOUNDS_CHECKING (&A68_JOB)) + { + a68_add_stmt (a68_multiple_single_bound_check (p, size_dim, multiple, + lower_bound, + false /* upper_bound */)); + a68_add_stmt (a68_multiple_single_bound_check (p, size_dim, multiple, + upper_bound, + true /* upper_bound */)); + } + + /* new_elements += i * strides[dim] */ + tree stride = save_expr (a68_multiple_stride (multiple, size_dim)); + tree new_elements = a68_multiple_elements (new_multiple); + tree offset = fold_build2 (MULT_EXPR, sizetype, + fold_convert (sizetype, fold_build2 (MINUS_EXPR, ssizetype, + lower_bound, dim_lower_bound)), + stride); + + offset = save_expr (offset); + new_elements = fold_build2 (POINTER_PLUS_EXPR, + elements_pointer_type, + new_elements, + offset); + a68_add_stmt (a68_multiple_set_elements (new_multiple, new_elements)); + + /* elements_size -= i * strides[dim] */ + tree elements_size = a68_multiple_elements_size (new_multiple); + elements_size = fold_build2 (MINUS_EXPR, sizetype, + elements_size, offset); + a68_add_stmt (a68_multiple_set_elements_size (new_multiple, + elements_size)); + + /* Fill the triplet for this dimension in new_multiple. */ + tree size_new_dim = size_int (*new_dim); + tree d = fold_build2 (MINUS_EXPR, ssizetype, lower_bound, at); + + a68_add_stmt (a68_multiple_set_lower_bound (new_multiple, size_new_dim, + fold_build2 (MINUS_EXPR, ssizetype, + lower_bound, d))); + a68_add_stmt (a68_multiple_set_upper_bound (new_multiple, size_new_dim, + fold_build2 (MINUS_EXPR, ssizetype, + upper_bound, d))); + a68_add_stmt (a68_multiple_set_stride (new_multiple, size_new_dim, stride)); + + *new_dim += 1; + *dim += 1; + break; + } + default: + lower_subscript_for_trimmers (SUB (p), ctx, + multiple, new_multiple, + dim, new_dim, + elements_pointer_type); + } + } +} + +tree +a68_lower_slice (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *indexer = NEXT_SUB (p); + MOID_T *orig_multiple_mode = MOID (SUB (p)); + MOID_T *multiple_mode = orig_multiple_mode; + bool slicing_name = false; + + /* First of all, lower the multiple being sliced. If it is a name to a + multiple, set a flag and dereference. */ + tree multiple = a68_lower_tree (SUB (p), ctx); + MOID_T *orig_sliced_multiple_mode = MOID (p); + MOID_T *sliced_multiple_mode = MOID (p); + size_t slice_num_dimensions = 0; + if (IS_REF (MOID (SUB (p)))) + { + slicing_name = true; + multiple = a68_low_deref (multiple, SUB (p)); + multiple_mode = SUB (multiple_mode); + slice_num_dimensions = DIM (SUB (MOID (p))); + sliced_multiple_mode = SUB (sliced_multiple_mode); + } + else + slice_num_dimensions = DIM (MOID (p)); + + tree slice = NULL_TREE; + if (ANNOTATION (indexer) == SLICE) + { + /* The slice has only indexers and no trimmers. Collect units and slice + an element of the multiple using a68_multiple_slice. This operation + results in an element of the multiple. */ + + /* Collect units */ + a68_push_range (NULL); + lower_subscript_for_indexes (SUB (indexer), ctx); + tree units = a68_pop_range (); + + /* We need to allocate space for as many indexes as dimensions of the + multiple. */ + tree num_dimensions_tree = a68_multiple_dimensions (multiple); + gcc_assert (TREE_CODE (num_dimensions_tree) == INTEGER_CST); + int num_dimensions = tree_to_shwi (num_dimensions_tree); + + int num_indexes = 0; + tree *indexes = (tree *) xmalloc (sizeof (tree) * num_dimensions); + for (tree_stmt_iterator si = tsi_start (units); + !tsi_end_p (si); + tsi_next (&si)) + { + /* Add the unit to the list of indexes. */ + indexes[num_indexes] = tsi_stmt (si); + num_indexes++; + } + gcc_assert (num_indexes == num_dimensions); + + /* Slice. */ + slice = a68_multiple_slice (p, multiple, slicing_name, + num_indexes, indexes); + free (indexes); + } + else if (ANNOTATION (indexer) == TRIMMER) + { + /* The slice has both indexers and trimmers. Traverse the indexer + subtree to obtain the descriptor of the trimmed multiple (which is + another multiple) and the pointer to the elements, which points to + some position within the elements of the trimmed multiple. This + operation results in a new multiple of the same mode than the trimmed + multiple with shared elements. */ + + a68_push_range (sliced_multiple_mode); + + tree sliced_multiple = a68_lower_tmpvar ("multiple%", TREE_TYPE (multiple), + multiple); + tree *lower_bounds = (tree *) xmalloc (sizeof (tree) * slice_num_dimensions); + tree *upper_bounds = (tree *) xmalloc (sizeof (tree) * slice_num_dimensions); + tree ssize_one_node = fold_convert (ssizetype, size_one_node); + tree ssize_zero_node = fold_convert (ssizetype, size_zero_node); + for (size_t d = 0; d < slice_num_dimensions; ++d) + { + /* Note that these dummy bounds and the implied strides will be + overwritten by lower_subscript_for_trimmers below. */ + lower_bounds[d] = ssize_one_node; + upper_bounds[d] = ssize_zero_node; + } + tree new_multiple = a68_row_value (CTYPE (sliced_multiple_mode), + slice_num_dimensions, + a68_multiple_elements (sliced_multiple), + a68_multiple_elements_size (sliced_multiple), + lower_bounds, upper_bounds); + new_multiple = save_expr (new_multiple); + new_multiple = a68_lower_tmpvar ("new_multiple%", TREE_TYPE (new_multiple), + new_multiple); + + int dim = 0; + int new_dim = 0; + lower_subscript_for_trimmers (SUB (indexer), ctx, + sliced_multiple, new_multiple, + &dim, &new_dim, + a68_row_elements_pointer_type (TREE_TYPE (multiple))); + a68_add_stmt (new_multiple); + slice = a68_pop_range (); + + /* In case we are slicing a ref to a multiple, return the address of the + resulting multiple and not the multiple itself. But in this case we + need an address in the heap, because the trimmed multiple may be in + the heap and the result shall have the same scope. */ + if (slicing_name) + { + tree ptrtype = CTYPE (orig_sliced_multiple_mode); + tree slice_addr = fold_build1 (ADDR_EXPR, ptrtype, slice); + tree alloc = a68_lower_malloc (ptrtype, size_in_bytes (TREE_TYPE (slice))); + alloc = save_expr (alloc); + tree copy = a68_lower_memcpy (alloc, slice_addr, size_in_bytes (TREE_TYPE (slice))); + + slice = fold_build2 (COMPOUND_EXPR, ptrtype, copy, alloc); + } + } + else + gcc_unreachable (); + + return slice; +} + +/* Lower a selection. + + selection : selector, secondary. + selector : field identifier, of symbol. + + The selection lowers into a COMPONENT_REF of the field corresponding to the + field identifier. */ + +tree +a68_lower_selection (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *secondary = NEXT (SUB (p)); + NODE_T *field_identifier = SUB (SUB (p)); + + MOID_T *secondary_mode = MOID (secondary); + tree secondary_expr = a68_lower_tree (secondary, ctx); + + tree res = NULL_TREE; + + /* If the secondary is an address, we need to indirect. */ + if (IS_REF (secondary_mode)) + { + secondary_expr = a68_low_deref (secondary_expr, secondary); + secondary_mode = SUB (secondary_mode); + } + + if (IS_FLEX (secondary_mode) || IS_ROW (secondary_mode)) + { + /* This is the selection of a multiple of structs. + + The result is a multiple with same dimensions, dimension bounds and + strides than the indexed multiple. The elements pointer is made to + point to the selected field of the first struct. */ + + MOID_T *result_mode = MOID (p); + if (IS_REF (result_mode)) + result_mode = SUB (result_mode); + MOID_T *struct_mode = SUB (secondary_mode); + tree field_id = a68_get_mangled_identifier (SYMBOL (INFO (field_identifier))); + tree struct_type = CTYPE (struct_mode); + a68_push_range (result_mode); + tree selection = a68_lower_tmpvar ("selection%", CTYPE (result_mode), + a68_get_skip_tree (result_mode)); + tree multiple = a68_lower_tmpvar ("multiple%", TREE_TYPE (secondary_expr), + secondary_expr); + + /* First set the bounds of the selection, which are exactly the same + bounds than the selected multiple. */ + for (int dim = 0; dim < DIM (DEFLEX (secondary_mode)); ++dim) + { + tree size_dim = size_int (dim); + tree lower_bound = a68_multiple_lower_bound (multiple, size_dim); + tree upper_bound = a68_multiple_upper_bound (multiple, size_dim); + tree stride = a68_multiple_stride (multiple, size_dim); + a68_add_stmt (a68_multiple_set_lower_bound (selection, size_dim, + lower_bound)); + a68_add_stmt (a68_multiple_set_upper_bound (selection, size_dim, + upper_bound)); + a68_add_stmt (a68_multiple_set_stride (selection, size_dim, + stride)); + } + + /* Now set the elements pointer, which is the elements pointer of the + selected multiple offset the offset of the selected field in its + struct type. */ + tree elements = a68_multiple_elements (selection); + tree multiple_elements = a68_multiple_elements (multiple); + tree multiple_elements_size = a68_multiple_elements_size (multiple); + tree element_pointer_type = TREE_TYPE (elements); + tree field_offset = NULL_TREE; + for (tree f = TYPE_FIELDS (struct_type); f; f = DECL_CHAIN (f)) + { + if (field_id == DECL_NAME (f)) + { + field_offset = byte_position (f); + break; + } + } + gcc_assert (field_offset != NULL_TREE); + a68_add_stmt (a68_multiple_set_elements (selection, + fold_build2 (POINTER_PLUS_EXPR, + element_pointer_type, + multiple_elements, + field_offset))); + + /* The size of the buffer pointed by the elements pointer has to be + adjusted accordingly. */ + a68_add_stmt (a68_multiple_set_elements_size (selection, + fold_build2 (MINUS_EXPR, sizetype, + multiple_elements_size, + field_offset))); + + a68_add_stmt (selection); + res = a68_pop_range (); + } + else + { + /* This is the selection of a struct field. */ + gcc_assert (A68_STRUCT_TYPE_P (TREE_TYPE (secondary_expr))); + + /* Search for the selected field in the struct type. */ + tree struct_type = TREE_TYPE (secondary_expr); + tree field_id = a68_get_mangled_identifier (SYMBOL (INFO (field_identifier))); + tree field = NULL_TREE; + for (tree f = TYPE_FIELDS (struct_type); f; f = DECL_CHAIN (f)) + { + if (field_id == DECL_NAME (f)) + { + field = f; + break; + } + } + gcc_assert (field != NULL_TREE); + + /* Emit the COMPONENT_REF. */ + res = fold_build3_loc (a68_get_node_location (p), + COMPONENT_REF, + TREE_TYPE (field), + secondary_expr, + field, + NULL_TREE); + } + + /* The selection of a name yields a name. */ + if (IS_REF (MOID (secondary))) + /* XXX This may require copying. */ + return fold_build1 (ADDR_EXPR, CTYPE (MOID (p)), res); + else + return res; +} + +/* Lower a secondary. + + secondary : primary; generator; selection. + + The secondary lowers into some GENERIC expression. */ + +tree +a68_lower_secondary (NODE_T *p, LOW_CTX_T ctx) +{ + return a68_lower_tree (SUB (p), ctx); +} + +/* Lower a formula. + + formula : secondary, operator, secondary; + secondary, operator, monadic formula; + secondary, operator, formula; + monadic formula; + monadic formula, operator, secondary; + monadic formula, operator, monadic formula; + monadic formula, operator, formula; + formula, operator, secondary; + formula, operator, monadic formula; + formula, operator, formula. + + The formula lowers into some GENERIC expression. */ + +tree +a68_lower_formula (NODE_T *p, LOW_CTX_T ctx) +{ + if (IS (SUB (p), MONADIC_FORMULA) && NEXT (SUB (p)) == NO_NODE) + return a68_lower_tree (SUB (p), ctx); + else + { + /* If the operator is defined in the standard prelude, then use its lowering + code. */ + if (TAG_TABLE (TAX (NEXT (SUB (p)))) == A68_STANDENV) + { + LOWERER_T lowerer = LOWERER (TAX (NEXT (SUB (p)))); + return (*lowerer) (p, ctx); + } + else + { + tree arg1 = a68_lower_tree (SUB (p), ctx); + tree op = a68_lower_tree (NEXT (SUB (p)), ctx); + tree arg2 = a68_lower_tree (NEXT (NEXT (SUB (p))), ctx); + + if (POINTER_TYPE_P (TREE_TYPE (op))) + op = fold_build1 (INDIRECT_REF, + TREE_TYPE (TREE_TYPE (op)), + op); + return build_call_expr_loc (a68_get_node_location (p), op, 2, arg1, arg2); + } + } +} + +/* Lower a monadic formula. + + monadic formula : operator, secondary; + operator, monadic formula. + + The monadic formula lowers into some GENERIC expression. */ + +tree +a68_lower_monadic_formula (NODE_T *p, LOW_CTX_T ctx) +{ + /* If the operator is defined in the standard prelude, then use its lowering + code. */ + if (TAG_TABLE (TAX (SUB (p))) == A68_STANDENV) + { + LOWERER_T lowerer = LOWERER (TAX (SUB (p))); + return (*lowerer) (p, ctx); + } + else + { + tree op = a68_lower_tree (SUB (p), ctx); + tree secondary = a68_lower_tree (NEXT (SUB (p)), ctx); + + if (POINTER_TYPE_P (TREE_TYPE (op))) + op = fold_build1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (op)), op); + return build_call_expr_loc (a68_get_node_location (p), op, 1, secondary); + } +} + +/* Lower a tertiary. + + tertiary : nihil; monadic formula; formula; secondary. + + The tertiary lowers to some GENERIC expression. */ + +tree +a68_lower_tertiary (NODE_T *p, LOW_CTX_T ctx) +{ + return a68_lower_tree (SUB (p), ctx); +} + +/* Lower an assignation. + + assignation : tertiary, assign symbol, tertiary; + tertiary, assign symbol, identity relation; + tertiary, assign symbol, and function; + tertiary, assign symbol, or function; + tertiary, assign symbol, routine text; + tertiary, assign symbol, jump; + tertiary, assign symbol, skip; + tertiary, assign symbol, assignation; + tertiary, assign symbol, code clause. + + An assignation lowers into appending a MODIFY_EXPR to the statements list, + and the result of the expression is the left hand side. A compound + expression fits perfectly */ + +tree +a68_lower_assignation (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *lhs_node = SUB (p); + NODE_T *rhs_node = NEXT (NEXT (SUB (p))); + tree lhs = a68_lower_tree (lhs_node, ctx); + tree rhs = a68_lower_tree (rhs_node, ctx); + + return a68_low_assignation (p, + lhs, MOID (lhs_node), + rhs, MOID (rhs_node)); +} + +/* Lower a generator. + + generator : loc symbol, declarer; + heap symbol, declarer; + new symbol, declarer. + + LOC generators lower into calls to BUILT_IN_ALLOCA. + HEAP generators lower into calls to malloc. */ + +tree +a68_lower_generator (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *declarer = NEXT (SUB (p)); + return a68_low_generator (declarer, + MOID (declarer), + !IS (SUB (p), LOC_SYMBOL), + ctx); +} + +/* Lower a procedure call. + + */ + +static void +collect_call_arguments (NODE_T *p, vec *args, LOW_CTX_T ctx) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, UNIT)) + { + /* In Algol 68 parameters are passed via an identity declaration, so + this must implement same semantics. */ + tree arg = a68_lower_tree (p, ctx); + if (HAS_ROWS (MOID (p))) + arg = a68_low_dup (arg); + arg = a68_consolidate_ref (MOID (p), arg); + args->quick_push (arg); + } + else + collect_call_arguments (SUB (p), args, ctx); + } +} + +tree +a68_lower_call (NODE_T *p, LOW_CTX_T ctx) +{ + MOID_T *proc_mode = MOID (SUB (p)); + MOID_T *ret_mode = SUB (proc_mode); + unsigned int nargs = DIM (proc_mode); + + /* Collect arguments. */ + vec *args; + vec_alloc (args, nargs); + collect_call_arguments (NEXT (SUB (p)), args, ctx); + + /* Lower the primary to call. */ + tree primary = a68_lower_tree (SUB (p), ctx); + + /* We need a pointer to a function type. */ + if (!POINTER_TYPE_P (TREE_TYPE (primary))) + primary = fold_build1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (primary)), + primary); + + /* Build a function call. */ + tree call = build_call_vec (CTYPE (ret_mode), primary, args); + SET_EXPR_LOCATION (call, a68_get_node_location (p)); + return call; +} + +/* Lower a routine text. + + routine text : parameter pack, (declarer ; void symbol), colon symbol, assignation; + parameter pack, (declarer ; void symbol), colon symbol, identity relation; + parameter pack, (declarer ; void symbol), colon symbol, and function; + parameter pack, (declarer ; void symbol), colon symbol, or runction; + parameter pack, (declarer ; void symbol), colon symbol, jump; + parameter pack, (declarer ; void symbol), colon symbol, skip; + parameter pack, (declarer ; void symbol), colon symbol, tertiary; + parameter pack, (declarer ; void symbol), colon symbol, routine text; + parameter pack, (declarer ; void symboL), colon symbol, code clause; + (declarer ; void symbol), colon symbol, assignation; + (declarer ; void symbol), colon symbol, identity relation; + (declarer ; void symbol), colon symbol, and function; + (declarer ; void symbol), colon symbol, or runction; + (declarer ; void symbol), colon symbol, jump; + (declarer ; void symbol), colon symbol, skip; + (declarer ; void symbol), colon symbol, tertiary; + (declarer ; void symbol), colon symbol, routine text; + (declarer ; void symbol), colon symbol, code clause. + + Routine texts are used to create routines. They can stand as the actual + parameter of an identity declaration, as the actual parameter of a call, or + as the right-hand side of an assignation. + + This lowering function is called in two different contexts: + + 1) As part of a routine-identity-declaration, in which case the routine + resulting from this routine-text is beign ascribed to an identifier given + in ctx.proc_decl_identifier. In that case, we lower to a FUNC_DECL + initialized with the body of the routine-text. + + 2) As a free standing routine-text. In that case ctx.proc_decl_identifier is + NO_NODE. We lower to the address of a FUNC_DECL that features some unique + name. This pointer will then likely be assigned or ascribed to some + variable or identifier in non-contracted identity declaration, but we + cannot assume that so we have to opt for the indirection. */ + +tree +a68_lower_routine_text (NODE_T *p, LOW_CTX_T ctx) +{ + NODE_T *s = SUB (p); + + tree func_decl = NULL_TREE; + NODE_T *defining_identifier = ctx.proc_decl_identifier; + bool defining_operator = ctx.proc_decl_operator; + if (defining_identifier != NO_NODE) + { + /* The routine-text is part of a routine-identity-declaration. */ + func_decl = TAX_TREE_DECL (TAX (defining_identifier)); + if (func_decl == NULL_TREE) + { + func_decl + = a68_make_proc_identity_declaration_decl (defining_identifier, + ctx.module_definition_name, + defining_operator /* indicant */); + TAX_TREE_DECL (TAX (defining_identifier)) = func_decl; + } + + /* If the routine-identity-declaration is in a public range then add the + declaration to the publicized declarations list. Otherwise chain the + declaration in the proper block and bind it. */ + if (PUBLIC_RANGE (TABLE (TAX (defining_identifier)))) + vec_safe_push (A68_MODULE_DEFINITION_DECLS, func_decl); + else + a68_add_decl (func_decl); + } + else + { + /* The routine-text is free standing. */ + func_decl = a68_make_anonymous_routine_decl (MOID (p)); + a68_add_decl (func_decl); + } + + a68_add_decl_expr (fold_build1_loc (a68_get_node_location (p), + DECL_EXPR, + TREE_TYPE (func_decl), + func_decl)); + announce_function (func_decl); + + /* PARAMETER_PACK. */ + NODE_T *parameter_pack_node = NO_NODE; + tree parameter_pack = NULL_TREE; /* This is computed below. */ + if (IS (s, PARAMETER_PACK)) + { + parameter_pack_node = s; + FORWARD (s); + } + + /* DECLARER or VOID_SYMBOL */ + if (IS (s, DECLARER) || IS (s, VOID_SYMBOL)) + /* This is not used, as this formal declarer is also available in the + procedure mode. So just skip it. */ + FORWARD (s); + + /* Skip the COLON_SYMBOL. */ + gcc_assert (IS (s, COLON_SYMBOL)); + FORWARD (s); + + /* Lower the function body. + + This should be done in a new range in which the formal parameters of the + routine-text have been declared. */ + a68_push_function_range (func_decl, CTYPE (SUB (MOID (p))) /* result_type */); + if (parameter_pack_node != NO_NODE) + parameter_pack = a68_lower_tree (parameter_pack_node, ctx); + DECL_ARGUMENTS (func_decl) = parameter_pack; + ctx.proc_decl_identifier = NO_NODE; + tree func_body = a68_lower_tree (s, ctx); + a68_pop_function_range (func_body); + + if (defining_identifier != NO_NODE) + /* Routine-text immediately ascribed to some identifier in a + proc-identity-declaration. Return the FUNC_DECL. */ + return func_decl; + else + /* Free standing routine-text. Return its address. */ + return fold_build1 (ADDR_EXPR, + build_pointer_type (TREE_TYPE (func_decl)), + func_decl); +} + +/* Lower an unit. + + unit : assignation; identity relation; + and function; or function; routine text; + jump; skip; tertiary; assertion; code clause. + + The unit lowers to an expression. */ + +tree +a68_lower_unit (NODE_T *p, LOW_CTX_T ctx) +{ + return a68_lower_tree (SUB (p), ctx); +} From 1150e6de7593c9df32106ea00a502429ef051703 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:54:37 +0200 Subject: [PATCH 173/373] a68: low: modes Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/a68-low-moids.cc: New file. --- gcc/algol68/a68-low-moids.cc | 729 +++++++++++++++++++++++++++++++++++ 1 file changed, 729 insertions(+) create mode 100644 gcc/algol68/a68-low-moids.cc diff --git a/gcc/algol68/a68-low-moids.cc b/gcc/algol68/a68-low-moids.cc new file mode 100644 index 000000000000..4dbf11891628 --- /dev/null +++ b/gcc/algol68/a68-low-moids.cc @@ -0,0 +1,729 @@ +/* Lower Algol 68 modes to GCC trees. + Copyright (C) 2025 Jose E. Marchesi. + + Written by Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public + License for more details. + + You should have received a copy of the GNU General Public License + along with GCC; see the file COPYING3. If not see + . */ + +#define INCLUDE_MEMORY +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "stringpool.h" +#include "tree.h" + +#include "tree.h" +#include "fold-const.h" +#include "diagnostic.h" +#include "langhooks.h" +#include "tm.h" +#include "function.h" +#include "toplev.h" +#include "varasm.h" +#include "predict.h" +#include "stor-layout.h" +#include "print-tree.h" + +#include "a68.h" + +static tree a68_lower_mode (MOID_T *m); + +/* + * Support routines and definitions. + */ + +/* Build a stub TYPE_DECL for a given TYPE. + + This is used for TYPE_STUB_DECL so we can generate debug info for all our + modes, so the TYPE_DECL has no name. */ + +static void +build_stub_type_decl (tree type, tree context) +{ + if (TYPE_STUB_DECL (type)) + return; + + tree decl = build_decl (UNKNOWN_LOCATION, + TYPE_DECL, + NULL_TREE /* name */, + type); + TREE_PUBLIC (decl) = 1; + DECL_CONTEXT (decl) = context; + TYPE_CONTEXT (type) = DECL_CONTEXT (decl); + TYPE_NAME (type) = decl; /* Weird. This is for typedefs! */ + TYPE_STUB_DECL (type) = decl; +} + +/* Builds a record type whose name is NAME. NFIELDS is the number of fields, + provided as field ident/type pairs. + + This code is copied from the D front end. */ + +static tree +make_struct_type (tree type, const char *name, int nfields, ...) +{ + tree fields = NULL_TREE; + va_list ap; + + va_start (ap, nfields); + + for (int i = 0; i < nfields; i++) + { + tree ident = va_arg (ap, tree); + tree type = va_arg (ap, tree); + tree field = build_decl (BUILTINS_LOCATION, FIELD_DECL, ident, type); + DECL_CHAIN (field) = fields; + fields = field; + } + + va_end (ap); + + if (type == NULL_TREE) + type = make_node (RECORD_TYPE); + finish_builtin_struct (type, name, fields, NULL_TREE); + + return type; +} + +/* Iterate over all the field selectors FIELDS of a structure type and add them + as fields to CONTEXT. Returns the number of field selectors found. */ + +static size_t +chain_struct_fields (PACK_T *fields, tree context) +{ + PACK_T *elem; + size_t num_fields; + + for (num_fields = 0, elem = fields; + elem != NO_PACK; + FORWARD (elem), ++num_fields) + { + const char *field_name = TEXT (elem); + MOID_T *field_mode = MOID (elem); + tree field_type = a68_lower_mode (field_mode); + + /* Create the field declaration. + The declaration is not a compiler-generated entity. + Do not ignore the declaration for symbolic debug purposes. */ + tree field_decl = build_decl ((NODE (field_mode) + ? a68_get_node_location (NODE (field_mode)) + : UNKNOWN_LOCATION), + FIELD_DECL, + field_name ? get_identifier (field_name) : NULL_TREE, + field_type); + DECL_ARTIFICIAL (field_decl) = 0; + DECL_IGNORED_P (field_decl) = 0; + + /* If the mode of the field is not a ref then references to the field + cannot appear in a LHS of an assignment. */ + TREE_READONLY (field_decl) = IS_REF (field_mode); + + /* Associate the tree field declaration and the front end node. */ + DECL_LANG_SPECIFIC (field_decl) = + (NODE (field_mode) ? a68_build_lang_decl (NODE (field_mode)) : NULL); + + /* Chain the field declaration in its containing context. */ + DECL_FIELD_CONTEXT (field_decl) = context; + TYPE_FIELDS (context) = chainon (TYPE_FIELDS (context), field_decl); + } + + return num_fields; +} + +/* If the union or struct type TYPE completes the type of any previous field + declarations, lay them out now. */ + +static void +finish_incomplete_fields (tree type) +{ + for (tree fwdref = TYPE_FORWARD_REFERENCES (type); fwdref != NULL_TREE; + fwdref = TREE_CHAIN (fwdref)) + { + tree field = TREE_VALUE (fwdref); + tree struct_or_union_type = DECL_FIELD_CONTEXT (field); + + relayout_decl (field); + bool type_complete = true; + for (tree field = TYPE_FIELDS (struct_or_union_type); + field; + field = DECL_CHAIN (field)) + { + if (!COMPLETE_TYPE_P (TREE_TYPE (field))) + { + type_complete = false; + break; + } + } + + if (type_complete) + { + // XXX why this fires + // gcc_assert (!COMPLETE_TYPE_P (struct_or_union_type)); + layout_type (struct_or_union_type); + /* Set the back-end type mode now that all fields have had their size + set. */ + compute_record_mode (struct_or_union_type); + } + }; + + /* No more forward references to process. */ + TYPE_FORWARD_REFERENCES (type) = NULL_TREE; +} + +/* + * Mode lowering routines. + */ + +/* Lower a HIP mode to a GENERIC tree. + HIP is the mode of NIL. */ + +static tree +lower_hip_mode (MOID_T *m) +{ + static tree hip_type; + + if (hip_type == NULL) + { + hip_type = build_pointer_type (a68_void_type); + TYPE_LANG_SPECIFIC (hip_type) = a68_build_lang_type (m); + CTYPE (m) = hip_type; + } + + return hip_type; +} + +/* Lower a standard mode to a GENERIC tree. + + Note that this function only has to handle the standard modes that have not + been resolved to some equivalent. */ + +static tree +lower_standard_mode (MOID_T *m) +{ + tree type = NULL_TREE; + + if (m == M_VOID) + type = a68_void_type; + else if (m == M_BOOL) + type = a68_bool_type; + else if (m == M_CHAR) + type = a68_char_type; + else if (m == M_SHORT_SHORT_INT) + type = a68_short_short_int_type; + else if (m == M_SHORT_INT) + type = a68_short_int_type; + else if (m == M_INT) + type = a68_int_type; + else if (m == M_LONG_INT) + type = a68_long_int_type; + else if (m == M_LONG_LONG_INT) + type = a68_long_long_int_type; + else if (m == M_REAL) + type = a68_real_type; + else if (m == M_LONG_REAL) + type = a68_long_real_type; + else if (m == M_LONG_LONG_REAL) + type = a68_long_long_real_type; + else if (m == M_SHORT_SHORT_BITS) + type = a68_short_short_bits_type; + else if (m == M_SHORT_BITS) + type = a68_short_bits_type; + else if (m == M_BITS) + type = a68_bits_type; + else if (m == M_LONG_BITS) + type = a68_long_bits_type; + else if (m == M_LONG_LONG_BITS) + type = a68_long_long_bits_type; + else if (m == M_BYTES) + type = a68_bytes_type; + else if (m == M_LONG_BYTES) + type = a68_long_bytes_type; + else if (m == M_FILE) + /* XXX for now this is a file descriptor. */ + type = integer_type_node; + else if (m == M_CHANNEL) + /* XXX for now this is a channel descriptor. */ + type = integer_type_node; + else + gcc_unreachable (); + + TYPE_LANG_SPECIFIC (type) = a68_build_lang_type (m); + return type; +} + +/* Lower a struct mode to a GENERIC tree. */ + +static tree +lower_struct_mode (MOID_T *m) +{ + /* First make the GENERIC struct. This is needed in case of + self-references. */ + tree struct_type = make_node (RECORD_TYPE); + TYPE_NAME (struct_type) = get_identifier ("lalastruct%"); + TYPE_FIELDS (struct_type) = NULL_TREE; + TYPE_CXX_ODR_P (struct_type) = 0; + CTYPE (m) = struct_type; + TYPE_LANG_SPECIFIC (struct_type) = a68_build_lang_type (m); /* XXX this will get overrided. */ + + /* Add field declarations. */ + chain_struct_fields (PACK (m), struct_type); + + /* Layout all fields. */ + bool struct_type_complete = true; + for (tree field = TYPE_FIELDS (struct_type); field; field = DECL_CHAIN (field)) + { + tree basetype = TREE_TYPE (field); + + if (!COMPLETE_TYPE_P (basetype)) + { + tree field_type = TREE_TYPE (field); + tree forward_refs = tree_cons (NULL_TREE, field, + TYPE_FORWARD_REFERENCES (field_type)); + TYPE_FORWARD_REFERENCES (struct_type) = forward_refs; + + struct_type_complete = false; + continue; + } + + layout_decl (field, 0); + gcc_assert (DECL_SIZE (field) != NULL_TREE); + } + + /* If all fields have complete types then we can layout the struct type now. + Otherwise it will be done in finish_incomplete_types. */ + if (struct_type_complete) + { + layout_type (struct_type); + /* Set the back-end type mode now that all fields have had their size + set. */ + compute_record_mode (struct_type); + } + + /* Finish debugging output for this type. */ + build_stub_type_decl (struct_type, NULL_TREE /* context */); + rest_of_type_compilation (struct_type, TYPE_FILE_SCOPE_P (struct_type)); + rest_of_decl_compilation (TYPE_NAME (struct_type), 1 /* file scope p */, 0); + A68_STRUCT_TYPE_P (struct_type) = 1; + return struct_type; +} + +/* Lower a ref mode to a GENERIC tree. + REF AMODE lowers to a pointer. */ + +static tree +lower_ref_mode (MOID_T *m) +{ + return build_pointer_type (a68_lower_mode (SUB (m))); +} + +/* Lower a flex mode to a GENERIC tree. */ + +static tree +lower_flex_mode (MOID_T *m) +{ + /* This is basically a qualifier of the parent REF. */ + return a68_lower_mode (SUB (m)); +} + +/* Lower a proc mode to a GENERIC tree. */ + +static tree +lower_proc_mode (MOID_T *m) +{ + tree fnargs = NULL_TREE; + tree ret_type; + + /* We have to create the function type in advance because it can appear + recursively as the type of arguments and/or of the return value. We + cannot use build_function_type, as it doesn't support recursive types. */ + tree function_type = make_node (FUNCTION_TYPE); + tree ptr_function_type = build_pointer_type (function_type); + CTYPE (m) = ptr_function_type; + + /* Now add arguments and return value types. */ + for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p)) + { + tree arg_type = a68_lower_mode (MOID (p)); + fnargs = chainon (fnargs, build_tree_list (0, arg_type)); + } + ret_type = a68_lower_mode (SUB (m)); + + /* Complete the function type. Note that there is some code duplication with + build_function_type, which we cannot use, but such is life. */ + TREE_TYPE (function_type) = ret_type; /* THIS */ + TYPE_ARG_TYPES (function_type) = fnargs; + SET_TYPE_STRUCTURAL_EQUALITY (function_type); + + if (!COMPLETE_TYPE_P (function_type)) + layout_type (function_type); + + return ptr_function_type; +} + +/* Lower an union mode to a GENERIC tree. + + overhead% Characterizes the actual mode of the value. + value% GENERIC union. */ + +static tree +lower_union_mode (MOID_T *m) +{ + // XXX make the union type QUAL_UNION_TYPE and relate the fields with the + // overhead%. This is necessary for DWARF. + tree union_type = make_node (RECORD_TYPE); + TYPE_NAME (union_type) = NULL_TREE; + TYPE_FIELDS (union_type) = NULL_TREE; + TYPE_CXX_ODR_P (union_type) = 0; + CTYPE (m) = union_type; + + /* Then the GENERIC union. */ + tree c_union_type = make_node (UNION_TYPE); + TYPE_NAME (c_union_type) = NULL_TREE; + TYPE_FIELDS (c_union_type) = NULL_TREE; + TYPE_CXX_ODR_P (c_union_type) = 0; // XXX otherwise lto complains. why. + SET_TYPE_STRUCTURAL_EQUALITY (c_union_type); + + /* Add field declarations. */ + chain_struct_fields (PACK (m), c_union_type); + + /* Layout all fields now the type is complete. */ + bool c_union_type_complete = true; + for (tree field = TYPE_FIELDS (c_union_type); field; field = DECL_CHAIN (field)) + { + tree field_type = TREE_TYPE (field); + + if (!COMPLETE_TYPE_P (field_type)) + { + tree field_type = TREE_TYPE (field); + tree forward_refs = tree_cons (NULL_TREE, field, + TYPE_FORWARD_REFERENCES (field_type)); + TYPE_FORWARD_REFERENCES (c_union_type) = forward_refs; + + c_union_type_complete = false; + continue; + } + + layout_decl (field, 0); + gcc_assert (DECL_SIZE (field) != NULL_TREE); + } + + /* If all fields have complete types then we can layout the c-union type now. + Otherwise it will be done in finish_incomplete_types. */ + if (c_union_type_complete) + { + layout_type (c_union_type); + /* Set the back-end type mode now that all fields have had their size + set. */ + compute_record_mode (c_union_type); + } + + /* Finish debugging output for this type. */ + build_stub_type_decl (c_union_type, NULL_TREE /* context */); + rest_of_type_compilation (c_union_type, TYPE_FILE_SCOPE_P (c_union_type)); + rest_of_decl_compilation (TYPE_NAME (c_union_type), 1 /* file scope p */, 0); + + /* Now the type with the overhead. */ + TYPE_NAME (union_type) = get_identifier ("union%"); + tree overhead_field = build_decl (UNKNOWN_LOCATION, FIELD_DECL, + get_identifier ("overhead%"), sizetype); + tree value_field = build_decl (UNKNOWN_LOCATION, FIELD_DECL, + get_identifier ("value%"), c_union_type); + DECL_FIELD_CONTEXT (overhead_field) = union_type; + DECL_FIELD_CONTEXT (value_field) = union_type; + DECL_CHAIN (value_field) = NULL_TREE; + DECL_CHAIN (overhead_field) = value_field; + TYPE_FIELDS (union_type) = overhead_field; + + if (c_union_type_complete) + { + layout_type (union_type); + /* Set the back-end type mode now that all fields have had their size + set. */ + compute_record_mode (union_type); + } + else + { + tree forward_refs = tree_cons (NULL_TREE, value_field, + TYPE_FORWARD_REFERENCES (union_type)); + TYPE_FORWARD_REFERENCES (union_type) = forward_refs; + } + + SET_TYPE_STRUCTURAL_EQUALITY (union_type); + A68_UNION_TYPE_P (union_type) = 1; + return union_type; +} + +/* Return the type for an array descriptor triplet. */ + +tree +a68_triplet_type (void) +{ + static tree triplet_type = NULL_TREE; + if (triplet_type == NULL_TREE) + { + triplet_type = make_struct_type (NULL_TREE, "triplet%", 3, + get_identifier ("lb%"), + ssizetype, + get_identifier ("ub%"), + ssizetype, + get_identifier ("stride%"), + sizetype); + } + + return triplet_type; +} + +/* Return the lower bound field in an array descriptor triplet. */ + +tree +a68_triplet_type_lower_bound (tree triplet) +{ + tree lb_field = TYPE_FIELDS (triplet); + return lb_field; +} + +/* Lower a row mode to a GENERIC tree. + + descriptor% + triplets% Value of ARRAY_TYPE with an entry per multiple dimension. + { + li% Lower bound of dimension. + ui% Upper bound of dimension. + di% Stride of dimension in bytes. + } + elements% Pointer to the elements. + elements_size% Size of elements% in bytes. +*/ + +static tree +lower_row_mode (MOID_T *m) +{ + int num_dimensions = DIM (m); + tree triplet_type = a68_triplet_type (); + tree triplets_type = build_array_type (triplet_type, + build_index_type (size_int (num_dimensions - 1))); + tree element_type = a68_lower_mode (SUB (m)); + tree row_type = make_struct_type (NULL_TREE, "row%", 3, + get_identifier ("triplets%"), + triplets_type, + get_identifier ("elements%"), + build_pointer_type (element_type), + get_identifier ("elements_size%"), + sizetype); + layout_type (row_type); + A68_ROW_TYPE_P (row_type) = 1; + return row_type; +} + +/* Given a row type, return the type of the pointer to its elements. */ + +tree +a68_row_elements_pointer_type (tree type) +{ + gcc_assert (A68_ROW_TYPE_P (type)); + /* elements% is the second field. */ + return TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (type))); +} + +/* Given a row type, return the type of its elements. */ + +tree +a68_row_elements_type (tree type) +{ + return TREE_TYPE (a68_row_elements_pointer_type (type)); +} + +/* Lower a ROWS mode to a GENERIC tree. + + dim% Number of dimensions. + triplets% Pointer to triplets. + + Values of this mode are passed to the operators UPB, LWB and ELEMS, which + need only descriptor information. There is no need to store any multiple + elements. */ + +static tree +lower_rows_mode (MOID_T *m ATTRIBUTE_UNUSED) +{ + static tree rows_type = NULL_TREE; + + if (rows_type == NULL_TREE) + { + rows_type = make_struct_type (NULL_TREE, "rows%", 2, + get_identifier ("dim%"), + sizetype, + get_identifier ("triplets%"), + build_pointer_type (a68_triplet_type ())); + A68_ROWS_TYPE_P (rows_type) = 1; + } + return rows_type; +} + +/* Lower modes in a series. This is used as the mode of the mode yielded by an + enclosed clause that yields a series of united rows, for M_ROWS. */ + +static tree +lower_series (MOID_T *m) +{ + for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p)) + { + if (IS (MOID (p), SERIES_MODE) || IS (MOID (p), STOWED_MODE)) + lower_series (MOID (p)); + else + (void) a68_lower_mode (MOID (p)); + } + + return lower_rows_mode (NO_MOID); +} + +/* Lower a mode to a GENERIC tree. */ + +static tree +a68_lower_mode (MOID_T *m) +{ + tree type = NULL_TREE; + + /* If the given mode has already been lowered, return the corresponding + tree. */ + if (CTYPE (m) != NULL) + return CTYPE (m); + + if (EQUIVALENT (m) != NO_MOID && EQUIVALENT (m) != m) + /* This covers INDICANTs and standard MOIDS having an equivalent mode. */ + type = a68_lower_mode (EQUIVALENT (m)); + else if (m == M_VOID) + type = a68_void_type; + else if (m == M_HIP) + type = lower_hip_mode (m); + else if (IS (m, STANDARD)) + type = lower_standard_mode (m); + else if (IS_REF (m)) + type = lower_ref_mode (m); + else if (IS_FLEX (m)) + type = lower_flex_mode (m); + else if (IS (m, PROC_SYMBOL)) + type = lower_proc_mode (m); + else if (IS_STRUCT (m)) + type = lower_struct_mode (m); + else if (IS_ROW (m)) + type = lower_row_mode (m); + else if (IS_UNION (m)) + type = lower_union_mode (m); + else if (m == M_SIMPLOUT || m == M_SIMPLIN) + type = a68_void_type; + else if (IS (m, ROWS_SYMBOL)) + /* ROWS is a mode that means "any row mode". */ + type = lower_rows_mode (m); + else if (m == M_VACUUM) + /* This is a mode that should not survive the parser. */ + type = a68_void_type; + else if (IS (m, SERIES_MODE) || IS (m, STOWED_MODE)) + { + /* When dealing with operators the parser creates some modes that leak + SERIES and STOWED "proto-modes" in them, such as for example: + + UNION ((INT, INT), INT, PROC [] CHAR) + + These are not really real Algol 68 modes and are useless by + themselves, so when we find them, we traverse them (they ultimately + contain valid modes that may show up in other contexts and that + require being lowered) and just report them as VOID. */ + type = lower_series (m); + } + else + { + fatal_error (NODE (m) ? a68_get_node_location (NODE (m)) : UNKNOWN_LOCATION, + "Cannot lower mode %s", + a68_moid_to_string (m, MOID_ERROR_WIDTH, NODE (m))); + } + + /* Associate the created tree node with the mode, and vice-versa. */ + gcc_assert (type != NULL_TREE); + TYPE_LANG_SPECIFIC (type) = a68_build_lang_type (m); + A68_TYPE_HAS_ROWS_P (type) = HAS_ROWS (m); + if (CTYPE (m) == NULL_TREE) + CTYPE (m) = type; + // printf ("DONE LOWERING %s\n", a68_moid_to_string (m, MOID_ERROR_WIDTH, NODE (m))); + return type; +} + +/* Lower MOIDs to GENERIC trees. */ + +void +a68_lower_moids (MOID_T *mode) +{ + /* First pass: all modes but refs. */ + for (MOID_T *m = mode; m != NO_MOID; FORWARD (m)) + (void) a68_lower_mode (m); + + /* Try to layout all incomplete types. This is a two-passes process. */ + + for (MOID_T *m = mode; m != NO_MOID; FORWARD (m)) + { + if (IS_STRUCT (m)) + { + tree struct_type = CTYPE (m); + finish_incomplete_fields (struct_type); + } + else if (IS_UNION (m)) + { + tree union_type = CTYPE (m); + tree c_union_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (union_type))); + finish_incomplete_fields (c_union_type); + finish_incomplete_fields (union_type); + } + } + + for (MOID_T *m = mode; m != NO_MOID; FORWARD (m)) + { + if (!COMPLETE_TYPE_P (CTYPE (m))) + { + if (IS_STRUCT (m)) + { + tree struct_type = CTYPE (m); + layout_type (struct_type); + compute_record_mode (struct_type); + } + else if (IS_UNION (m)) + { + tree union_type = CTYPE (m); + tree c_union_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (union_type))); + + if (!COMPLETE_TYPE_P (c_union_type)) + { + layout_type (c_union_type); + compute_record_mode (c_union_type); + } + + layout_type (union_type); + compute_record_mode (union_type); + } + else + layout_type (CTYPE (m)); + } + } + + /* Sanity check. */ + for (MOID_T *m = mode; m != NO_MOID; FORWARD (m)) + { + gcc_assert (COMPLETE_TYPE_P (CTYPE (m))); + if (IS_UNION (m)) + { + tree union_type = CTYPE (m); + tree c_union_type = TREE_TYPE (TREE_CHAIN (TYPE_FIELDS (union_type))); + gcc_assert (COMPLETE_TYPE_P (c_union_type)); + } + } +} From b67e045af7c2a91f13f48075a48ec63018c47a19 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:54:57 +0200 Subject: [PATCH 174/373] a68: libga68: sources, spec and misc files Signed-off-by: Jose E. Marchesi ChangeLog * libga68/README: New file. * libga68/ga68-alloc.c: Likewise. * libga68/ga68-error.c: Likewise. * libga68/ga68-posix.c: Likewise. * libga68/ga68-standenv.c: Likewise. * libga68/ga68-unistr.c: Likewise. * libga68/ga68.h: Likewise. * libga68/libga68.c: Likewise. * libga68/libga68.spec.in: Likewise. --- libga68/README | 2 + libga68/ga68-alloc.c | 114 ++++++++ libga68/ga68-error.c | 151 ++++++++++ libga68/ga68-posix.c | 463 ++++++++++++++++++++++++++++++ libga68/ga68-standenv.c | 48 ++++ libga68/ga68-unistr.c | 615 ++++++++++++++++++++++++++++++++++++++++ libga68/ga68.h | 126 ++++++++ libga68/libga68.c | 52 ++++ libga68/libga68.spec.in | 11 + 9 files changed, 1582 insertions(+) create mode 100644 libga68/README create mode 100644 libga68/ga68-alloc.c create mode 100644 libga68/ga68-error.c create mode 100644 libga68/ga68-posix.c create mode 100644 libga68/ga68-standenv.c create mode 100644 libga68/ga68-unistr.c create mode 100644 libga68/ga68.h create mode 100644 libga68/libga68.c create mode 100644 libga68/libga68.spec.in diff --git a/libga68/README b/libga68/README new file mode 100644 index 000000000000..23929a60451e --- /dev/null +++ b/libga68/README @@ -0,0 +1,2 @@ +This is the GNU Algol 68 run-time library. It provides the run-time +components needed by programs compiled by the ga68 compiler. diff --git a/libga68/ga68-alloc.c b/libga68/ga68-alloc.c new file mode 100644 index 000000000000..1cf922eb2115 --- /dev/null +++ b/libga68/ga68-alloc.c @@ -0,0 +1,114 @@ +/* Run-time routines for memory allocation. + + Copyright (C) 2025 Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it under the + terms of the GNU General Public License as published by the Free Software + Foundation; either version 3, or (at your option) any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + details. + + Under Section 7 of GPL version 3, you are granted additional permissions + described in the GCC Runtime Library Exception, version 3.1, as published by + the Free Software Foundation. + + You should have received a copy of the GNU General Public License and a copy + of the GCC Runtime Library Exception along with this program; see the files + COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + +#include + +#include "ga68.h" + +/* Heap allocation routines. */ + +void +_libga68_free_internal (void *pt) +{ + free (pt); +} + +void * +_libga68_malloc_internal (size_t size) +{ + void *res = (void *) malloc (size); + if (!res) + _libga68_abort ("Virtual memory exhausted\n"); + return res; +} + +#if LIBGA68_WITH_GC +#include + +void +_libga68_init_heap (void) +{ + if (!GC_is_init_called ()) + { + GC_INIT (); + /* GC_allow_register_threads (); */ + } +} + +void * +_libga68_realloc (void *ptr, size_t size) +{ + void *res = (void *) GC_realloc (ptr, size); + if (!res) + _libga68_abort ("Virtual memory exhausted\n"); + return res; +} + +void * +_libga68_realloc_unchecked (void *ptr, size_t size) +{ + void *res = (void *) GC_realloc (ptr, size); + return res; +} + +void * +_libga68_malloc (size_t size) +{ + void *res = (void *) GC_malloc (size); + if (!res) + _libga68_abort ("Virtual memory exhausted\n"); + return res; +} + +#else + +void +_libga68_init_heap (void) +{ +} + +void * +_libga68_realloc (void *ptr, size_t size) +{ + void *res = (void *) realloc (ptr, size); + if (!res) + _libga68_abort ("Virtual memory exhausted\n"); + return res; +} + +void * +_libga68_realloc_unchecked (void *ptr, size_t size) +{ + void *res = (void *) realloc (ptr, size); + return res; +} + +void * +_libga68_malloc (size_t size) +{ + void *res = (void *) malloc (size); + if (!res) + _libga68_abort ("Virtual memory exhausted\n"); + return res; +} + +#endif /* !LIBGA68_WITH_GC */ diff --git a/libga68/ga68-error.c b/libga68/ga68-error.c new file mode 100644 index 000000000000..28f71659645f --- /dev/null +++ b/libga68/ga68-error.c @@ -0,0 +1,151 @@ +/* Support run-time routines for error handling. + + Copyright (C) 2025 Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it under the + terms of the GNU General Public License as published by the Free Software + Foundation; either version 3, or (at your option) any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + details. + + Under Section 7 of GPL version 3, you are granted additional permissions + described in the GCC Runtime Library Exception, version 3.1, as published by + the Free Software Foundation. + + You should have received a copy of the GNU General Public License and a copy + of the GCC Runtime Library Exception along with this program; see the files + COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + +#include +#include /* For abort. */ + +#include "ga68.h" + +/* Run-time error handling. + + Please use the following format when outputing runtime error messages: + + FILE:LINE:[COLUMN:] TEXT + + This keeps the output aligned with other runtime libraries such as the + sanitizers. */ + +/* Emit a formatted error message to the standard output and then terminate the + process with an error code. */ + +void +_libga68_abort (const char *fmt, ...) +{ + va_list ap; + + va_start (ap, fmt); + vfprintf (stderr, fmt, ap); + abort (); + va_end (ap); +} + +/* Assertion failure. */ + +void +_libga68_assert (const char *filename, unsigned int lineno) +{ + _libga68_abort ("%s:%u: runtime error: ASSERT failure\n", + filename, lineno); +} + +/* Attempt to dereference NIL failure. */ + +void +_libga68_derefnil (const char *filename, unsigned int lineno) +{ + _libga68_abort ("%s:%u: runtime error: attempt to dereference NIL\n", + filename, lineno); +} + +/* Invalid character expression. */ + +void +_libga68_invalidcharerror (const char *filename, unsigned int lineno, + int c) +{ + if (c < 0) + _libga68_abort ("%s:%u: runtime error: %d is not a valid character point\n", + filename, lineno, c); + _libga68_abort ("%s:%u: runtime error: U+%x is not a valid character point\n", + filename, lineno, c); +} + +/* Out of bounds error in bits ELEM operator. */ + +void +_libga68_bitsboundserror (const char *filename, unsigned int lineno, + ssize_t pos) +{ + _libga68_abort ("%s:%u: runtime error: bound %zd out of range in ELEM\n", + filename, lineno, pos); +} + +/* Unreachable error. */ + +void +_libga68_unreachable (const char *filename, unsigned int lineno) +{ + _libga68_abort ("%s:%u: runtime error: unreachable reached\n", + filename, lineno); +} + +/* Lower bound failure. */ + +void +_libga68_lower_bound (const char *filename, unsigned int lineno, + ssize_t index, ssize_t lower_bound) +{ + _libga68_abort ("%s:%u: runtime error: lower bound %zd must be >= %zd\n", + filename, lineno, index, lower_bound); +} + +/* Upper bound failure. */ + +void +_libga68_upper_bound (const char *filename, unsigned int lineno, + ssize_t index, ssize_t upper_bound) +{ + _libga68_abort ("%s:%u: runtime error: upper bound %zd must be <= %zd\n", + filename, lineno, index, upper_bound); +} + +/* Bounds failure. */ + +void +_libga68_bounds (const char *filename, unsigned int lineno, + ssize_t index, ssize_t lower_bound, ssize_t upper_bound) +{ + _libga68_abort ("%s:%u: runtime error: bound %zd out of range [%zd:%zd]\n", + filename, lineno, index, lower_bound, upper_bound); +} + +/* Dimension failure. */ + +void +_libga68_dim (const char *filename, unsigned int lineno, + size_t dim, size_t index) +{ + _libga68_abort ("%s:%u: runtime error: invalid dimension %zd; shall be > 0 and <= %zu\n", + filename, lineno, index, dim); +} + +/* Multiples have different bounds in assignations. */ + +void +_libga68_bounds_mismatch (const char *filename, unsigned int lineno, + size_t dim, ssize_t lb1, ssize_t ub1, + ssize_t lb2, ssize_t ub2) +{ + _libga68_abort ("%s:%u: runtime error: multiple bounds mismatch in \ +assignation: dim %zu: [%zd:%zd] /= [%zd:%zd]\n", + filename, lineno, dim, lb1, ub1, lb2, ub2); +} diff --git a/libga68/ga68-posix.c b/libga68/ga68-posix.c new file mode 100644 index 000000000000..47038d6e39fd --- /dev/null +++ b/libga68/ga68-posix.c @@ -0,0 +1,463 @@ +/* Support run-time routines for the POSIX prelude. + + Copyright (C) 2025 Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it under the + terms of the GNU General Public License as published by the Free Software + Foundation; either version 3, or (at your option) any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + details. + + Under Section 7 of GPL version 3, you are granted additional permissions + described in the GCC Runtime Library Exception, version 3.1, as published by + the Free Software Foundation. + + You should have received a copy of the GNU General Public License and a copy + of the GCC Runtime Library Exception along with this program; see the files + COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + +#include "ga68.h" + +#include +#include +#include +#include /* For open. */ +#include /* For close and write. */ +#include /* For errno. */ +#include +#include /* For struct stat */ +#include +#include /* For gethostbyname. */ +#include /* For LLONG_MAX */ + +#define EOF_PSEUDO_CHARACTER -1 + +/* Some Unicode code points used in this file. */ + +#define REPLACEMENT_CHARACTER 0xFFFD +#define NEWLINE 0x000A + +/* Errno. */ + +static int _libga68_errno; + +/* Simple I/O based on POSIX file descriptors. */ + +int +_libga68_posixerrno (void) +{ + return _libga68_errno; +} + +void +_libga68_posixperror (uint32_t *s, size_t len, size_t stride) +{ + size_t u8len; + uint8_t *u8str = _libga68_u32_to_u8 (s, len, stride, NULL, &u8len); + + const char *errstr = strerror (_libga68_errno); + (void) write (2, u8str, u8len); + (void) write (2, ": ", 2); + (void) write (2, errstr, strlen (errstr)); + (void) write (2, "\n", 1); +} + +uint32_t * +_libga68_posixstrerror (int errnum, size_t *len) +{ + const char *str = strerror (errnum); + return _libga68_u8_to_u32 ((const uint8_t *)str, strlen (str), NULL, len); +} + +/* Helper for _libga68_posixfopen. */ +static int +_libga68_open (const char *path, unsigned int flags) +{ + int fd = open (path, flags); + _libga68_errno = errno; + return fd; +} + +#define FILE_O_DEFAULT 0x99999999 +#define FILE_O_RDONLY 0x0 +#define FILE_O_WRONLY 0x1 +#define FILE_O_RDWR 0x2 +#define FILE_O_TRUNC 0x8 + +int +_libga68_posixfopen (const uint32_t *pathname, size_t len, size_t stride, + unsigned int flags) +{ + int fd; + int openflags = 0; + size_t u8len; + const uint8_t *u8pathname = _libga68_u32_to_u8 (pathname, len, stride, NULL, + &u8len); + char *filepath = (char *) _libga68_malloc_internal (u8len + 1); + memcpy (filepath, u8pathname, u8len); + filepath[u8len] = '\0'; + + /* Default mode: try read-write initially. + If that fails, then try read-only. + If that fails, then try write-only. */ + if (flags == FILE_O_DEFAULT) + { + openflags = O_RDWR; + if ((fd = _libga68_open (filepath, openflags)) < 0) + { + openflags = O_RDONLY; + if ((fd = _libga68_open (filepath, openflags)) < 0) + { + openflags = O_WRONLY; + fd = _libga68_open (filepath, openflags); + _libga68_free_internal (filepath); + return fd; + } + } + _libga68_free_internal (filepath); + return fd; + } + + if (flags & FILE_O_RDONLY) + openflags |= O_RDONLY; + if (flags & FILE_O_WRONLY) + openflags |= O_WRONLY; + if (flags & FILE_O_RDWR) + openflags |= O_RDWR; + if (flags & FILE_O_TRUNC) + openflags |= O_TRUNC; + + fd = _libga68_open (filepath, openflags); + _libga68_free_internal (filepath); + return fd; +} + +int +_libga68_posixcreat (uint32_t *pathname, size_t len, size_t stride, + uint32_t mode) +{ + size_t u8len; + uint8_t *u8pathname = _libga68_u32_to_u8 (pathname, len, stride, NULL, &u8len); + u8pathname[u8len] = '\0'; + + int res = creat (u8pathname, mode); + _libga68_errno = errno; + return res; +} + +int +_libga68_posixclose (int fd) +{ + int res = close (fd); + _libga68_errno = errno; + return res; +} + +/* Implementation of the posix prelude `posix argc'. */ + +int +_libga68_posixargc (void) +{ + return _libga68_argc; +} + +/* Implementation of the posix prelude `posix argv'. */ + +uint32_t * +_libga68_posixargv (int n, size_t *len) +{ + if (n < 0 || n > _libga68_argc) + { + /* Return an empty string. */ + *len = 0; + return NULL; + } + else + { + char *arg = _libga68_argv[n - 1]; + return _libga68_u8_to_u32 (arg, strlen (arg), NULL, len); + } +} + +/* Implementation of the posix prelude `posix getenv'. */ + +void +_libga68_posixgetenv (uint32_t *s, size_t len, size_t stride, + uint32_t **r, size_t *rlen) +{ + size_t varlen; + char *varname = _libga68_u32_to_u8 (s, len, stride, NULL, &varlen); + + char *var = _libga68_malloc_internal (varlen + 1); + memcpy (var, varname, varlen); + var[varlen] = '\0'; + char *val = getenv (var); + _libga68_free_internal (var); + + if (val == NULL) + { + /* Return an empty string. */ + *r = NULL; + *rlen = 0; + } + else + *r = _libga68_u8_to_u32 (val, strlen (val), NULL, rlen); +} + +/* Implementation of the posix prelude `posix puts'. */ + +void +_libga68_posixputs (uint32_t *s, size_t len, size_t stride) +{ + (void) _libga68_posixfputs (1, s, len, stride); +} + +/* Implementation of the posix prelude `posix fputs'. */ + +int +_libga68_posixfputs (int fd, uint32_t *s, size_t len, size_t stride) +{ + size_t u8len; + uint8_t *u8str = _libga68_u32_to_u8 (s, len, stride, NULL, &u8len); + + ssize_t ret = write (fd, u8str, u8len); + _libga68_errno = errno; + if (ret == -1) + return 0; + else + return u8len; +} + +/* Implementation of the posix prelude `posix putc'. */ + +uint32_t +_libga68_posixfputc (int fd, uint32_t c) +{ + uint8_t u8[6]; + + int u8len = _libga68_u8_uctomb (u8, c, 6); + if (u8len < 0) + return EOF_PSEUDO_CHARACTER; + + ssize_t ret = write (fd, &u8, u8len); + if (ret == -1) + return EOF_PSEUDO_CHARACTER; + else + return c; +} + +/* Implementation of the posix prelude `posix putchar'. */ + +uint32_t +_libga68_posixputchar (uint32_t c) +{ + return _libga68_posixfputc (1, c); +} + +/* Implementation of the posix prelude `posix fgetc'. */ + +uint32_t +_libga68_posixfgetc (int fd) +{ + /* We need to read one char (byte) at a time from FD, until we complete a + full Unicode character. Then we convert to UCS-4. */ + + uint8_t c; + uint8_t u8c[6]; + size_t morechars = 0; + size_t i; + + /* Read first UTF-8 character. This gives us the total length of the + character. */ + if (read (fd, &c, 1) != 1) + return EOF_PSEUDO_CHARACTER; + + if (c < 128) + morechars = 0; + else if (c < 224) + morechars = 1; + else if (c < 240) + morechars = 2; + else + morechars = 3; + + u8c[0] = c; + for (i = 0; i < morechars; ++i) + { + if (read (fd, &c, 1) != 1) + return EOF_PSEUDO_CHARACTER; + u8c[i + 1] = c; + } + + uint32_t res; + int num_units = morechars + 1; + int length = _libga68_u8_mbtouc (&res, (const uint8_t *) &u8c, num_units); + if (res == REPLACEMENT_CHARACTER || length != num_units) + return REPLACEMENT_CHARACTER; + else + return res; +} + +/* Implementation of the posix prelude `posix getchar'. */ + +uint32_t +_libga68_posixgetchar (void) +{ + return _libga68_posixfgetc (0); +} + +/* Implementation of the posix prelude `posix fgets'. */ + +uint32_t * +_libga68_posixfgets (int fd, int nchars, size_t *len) +{ + uint32_t *res = NULL; + int n = 0; + uint32_t uc; + + if (nchars > 0) + { + /* Read exactly nchar or until EOF. */ + res = _libga68_malloc (nchars * sizeof (uint32_t)); + do + { + uc = _libga68_posixfgetc (fd); + if (uc == EOF_PSEUDO_CHARACTER) + break; + res[n++] = uc; + } + while (n < nchars); + } + else + { + /* Read until newline or EOF. */ + size_t allocated = 80 * sizeof (uint32_t); + res = _libga68_malloc (allocated); + do + { + uc = _libga68_posixfgetc (fd); + if (uc != EOF_PSEUDO_CHARACTER) + { + if (n % 80 == 0) + res = _libga68_realloc (res, n * 80 * sizeof (uint32_t) + 80 * sizeof (uint32_t)); + res[n++] = uc; + } + } + while (uc != NEWLINE && uc != EOF_PSEUDO_CHARACTER); + if (n > 0) + res = _libga68_realloc (res, n * 80 * sizeof (uint32_t)); + } + + *len = n; + return res; +} + +/* Implementation of the posix prelude `posix gets'. */ + +uint32_t * +_libga68_posixgets (int nchars, size_t *len) +{ + return _libga68_posixfgets (0, nchars, len); +} + +/* Implementation of the posix prelude `fconnect'. */ + +int +_libga68_posixfconnect (uint32_t *str, size_t len, size_t stride, + int port) +{ + size_t u8len; + uint8_t *u8host = _libga68_u32_to_u8 (str, len, stride, NULL, &u8len); + + /* Create a stream socket. */ + int fd = socket (AF_INET, SOCK_STREAM, 0); + _libga68_errno = errno; + if (fd < 0) + goto error; + + /* Lookup the specified host. */ + char *host = _libga68_malloc_internal (u8len + 1); + memcpy (host, u8host, u8len); + host[u8len] = '\0'; + struct hostent *server = gethostbyname (host); + if (server == NULL) + { + _libga68_errno = h_errno; + goto close_fd_and_error; + } + + /* Connect the socket to the server. */ + struct sockaddr_in serv_addr; + memset (&serv_addr, 0, sizeof (serv_addr)); + serv_addr.sin_family = AF_INET; + serv_addr.sin_port = htons (port); + memcpy (&serv_addr.sin_addr.s_addr, + server->h_addr, + server->h_length); + int res = connect (fd, (struct sockaddr *) &serv_addr, + sizeof (serv_addr)); + _libga68_errno = errno; + if (res == -1) + goto close_fd_and_error; + + _libga68_free_internal (host); + return fd; + + close_fd_and_error: + close (fd); + error: + _libga68_free_internal (host); + return -1; +} + +/* Implementation of the posix prelude `fsize'. */ + +long long int +_libga68_posixfsize (int fd) +{ + struct stat stat; + + if (fstat (fd, &stat) == -1) + { + _libga68_errno = errno; + return -1; + } + + if (stat.st_size > LLONG_MAX) + { + _libga68_errno = EOVERFLOW; + return -1; + } + + return (long int) stat.st_size; +} + +/* Implementation of the posix prelude `lseek'. */ +#define A68_SEEK_CUR 0 +#define A68_SEEK_END 1 +#define A68_SEEK_SET 2 + +long long int +_libga68_posixlseek (int fd, long long int offset, int whence) +{ + switch (whence) + { + case A68_SEEK_CUR: + whence = SEEK_CUR; + break; + case A68_SEEK_END: + whence = SEEK_END; + break; + case A68_SEEK_SET: + whence = SEEK_SET; + break; + } + + long long int ret = (long long int) lseek(fd, offset, whence); + _libga68_errno = errno; + return ret; +} diff --git a/libga68/ga68-standenv.c b/libga68/ga68-standenv.c new file mode 100644 index 000000000000..2c1b7979af10 --- /dev/null +++ b/libga68/ga68-standenv.c @@ -0,0 +1,48 @@ +/* Support run-time routines for the standard prelude. + + Copyright (C) 2025 Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it under the + terms of the GNU General Public License as published by the Free Software + Foundation; either version 3, or (at your option) any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + details. + + Under Section 7 of GPL version 3, you are granted additional permissions + described in the GCC Runtime Library Exception, version 3.1, as published by + the Free Software Foundation. + + You should have received a copy of the GNU General Public License and a copy + of the GCC Runtime Library Exception along with this program; see the files + COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + +#include /* For rand. */ + +#include "ga68.h" + +/* Implementation of the standard prelude `random' function. */ + +float +_libga68_random (void) +{ + float res = (float) rand () / (float) (RAND_MAX); + return res; +} + +double +_libga68_longrandom (void) +{ + double res = (double) rand () / (float) (RAND_MAX); + return res; +} + +long double +_libga68_longlongrandom (void) +{ + long double res = (long double) rand () / (float) (RAND_MAX); + return res; +} diff --git a/libga68/ga68-unistr.c b/libga68/ga68-unistr.c new file mode 100644 index 000000000000..7f2cb97de70b --- /dev/null +++ b/libga68/ga68-unistr.c @@ -0,0 +1,615 @@ +/* libga68 unicode support routines. + Copyright (C) 2009-2025 Free Software Foundation, Inc. + Copyright (C) 2025 Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it under the + terms of the GNU General Public License as published by the Free Software + Foundation; either version 3, or (at your option) any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + details. + + Under Section 7 of GPL version 3, you are granted additional permissions + described in the GCC Runtime Library Exception, version 3.1, as published by + the Free Software Foundation. + + You should have received a copy of the GNU General Public License and a copy + of the GCC Runtime Library Exception along with this program; see the files + COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + +/* The code in this file has been copied from the unistr gnulib module, written + by Bruno Haible, and adapted to support strides. */ + +#include /* For ptrdiff_t */ +#include +#include +#include +#include + +#include "ga68.h" + +/* CMP (n1, n2) performs a three-valued comparison on n1 vs. n2, where + n1 and n2 are expressions without side effects, that evaluate to real + numbers (excluding NaN). + It returns + 1 if n1 > n2 + 0 if n1 == n2 + -1 if n1 < n2 + The naïve code (n1 > n2 ? 1 : n1 < n2 ? -1 : 0) produces a conditional + jump with nearly all GCC versions up to GCC 10. + This variant (n1 < n2 ? -1 : n1 > n2) produces a conditional with many + GCC versions up to GCC 9. + The better code (n1 > n2) - (n1 < n2) from Hacker's Delight § 2-9 + avoids conditional jumps in all GCC versions >= 3.4. */ + +#define CMP(n1, n2) (((n1) > (n2)) - ((n1) < (n2))) + +/* MIN(a,b) returns the minimum of A and B. */ + +#ifndef MIN +# define MIN(a,b) ((a) < (b) ? (a) : (b)) +#endif + +/* Compare two UCS-4 strings of same lenght, lexicographically. + Return -1, 0 or 1. */ + +int +_libga68_u32_cmp (const uint32_t *s1, size_t stride1, + const uint32_t *s2, size_t stride2, + size_t n) +{ + stride1 = stride1 / sizeof (uint32_t); + stride2 = stride2 / sizeof (uint32_t); + + for (; n > 0;) + { + uint32_t uc1 = *s1; + s1 += stride1; + uint32_t uc2 = *s2; + s2 += stride2; + if (uc1 == uc2) + { + n--; + continue; + } + /* Note that uc1 and uc2 each have at most 31 bits. */ + return (int)uc1 - (int)uc2; + /* > 0 if uc1 > uc2, < 0 if uc1 < uc2. */ + } + return 0; +} + +/* Compare two UCS-4 strings of perhaps different lenghts, lexicographically. + Return -1, 0 or 1. */ + +int +_libga68_u32_cmp2 (const uint32_t *s1, size_t n1, size_t stride1, + const uint32_t *s2, size_t n2, size_t stride2) +{ + int cmp = _libga68_u32_cmp (s1, stride1, s2, stride2, MIN (n1, n2)); + + if (cmp == 0) + cmp = CMP (n1, n2); + + return cmp; +} + +/* Get the UCS code for the first character of a given UTF-8 string. */ + +int +_libga68_u8_mbtouc (uint32_t *puc, const uint8_t *s, size_t n) +{ + uint8_t c = *s; + + if (c < 0x80) + { + *puc = c; + return 1; + } + else if (c >= 0xc2) + { + if (c < 0xe0) + { + if (n >= 2) + { + if ((s[1] ^ 0x80) < 0x40) + { + *puc = ((unsigned int) (c & 0x1f) << 6) + | (unsigned int) (s[1] ^ 0x80); + return 2; + } + /* invalid multibyte character */ + } + else + { + /* incomplete multibyte character */ + *puc = 0xfffd; + return 1; + } + } + else if (c < 0xf0) + { + if (n >= 3) + { + if ((s[1] ^ 0x80) < 0x40 + && (c >= 0xe1 || s[1] >= 0xa0) + && (c != 0xed || s[1] < 0xa0)) + { + if ((s[2] ^ 0x80) < 0x40) + { + *puc = ((unsigned int) (c & 0x0f) << 12) + | ((unsigned int) (s[1] ^ 0x80) << 6) + | (unsigned int) (s[2] ^ 0x80); + return 3; + } + /* invalid multibyte character */ + *puc = 0xfffd; + return 2; + } + /* invalid multibyte character */ + *puc = 0xfffd; + return 1; + } + else + { + *puc = 0xfffd; + if (n == 1) + { + /* incomplete multibyte character */ + return 1; + } + else + { + if ((s[1] ^ 0x80) < 0x40 + && (c >= 0xe1 || s[1] >= 0xa0) + && (c != 0xed || s[1] < 0xa0)) + { + /* incomplete multibyte character */ + return 2; + } + else + { + /* invalid multibyte character */ + return 1; + } + } + } + } + else if (c <= 0xf4) + { + if (n >= 4) + { + if ((s[1] ^ 0x80) < 0x40 + && (c >= 0xf1 || s[1] >= 0x90) + && (c < 0xf4 || (/* c == 0xf4 && */ s[1] < 0x90))) + { + if ((s[2] ^ 0x80) < 0x40) + { + if ((s[3] ^ 0x80) < 0x40) + { + *puc = ((unsigned int) (c & 0x07) << 18) + | ((unsigned int) (s[1] ^ 0x80) << 12) + | ((unsigned int) (s[2] ^ 0x80) << 6) + | (unsigned int) (s[3] ^ 0x80); + return 4; + } + /* invalid multibyte character */ + *puc = 0xfffd; + return 3; + } + /* invalid multibyte character */ + *puc = 0xfffd; + return 2; + } + /* invalid multibyte character */ + *puc = 0xfffd; + return 1; + } + else + { + *puc = 0xfffd; + if (n == 1) + { + /* incomplete multibyte character */ + return 1; + } + else + { + if ((s[1] ^ 0x80) < 0x40 + && (c >= 0xf1 || s[1] >= 0x90) + && (c < 0xf4 || (/* c == 0xf4 && */ s[1] < 0x90))) + { + if (n == 2) + { + /* incomplete multibyte character */ + return 2; + } + else + { + if ((s[2] ^ 0x80) < 0x40) + { + /* incomplete multibyte character */ + return 3; + } + else + { + /* invalid multibyte character */ + return 2; + } + } + } + else + { + /* invalid multibyte character */ + return 1; + } + } + } + } + } + /* invalid multibyte character */ + *puc = 0xfffd; + return 1; +} + +/* Encode a given UCS code in UTF-8. */ + +int +_libga68_u8_uctomb (uint8_t *s, uint32_t uc, ptrdiff_t n) +{ + if (uc < 0x80) + { + if (n > 0) + { + s[0] = uc; + return 1; + } + /* else return -2, below. */ + } + else + { + int count; + + if (uc < 0x800) + count = 2; + else if (uc < 0x10000) + { + if (uc < 0xd800 || uc >= 0xe000) + count = 3; + else + return -1; + } + else if (uc < 0x110000) + count = 4; + else + return -1; + + if (n >= count) + { + switch (count) /* note: code falls through cases! */ + { + case 4: s[3] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x10000; + /* Fallthrough. */ + case 3: s[2] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0x800; + /* Fallthrough. */ + case 2: s[1] = 0x80 | (uc & 0x3f); uc = uc >> 6; uc |= 0xc0; + /*case 1:*/ s[0] = uc; + } + return count; + } + } + return -2; +} + +/* Convert UCS-4 to UTF-8 */ + +uint8_t * +_libga68_u32_to_u8 (const uint32_t *s, size_t n, size_t stride, + uint8_t *resultbuf, size_t *lengthp) +{ + const uint32_t *s_end; + /* Output string accumulator. */ + uint8_t *result; + size_t allocated; + size_t length; + + stride = stride / sizeof (uint32_t); + s_end = s + (n * stride); + + if (resultbuf != NULL) + { + result = resultbuf; + allocated = *lengthp; + } + else + { + result = NULL; + allocated = 0; + } + length = 0; + /* Invariants: + result is either == resultbuf or == NULL or malloc-allocated. + If length > 0, then result != NULL. */ + + while (s < s_end) + { + uint32_t uc; + int count; + + /* Fetch a Unicode character from the input string. */ + uc = *s; + s += stride; + /* No need to call the safe variant u32_mbtouc, because + u8_uctomb will verify uc anyway. */ + + /* Store it in the output string. */ + count = _libga68_u8_uctomb (result + length, uc, allocated - length); + if (count == -1) + { + if (!(result == resultbuf || result == NULL)) + free (result); + errno = EILSEQ; + return NULL; + } + if (count == -2) + { + uint8_t *memory; + + allocated = (allocated > 0 ? 2 * allocated : 12); + if (length + 6 > allocated) + allocated = length + 6; + if (result == resultbuf || result == NULL) + memory = (uint8_t *) _libga68_malloc (allocated * sizeof (uint8_t)); + else + memory = + (uint8_t *) _libga68_realloc (result, allocated * sizeof (uint8_t)); + + if (result == resultbuf && length > 0) + memcpy ((char *) memory, (char *) result, + length * sizeof (uint8_t)); + result = memory; + count = _libga68_u8_uctomb (result + length, uc, allocated - length); + if (count < 0) + abort (); + } + length += count; + } + + if (length == 0) + { + if (result == NULL) + { + /* Return a non-NULL value. NULL means error. */ + result = (uint8_t *) _libga68_malloc (1); + if (result == NULL) + { + errno = ENOMEM; + return NULL; + } + } + } + else if (result != resultbuf && length < allocated) + { + /* Shrink the allocated memory if possible. */ + uint8_t *memory; + + memory = (uint8_t *) _libga68_realloc_unchecked (result, length * sizeof (uint8_t)); + if (memory != NULL) + result = memory; + } + + *lengthp = length; + return result; +} + +/* Used by ga68_u8_to_u32 below. */ + +static int +_libga68_u8_mbtoucr (uint32_t *puc, const uint8_t *s, size_t n) +{ + uint8_t c = *s; + + if (c < 0x80) + { + *puc = c; + return 1; + } + else if (c >= 0xc2) + { + if (c < 0xe0) + { + if (n >= 2) + { + if ((s[1] ^ 0x80) < 0x40) + { + *puc = ((unsigned int) (c & 0x1f) << 6) + | (unsigned int) (s[1] ^ 0x80); + return 2; + } + /* invalid multibyte character */ + } + else + { + /* incomplete multibyte character */ + *puc = 0xfffd; + return -2; + } + } + else if (c < 0xf0) + { + if (n >= 2) + { + if ((s[1] ^ 0x80) < 0x40 + && (c >= 0xe1 || s[1] >= 0xa0) + && (c != 0xed || s[1] < 0xa0)) + { + if (n >= 3) + { + if ((s[2] ^ 0x80) < 0x40) + { + *puc = ((unsigned int) (c & 0x0f) << 12) + | ((unsigned int) (s[1] ^ 0x80) << 6) + | (unsigned int) (s[2] ^ 0x80); + return 3; + } + /* invalid multibyte character */ + } + else + { + /* incomplete multibyte character */ + *puc = 0xfffd; + return -2; + } + } + /* invalid multibyte character */ + } + else + { + /* incomplete multibyte character */ + *puc = 0xfffd; + return -2; + } + } + else if (c <= 0xf4) + { + if (n >= 2) + { + if ((s[1] ^ 0x80) < 0x40 + && (c >= 0xf1 || s[1] >= 0x90) + && (c < 0xf4 || (/* c == 0xf4 && */ s[1] < 0x90))) + { + if (n >= 3) + { + if ((s[2] ^ 0x80) < 0x40) + { + if (n >= 4) + { + if ((s[3] ^ 0x80) < 0x40) + { + *puc = ((unsigned int) (c & 0x07) << 18) + | ((unsigned int) (s[1] ^ 0x80) << 12) + | ((unsigned int) (s[2] ^ 0x80) << 6) + | (unsigned int) (s[3] ^ 0x80); + return 4; + } + /* invalid multibyte character */ + } + else + { + /* incomplete multibyte character */ + *puc = 0xfffd; + return -2; + } + } + /* invalid multibyte character */ + } + else + { + /* incomplete multibyte character */ + *puc = 0xfffd; + return -2; + } + } + /* invalid multibyte character */ + } + else + { + /* incomplete multibyte character */ + *puc = 0xfffd; + return -2; + } + } + } + /* invalid multibyte character */ + *puc = 0xfffd; + return -1; +} + +/* Convert UTF-8 to UTF-32/UCS-4 */ + +uint32_t * +_libga68_u8_to_u32 (const uint8_t *s, size_t n, uint32_t *resultbuf, size_t *lengthp) +{ + const uint8_t *s_end = s + n; + /* Output string accumulator. */ + uint32_t *result; + size_t allocated; + size_t length; + + if (resultbuf != NULL) + { + result = resultbuf; + allocated = *lengthp; + } + else + { + result = NULL; + allocated = 0; + } + length = 0; + /* Invariants: + result is either == resultbuf or == NULL or malloc-allocated. + If length > 0, then result != NULL. */ + + while (s < s_end) + { + uint32_t uc; + int count; + + /* Fetch a Unicode character from the input string. */ + count = _libga68_u8_mbtoucr (&uc, s, s_end - s); + if (count < 0) + { + if (!(result == resultbuf || result == NULL)) + free (result); + errno = EILSEQ; + return NULL; + } + s += count; + + /* Store it in the output string. */ + if (length + 1 > allocated) + { + uint32_t *memory; + + allocated = (allocated > 0 ? 2 * allocated : 12); + if (length + 1 > allocated) + allocated = length + 1; + if (result == resultbuf || result == NULL) + memory = (uint32_t *) _libga68_malloc (allocated * sizeof (uint32_t)); + else + memory = + (uint32_t *) _libga68_realloc (result, allocated * sizeof (uint32_t)); + + if (result == resultbuf && length > 0) + memcpy ((char *) memory, (char *) result, + length * sizeof (uint32_t)); + result = memory; + } + result[length++] = uc; + } + + if (length == 0) + { + if (result == NULL) + { + /* Return a non-NULL value. NULL means error. */ + result = (uint32_t *) _libga68_malloc (1); + } + } + else if (result != resultbuf && length < allocated) + { + /* Shrink the allocated memory if possible. */ + uint32_t *memory; + + memory = (uint32_t *) _libga68_realloc_unchecked (result, length * sizeof (uint32_t)); + if (memory != NULL) + result = memory; + } + + *lengthp = length; + return result; +} diff --git a/libga68/ga68.h b/libga68/ga68.h new file mode 100644 index 000000000000..764ea2b3ce79 --- /dev/null +++ b/libga68/ga68.h @@ -0,0 +1,126 @@ +/* Definitions for libga68. + Copyright (C) 2025 Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it under the + terms of the GNU General Public License as published by the Free Software + Foundation; either version 3, or (at your option) any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + details. + + Under Section 7 of GPL version 3, you are granted additional permissions + described in the GCC Runtime Library Exception, version 3.1, as published by + the Free Software Foundation. + + You should have received a copy of the GNU General Public License and a copy + of the GCC Runtime Library Exception along with this program; see the files + COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + +#ifndef GA68_H +#define GA68_H + +#include "config.h" + +#include /* For size_t. */ +#include +#include +#ifdef __has_include +# if __has_include () +# include /* For ssize_t. */ +# endif +#endif + +/* ga68-error.c */ + +void _libga68_abort (const char *fmt, ...) + __attribute__ ((__format__ (__printf__, 1, 2), __nonnull__ (1), + __noreturn__)); + +void _libga68_assert (const char *filename, unsigned int lineno); +void _libga68_derefnil (const char *filename, unsigned int lineno); +void _libga68_invalidcharerror (const char *filename, unsigned int lineno, + int c); + +void _libga68_bitsboundserror (const char *filename, unsigned int lineno, + ssize_t pos); +void _libga68_unreachable (const char *filename, unsigned int lineno); +void _libga68_lower_bound (const char *filename, unsigned int lineno, + ssize_t index, ssize_t lower_bound); +void _libga68_upper_bound (const char *filename, unsigned int lineno, + ssize_t index, ssize_t upper_bound); +void _libga68_bounds (const char *filename, unsigned int lineno, + ssize_t index, ssize_t lower_bound, ssize_t upper_bound); +void _libga68_dim (const char *filename, unsigned int lineno, + size_t dim, size_t index); +void _libga68_bounds_mismatch (const char *filename, unsigned int lineno, + size_t dim, ssize_t lb1, ssize_t ub1, + ssize_t lb2, ssize_t ub2); + +/* ga68-alloc.c */ + +void _libga68_init_heap (void); +void *_libga68_malloc (size_t size); +void *_libga68_malloc_internal (size_t size); +void *_libga68_realloc (void *ptr, size_t size); +void *_libga68_realloc_unchecked (void *ptr, size_t size); +void _libga68_free_internal (void *ptr); + +/* ga68-standenv.c */ + +float _libga68_random (void); +double _libga68_longrandom (void); +long double _libga68_longlongrandom (void); + +/* ga68-posix.c */ + +int _libga68_posixerrno (void); +void _libga68_posixperror (uint32_t *s, size_t len, size_t stride); +uint32_t *_libga68_posixstrerror (int errnum, size_t *len); +long long int _libga68_posixfsize (int fd); +int _libga68_posixfopen (const uint32_t *pathname, size_t len, size_t stride, + unsigned int flags); +int _libga68_posixcreat (uint32_t *pathname, size_t len, size_t stride, uint32_t mode); +int _libga68_posixclose (int fd); +int _libga68_posixargc (void); +uint32_t *_libga68_posixargv (int n, size_t *len); +void _libga68_posixgetenv (uint32_t *s, size_t len, size_t stride, + uint32_t **r, size_t *rlen); +void _libga68_posixputs (uint32_t *s, size_t len, size_t stride); +uint32_t _libga68_posixputchar (uint32_t c); +uint32_t _libga68_posixfputc (int fd, uint32_t c); +int _libga68_posixfputs (int fd, uint32_t *s, size_t len, size_t stride); + +uint32_t _libga68_posixgetchar (void); +uint32_t _libga68_posixfgetc (int fd); +uint32_t *_libga68_posixfgets (int fd, int nchars, size_t *len); +uint32_t *_libga68_posixgets (int nchars, size_t *len); + +int _libga68_posixfconnect (uint32_t *str, size_t len, size_t stride, + int port); +long long int _libga68_posixlseek (int fd, long long int offset, int whence); + +/* ga68-unistr.c */ + +int _libga68_u32_cmp (const uint32_t *s1, size_t stride1, + const uint32_t *s2, size_t stride2, + size_t n); +int _libga68_u32_cmp2 (const uint32_t *s1, size_t n1, size_t stride1, + const uint32_t *s2, size_t n2, size_t stride2); +int _libga68_u8_uctomb (uint8_t *s, uint32_t uc, ptrdiff_t n); +int _libga68_u8_mbtouc (uint32_t *puc, const uint8_t *s, size_t n); +uint8_t *_libga68_u32_to_u8 (const uint32_t *s, size_t n, size_t stride, + uint8_t *resultbuf, size_t *lengthp); +uint32_t *_libga68_u8_to_u32 (const uint8_t *s, size_t n, + uint32_t *resultbuf, size_t *lengthp); + +/* libga68.c */ + +extern int _libga68_argc; +extern char **_libga68_argv; + +void _libga68_set_exit_status (int status); + +#endif /* ! GA68_H */ diff --git a/libga68/libga68.c b/libga68/libga68.c new file mode 100644 index 000000000000..60f930a53334 --- /dev/null +++ b/libga68/libga68.c @@ -0,0 +1,52 @@ +/* GNU Algol Compiler run-time. + Copyright (C) 2025 Jose E. Marchesi. + + GCC is free software; you can redistribute it and/or modify it under the + terms of the GNU General Public License as published by the Free Software + Foundation; either version 3, or (at your option) any later version. + + GCC is distributed in the hope that it will be useful, but WITHOUT ANY + WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS + FOR A PARTICULAR PURPOSE. See the GNU General Public License for more + details. + + Under Section 7 of GPL version 3, you are granted additional permissions + described in the GCC Runtime Library Exception, version 3.1, as published by + the Free Software Foundation. + + You should have received a copy of the GNU General Public License and a copy + of the GCC Runtime Library Exception along with this program; see the files + COPYING3 and COPYING.RUNTIME respectively. If not, see + . */ + +#include "ga68.h" + +/* argc and argv are preserved in the following objects. */ + +int _libga68_argc; +char **_libga68_argv; + +/* Exit status of the program reported to the OS upon exit. */ + +static int exit_status; + +void +_libga68_set_exit_status (int status) +{ + exit_status = status; +} + +/* Entry point for Algol 68 programs. */ + +void __algol68_main (void); + +int +main (int argc, char **argv) +{ + _libga68_argc = argc; + _libga68_argv = argv; + + _libga68_init_heap (); + __algol68_main (); + return exit_status; +} diff --git a/libga68/libga68.spec.in b/libga68/libga68.spec.in new file mode 100644 index 000000000000..7b09f655a2b4 --- /dev/null +++ b/libga68/libga68.spec.in @@ -0,0 +1,11 @@ +# +# This spec file is read by ga68 when linking. +# It is used to specify the libraries we need to link in, in the right +# order. +# + +%rename link linkorig_ga68_renamed +*link: %(linkorig_ga68_renamed) + +%rename lib liborig_ga68_renamed +*lib: %{noga68lib: ; :@SPEC_LIBGA68_DEPS@} %(liborig_ga68_renamed) From 18518d2843f868b9ff8e07512fb3c442ec59f480 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:55:19 +0200 Subject: [PATCH 175/373] a68: libga68: build system Signed-off-by: Jose E. Marchesi ChangeLog * libga68/Makefile.am: New file. * libga68/configure.ac: Likewise. * libga68/Makefile.in: Generate. * libga68/aclocal.m4: Likewise. --- libga68/Makefile.am | 122 +++++ libga68/Makefile.in | 906 +++++++++++++++++++++++++++++++ libga68/aclocal.m4 | 1200 ++++++++++++++++++++++++++++++++++++++++++ libga68/configure.ac | 371 +++++++++++++ 4 files changed, 2599 insertions(+) create mode 100644 libga68/Makefile.am create mode 100644 libga68/Makefile.in create mode 100644 libga68/aclocal.m4 create mode 100644 libga68/configure.ac diff --git a/libga68/Makefile.am b/libga68/Makefile.am new file mode 100644 index 000000000000..accdd910d8d1 --- /dev/null +++ b/libga68/Makefile.am @@ -0,0 +1,122 @@ +# Makefile for libga68. +# Copyright (C) 2025 Jose E. Marchesi. +# +# This file is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING3. If not see +# . +# +# +# if this file is changed then you need to run +# +# autoreconf2.69 + +AUTOMAKE_OPTIONS = 1.8 foreign +ACLOCAL_AMFLAGS = -I .. -I ../config +# Multilib support. +MAKEOVERRIDES= + +gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER) +TOP_GCCDIR := $(shell cd $(top_srcdir) && cd .. && pwd) + +GCC_DIR = $(TOP_GCCDIR)/gcc +A68_SRC = $(GCC_DIR)/algol68 + +toolexeclibdir=@toolexeclibdir@ +toolexecdir=@toolexecdir@ +A68_FOR_TARGET=@A68_FOR_TARGET@ + +extra_darwin_ldflags_libga68=@extra_darwin_ldflags_libga68@ + +if ENABLE_DARWIN_AT_RPATH +extra_darwin_ldflags_libga68 += -Wc,-nodefaultrpaths +extra_darwin_ldflags_libga68 += -Wl,-rpath,@loader_path +endif + +A68_BUILDDIR := $(shell pwd) + +# Work around what appears to be a GNU make bug handling MAKEFLAGS +# values defined in terms of make variables, as is the case for CC and +# friends when we are called from the top level Makefile. +AM_MAKEFLAGS = \ + "GCC_DIR=$(GCC_DIR)" \ + "A68_SRC=$(A68_SRC)" \ + "AR_FLAGS=$(AR_FLAGS)" \ + "CC_FOR_BUILD=$(CC_FOR_BUILD)" \ + "CC_FOR_TARGET=$(CC_FOR_TARGET)" \ + "A68_FOR_TARGET=$(A68_FOR_TARGET)" \ + "CFLAGS=$(CFLAGS)" \ + "CXXFLAGS=$(CXXFLAGS)" \ + "CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \ + "CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \ + "CFLAGS_LONGDOUBLE=$(CFLAGS_LONGDOUBLE)" \ + "EXPECT=$(EXPECT)" \ + "INSTALL=$(INSTALL)" \ + "INSTALL_DATA=$(INSTALL_DATA)" \ + "INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \ + "INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \ + "LDFLAGS=$(LDFLAGS)" \ + "LIBCFLAGS=$(LIBCFLAGS)" \ + "LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \ + "MAKE=$(MAKE)" \ + "MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \ + "PICFLAG=$(PICFLAG)" \ + "PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \ + "SHELL=$(SHELL)" \ + "RUNTESTFLAGS=$(RUNTESTFLAGS)" \ + "exec_prefix=$(exec_prefix)" \ + "infodir=$(infodir)" \ + "libdir=$(libdir)" \ + "includedir=$(includedir)" \ + "prefix=$(prefix)" \ + "tooldir=$(tooldir)" \ + "gxx_include_dir=$(gxx_include_dir)" \ + "AR=$(AR)" \ + "AS=$(AS)" \ + "LD=$(LD)" \ + "RANLIB=$(RANLIB)" \ + "NM=$(NM)" \ + "NM_FOR_BUILD=$(NM_FOR_BUILD)" \ + "NM_FOR_TARGET=$(NM_FOR_TARGET)" \ + "DESTDIR=$(DESTDIR)" \ + "WERROR=$(WERROR)" \ + "TARGET_LIB_PATH=$(TARGET_LIB_PATH)" \ + "TARGET_LIB_PATH_libgm2=$(TARGET_LIB_PATH_libgm2)" \ + "LIBTOOL=$(A68_BUILDDIR)/libtool" \ + "DARWIN_AT_RPATH=$(DARWIN_AT_RPATH)" + +# Subdir rules rely on $(FLAGS_TO_PASS) +FLAGS_TO_PASS = $(AM_MAKEFLAGS) + +gcc_objdir = $(MULTIBUILDTOP)../../$(host_subdir)/gcc + +toolexeclib_DATA = libga68.spec +toolexeclib_LTLIBRARIES = libga68.la + +libga68_la_SOURCES = libga68.c \ + ga68-unistr.c \ + ga68-posix.c \ + ga68-alloc.c \ + ga68-error.c \ + ga68-standenv.c \ + ga68.h +libga68_la_LIBTOOLFLAGS = +libga68_la_CFLAGS = $(LIBGA68_GCFLAGS) $(LIBGA68_BOEHM_GC_INCLUDES) +libga68_la_LDFLAGS = -version-info $(libga68_VERSION) \ + $(extra_darwin_ldflags_libga68) +libga68_la_DEPENDENCIES = libga68.spec +libga68_la_LIBADD = $(LIBGA68_BOEHM_GC_LIBS) + +# target overrides +-include $(tmake_file) + +include $(top_srcdir)/../multilib.am diff --git a/libga68/Makefile.in b/libga68/Makefile.in new file mode 100644 index 000000000000..1a1f40c82c7e --- /dev/null +++ b/libga68/Makefile.in @@ -0,0 +1,906 @@ +# Makefile.in generated by automake 1.15.1 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994-2017 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +# Makefile for libga68. +# Copyright (C) 2025 Jose E. Marchesi. +# +# This file is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; see the file COPYING3. If not see +# . +# +# +# if this file is changed then you need to run +# +# autoreconf2.69 + + +VPATH = @srcdir@ +am__is_gnu_make = { \ + if test -z '$(MAKELEVEL)'; then \ + false; \ + elif test -n '$(MAKE_HOST)'; then \ + true; \ + elif test -n '$(MAKE_VERSION)' && test -n '$(CURDIR)'; then \ + true; \ + else \ + false; \ + fi; \ +} +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +target_triplet = @target@ +@ENABLE_DARWIN_AT_RPATH_TRUE@am__append_1 = -Wc,-nodefaultrpaths \ +@ENABLE_DARWIN_AT_RPATH_TRUE@ -Wl,-rpath,@loader_path +subdir = . +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/../config/acx.m4 \ + $(top_srcdir)/../config/depstand.m4 \ + $(top_srcdir)/../config/lead-dot.m4 \ + $(top_srcdir)/../config/multi.m4 \ + $(top_srcdir)/../config/no-executables.m4 \ + $(top_srcdir)/../config/override.m4 \ + $(top_srcdir)/../libtool.m4 $(top_srcdir)/../ltoptions.m4 \ + $(top_srcdir)/../ltsugar.m4 $(top_srcdir)/../ltversion.m4 \ + $(top_srcdir)/../lt~obsolete.m4 $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +DIST_COMMON = $(srcdir)/Makefile.am $(top_srcdir)/configure \ + $(am__configure_deps) +am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \ + configure.lineno config.status.lineno +mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs +CONFIG_HEADER = config.h +CONFIG_CLEAN_FILES = libga68.spec +CONFIG_CLEAN_VPATH_FILES = +am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; +am__vpath_adj = case $$p in \ + $(srcdir)/*) f=`echo "$$p" | sed "s|^$$srcdirstrip/||"`;; \ + *) f=$$p;; \ + esac; +am__strip_dir = f=`echo $$p | sed -e 's|^.*/||'`; +am__install_max = 40 +am__nobase_strip_setup = \ + srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*|]/\\\\&/g'` +am__nobase_strip = \ + for p in $$list; do echo "$$p"; done | sed -e "s|$$srcdirstrip/||" +am__nobase_list = $(am__nobase_strip_setup); \ + for p in $$list; do echo "$$p $$p"; done | \ + sed "s| $$srcdirstrip/| |;"' / .*\//!s/ .*/ ./; s,\( .*\)/[^/]*$$,\1,' | \ + $(AWK) 'BEGIN { files["."] = "" } { files[$$2] = files[$$2] " " $$1; \ + if (++n[$$2] == $(am__install_max)) \ + { print $$2, files[$$2]; n[$$2] = 0; files[$$2] = "" } } \ + END { for (dir in files) print dir, files[dir] }' +am__base_list = \ + sed '$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;$$!N;s/\n/ /g' | \ + sed '$$!N;$$!N;$$!N;$$!N;s/\n/ /g' +am__uninstall_files_from_dir = { \ + test -z "$$files" \ + || { test ! -d "$$dir" && test ! -f "$$dir" && test ! -r "$$dir"; } \ + || { echo " ( cd '$$dir' && rm -f" $$files ")"; \ + $(am__cd) "$$dir" && rm -f $$files; }; \ + } +am__installdirs = "$(DESTDIR)$(toolexeclibdir)" \ + "$(DESTDIR)$(toolexeclibdir)" +LTLIBRARIES = $(toolexeclib_LTLIBRARIES) +am__DEPENDENCIES_1 = +am_libga68_la_OBJECTS = libga68_la-libga68.lo \ + libga68_la-ga68-unistr.lo libga68_la-ga68-posix.lo \ + libga68_la-ga68-alloc.lo libga68_la-ga68-error.lo \ + libga68_la-ga68-standenv.lo +libga68_la_OBJECTS = $(am_libga68_la_OBJECTS) +AM_V_lt = $(am__v_lt_@AM_V@) +am__v_lt_ = $(am__v_lt_@AM_DEFAULT_V@) +am__v_lt_0 = --silent +am__v_lt_1 = +libga68_la_LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC \ + $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=link $(CCLD) \ + $(libga68_la_CFLAGS) $(CFLAGS) $(libga68_la_LDFLAGS) \ + $(LDFLAGS) -o $@ +AM_V_P = $(am__v_P_@AM_V@) +am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = +DEFAULT_INCLUDES = -I.@am__isrc@ +depcomp = $(SHELL) $(top_srcdir)/../depcomp +am__depfiles_maybe = depfiles +am__mv = mv -f +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +LTCOMPILE = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) \ + $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \ + $(AM_CFLAGS) $(CFLAGS) +AM_V_CC = $(am__v_CC_@AM_V@) +am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@) +am__v_CC_0 = @echo " CC " $@; +am__v_CC_1 = +CCLD = $(CC) +LINK = $(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) \ + $(LIBTOOLFLAGS) --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) \ + $(AM_LDFLAGS) $(LDFLAGS) -o $@ +AM_V_CCLD = $(am__v_CCLD_@AM_V@) +am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@) +am__v_CCLD_0 = @echo " CCLD " $@; +am__v_CCLD_1 = +SOURCES = $(libga68_la_SOURCES) +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +DATA = $(toolexeclib_DATA) +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) \ + $(LISP)config.h.in +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +ETAGS = etags +CTAGS = ctags +CSCOPE = cscope +AM_RECURSIVE_TARGETS = cscope +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ +AR = @AR@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CC = @CC@ +CCAS = @CCAS@ +CCASDEPMODE = @CCASDEPMODE@ +CCASFLAGS = @CCASFLAGS@ +CCDEPMODE = @CCDEPMODE@ +CC_FOR_BUILD = @CC_FOR_BUILD@ +CFLAGS = @CFLAGS@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CXX = @CXX@ +CXXCPP = @CXXCPP@ +CXXDEPMODE = @CXXDEPMODE@ +CXXFLAGS = @CXXFLAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +FGREP = @FGREP@ +GREP = @GREP@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LIBGA68_BOEHM_GC_INCLUDES = @LIBGA68_BOEHM_GC_INCLUDES@ +LIBGA68_BOEHM_GC_LIBS = @LIBGA68_BOEHM_GC_LIBS@ +LIBGA68_GCFLAGS = @LIBGA68_GCFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +MAINT = @MAINT@ +MAKEINFO = @MAKEINFO@ +MKDIR_P = @MKDIR_P@ +NM = @NM@ +NMEDIT = @NMEDIT@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +RANLIB = @RANLIB@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +SPEC_LIBGA68_DEPS = @SPEC_LIBGA68_DEPS@ +STRIP = @STRIP@ +VERSION = @VERSION@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_CXX = @ac_ct_CXX@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_libsubdir = @build_libsubdir@ +build_os = @build_os@ +build_subdir = @build_subdir@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +enable_shared = @enable_shared@ +enable_static = @enable_static@ +exec_prefix = @exec_prefix@ +extra_darwin_ldflags_libga68 = @extra_darwin_ldflags_libga68@ \ + $(am__append_1) +get_gcc_base_ver = @get_gcc_base_ver@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_noncanonical = @host_noncanonical@ +host_os = @host_os@ +host_subdir = @host_subdir@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +libga68_VERSION = @libga68_VERSION@ +localedir = @localedir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +multi_basedir = @multi_basedir@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +slibdir = @slibdir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target = @target@ +target_alias = @target_alias@ +target_cpu = @target_cpu@ +target_noncanonical = @target_noncanonical@ +target_os = @target_os@ +target_subdir = @target_subdir@ +target_vendor = @target_vendor@ +toolexecdir = @toolexecdir@ +toolexeclibdir = @toolexeclibdir@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +AUTOMAKE_OPTIONS = 1.8 foreign +ACLOCAL_AMFLAGS = -I .. -I ../config +# Multilib support. +MAKEOVERRIDES = +gcc_version := $(shell @get_gcc_base_ver@ $(top_srcdir)/../gcc/BASE-VER) +TOP_GCCDIR := $(shell cd $(top_srcdir) && cd .. && pwd) +GCC_DIR = $(TOP_GCCDIR)/gcc +A68_SRC = $(GCC_DIR)/algol68 +A68_FOR_TARGET = @A68_FOR_TARGET@ +A68_BUILDDIR := $(shell pwd) + +# Work around what appears to be a GNU make bug handling MAKEFLAGS +# values defined in terms of make variables, as is the case for CC and +# friends when we are called from the top level Makefile. +AM_MAKEFLAGS = \ + "GCC_DIR=$(GCC_DIR)" \ + "A68_SRC=$(A68_SRC)" \ + "AR_FLAGS=$(AR_FLAGS)" \ + "CC_FOR_BUILD=$(CC_FOR_BUILD)" \ + "CC_FOR_TARGET=$(CC_FOR_TARGET)" \ + "A68_FOR_TARGET=$(A68_FOR_TARGET)" \ + "CFLAGS=$(CFLAGS)" \ + "CXXFLAGS=$(CXXFLAGS)" \ + "CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \ + "CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \ + "CFLAGS_LONGDOUBLE=$(CFLAGS_LONGDOUBLE)" \ + "EXPECT=$(EXPECT)" \ + "INSTALL=$(INSTALL)" \ + "INSTALL_DATA=$(INSTALL_DATA)" \ + "INSTALL_PROGRAM=$(INSTALL_PROGRAM)" \ + "INSTALL_SCRIPT=$(INSTALL_SCRIPT)" \ + "LDFLAGS=$(LDFLAGS)" \ + "LIBCFLAGS=$(LIBCFLAGS)" \ + "LIBCFLAGS_FOR_TARGET=$(LIBCFLAGS_FOR_TARGET)" \ + "MAKE=$(MAKE)" \ + "MAKEINFO=$(MAKEINFO) $(MAKEINFOFLAGS)" \ + "PICFLAG=$(PICFLAG)" \ + "PICFLAG_FOR_TARGET=$(PICFLAG_FOR_TARGET)" \ + "SHELL=$(SHELL)" \ + "RUNTESTFLAGS=$(RUNTESTFLAGS)" \ + "exec_prefix=$(exec_prefix)" \ + "infodir=$(infodir)" \ + "libdir=$(libdir)" \ + "includedir=$(includedir)" \ + "prefix=$(prefix)" \ + "tooldir=$(tooldir)" \ + "gxx_include_dir=$(gxx_include_dir)" \ + "AR=$(AR)" \ + "AS=$(AS)" \ + "LD=$(LD)" \ + "RANLIB=$(RANLIB)" \ + "NM=$(NM)" \ + "NM_FOR_BUILD=$(NM_FOR_BUILD)" \ + "NM_FOR_TARGET=$(NM_FOR_TARGET)" \ + "DESTDIR=$(DESTDIR)" \ + "WERROR=$(WERROR)" \ + "TARGET_LIB_PATH=$(TARGET_LIB_PATH)" \ + "TARGET_LIB_PATH_libgm2=$(TARGET_LIB_PATH_libgm2)" \ + "LIBTOOL=$(A68_BUILDDIR)/libtool" \ + "DARWIN_AT_RPATH=$(DARWIN_AT_RPATH)" + + +# Subdir rules rely on $(FLAGS_TO_PASS) +FLAGS_TO_PASS = $(AM_MAKEFLAGS) +gcc_objdir = $(MULTIBUILDTOP)../../$(host_subdir)/gcc +toolexeclib_DATA = libga68.spec +toolexeclib_LTLIBRARIES = libga68.la +libga68_la_SOURCES = libga68.c \ + ga68-unistr.c \ + ga68-posix.c \ + ga68-alloc.c \ + ga68-error.c \ + ga68-standenv.c \ + ga68.h + +libga68_la_LIBTOOLFLAGS = +libga68_la_CFLAGS = $(LIBGA68_GCFLAGS) $(LIBGA68_BOEHM_GC_INCLUDES) +libga68_la_LDFLAGS = -version-info $(libga68_VERSION) \ + $(extra_darwin_ldflags_libga68) + +libga68_la_DEPENDENCIES = libga68.spec +libga68_la_LIBADD = $(LIBGA68_BOEHM_GC_LIBS) +MULTISRCTOP = +MULTIBUILDTOP = +MULTIDIRS = +MULTISUBDIR = +MULTIDO = true +MULTICLEAN = true +all: config.h + $(MAKE) $(AM_MAKEFLAGS) all-am + +.SUFFIXES: +.SUFFIXES: .c .lo .o .obj +am--refresh: Makefile + @: +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(top_srcdir)/../multilib.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + echo ' cd $(srcdir) && $(AUTOMAKE) --foreign'; \ + $(am__cd) $(srcdir) && $(AUTOMAKE) --foreign \ + && exit 0; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --foreign Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + echo ' $(SHELL) ./config.status'; \ + $(SHELL) ./config.status;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $@ $(am__depfiles_maybe);; \ + esac; +$(top_srcdir)/../multilib.am $(am__empty): + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + $(SHELL) ./config.status --recheck + +$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + $(am__cd) $(srcdir) && $(AUTOCONF) +$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps) + $(am__cd) $(srcdir) && $(ACLOCAL) $(ACLOCAL_AMFLAGS) +$(am__aclocal_m4_deps): + +config.h: stamp-h1 + @test -f $@ || rm -f stamp-h1 + @test -f $@ || $(MAKE) $(AM_MAKEFLAGS) stamp-h1 + +stamp-h1: $(srcdir)/config.h.in $(top_builddir)/config.status + @rm -f stamp-h1 + cd $(top_builddir) && $(SHELL) ./config.status config.h +$(srcdir)/config.h.in: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + ($(am__cd) $(top_srcdir) && $(AUTOHEADER)) + rm -f stamp-h1 + touch $@ + +distclean-hdr: + -rm -f config.h stamp-h1 +libga68.spec: $(top_builddir)/config.status $(srcdir)/libga68.spec.in + cd $(top_builddir) && $(SHELL) ./config.status $@ + +install-toolexeclibLTLIBRARIES: $(toolexeclib_LTLIBRARIES) + @$(NORMAL_INSTALL) + @list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \ + list2=; for p in $$list; do \ + if test -f $$p; then \ + list2="$$list2 $$p"; \ + else :; fi; \ + done; \ + test -z "$$list2" || { \ + echo " $(MKDIR_P) '$(DESTDIR)$(toolexeclibdir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(toolexeclibdir)" || exit 1; \ + echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 '$(DESTDIR)$(toolexeclibdir)'"; \ + $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=install $(INSTALL) $(INSTALL_STRIP_FLAG) $$list2 "$(DESTDIR)$(toolexeclibdir)"; \ + } + +uninstall-toolexeclibLTLIBRARIES: + @$(NORMAL_UNINSTALL) + @list='$(toolexeclib_LTLIBRARIES)'; test -n "$(toolexeclibdir)" || list=; \ + for p in $$list; do \ + $(am__strip_dir) \ + echo " $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f '$(DESTDIR)$(toolexeclibdir)/$$f'"; \ + $(LIBTOOL) $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=uninstall rm -f "$(DESTDIR)$(toolexeclibdir)/$$f"; \ + done + +clean-toolexeclibLTLIBRARIES: + -test -z "$(toolexeclib_LTLIBRARIES)" || rm -f $(toolexeclib_LTLIBRARIES) + @list='$(toolexeclib_LTLIBRARIES)'; \ + locs=`for p in $$list; do echo $$p; done | \ + sed 's|^[^/]*$$|.|; s|/[^/]*$$||; s|$$|/so_locations|' | \ + sort -u`; \ + test -z "$$locs" || { \ + echo rm -f $${locs}; \ + rm -f $${locs}; \ + } + +libga68.la: $(libga68_la_OBJECTS) $(libga68_la_DEPENDENCIES) $(EXTRA_libga68_la_DEPENDENCIES) + $(AM_V_CCLD)$(libga68_la_LINK) -rpath $(toolexeclibdir) $(libga68_la_OBJECTS) $(libga68_la_LIBADD) $(LIBS) + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libga68_la-ga68-alloc.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libga68_la-ga68-error.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libga68_la-ga68-posix.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libga68_la-ga68-standenv.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libga68_la-ga68-unistr.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libga68_la-libga68.Plo@am__quote@ + +.c.o: +@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ $< + +.c.obj: +@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c -o $@ `$(CYGPATH_W) '$<'` + +.c.lo: +@am__fastdepCC_TRUE@ $(AM_V_CC)$(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LTCOMPILE) -c -o $@ $< + +libga68_la-libga68.lo: libga68.c +@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -MT libga68_la-libga68.lo -MD -MP -MF $(DEPDIR)/libga68_la-libga68.Tpo -c -o libga68_la-libga68.lo `test -f 'libga68.c' || echo '$(srcdir)/'`libga68.c +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libga68_la-libga68.Tpo $(DEPDIR)/libga68_la-libga68.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='libga68.c' object='libga68_la-libga68.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -c -o libga68_la-libga68.lo `test -f 'libga68.c' || echo '$(srcdir)/'`libga68.c + +libga68_la-ga68-unistr.lo: ga68-unistr.c +@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -MT libga68_la-ga68-unistr.lo -MD -MP -MF $(DEPDIR)/libga68_la-ga68-unistr.Tpo -c -o libga68_la-ga68-unistr.lo `test -f 'ga68-unistr.c' || echo '$(srcdir)/'`ga68-unistr.c +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libga68_la-ga68-unistr.Tpo $(DEPDIR)/libga68_la-ga68-unistr.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='ga68-unistr.c' object='libga68_la-ga68-unistr.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -c -o libga68_la-ga68-unistr.lo `test -f 'ga68-unistr.c' || echo '$(srcdir)/'`ga68-unistr.c + +libga68_la-ga68-posix.lo: ga68-posix.c +@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -MT libga68_la-ga68-posix.lo -MD -MP -MF $(DEPDIR)/libga68_la-ga68-posix.Tpo -c -o libga68_la-ga68-posix.lo `test -f 'ga68-posix.c' || echo '$(srcdir)/'`ga68-posix.c +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libga68_la-ga68-posix.Tpo $(DEPDIR)/libga68_la-ga68-posix.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='ga68-posix.c' object='libga68_la-ga68-posix.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -c -o libga68_la-ga68-posix.lo `test -f 'ga68-posix.c' || echo '$(srcdir)/'`ga68-posix.c + +libga68_la-ga68-alloc.lo: ga68-alloc.c +@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -MT libga68_la-ga68-alloc.lo -MD -MP -MF $(DEPDIR)/libga68_la-ga68-alloc.Tpo -c -o libga68_la-ga68-alloc.lo `test -f 'ga68-alloc.c' || echo '$(srcdir)/'`ga68-alloc.c +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libga68_la-ga68-alloc.Tpo $(DEPDIR)/libga68_la-ga68-alloc.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='ga68-alloc.c' object='libga68_la-ga68-alloc.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -c -o libga68_la-ga68-alloc.lo `test -f 'ga68-alloc.c' || echo '$(srcdir)/'`ga68-alloc.c + +libga68_la-ga68-error.lo: ga68-error.c +@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -MT libga68_la-ga68-error.lo -MD -MP -MF $(DEPDIR)/libga68_la-ga68-error.Tpo -c -o libga68_la-ga68-error.lo `test -f 'ga68-error.c' || echo '$(srcdir)/'`ga68-error.c +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libga68_la-ga68-error.Tpo $(DEPDIR)/libga68_la-ga68-error.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='ga68-error.c' object='libga68_la-ga68-error.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -c -o libga68_la-ga68-error.lo `test -f 'ga68-error.c' || echo '$(srcdir)/'`ga68-error.c + +libga68_la-ga68-standenv.lo: ga68-standenv.c +@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -MT libga68_la-ga68-standenv.lo -MD -MP -MF $(DEPDIR)/libga68_la-ga68-standenv.Tpo -c -o libga68_la-ga68-standenv.lo `test -f 'ga68-standenv.c' || echo '$(srcdir)/'`ga68-standenv.c +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libga68_la-ga68-standenv.Tpo $(DEPDIR)/libga68_la-ga68-standenv.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='ga68-standenv.c' object='libga68_la-ga68-standenv.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(libga68_la_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libga68_la_CFLAGS) $(CFLAGS) -c -o libga68_la-ga68-standenv.lo `test -f 'ga68-standenv.c' || echo '$(srcdir)/'`ga68-standenv.c + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs + +distclean-libtool: + -rm -f libtool config.lt +install-toolexeclibDATA: $(toolexeclib_DATA) + @$(NORMAL_INSTALL) + @list='$(toolexeclib_DATA)'; test -n "$(toolexeclibdir)" || list=; \ + if test -n "$$list"; then \ + echo " $(MKDIR_P) '$(DESTDIR)$(toolexeclibdir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(toolexeclibdir)" || exit 1; \ + fi; \ + for p in $$list; do \ + if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \ + echo "$$d$$p"; \ + done | $(am__base_list) | \ + while read files; do \ + echo " $(INSTALL_DATA) $$files '$(DESTDIR)$(toolexeclibdir)'"; \ + $(INSTALL_DATA) $$files "$(DESTDIR)$(toolexeclibdir)" || exit $$?; \ + done + +uninstall-toolexeclibDATA: + @$(NORMAL_UNINSTALL) + @list='$(toolexeclib_DATA)'; test -n "$(toolexeclibdir)" || list=; \ + files=`for p in $$list; do echo $$p; done | sed -e 's|^.*/||'`; \ + dir='$(DESTDIR)$(toolexeclibdir)'; $(am__uninstall_files_from_dir) + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-am +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-am + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscope: cscope.files + test ! -s cscope.files \ + || $(CSCOPE) -b -q $(AM_CSCOPEFLAGS) $(CSCOPEFLAGS) -i cscope.files $(CSCOPE_ARGS) +clean-cscope: + -rm -f cscope.files +cscope.files: clean-cscope cscopelist +cscopelist: cscopelist-am + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + -rm -f cscope.out cscope.in.out cscope.po.out cscope.files +check-am: all-am +check: check-am +all-am: Makefile $(LTLIBRARIES) $(DATA) config.h all-local +installdirs: + for dir in "$(DESTDIR)$(toolexeclibdir)" "$(DESTDIR)$(toolexeclibdir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-libtool clean-local \ + clean-toolexeclibLTLIBRARIES mostlyclean-am + +distclean: distclean-am + -rm -f $(am__CONFIG_DISTCLEAN_FILES) + -rm -rf ./$(DEPDIR) + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-hdr distclean-libtool distclean-local distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: install-exec-local install-toolexeclibDATA \ + install-toolexeclibLTLIBRARIES + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -f $(am__CONFIG_DISTCLEAN_FILES) + -rm -rf $(top_srcdir)/autom4te.cache + -rm -rf ./$(DEPDIR) + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic \ + maintainer-clean-local + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic \ + mostlyclean-libtool mostlyclean-local + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: uninstall-toolexeclibDATA \ + uninstall-toolexeclibLTLIBRARIES + +.MAKE: all install-am install-strip + +.PHONY: CTAGS GTAGS TAGS all all-am all-local am--refresh check \ + check-am clean clean-cscope clean-generic clean-libtool \ + clean-local clean-toolexeclibLTLIBRARIES cscope cscopelist-am \ + ctags ctags-am distclean distclean-compile distclean-generic \ + distclean-hdr distclean-libtool distclean-local distclean-tags \ + dvi dvi-am html html-am info info-am install install-am \ + install-data install-data-am install-dvi install-dvi-am \ + install-exec install-exec-am install-exec-local install-html \ + install-html-am install-info install-info-am install-man \ + install-pdf install-pdf-am install-ps install-ps-am \ + install-strip install-toolexeclibDATA \ + install-toolexeclibLTLIBRARIES installcheck installcheck-am \ + installdirs maintainer-clean maintainer-clean-generic \ + maintainer-clean-local mostlyclean mostlyclean-compile \ + mostlyclean-generic mostlyclean-libtool mostlyclean-local pdf \ + pdf-am ps ps-am tags tags-am uninstall uninstall-am \ + uninstall-toolexeclibDATA uninstall-toolexeclibLTLIBRARIES + +.PRECIOUS: Makefile + + +# target overrides +-include $(tmake_file) + +# GNU Make needs to see an explicit $(MAKE) variable in the command it +# runs to enable its job server during parallel builds. Hence the +# comments below. +all-multi: + $(MULTIDO) $(AM_MAKEFLAGS) DO=all multi-do # $(MAKE) +install-multi: + $(MULTIDO) $(AM_MAKEFLAGS) DO=install multi-do # $(MAKE) +mostlyclean-multi: + $(MULTICLEAN) $(AM_MAKEFLAGS) DO=mostlyclean multi-clean # $(MAKE) +clean-multi: + $(MULTICLEAN) $(AM_MAKEFLAGS) DO=clean multi-clean # $(MAKE) +distclean-multi: + $(MULTICLEAN) $(AM_MAKEFLAGS) DO=distclean multi-clean # $(MAKE) +maintainer-clean-multi: + $(MULTICLEAN) $(AM_MAKEFLAGS) DO=maintainer-clean multi-clean # $(MAKE) + +.MAKE .PHONY: all-multi clean-multi distclean-multi install-am \ + install-multi maintainer-clean-multi mostlyclean-multi + +install-exec-local: install-multi + +all-local: all-multi +mostlyclean-local: mostlyclean-multi +clean-local: clean-multi +distclean-local: distclean-multi +maintainer-clean-local: maintainer-clean-multi + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/libga68/aclocal.m4 b/libga68/aclocal.m4 new file mode 100644 index 000000000000..832065fbb9be --- /dev/null +++ b/libga68/aclocal.m4 @@ -0,0 +1,1200 @@ +# generated automatically by aclocal 1.15.1 -*- Autoconf -*- + +# Copyright (C) 1996-2017 Free Software Foundation, Inc. + +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +m4_ifndef([AC_CONFIG_MACRO_DIRS], [m4_defun([_AM_CONFIG_MACRO_DIRS], [])m4_defun([AC_CONFIG_MACRO_DIRS], [_AM_CONFIG_MACRO_DIRS($@)])]) +m4_ifndef([AC_AUTOCONF_VERSION], + [m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl +m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.69],, +[m4_warning([this file was generated for autoconf 2.69. +You have another version of autoconf. It may work, but is not guaranteed to. +If you have problems, you may need to regenerate the build system entirely. +To do so, use the procedure documented by the package, typically 'autoreconf'.])]) + +# Copyright (C) 2002-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# AM_AUTOMAKE_VERSION(VERSION) +# ---------------------------- +# Automake X.Y traces this macro to ensure aclocal.m4 has been +# generated from the m4 files accompanying Automake X.Y. +# (This private macro should not be called outside this file.) +AC_DEFUN([AM_AUTOMAKE_VERSION], +[am__api_version='1.15' +dnl Some users find AM_AUTOMAKE_VERSION and mistake it for a way to +dnl require some minimum version. Point them to the right macro. +m4_if([$1], [1.15.1], [], + [AC_FATAL([Do not call $0, use AM_INIT_AUTOMAKE([$1]).])])dnl +]) + +# _AM_AUTOCONF_VERSION(VERSION) +# ----------------------------- +# aclocal traces this macro to find the Autoconf version. +# This is a private macro too. Using m4_define simplifies +# the logic in aclocal, which can simply ignore this definition. +m4_define([_AM_AUTOCONF_VERSION], []) + +# AM_SET_CURRENT_AUTOMAKE_VERSION +# ------------------------------- +# Call AM_AUTOMAKE_VERSION and AM_AUTOMAKE_VERSION so they can be traced. +# This function is AC_REQUIREd by AM_INIT_AUTOMAKE. +AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION], +[AM_AUTOMAKE_VERSION([1.15.1])dnl +m4_ifndef([AC_AUTOCONF_VERSION], + [m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl +_AM_AUTOCONF_VERSION(m4_defn([AC_AUTOCONF_VERSION]))]) + +# Figure out how to run the assembler. -*- Autoconf -*- + +# Copyright (C) 2001-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# AM_PROG_AS +# ---------- +AC_DEFUN([AM_PROG_AS], +[# By default we simply use the C compiler to build assembly code. +AC_REQUIRE([AC_PROG_CC]) +test "${CCAS+set}" = set || CCAS=$CC +test "${CCASFLAGS+set}" = set || CCASFLAGS=$CFLAGS +AC_ARG_VAR([CCAS], [assembler compiler command (defaults to CC)]) +AC_ARG_VAR([CCASFLAGS], [assembler compiler flags (defaults to CFLAGS)]) +_AM_IF_OPTION([no-dependencies],, [_AM_DEPENDENCIES([CCAS])])dnl +]) + +# AM_AUX_DIR_EXPAND -*- Autoconf -*- + +# Copyright (C) 2001-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# For projects using AC_CONFIG_AUX_DIR([foo]), Autoconf sets +# $ac_aux_dir to '$srcdir/foo'. In other projects, it is set to +# '$srcdir', '$srcdir/..', or '$srcdir/../..'. +# +# Of course, Automake must honor this variable whenever it calls a +# tool from the auxiliary directory. The problem is that $srcdir (and +# therefore $ac_aux_dir as well) can be either absolute or relative, +# depending on how configure is run. This is pretty annoying, since +# it makes $ac_aux_dir quite unusable in subdirectories: in the top +# source directory, any form will work fine, but in subdirectories a +# relative path needs to be adjusted first. +# +# $ac_aux_dir/missing +# fails when called from a subdirectory if $ac_aux_dir is relative +# $top_srcdir/$ac_aux_dir/missing +# fails if $ac_aux_dir is absolute, +# fails when called from a subdirectory in a VPATH build with +# a relative $ac_aux_dir +# +# The reason of the latter failure is that $top_srcdir and $ac_aux_dir +# are both prefixed by $srcdir. In an in-source build this is usually +# harmless because $srcdir is '.', but things will broke when you +# start a VPATH build or use an absolute $srcdir. +# +# So we could use something similar to $top_srcdir/$ac_aux_dir/missing, +# iff we strip the leading $srcdir from $ac_aux_dir. That would be: +# am_aux_dir='\$(top_srcdir)/'`expr "$ac_aux_dir" : "$srcdir//*\(.*\)"` +# and then we would define $MISSING as +# MISSING="\${SHELL} $am_aux_dir/missing" +# This will work as long as MISSING is not called from configure, because +# unfortunately $(top_srcdir) has no meaning in configure. +# However there are other variables, like CC, which are often used in +# configure, and could therefore not use this "fixed" $ac_aux_dir. +# +# Another solution, used here, is to always expand $ac_aux_dir to an +# absolute PATH. The drawback is that using absolute paths prevent a +# configured tree to be moved without reconfiguration. + +AC_DEFUN([AM_AUX_DIR_EXPAND], +[AC_REQUIRE([AC_CONFIG_AUX_DIR_DEFAULT])dnl +# Expand $ac_aux_dir to an absolute path. +am_aux_dir=`cd "$ac_aux_dir" && pwd` +]) + +# AM_CONDITIONAL -*- Autoconf -*- + +# Copyright (C) 1997-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# AM_CONDITIONAL(NAME, SHELL-CONDITION) +# ------------------------------------- +# Define a conditional. +AC_DEFUN([AM_CONDITIONAL], +[AC_PREREQ([2.52])dnl + m4_if([$1], [TRUE], [AC_FATAL([$0: invalid condition: $1])], + [$1], [FALSE], [AC_FATAL([$0: invalid condition: $1])])dnl +AC_SUBST([$1_TRUE])dnl +AC_SUBST([$1_FALSE])dnl +_AM_SUBST_NOTMAKE([$1_TRUE])dnl +_AM_SUBST_NOTMAKE([$1_FALSE])dnl +m4_define([_AM_COND_VALUE_$1], [$2])dnl +if $2; then + $1_TRUE= + $1_FALSE='#' +else + $1_TRUE='#' + $1_FALSE= +fi +AC_CONFIG_COMMANDS_PRE( +[if test -z "${$1_TRUE}" && test -z "${$1_FALSE}"; then + AC_MSG_ERROR([[conditional "$1" was never defined. +Usually this means the macro was only invoked conditionally.]]) +fi])]) + +# Copyright (C) 1999-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + + +# There are a few dirty hacks below to avoid letting 'AC_PROG_CC' be +# written in clear, in which case automake, when reading aclocal.m4, +# will think it sees a *use*, and therefore will trigger all it's +# C support machinery. Also note that it means that autoscan, seeing +# CC etc. in the Makefile, will ask for an AC_PROG_CC use... + + +# _AM_DEPENDENCIES(NAME) +# ---------------------- +# See how the compiler implements dependency checking. +# NAME is "CC", "CXX", "OBJC", "OBJCXX", "UPC", or "GJC". +# We try a few techniques and use that to set a single cache variable. +# +# We don't AC_REQUIRE the corresponding AC_PROG_CC since the latter was +# modified to invoke _AM_DEPENDENCIES(CC); we would have a circular +# dependency, and given that the user is not expected to run this macro, +# just rely on AC_PROG_CC. +AC_DEFUN([_AM_DEPENDENCIES], +[AC_REQUIRE([AM_SET_DEPDIR])dnl +AC_REQUIRE([AM_OUTPUT_DEPENDENCY_COMMANDS])dnl +AC_REQUIRE([AM_MAKE_INCLUDE])dnl +AC_REQUIRE([AM_DEP_TRACK])dnl + +m4_if([$1], [CC], [depcc="$CC" am_compiler_list=], + [$1], [CXX], [depcc="$CXX" am_compiler_list=], + [$1], [OBJC], [depcc="$OBJC" am_compiler_list='gcc3 gcc'], + [$1], [OBJCXX], [depcc="$OBJCXX" am_compiler_list='gcc3 gcc'], + [$1], [UPC], [depcc="$UPC" am_compiler_list=], + [$1], [GCJ], [depcc="$GCJ" am_compiler_list='gcc3 gcc'], + [depcc="$$1" am_compiler_list=]) + +AC_CACHE_CHECK([dependency style of $depcc], + [am_cv_$1_dependencies_compiler_type], +[if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then + # We make a subdir and do the tests there. Otherwise we can end up + # making bogus files that we don't know about and never remove. For + # instance it was reported that on HP-UX the gcc test will end up + # making a dummy file named 'D' -- because '-MD' means "put the output + # in D". + rm -rf conftest.dir + mkdir conftest.dir + # Copy depcomp to subdir because otherwise we won't find it if we're + # using a relative directory. + cp "$am_depcomp" conftest.dir + cd conftest.dir + # We will build objects and dependencies in a subdirectory because + # it helps to detect inapplicable dependency modes. For instance + # both Tru64's cc and ICC support -MD to output dependencies as a + # side effect of compilation, but ICC will put the dependencies in + # the current directory while Tru64 will put them in the object + # directory. + mkdir sub + + am_cv_$1_dependencies_compiler_type=none + if test "$am_compiler_list" = ""; then + am_compiler_list=`sed -n ['s/^#*\([a-zA-Z0-9]*\))$/\1/p'] < ./depcomp` + fi + am__universal=false + m4_case([$1], [CC], + [case " $depcc " in #( + *\ -arch\ *\ -arch\ *) am__universal=true ;; + esac], + [CXX], + [case " $depcc " in #( + *\ -arch\ *\ -arch\ *) am__universal=true ;; + esac]) + + for depmode in $am_compiler_list; do + # Setup a source with many dependencies, because some compilers + # like to wrap large dependency lists on column 80 (with \), and + # we should not choose a depcomp mode which is confused by this. + # + # We need to recreate these files for each test, as the compiler may + # overwrite some of them when testing with obscure command lines. + # This happens at least with the AIX C compiler. + : > sub/conftest.c + for i in 1 2 3 4 5 6; do + echo '#include "conftst'$i'.h"' >> sub/conftest.c + # Using ": > sub/conftst$i.h" creates only sub/conftst1.h with + # Solaris 10 /bin/sh. + echo '/* dummy */' > sub/conftst$i.h + done + echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf + + # We check with '-c' and '-o' for the sake of the "dashmstdout" + # mode. It turns out that the SunPro C++ compiler does not properly + # handle '-M -o', and we need to detect this. Also, some Intel + # versions had trouble with output in subdirs. + am__obj=sub/conftest.${OBJEXT-o} + am__minus_obj="-o $am__obj" + case $depmode in + gcc) + # This depmode causes a compiler race in universal mode. + test "$am__universal" = false || continue + ;; + nosideeffect) + # After this tag, mechanisms are not by side-effect, so they'll + # only be used when explicitly requested. + if test "x$enable_dependency_tracking" = xyes; then + continue + else + break + fi + ;; + msvc7 | msvc7msys | msvisualcpp | msvcmsys) + # This compiler won't grok '-c -o', but also, the minuso test has + # not run yet. These depmodes are late enough in the game, and + # so weak that their functioning should not be impacted. + am__obj=conftest.${OBJEXT-o} + am__minus_obj= + ;; + none) break ;; + esac + if depmode=$depmode \ + source=sub/conftest.c object=$am__obj \ + depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ + $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \ + >/dev/null 2>conftest.err && + grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 && + grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && + grep $am__obj sub/conftest.Po > /dev/null 2>&1 && + ${MAKE-make} -s -f confmf > /dev/null 2>&1; then + # icc doesn't choke on unknown options, it will just issue warnings + # or remarks (even with -Werror). So we grep stderr for any message + # that says an option was ignored or not supported. + # When given -MP, icc 7.0 and 7.1 complain thusly: + # icc: Command line warning: ignoring option '-M'; no argument required + # The diagnosis changed in icc 8.0: + # icc: Command line remark: option '-MP' not supported + if (grep 'ignoring option' conftest.err || + grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else + am_cv_$1_dependencies_compiler_type=$depmode + break + fi + fi + done + + cd .. + rm -rf conftest.dir +else + am_cv_$1_dependencies_compiler_type=none +fi +]) +AC_SUBST([$1DEPMODE], [depmode=$am_cv_$1_dependencies_compiler_type]) +AM_CONDITIONAL([am__fastdep$1], [ + test "x$enable_dependency_tracking" != xno \ + && test "$am_cv_$1_dependencies_compiler_type" = gcc3]) +]) + + +# AM_SET_DEPDIR +# ------------- +# Choose a directory name for dependency files. +# This macro is AC_REQUIREd in _AM_DEPENDENCIES. +AC_DEFUN([AM_SET_DEPDIR], +[AC_REQUIRE([AM_SET_LEADING_DOT])dnl +AC_SUBST([DEPDIR], ["${am__leading_dot}deps"])dnl +]) + + +# AM_DEP_TRACK +# ------------ +AC_DEFUN([AM_DEP_TRACK], +[AC_ARG_ENABLE([dependency-tracking], [dnl +AS_HELP_STRING( + [--enable-dependency-tracking], + [do not reject slow dependency extractors]) +AS_HELP_STRING( + [--disable-dependency-tracking], + [speeds up one-time build])]) +if test "x$enable_dependency_tracking" != xno; then + am_depcomp="$ac_aux_dir/depcomp" + AMDEPBACKSLASH='\' + am__nodep='_no' +fi +AM_CONDITIONAL([AMDEP], [test "x$enable_dependency_tracking" != xno]) +AC_SUBST([AMDEPBACKSLASH])dnl +_AM_SUBST_NOTMAKE([AMDEPBACKSLASH])dnl +AC_SUBST([am__nodep])dnl +_AM_SUBST_NOTMAKE([am__nodep])dnl +]) + +# Generate code to set up dependency tracking. -*- Autoconf -*- + +# Copyright (C) 1999-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + + +# _AM_OUTPUT_DEPENDENCY_COMMANDS +# ------------------------------ +AC_DEFUN([_AM_OUTPUT_DEPENDENCY_COMMANDS], +[{ + # Older Autoconf quotes --file arguments for eval, but not when files + # are listed without --file. Let's play safe and only enable the eval + # if we detect the quoting. + case $CONFIG_FILES in + *\'*) eval set x "$CONFIG_FILES" ;; + *) set x $CONFIG_FILES ;; + esac + shift + for mf + do + # Strip MF so we end up with the name of the file. + mf=`echo "$mf" | sed -e 's/:.*$//'` + # Check whether this is an Automake generated Makefile or not. + # We used to match only the files named 'Makefile.in', but + # some people rename them; so instead we look at the file content. + # Grep'ing the first line is not enough: some people post-process + # each Makefile.in and add a new line on top of each file to say so. + # Grep'ing the whole file is not good either: AIX grep has a line + # limit of 2048, but all sed's we know have understand at least 4000. + if sed -n 's,^#.*generated by automake.*,X,p' "$mf" | grep X >/dev/null 2>&1; then + dirpart=`AS_DIRNAME("$mf")` + else + continue + fi + # Extract the definition of DEPDIR, am__include, and am__quote + # from the Makefile without running 'make'. + DEPDIR=`sed -n 's/^DEPDIR = //p' < "$mf"` + test -z "$DEPDIR" && continue + am__include=`sed -n 's/^am__include = //p' < "$mf"` + test -z "$am__include" && continue + am__quote=`sed -n 's/^am__quote = //p' < "$mf"` + # Find all dependency output files, they are included files with + # $(DEPDIR) in their names. We invoke sed twice because it is the + # simplest approach to changing $(DEPDIR) to its actual value in the + # expansion. + for file in `sed -n " + s/^$am__include $am__quote\(.*(DEPDIR).*\)$am__quote"'$/\1/p' <"$mf" | \ + sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g'`; do + # Make sure the directory exists. + test -f "$dirpart/$file" && continue + fdir=`AS_DIRNAME(["$file"])` + AS_MKDIR_P([$dirpart/$fdir]) + # echo "creating $dirpart/$file" + echo '# dummy' > "$dirpart/$file" + done + done +} +])# _AM_OUTPUT_DEPENDENCY_COMMANDS + + +# AM_OUTPUT_DEPENDENCY_COMMANDS +# ----------------------------- +# This macro should only be invoked once -- use via AC_REQUIRE. +# +# This code is only required when automatic dependency tracking +# is enabled. FIXME. This creates each '.P' file that we will +# need in order to bootstrap the dependency handling code. +AC_DEFUN([AM_OUTPUT_DEPENDENCY_COMMANDS], +[AC_CONFIG_COMMANDS([depfiles], + [test x"$AMDEP_TRUE" != x"" || _AM_OUTPUT_DEPENDENCY_COMMANDS], + [AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir"]) +]) + +# Do all the work for Automake. -*- Autoconf -*- + +# Copyright (C) 1996-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This macro actually does too much. Some checks are only needed if +# your package does certain things. But this isn't really a big deal. + +dnl Redefine AC_PROG_CC to automatically invoke _AM_PROG_CC_C_O. +m4_define([AC_PROG_CC], +m4_defn([AC_PROG_CC]) +[_AM_PROG_CC_C_O +]) + +# AM_INIT_AUTOMAKE(PACKAGE, VERSION, [NO-DEFINE]) +# AM_INIT_AUTOMAKE([OPTIONS]) +# ----------------------------------------------- +# The call with PACKAGE and VERSION arguments is the old style +# call (pre autoconf-2.50), which is being phased out. PACKAGE +# and VERSION should now be passed to AC_INIT and removed from +# the call to AM_INIT_AUTOMAKE. +# We support both call styles for the transition. After +# the next Automake release, Autoconf can make the AC_INIT +# arguments mandatory, and then we can depend on a new Autoconf +# release and drop the old call support. +AC_DEFUN([AM_INIT_AUTOMAKE], +[AC_PREREQ([2.65])dnl +dnl Autoconf wants to disallow AM_ names. We explicitly allow +dnl the ones we care about. +m4_pattern_allow([^AM_[A-Z]+FLAGS$])dnl +AC_REQUIRE([AM_SET_CURRENT_AUTOMAKE_VERSION])dnl +AC_REQUIRE([AC_PROG_INSTALL])dnl +if test "`cd $srcdir && pwd`" != "`pwd`"; then + # Use -I$(srcdir) only when $(srcdir) != ., so that make's output + # is not polluted with repeated "-I." + AC_SUBST([am__isrc], [' -I$(srcdir)'])_AM_SUBST_NOTMAKE([am__isrc])dnl + # test to see if srcdir already configured + if test -f $srcdir/config.status; then + AC_MSG_ERROR([source directory already configured; run "make distclean" there first]) + fi +fi + +# test whether we have cygpath +if test -z "$CYGPATH_W"; then + if (cygpath --version) >/dev/null 2>/dev/null; then + CYGPATH_W='cygpath -w' + else + CYGPATH_W=echo + fi +fi +AC_SUBST([CYGPATH_W]) + +# Define the identity of the package. +dnl Distinguish between old-style and new-style calls. +m4_ifval([$2], +[AC_DIAGNOSE([obsolete], + [$0: two- and three-arguments forms are deprecated.]) +m4_ifval([$3], [_AM_SET_OPTION([no-define])])dnl + AC_SUBST([PACKAGE], [$1])dnl + AC_SUBST([VERSION], [$2])], +[_AM_SET_OPTIONS([$1])dnl +dnl Diagnose old-style AC_INIT with new-style AM_AUTOMAKE_INIT. +m4_if( + m4_ifdef([AC_PACKAGE_NAME], [ok]):m4_ifdef([AC_PACKAGE_VERSION], [ok]), + [ok:ok],, + [m4_fatal([AC_INIT should be called with package and version arguments])])dnl + AC_SUBST([PACKAGE], ['AC_PACKAGE_TARNAME'])dnl + AC_SUBST([VERSION], ['AC_PACKAGE_VERSION'])])dnl + +_AM_IF_OPTION([no-define],, +[AC_DEFINE_UNQUOTED([PACKAGE], ["$PACKAGE"], [Name of package]) + AC_DEFINE_UNQUOTED([VERSION], ["$VERSION"], [Version number of package])])dnl + +# Some tools Automake needs. +AC_REQUIRE([AM_SANITY_CHECK])dnl +AC_REQUIRE([AC_ARG_PROGRAM])dnl +AM_MISSING_PROG([ACLOCAL], [aclocal-${am__api_version}]) +AM_MISSING_PROG([AUTOCONF], [autoconf]) +AM_MISSING_PROG([AUTOMAKE], [automake-${am__api_version}]) +AM_MISSING_PROG([AUTOHEADER], [autoheader]) +AM_MISSING_PROG([MAKEINFO], [makeinfo]) +AC_REQUIRE([AM_PROG_INSTALL_SH])dnl +AC_REQUIRE([AM_PROG_INSTALL_STRIP])dnl +AC_REQUIRE([AC_PROG_MKDIR_P])dnl +# For better backward compatibility. To be removed once Automake 1.9.x +# dies out for good. For more background, see: +# +# +AC_SUBST([mkdir_p], ['$(MKDIR_P)']) +# We need awk for the "check" target (and possibly the TAP driver). The +# system "awk" is bad on some platforms. +AC_REQUIRE([AC_PROG_AWK])dnl +AC_REQUIRE([AC_PROG_MAKE_SET])dnl +AC_REQUIRE([AM_SET_LEADING_DOT])dnl +_AM_IF_OPTION([tar-ustar], [_AM_PROG_TAR([ustar])], + [_AM_IF_OPTION([tar-pax], [_AM_PROG_TAR([pax])], + [_AM_PROG_TAR([v7])])]) +_AM_IF_OPTION([no-dependencies],, +[AC_PROVIDE_IFELSE([AC_PROG_CC], + [_AM_DEPENDENCIES([CC])], + [m4_define([AC_PROG_CC], + m4_defn([AC_PROG_CC])[_AM_DEPENDENCIES([CC])])])dnl +AC_PROVIDE_IFELSE([AC_PROG_CXX], + [_AM_DEPENDENCIES([CXX])], + [m4_define([AC_PROG_CXX], + m4_defn([AC_PROG_CXX])[_AM_DEPENDENCIES([CXX])])])dnl +AC_PROVIDE_IFELSE([AC_PROG_OBJC], + [_AM_DEPENDENCIES([OBJC])], + [m4_define([AC_PROG_OBJC], + m4_defn([AC_PROG_OBJC])[_AM_DEPENDENCIES([OBJC])])])dnl +AC_PROVIDE_IFELSE([AC_PROG_OBJCXX], + [_AM_DEPENDENCIES([OBJCXX])], + [m4_define([AC_PROG_OBJCXX], + m4_defn([AC_PROG_OBJCXX])[_AM_DEPENDENCIES([OBJCXX])])])dnl +]) +AC_REQUIRE([AM_SILENT_RULES])dnl +dnl The testsuite driver may need to know about EXEEXT, so add the +dnl 'am__EXEEXT' conditional if _AM_COMPILER_EXEEXT was seen. This +dnl macro is hooked onto _AC_COMPILER_EXEEXT early, see below. +AC_CONFIG_COMMANDS_PRE(dnl +[m4_provide_if([_AM_COMPILER_EXEEXT], + [AM_CONDITIONAL([am__EXEEXT], [test -n "$EXEEXT"])])])dnl + +# POSIX will say in a future version that running "rm -f" with no argument +# is OK; and we want to be able to make that assumption in our Makefile +# recipes. So use an aggressive probe to check that the usage we want is +# actually supported "in the wild" to an acceptable degree. +# See automake bug#10828. +# To make any issue more visible, cause the running configure to be aborted +# by default if the 'rm' program in use doesn't match our expectations; the +# user can still override this though. +if rm -f && rm -fr && rm -rf; then : OK; else + cat >&2 <<'END' +Oops! + +Your 'rm' program seems unable to run without file operands specified +on the command line, even when the '-f' option is present. This is contrary +to the behaviour of most rm programs out there, and not conforming with +the upcoming POSIX standard: + +Please tell bug-automake@gnu.org about your system, including the value +of your $PATH and any error possibly output before this message. This +can help us improve future automake versions. + +END + if test x"$ACCEPT_INFERIOR_RM_PROGRAM" = x"yes"; then + echo 'Configuration will proceed anyway, since you have set the' >&2 + echo 'ACCEPT_INFERIOR_RM_PROGRAM variable to "yes"' >&2 + echo >&2 + else + cat >&2 <<'END' +Aborting the configuration process, to ensure you take notice of the issue. + +You can download and install GNU coreutils to get an 'rm' implementation +that behaves properly: . + +If you want to complete the configuration process using your problematic +'rm' anyway, export the environment variable ACCEPT_INFERIOR_RM_PROGRAM +to "yes", and re-run configure. + +END + AC_MSG_ERROR([Your 'rm' program is bad, sorry.]) + fi +fi +dnl The trailing newline in this macro's definition is deliberate, for +dnl backward compatibility and to allow trailing 'dnl'-style comments +dnl after the AM_INIT_AUTOMAKE invocation. See automake bug#16841. +]) + +dnl Hook into '_AC_COMPILER_EXEEXT' early to learn its expansion. Do not +dnl add the conditional right here, as _AC_COMPILER_EXEEXT may be further +dnl mangled by Autoconf and run in a shell conditional statement. +m4_define([_AC_COMPILER_EXEEXT], +m4_defn([_AC_COMPILER_EXEEXT])[m4_provide([_AM_COMPILER_EXEEXT])]) + +# When config.status generates a header, we must update the stamp-h file. +# This file resides in the same directory as the config header +# that is generated. The stamp files are numbered to have different names. + +# Autoconf calls _AC_AM_CONFIG_HEADER_HOOK (when defined) in the +# loop where config.status creates the headers, so we can generate +# our stamp files there. +AC_DEFUN([_AC_AM_CONFIG_HEADER_HOOK], +[# Compute $1's index in $config_headers. +_am_arg=$1 +_am_stamp_count=1 +for _am_header in $config_headers :; do + case $_am_header in + $_am_arg | $_am_arg:* ) + break ;; + * ) + _am_stamp_count=`expr $_am_stamp_count + 1` ;; + esac +done +echo "timestamp for $_am_arg" >`AS_DIRNAME(["$_am_arg"])`/stamp-h[]$_am_stamp_count]) + +# Copyright (C) 2001-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# AM_PROG_INSTALL_SH +# ------------------ +# Define $install_sh. +AC_DEFUN([AM_PROG_INSTALL_SH], +[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl +if test x"${install_sh+set}" != xset; then + case $am_aux_dir in + *\ * | *\ *) + install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;; + *) + install_sh="\${SHELL} $am_aux_dir/install-sh" + esac +fi +AC_SUBST([install_sh])]) + +# Add --enable-maintainer-mode option to configure. -*- Autoconf -*- +# From Jim Meyering + +# Copyright (C) 1996-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# AM_MAINTAINER_MODE([DEFAULT-MODE]) +# ---------------------------------- +# Control maintainer-specific portions of Makefiles. +# Default is to disable them, unless 'enable' is passed literally. +# For symmetry, 'disable' may be passed as well. Anyway, the user +# can override the default with the --enable/--disable switch. +AC_DEFUN([AM_MAINTAINER_MODE], +[m4_case(m4_default([$1], [disable]), + [enable], [m4_define([am_maintainer_other], [disable])], + [disable], [m4_define([am_maintainer_other], [enable])], + [m4_define([am_maintainer_other], [enable]) + m4_warn([syntax], [unexpected argument to AM@&t@_MAINTAINER_MODE: $1])]) +AC_MSG_CHECKING([whether to enable maintainer-specific portions of Makefiles]) + dnl maintainer-mode's default is 'disable' unless 'enable' is passed + AC_ARG_ENABLE([maintainer-mode], + [AS_HELP_STRING([--]am_maintainer_other[-maintainer-mode], + am_maintainer_other[ make rules and dependencies not useful + (and sometimes confusing) to the casual installer])], + [USE_MAINTAINER_MODE=$enableval], + [USE_MAINTAINER_MODE=]m4_if(am_maintainer_other, [enable], [no], [yes])) + AC_MSG_RESULT([$USE_MAINTAINER_MODE]) + AM_CONDITIONAL([MAINTAINER_MODE], [test $USE_MAINTAINER_MODE = yes]) + MAINT=$MAINTAINER_MODE_TRUE + AC_SUBST([MAINT])dnl +] +) + +# Check to see how 'make' treats includes. -*- Autoconf -*- + +# Copyright (C) 2001-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# AM_MAKE_INCLUDE() +# ----------------- +# Check to see how make treats includes. +AC_DEFUN([AM_MAKE_INCLUDE], +[am_make=${MAKE-make} +cat > confinc << 'END' +am__doit: + @echo this is the am__doit target +.PHONY: am__doit +END +# If we don't find an include directive, just comment out the code. +AC_MSG_CHECKING([for style of include used by $am_make]) +am__include="#" +am__quote= +_am_result=none +# First try GNU make style include. +echo "include confinc" > confmf +# Ignore all kinds of additional output from 'make'. +case `$am_make -s -f confmf 2> /dev/null` in #( +*the\ am__doit\ target*) + am__include=include + am__quote= + _am_result=GNU + ;; +esac +# Now try BSD make style include. +if test "$am__include" = "#"; then + echo '.include "confinc"' > confmf + case `$am_make -s -f confmf 2> /dev/null` in #( + *the\ am__doit\ target*) + am__include=.include + am__quote="\"" + _am_result=BSD + ;; + esac +fi +AC_SUBST([am__include]) +AC_SUBST([am__quote]) +AC_MSG_RESULT([$_am_result]) +rm -f confinc confmf +]) + +# Fake the existence of programs that GNU maintainers use. -*- Autoconf -*- + +# Copyright (C) 1997-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# AM_MISSING_PROG(NAME, PROGRAM) +# ------------------------------ +AC_DEFUN([AM_MISSING_PROG], +[AC_REQUIRE([AM_MISSING_HAS_RUN]) +$1=${$1-"${am_missing_run}$2"} +AC_SUBST($1)]) + +# AM_MISSING_HAS_RUN +# ------------------ +# Define MISSING if not defined so far and test if it is modern enough. +# If it is, set am_missing_run to use it, otherwise, to nothing. +AC_DEFUN([AM_MISSING_HAS_RUN], +[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl +AC_REQUIRE_AUX_FILE([missing])dnl +if test x"${MISSING+set}" != xset; then + case $am_aux_dir in + *\ * | *\ *) + MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;; + *) + MISSING="\${SHELL} $am_aux_dir/missing" ;; + esac +fi +# Use eval to expand $SHELL +if eval "$MISSING --is-lightweight"; then + am_missing_run="$MISSING " +else + am_missing_run= + AC_MSG_WARN(['missing' script is too old or missing]) +fi +]) + +# Helper functions for option handling. -*- Autoconf -*- + +# Copyright (C) 2001-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# _AM_MANGLE_OPTION(NAME) +# ----------------------- +AC_DEFUN([_AM_MANGLE_OPTION], +[[_AM_OPTION_]m4_bpatsubst($1, [[^a-zA-Z0-9_]], [_])]) + +# _AM_SET_OPTION(NAME) +# -------------------- +# Set option NAME. Presently that only means defining a flag for this option. +AC_DEFUN([_AM_SET_OPTION], +[m4_define(_AM_MANGLE_OPTION([$1]), [1])]) + +# _AM_SET_OPTIONS(OPTIONS) +# ------------------------ +# OPTIONS is a space-separated list of Automake options. +AC_DEFUN([_AM_SET_OPTIONS], +[m4_foreach_w([_AM_Option], [$1], [_AM_SET_OPTION(_AM_Option)])]) + +# _AM_IF_OPTION(OPTION, IF-SET, [IF-NOT-SET]) +# ------------------------------------------- +# Execute IF-SET if OPTION is set, IF-NOT-SET otherwise. +AC_DEFUN([_AM_IF_OPTION], +[m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])]) + +# Copyright (C) 1999-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# _AM_PROG_CC_C_O +# --------------- +# Like AC_PROG_CC_C_O, but changed for automake. We rewrite AC_PROG_CC +# to automatically call this. +AC_DEFUN([_AM_PROG_CC_C_O], +[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl +AC_REQUIRE_AUX_FILE([compile])dnl +AC_LANG_PUSH([C])dnl +AC_CACHE_CHECK( + [whether $CC understands -c and -o together], + [am_cv_prog_cc_c_o], + [AC_LANG_CONFTEST([AC_LANG_PROGRAM([])]) + # Make sure it works both with $CC and with simple cc. + # Following AC_PROG_CC_C_O, we do the test twice because some + # compilers refuse to overwrite an existing .o file with -o, + # though they will create one. + am_cv_prog_cc_c_o=yes + for am_i in 1 2; do + if AM_RUN_LOG([$CC -c conftest.$ac_ext -o conftest2.$ac_objext]) \ + && test -f conftest2.$ac_objext; then + : OK + else + am_cv_prog_cc_c_o=no + break + fi + done + rm -f core conftest* + unset am_i]) +if test "$am_cv_prog_cc_c_o" != yes; then + # Losing compiler, so override with the script. + # FIXME: It is wrong to rewrite CC. + # But if we don't then we get into trouble of one sort or another. + # A longer-term fix would be to have automake use am__CC in this case, + # and then we could set am__CC="\$(top_srcdir)/compile \$(CC)" + CC="$am_aux_dir/compile $CC" +fi +AC_LANG_POP([C])]) + +# For backward compatibility. +AC_DEFUN_ONCE([AM_PROG_CC_C_O], [AC_REQUIRE([AC_PROG_CC])]) + +# Copyright (C) 2001-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# AM_RUN_LOG(COMMAND) +# ------------------- +# Run COMMAND, save the exit status in ac_status, and log it. +# (This has been adapted from Autoconf's _AC_RUN_LOG macro.) +AC_DEFUN([AM_RUN_LOG], +[{ echo "$as_me:$LINENO: $1" >&AS_MESSAGE_LOG_FD + ($1) >&AS_MESSAGE_LOG_FD 2>&AS_MESSAGE_LOG_FD + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&AS_MESSAGE_LOG_FD + (exit $ac_status); }]) + +# Check to make sure that the build environment is sane. -*- Autoconf -*- + +# Copyright (C) 1996-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# AM_SANITY_CHECK +# --------------- +AC_DEFUN([AM_SANITY_CHECK], +[AC_MSG_CHECKING([whether build environment is sane]) +# Reject unsafe characters in $srcdir or the absolute working directory +# name. Accept space and tab only in the latter. +am_lf=' +' +case `pwd` in + *[[\\\"\#\$\&\'\`$am_lf]]*) + AC_MSG_ERROR([unsafe absolute working directory name]);; +esac +case $srcdir in + *[[\\\"\#\$\&\'\`$am_lf\ \ ]]*) + AC_MSG_ERROR([unsafe srcdir value: '$srcdir']);; +esac + +# Do 'set' in a subshell so we don't clobber the current shell's +# arguments. Must try -L first in case configure is actually a +# symlink; some systems play weird games with the mod time of symlinks +# (eg FreeBSD returns the mod time of the symlink's containing +# directory). +if ( + am_has_slept=no + for am_try in 1 2; do + echo "timestamp, slept: $am_has_slept" > conftest.file + set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null` + if test "$[*]" = "X"; then + # -L didn't work. + set X `ls -t "$srcdir/configure" conftest.file` + fi + if test "$[*]" != "X $srcdir/configure conftest.file" \ + && test "$[*]" != "X conftest.file $srcdir/configure"; then + + # If neither matched, then we have a broken ls. This can happen + # if, for instance, CONFIG_SHELL is bash and it inherits a + # broken ls alias from the environment. This has actually + # happened. Such a system could not be considered "sane". + AC_MSG_ERROR([ls -t appears to fail. Make sure there is not a broken + alias in your environment]) + fi + if test "$[2]" = conftest.file || test $am_try -eq 2; then + break + fi + # Just in case. + sleep 1 + am_has_slept=yes + done + test "$[2]" = conftest.file + ) +then + # Ok. + : +else + AC_MSG_ERROR([newly created file is older than distributed files! +Check your system clock]) +fi +AC_MSG_RESULT([yes]) +# If we didn't sleep, we still need to ensure time stamps of config.status and +# generated files are strictly newer. +am_sleep_pid= +if grep 'slept: no' conftest.file >/dev/null 2>&1; then + ( sleep 1 ) & + am_sleep_pid=$! +fi +AC_CONFIG_COMMANDS_PRE( + [AC_MSG_CHECKING([that generated files are newer than configure]) + if test -n "$am_sleep_pid"; then + # Hide warnings about reused PIDs. + wait $am_sleep_pid 2>/dev/null + fi + AC_MSG_RESULT([done])]) +rm -f conftest.file +]) + +# Copyright (C) 2009-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# AM_SILENT_RULES([DEFAULT]) +# -------------------------- +# Enable less verbose build rules; with the default set to DEFAULT +# ("yes" being less verbose, "no" or empty being verbose). +AC_DEFUN([AM_SILENT_RULES], +[AC_ARG_ENABLE([silent-rules], [dnl +AS_HELP_STRING( + [--enable-silent-rules], + [less verbose build output (undo: "make V=1")]) +AS_HELP_STRING( + [--disable-silent-rules], + [verbose build output (undo: "make V=0")])dnl +]) +case $enable_silent_rules in @%:@ ((( + yes) AM_DEFAULT_VERBOSITY=0;; + no) AM_DEFAULT_VERBOSITY=1;; + *) AM_DEFAULT_VERBOSITY=m4_if([$1], [yes], [0], [1]);; +esac +dnl +dnl A few 'make' implementations (e.g., NonStop OS and NextStep) +dnl do not support nested variable expansions. +dnl See automake bug#9928 and bug#10237. +am_make=${MAKE-make} +AC_CACHE_CHECK([whether $am_make supports nested variables], + [am_cv_make_support_nested_variables], + [if AS_ECHO([['TRUE=$(BAR$(V)) +BAR0=false +BAR1=true +V=1 +am__doit: + @$(TRUE) +.PHONY: am__doit']]) | $am_make -f - >/dev/null 2>&1; then + am_cv_make_support_nested_variables=yes +else + am_cv_make_support_nested_variables=no +fi]) +if test $am_cv_make_support_nested_variables = yes; then + dnl Using '$V' instead of '$(V)' breaks IRIX make. + AM_V='$(V)' + AM_DEFAULT_V='$(AM_DEFAULT_VERBOSITY)' +else + AM_V=$AM_DEFAULT_VERBOSITY + AM_DEFAULT_V=$AM_DEFAULT_VERBOSITY +fi +AC_SUBST([AM_V])dnl +AM_SUBST_NOTMAKE([AM_V])dnl +AC_SUBST([AM_DEFAULT_V])dnl +AM_SUBST_NOTMAKE([AM_DEFAULT_V])dnl +AC_SUBST([AM_DEFAULT_VERBOSITY])dnl +AM_BACKSLASH='\' +AC_SUBST([AM_BACKSLASH])dnl +_AM_SUBST_NOTMAKE([AM_BACKSLASH])dnl +]) + +# Copyright (C) 2001-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# AM_PROG_INSTALL_STRIP +# --------------------- +# One issue with vendor 'install' (even GNU) is that you can't +# specify the program used to strip binaries. This is especially +# annoying in cross-compiling environments, where the build's strip +# is unlikely to handle the host's binaries. +# Fortunately install-sh will honor a STRIPPROG variable, so we +# always use install-sh in "make install-strip", and initialize +# STRIPPROG with the value of the STRIP variable (set by the user). +AC_DEFUN([AM_PROG_INSTALL_STRIP], +[AC_REQUIRE([AM_PROG_INSTALL_SH])dnl +# Installed binaries are usually stripped using 'strip' when the user +# run "make install-strip". However 'strip' might not be the right +# tool to use in cross-compilation environments, therefore Automake +# will honor the 'STRIP' environment variable to overrule this program. +dnl Don't test for $cross_compiling = yes, because it might be 'maybe'. +if test "$cross_compiling" != no; then + AC_CHECK_TOOL([STRIP], [strip], :) +fi +INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s" +AC_SUBST([INSTALL_STRIP_PROGRAM])]) + +# Copyright (C) 2006-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# _AM_SUBST_NOTMAKE(VARIABLE) +# --------------------------- +# Prevent Automake from outputting VARIABLE = @VARIABLE@ in Makefile.in. +# This macro is traced by Automake. +AC_DEFUN([_AM_SUBST_NOTMAKE]) + +# AM_SUBST_NOTMAKE(VARIABLE) +# -------------------------- +# Public sister of _AM_SUBST_NOTMAKE. +AC_DEFUN([AM_SUBST_NOTMAKE], [_AM_SUBST_NOTMAKE($@)]) + +# Check how to create a tarball. -*- Autoconf -*- + +# Copyright (C) 2004-2017 Free Software Foundation, Inc. +# +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# _AM_PROG_TAR(FORMAT) +# -------------------- +# Check how to create a tarball in format FORMAT. +# FORMAT should be one of 'v7', 'ustar', or 'pax'. +# +# Substitute a variable $(am__tar) that is a command +# writing to stdout a FORMAT-tarball containing the directory +# $tardir. +# tardir=directory && $(am__tar) > result.tar +# +# Substitute a variable $(am__untar) that extract such +# a tarball read from stdin. +# $(am__untar) < result.tar +# +AC_DEFUN([_AM_PROG_TAR], +[# Always define AMTAR for backward compatibility. Yes, it's still used +# in the wild :-( We should find a proper way to deprecate it ... +AC_SUBST([AMTAR], ['$${TAR-tar}']) + +# We'll loop over all known methods to create a tar archive until one works. +_am_tools='gnutar m4_if([$1], [ustar], [plaintar]) pax cpio none' + +m4_if([$1], [v7], + [am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -'], + + [m4_case([$1], + [ustar], + [# The POSIX 1988 'ustar' format is defined with fixed-size fields. + # There is notably a 21 bits limit for the UID and the GID. In fact, + # the 'pax' utility can hang on bigger UID/GID (see automake bug#8343 + # and bug#13588). + am_max_uid=2097151 # 2^21 - 1 + am_max_gid=$am_max_uid + # The $UID and $GID variables are not portable, so we need to resort + # to the POSIX-mandated id(1) utility. Errors in the 'id' calls + # below are definitely unexpected, so allow the users to see them + # (that is, avoid stderr redirection). + am_uid=`id -u || echo unknown` + am_gid=`id -g || echo unknown` + AC_MSG_CHECKING([whether UID '$am_uid' is supported by ustar format]) + if test $am_uid -le $am_max_uid; then + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + _am_tools=none + fi + AC_MSG_CHECKING([whether GID '$am_gid' is supported by ustar format]) + if test $am_gid -le $am_max_gid; then + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + _am_tools=none + fi], + + [pax], + [], + + [m4_fatal([Unknown tar format])]) + + AC_MSG_CHECKING([how to create a $1 tar archive]) + + # Go ahead even if we have the value already cached. We do so because we + # need to set the values for the 'am__tar' and 'am__untar' variables. + _am_tools=${am_cv_prog_tar_$1-$_am_tools} + + for _am_tool in $_am_tools; do + case $_am_tool in + gnutar) + for _am_tar in tar gnutar gtar; do + AM_RUN_LOG([$_am_tar --version]) && break + done + am__tar="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$$tardir"' + am__tar_="$_am_tar --format=m4_if([$1], [pax], [posix], [$1]) -chf - "'"$tardir"' + am__untar="$_am_tar -xf -" + ;; + plaintar) + # Must skip GNU tar: if it does not support --format= it doesn't create + # ustar tarball either. + (tar --version) >/dev/null 2>&1 && continue + am__tar='tar chf - "$$tardir"' + am__tar_='tar chf - "$tardir"' + am__untar='tar xf -' + ;; + pax) + am__tar='pax -L -x $1 -w "$$tardir"' + am__tar_='pax -L -x $1 -w "$tardir"' + am__untar='pax -r' + ;; + cpio) + am__tar='find "$$tardir" -print | cpio -o -H $1 -L' + am__tar_='find "$tardir" -print | cpio -o -H $1 -L' + am__untar='cpio -i -H $1 -d' + ;; + none) + am__tar=false + am__tar_=false + am__untar=false + ;; + esac + + # If the value was cached, stop now. We just wanted to have am__tar + # and am__untar set. + test -n "${am_cv_prog_tar_$1}" && break + + # tar/untar a dummy directory, and stop if the command works. + rm -rf conftest.dir + mkdir conftest.dir + echo GrepMe > conftest.dir/file + AM_RUN_LOG([tardir=conftest.dir && eval $am__tar_ >conftest.tar]) + rm -rf conftest.dir + if test -s conftest.tar; then + AM_RUN_LOG([$am__untar /dev/null 2>&1 && break + fi + done + rm -rf conftest.dir + + AC_CACHE_VAL([am_cv_prog_tar_$1], [am_cv_prog_tar_$1=$_am_tool]) + AC_MSG_RESULT([$am_cv_prog_tar_$1])]) + +AC_SUBST([am__tar]) +AC_SUBST([am__untar]) +]) # _AM_PROG_TAR + +m4_include([../config/acx.m4]) +m4_include([../config/depstand.m4]) +m4_include([../config/lead-dot.m4]) +m4_include([../config/multi.m4]) +m4_include([../config/no-executables.m4]) +m4_include([../config/override.m4]) +m4_include([../libtool.m4]) +m4_include([../ltoptions.m4]) +m4_include([../ltsugar.m4]) +m4_include([../ltversion.m4]) +m4_include([../lt~obsolete.m4]) diff --git a/libga68/configure.ac b/libga68/configure.ac new file mode 100644 index 000000000000..56ef197e5f40 --- /dev/null +++ b/libga68/configure.ac @@ -0,0 +1,371 @@ +# Configure script for libga68. +# Copyright (C) 2025 Jose E. Marchesi. + +# GCC is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3, or (at your option) +# any later version. + +# GCC is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +# Process this file with autoreconf to produce a configure script. + +AC_INIT(package-unused, version-unused,,libga68) +AC_CONFIG_SRCDIR(Makefile.am) +AC_CONFIG_HEADER(config.h) + +# Add --enable-multilib to configure, which defaults to enable. +AM_ENABLE_MULTILIB(, ..) + +if test "${multilib}" = "yes"; then + multilib_arg="--enable-multilib" +else + multilib_arg= +fi + +# Cope with compilers, in subsequent tests, that at this stage may not +# be able to build executables. +GCC_NO_EXECUTABLES + +# Enable extensions to C or POSIX on hosts that normally disable the +# extensions. This should be called before any macros that run the C +# compiler. +AC_USE_SYSTEM_EXTENSIONS + +# Determine the system type and set output variabls to the names of +# the canonical system types. +# +# Do not delete or change the following two lines. For why, and for +# why we are using the obsolete AC_CANONICAL_SYSTEM as ell as the +# recommended AC_CANONICAL_HOST, see +# http://gcc.gnu.org/ml/libstdc++/2003-07/msg00451.html +AC_CANONICAL_SYSTEM +target_alias=${target_alias-$host_alias} +AC_SUBST(target_alias) +AC_CANONICAL_HOST + +# These macro are for supporting canadian crosses, in which build /= +# host /= target. +ACX_NONCANONICAL_HOST +ACX_NONCANONICAL_TARGET +GCC_TOPLEV_SUBDIRS + +# Initialize Automake with proper options. +AM_INIT_AUTOMAKE([1.15.1 no-define foreign no-dist -Wall -Wno-portability]) + +# Tell Autoheader to include templates for PACKAGE and VERSION in +# config.h.in. +AH_TEMPLATE(PACKAGE, [Name of package]) +AH_TEMPLATE(VERSION, [Version number of package]) + +# Command-line options. + +# Enable large-file support. +AC_SYS_LARGEFILE + +AC_ARG_WITH(cross-host, +[ --with-cross-host=HOST Configuring with a cross compiler]) + +AC_MSG_CHECKING([for --enable-version-specific-runtime-libs]) +AC_ARG_ENABLE(version-specific-runtime-libs, +[ --enable-version-specific-runtime-libs Specify that runtime libraries should be installed in a compiler-specific directory ], +[case "$enableval" in + yes) version_specific_libs=yes ;; + no) version_specific_libs=no ;; + *) AC_MSG_ERROR([Unknown argument to enable/disable version-specific libs]);; + esac], +[version_specific_libs=no]) +AC_MSG_RESULT($version_specific_libs) + +AC_ARG_WITH(slibdir, +[ --with-slibdir=DIR shared libraries in DIR [LIBDIR]], +slibdir="$with_slibdir", +if test "${version_specific_libs}" = yes; then + slibdir='$(libsubdir)' +elif test -n "$with_cross_host" && test x"$with_cross_host" != x"no"; then + slibdir='$(exec_prefix)/$(host_noncanonical)/lib' +else + slibdir='$(libdir)' +fi) +AC_SUBST(slibdir) + +# Calculate toolexeclibdir +# Also toolexecdir, though it's only used in toolexeclibdir +toolexecdir=no +toolexeclibdir=no +case ${version_specific_libs} in + yes) + # Need the gcc compiler version to know where to install libraries + # and header files if --enable-version-specific-runtime-libs option + # is selected. + toolexecdir='$(libdir)/gcc/$(target_noncanonical)' + toolexeclibdir='$(toolexecdir)/$(gcc_version)$(MULTISUBDIR)' + ;; + no) + if test -n "$with_cross_host" && + test x"$with_cross_host" != x"no"; then + # Install a library built with a cross compiler in tooldir, not libdir. + toolexecdir='$(exec_prefix)/$(target_noncanonical)' + toolexeclibdir='$(toolexecdir)/lib' + else + toolexecdir='$(libdir)/gcc-lib/$(target_noncanonical)' + toolexeclibdir='$(libdir)' + fi + multi_os_directory=`$CC -print-multi-os-directory` + case $multi_os_directory in + .) ;; # Avoid trailing /. + *) toolexeclibdir=$toolexeclibdir/$multi_os_directory ;; + esac + ;; +esac +AC_SUBST(toolexecdir) +AC_SUBST(toolexeclibdir) + +# Add support for --enable-maintainer-mode={yes,no} to configure. +AM_MAINTAINER_MODE + +# We must force CC to /not/ be precious variables; otherwise +# the wrong, non-multilib-adjusted value will be used in multilibs. +# As a side effect, we have to subst CFLAGS ourselves. +m4_rename([_AC_ARG_VAR_PRECIOUS],[real_PRECIOUS]) +m4_define([_AC_ARG_VAR_PRECIOUS],[]) +AC_PROG_CC +AM_PROG_AS +m4_rename_force([real_PRECIOUS],[_AC_ARG_VAR_PRECIOUS]) +AC_SUBST(CFLAGS) + +# In order to override CFLAGS_FOR_TARGET, all of our special flags go +# in XCFLAGS. But we need them in CFLAGS during configury. So put them +# in both places for now and restore CFLAGS at the end of config. +save_CFLAGS="$CFLAGS" + +# Find other programs we need. +AC_CHECK_TOOL(AR, ar) +AC_CHECK_TOOL(NM, nm) +AC_CHECK_TOOL(RANLIB, ranlib, ranlib-not-found-in-path-error) +AC_PROG_MAKE_SET +AC_PROG_INSTALL + +# Initialize libtool. +LT_INIT + +AM_CONDITIONAL([ENABLE_DARWIN_AT_RPATH], [test x$enable_darwin_at_rpath = xyes]) + +AC_SUBST(enable_shared) +AC_SUBST(enable_static) + +# Do compilation tests using the C compiler and preprocessor. +AC_LANG_C([C]) + +# Allow the user to set CC_FOR_BUILD in the environment. +CC_FOR_BUILD=${CC_FOR_BUILD:-gcc} +AC_SUBST(CC_FOR_BUILD) + +# Search for needed functions in host libraries. +AC_SEARCH_LIBS([malloc], [c]) +AC_SEARCH_LIBS([cosf], [m]) + +# Determine what GCC version number to use in filesystem paths. +GCC_BASE_VER + +# Add dependencies for libga68.spec file +SPEC_LIBGA68_DEPS="$LIBS" +AC_SUBST(SPEC_LIBGA68_DEPS) + +# libga68 soname version +libga68_VERSION=2:0:0 +AC_SUBST(libga68_VERSION) + +# The Boehm GC + +AC_ARG_ENABLE(algol68-gc, +[AS_HELP_STRING([--enable-algol68-gc], + [enable use of Boehm's garbage collector with the + GNU Algol runtime])],,enable_algol68_gc=no) +AC_ARG_WITH([target-bdw-gc], +[AS_HELP_STRING([--with-target-bdw-gc=PATHLIST], + [specify prefix directory for installed bdw-gc package. + Equivalent to --with-target-bdw-gc-include=PATH/include + plus --with-target-bdw-gc-lib=PATH/lib])]) +AC_ARG_WITH([target-bdw-gc-include], +[AS_HELP_STRING([--with-target-bdw-gc-include=PATHLIST], + [specify directories for installed bdw-gc include files])]) +AC_ARG_WITH([target-bdw-gc-lib], +[AS_HELP_STRING([--with-target-bdw-gc-lib=PATHLIST], + [specify directories for installed bdw-gc library])]) + +bdw_lib_dir= +case "$enable_algol68_gc" in +no) + use_bdw_gc=no + ;; +*) + AC_MSG_CHECKING([for bdw garbage collector]) + if test "x$with_target_bdw_gc$with_target_bdw_gc_include$with_target_bdw_gc_lib" = x; then + dnl no bdw-gw options, assuming bdw-gc in default locations + BDW_GC_CFLAGS= + BDW_GC_LIBS="-lgc" + else + dnl bdw-gw options passed by configure flags + if test "x$with_target_bdw_gc_include" = x && test "x$with_target_bdw_gc_lib" != x; then + AC_MSG_ERROR([found --with-target-bdw-gc-lib but --with-target-bdw-gc-include missing]) + elif test "x$with_target_bdw_gc_include" != x && test "x$with_target_bdw_gc_lib" = x; then + AC_MSG_ERROR([found --with-target-bdw-gc-include but --with-target-bdw-gc-lib missing]) + else + AC_MSG_RESULT([using paths configured with --with-target-bdw-gc options]) + fi + mldir=`${CC-gcc} --print-multi-directory 2>/dev/null` + bdw_val= + if test "x$with_target_bdw_gc" != x; then + for i in `echo $with_target_bdw_gc | tr ',' ' '`; do + case "$i" in + *=*) sd=${i%%=*}; d=${i#*=} ;; + *) sd=.; d=$i ;; + esac + if test "$mldir" = "$sd"; then + bdw_val=$d + fi + done + if test "x$bdw_val" = x; then + AC_MSG_ERROR([no multilib path ($mldir) found in --with-target-bdw-gc]) + fi + bdw_inc_dir="$bdw_val/include" + bdw_lib_dir="$bdw_val/lib" + fi + bdw_val= + if test "x$with_target_bdw_gc_include" != x; then + for i in `echo $with_target_bdw_gc_include | tr ',' ' '`; do + case "$i" in + *=*) sd=${i%%=*}; d=${i#*=} ;; + *) sd=.; d=$i; fallback=$i ;; + esac + if test "$mldir" = "$sd"; then + bdw_val=$d + fi + done + if test "x$bdw_val" = x && test "x$bdw_inc_dir" = x && test "x$fallback" != x; then + bdw_inc_dir="$fallback" + elif test "x$bdw_val" = x; then + AC_MSG_ERROR([no multilib path ($mldir) found in --with-target-bdw-gc-include]) + else + bdw_inc_dir="$bdw_val" + fi + fi + bdw_val= + if test "x$with_target_bdw_gc_lib" != x; then + for i in `echo $with_target_bdw_gc_lib | tr ',' ' '`; do + case "$i" in + *=*) sd=${i%%=*}; d=${i#*=} ;; + *) sd=.; d=$i ;; + esac + if test "$mldir" = "$sd"; then + bdw_val=$d + fi + done + if test "x$bdw_val" = x; then + AC_MSG_ERROR([no multilib path ($mldir) found in --with-target-bdw-gc-lib]) + fi + bdw_lib_dir="$bdw_val" + fi + if test "x$bdw_inc_dir" = x; then + AC_MSG_ERROR([no multilib path ($mldir) found in --with-target-bdw-gc-include]) + fi + if test "x$bdw_lib_dir" = x; then + AC_MSG_ERROR([no multilib path ($mldir) found in --with-target-bdw-gc-lib]) + fi + BDW_GC_CFLAGS="-I$bdw_inc_dir" + if test -f $bdw_lib_dir/libgc.la; then + BDW_GC_LIBS="$bdw_lib_dir/libgc.la" + else + BDW_GC_LIBS="-L$bdw_lib_dir -lgc" + fi + AC_MSG_RESULT([found]) + fi + + case "$BDW_GC_LIBS" in + *libgc.la) + use_bdw_gc=yes + ;; + *) + AC_MSG_CHECKING([for system boehm-gc]) + save_CFLAGS=$CFLAGS + save_LIBS=$LIBS + CFLAGS="$CFLAGS $BDW_GC_CFLAGS" + LIBS="$LIBS $BDW_GC_LIBS" + dnl the link test is not good enough for ARM32 multilib detection, + dnl first check to link, then to run + AC_LINK_IFELSE( + [AC_LANG_PROGRAM([#include ],[GC_init()])], + [ + AC_RUN_IFELSE([AC_LANG_SOURCE([[ + #include + int main() { + GC_init(); + return 0; + } + ]])], + [system_bdw_gc_found=yes], + [system_bdw_gc_found=no], + dnl assume no system boehm-gc for cross builds ... + [system_bdw_gc_found=no] + ) + ], + [system_bdw_gc_found=no]) + CFLAGS=$save_CFLAGS + LIBS=$save_LIBS + if test x$enable_algol68_gc = xauto && test x$system_bdw_gc_found = xno; then + AC_MSG_WARN([system bdw-gc not found, building libga68 with no GC support]) + use_bdw_gc=no + elif test x$enable_algol68_gc = xyes && test x$system_bdw_gc_found = xno; then + AC_MSG_ERROR([system bdw-gc required but not found]) + else + use_bdw_gc=yes + AC_MSG_RESULT([found]) + fi + esac +esac + +if test "$use_bdw_gc" = no; then + LIBGA68_GCFLAGS='' + LIBGA68_BOEHM_GC_INCLUDES='' + LIBGA68_BOEHM_GC_LIBS='' +else + LIBGA68_GCFLAGS='-DLIBGA68_WITH_GC=1' + LIBGA68_BOEHM_GC_INCLUDES=$BDW_GC_CFLAGS + LIBGA68_BOEHM_GC_LIBS=$BDW_GC_LIBS + SPEC_LIBGA68_DEPS="$SPEC_LIBGA68_DEPS $BDW_GC_LIBS" +fi + +extra_darwin_ldflags_libga68= +case $host in + *-*-darwin*) + extra_darwin_ldflags_libga68=-Wl,-U,___algol68_main + if test -f $bdw_lib_dir/libgc.a; then + # Darwin wants to link this statically into the library + LIBGA68_BOEHM_GC_LIBS="$bdw_lib_dir/libgc.a" + # No spec entry. + BDW_GC_LIBS= + fi + ;; + *) ;; +esac +AC_SUBST(extra_darwin_ldflags_libga68) + +# Subst some variables used in Makefile.am +AC_SUBST(LIBGA68_GCFLAGS) +AC_SUBST(LIBGA68_BOEHM_GC_INCLUDES) +AC_SUBST(LIBGA68_BOEHM_GC_LIBS) + +# Output files and be done. +AC_CONFIG_SRCDIR([Makefile.am]) +AC_CONFIG_FILES([Makefile]) +AC_CONFIG_FILES(libga68.spec) +AC_MSG_NOTICE([libga68 has been configured.]) +AC_OUTPUT From 4aa120ce5eb743e46a23858edecb252347141da0 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:55:39 +0200 Subject: [PATCH 176/373] a68: libga68: build system (generated files) Signed-off-by: Jose E. Marchesi ChangeLog * libga68/config.h.in: Regenerate. * libga68/configure: Likewise. * libga68/Makefile.in: Likewise. * libga68/aclocal.m4: Likewise. --- libga68/Makefile.in | 8 +- libga68/aclocal.m4 | 2 + libga68/config.h.in | 105 + libga68/configure | 15709 ++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 15819 insertions(+), 5 deletions(-) create mode 100644 libga68/config.h.in create mode 100755 libga68/configure diff --git a/libga68/Makefile.in b/libga68/Makefile.in index 1a1f40c82c7e..efba8b8ee11b 100644 --- a/libga68/Makefile.in +++ b/libga68/Makefile.in @@ -117,7 +117,9 @@ target_triplet = @target@ subdir = . ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/../config/acx.m4 \ + $(top_srcdir)/../config/clang-plugin.m4 \ $(top_srcdir)/../config/depstand.m4 \ + $(top_srcdir)/../config/gcc-plugin.m4 \ $(top_srcdir)/../config/lead-dot.m4 \ $(top_srcdir)/../config/multi.m4 \ $(top_srcdir)/../config/no-executables.m4 \ @@ -259,10 +261,6 @@ CC_FOR_BUILD = @CC_FOR_BUILD@ CFLAGS = @CFLAGS@ CPP = @CPP@ CPPFLAGS = @CPPFLAGS@ -CXX = @CXX@ -CXXCPP = @CXXCPP@ -CXXDEPMODE = @CXXDEPMODE@ -CXXFLAGS = @CXXFLAGS@ CYGPATH_W = @CYGPATH_W@ DEFS = @DEFS@ DEPDIR = @DEPDIR@ @@ -289,6 +287,7 @@ LIBOBJS = @LIBOBJS@ LIBS = @LIBS@ LIBTOOL = @LIBTOOL@ LIPO = @LIPO@ +LLVM_CONFIG = @LLVM_CONFIG@ LN_S = @LN_S@ LTLIBOBJS = @LTLIBOBJS@ MAINT = @MAINT@ @@ -320,7 +319,6 @@ abs_srcdir = @abs_srcdir@ abs_top_builddir = @abs_top_builddir@ abs_top_srcdir = @abs_top_srcdir@ ac_ct_CC = @ac_ct_CC@ -ac_ct_CXX = @ac_ct_CXX@ ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ am__include = @am__include@ am__leading_dot = @am__leading_dot@ diff --git a/libga68/aclocal.m4 b/libga68/aclocal.m4 index 832065fbb9be..1d3f9eceae14 100644 --- a/libga68/aclocal.m4 +++ b/libga68/aclocal.m4 @@ -1188,7 +1188,9 @@ AC_SUBST([am__untar]) ]) # _AM_PROG_TAR m4_include([../config/acx.m4]) +m4_include([../config/clang-plugin.m4]) m4_include([../config/depstand.m4]) +m4_include([../config/gcc-plugin.m4]) m4_include([../config/lead-dot.m4]) m4_include([../config/multi.m4]) m4_include([../config/no-executables.m4]) diff --git a/libga68/config.h.in b/libga68/config.h.in new file mode 100644 index 000000000000..b4e941a2bf7f --- /dev/null +++ b/libga68/config.h.in @@ -0,0 +1,105 @@ +/* config.h.in. Generated from configure.ac by autoheader. */ + +/* Define to 1 if you have the header file. */ +#undef HAVE_DLFCN_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_INTTYPES_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_MEMORY_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STDINT_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STDLIB_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STRINGS_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STRING_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_STAT_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_TYPES_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_UNISTD_H + +/* Define to the sub-directory in which libtool stores uninstalled libraries. + */ +#undef LT_OBJDIR + +/* Name of package */ +#undef PACKAGE + +/* Define to the address where bug reports for this package should be sent. */ +#undef PACKAGE_BUGREPORT + +/* Define to the full name of this package. */ +#undef PACKAGE_NAME + +/* Define to the full name and version of this package. */ +#undef PACKAGE_STRING + +/* Define to the one symbol short name of this package. */ +#undef PACKAGE_TARNAME + +/* Define to the home page for this package. */ +#undef PACKAGE_URL + +/* Define to the version of this package. */ +#undef PACKAGE_VERSION + +/* Define to 1 if you have the ANSI C header files. */ +#undef STDC_HEADERS + +/* Enable extensions on AIX 3, Interix. */ +#ifndef _ALL_SOURCE +# undef _ALL_SOURCE +#endif +/* Enable GNU extensions on systems that have them. */ +#ifndef _GNU_SOURCE +# undef _GNU_SOURCE +#endif +/* Enable threading extensions on Solaris. */ +#ifndef _POSIX_PTHREAD_SEMANTICS +# undef _POSIX_PTHREAD_SEMANTICS +#endif +/* Enable extensions on HP NonStop. */ +#ifndef _TANDEM_SOURCE +# undef _TANDEM_SOURCE +#endif +/* Enable general extensions on Solaris. */ +#ifndef __EXTENSIONS__ +# undef __EXTENSIONS__ +#endif + + +/* Version number of package */ +#undef VERSION + +/* Enable large inode numbers on Mac OS X 10.5. */ +#ifndef _DARWIN_USE_64_BIT_INODE +# define _DARWIN_USE_64_BIT_INODE 1 +#endif + +/* Number of bits in a file offset, on hosts where this is settable. */ +#undef _FILE_OFFSET_BITS + +/* Define for large files, on AIX-style hosts. */ +#undef _LARGE_FILES + +/* Define to 1 if on MINIX. */ +#undef _MINIX + +/* Define to 2 if the system does not provide POSIX.1 features except with + this defined. */ +#undef _POSIX_1_SOURCE + +/* Define to 1 if you need to in order for `stat' and other things to work. */ +#undef _POSIX_SOURCE diff --git a/libga68/configure b/libga68/configure new file mode 100755 index 000000000000..b0a1302c8818 --- /dev/null +++ b/libga68/configure @@ -0,0 +1,15709 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.69 for package-unused version-unused. +# +# +# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. +# +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +as_fn_exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1 +test -x / || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 +test \$(( 1 + 1 )) = 2 || exit 1 + + test -n \"\${ZSH_VERSION+set}\${BASH_VERSION+set}\" || ( + ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' + ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO + ECHO=\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO\$ECHO + PATH=/empty FPATH=/empty; export PATH FPATH + test \"X\`printf %s \$ECHO\`\" = \"X\$ECHO\" \\ + || test \"X\`print -r -- \$ECHO\`\" = \"X\$ECHO\" ) || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." + else + $as_echo "$0: Please tell bug-autoconf@gnu.org about your system, +$0: including any error possibly output before this +$0: message. Then install a modern shell, or manually run +$0: the script under such a shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + +SHELL=${CONFIG_SHELL-/bin/sh} + + +test -n "$DJDIR" || exec 7<&0 &1 + +# Name of the host. +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME='package-unused' +PACKAGE_TARNAME='libga68' +PACKAGE_VERSION='version-unused' +PACKAGE_STRING='package-unused version-unused' +PACKAGE_BUGREPORT='' +PACKAGE_URL='' + +ac_unique_file="Makefile.am" +# Factoring default headers for most tests. +ac_includes_default="\ +#include +#ifdef HAVE_SYS_TYPES_H +# include +#endif +#ifdef HAVE_SYS_STAT_H +# include +#endif +#ifdef STDC_HEADERS +# include +# include +#else +# ifdef HAVE_STDLIB_H +# include +# endif +#endif +#ifdef HAVE_STRING_H +# if !defined STDC_HEADERS && defined HAVE_MEMORY_H +# include +# endif +# include +#endif +#ifdef HAVE_STRINGS_H +# include +#endif +#ifdef HAVE_INTTYPES_H +# include +#endif +#ifdef HAVE_STDINT_H +# include +#endif +#ifdef HAVE_UNISTD_H +# include +#endif" + +ac_unique_file="Makefile.am" +ac_subst_vars='am__EXEEXT_FALSE +am__EXEEXT_TRUE +LTLIBOBJS +LIBOBJS +LIBGA68_BOEHM_GC_LIBS +LIBGA68_BOEHM_GC_INCLUDES +LIBGA68_GCFLAGS +extra_darwin_ldflags_libga68 +libga68_VERSION +SPEC_LIBGA68_DEPS +get_gcc_base_ver +CC_FOR_BUILD +enable_static +enable_shared +ENABLE_DARWIN_AT_RPATH_FALSE +ENABLE_DARWIN_AT_RPATH_TRUE +OTOOL64 +OTOOL +LIPO +NMEDIT +DSYMUTIL +LLVM_CONFIG +OBJDUMP +LN_S +ac_ct_DUMPBIN +DUMPBIN +LD +FGREP +SED +LIBTOOL +RANLIB +NM +AR +am__fastdepCCAS_FALSE +am__fastdepCCAS_TRUE +CCASDEPMODE +CCASFLAGS +CCAS +MAINT +MAINTAINER_MODE_FALSE +MAINTAINER_MODE_TRUE +toolexeclibdir +toolexecdir +slibdir +AM_BACKSLASH +AM_DEFAULT_VERBOSITY +AM_DEFAULT_V +AM_V +am__fastdepCC_FALSE +am__fastdepCC_TRUE +CCDEPMODE +am__nodep +AMDEPBACKSLASH +AMDEP_FALSE +AMDEP_TRUE +am__quote +am__include +DEPDIR +am__untar +am__tar +AMTAR +am__leading_dot +SET_MAKE +AWK +mkdir_p +MKDIR_P +INSTALL_STRIP_PROGRAM +STRIP +install_sh +MAKEINFO +AUTOHEADER +AUTOMAKE +AUTOCONF +ACLOCAL +VERSION +PACKAGE +CYGPATH_W +am__isrc +INSTALL_DATA +INSTALL_SCRIPT +INSTALL_PROGRAM +target_subdir +host_subdir +build_subdir +build_libsubdir +target_noncanonical +host_noncanonical +target_os +target_vendor +target_cpu +target +host_os +host_vendor +host_cpu +host +build_os +build_vendor +build_cpu +build +EGREP +GREP +CPP +OBJEXT +EXEEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +multi_basedir +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +enable_multilib +with_build_libsubdir +enable_dependency_tracking +enable_silent_rules +enable_largefile +with_cross_host +enable_version_specific_runtime_libs +with_slibdir +enable_maintainer_mode +enable_shared +enable_static +with_pic +enable_fast_install +with_gnu_ld +enable_libtool_lock +enable_darwin_at_rpath +with_gcc_major_version_only +enable_algol68_gc +with_target_bdw_gc +with_target_bdw_gc_include +with_target_bdw_gc_lib +' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +CPP' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error $? "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures package-unused version-unused to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking ...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/libga68] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF + +Program names: + --program-prefix=PREFIX prepend PREFIX to installed program names + --program-suffix=SUFFIX append SUFFIX to installed program names + --program-transform-name=PROGRAM run sed PROGRAM on installed program names + +System types: + --build=BUILD configure for building on BUILD [guessed] + --host=HOST cross-compile to build programs to run on HOST [BUILD] + --target=TARGET configure for building compilers for TARGET [HOST] +_ACEOF +fi + +if test -n "$ac_init_help"; then + case $ac_init_help in + short | recursive ) echo "Configuration of package-unused version-unused:";; + esac + cat <<\_ACEOF + +Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --enable-multilib build many library versions (default) + --enable-dependency-tracking + do not reject slow dependency extractors + --disable-dependency-tracking + speeds up one-time build + --enable-silent-rules less verbose build output (undo: "make V=1") + --disable-silent-rules verbose build output (undo: "make V=0") + --disable-largefile omit support for large files + --enable-version-specific-runtime-libs Specify that runtime libraries should be installed in a compiler-specific directory + --enable-maintainer-mode + enable make rules and dependencies not useful (and + sometimes confusing) to the casual installer + --enable-shared[=PKGS] build shared libraries [default=yes] + --enable-static[=PKGS] build static libraries [default=yes] + --enable-fast-install[=PKGS] + optimize for fast installation [default=yes] + --disable-libtool-lock avoid locking (might break parallel builds) + --enable-darwin-at-rpath + install libraries with @rpath/library-name, requires + rpaths to be added to executables + --enable-algol68-gc enable use of Boehm's garbage collector with the GNU + Algol runtime + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-build-libsubdir=DIR Directory where to find libraries for build system + --with-cross-host=HOST Configuring with a cross compiler + --with-slibdir=DIR shared libraries in DIR LIBDIR + --with-pic try to use only PIC/non-PIC objects [default=use + both] + --with-gnu-ld assume the C compiler uses GNU ld [default=no] + --with-gcc-major-version-only + use only GCC major number in filesystem paths + --with-target-bdw-gc=PATHLIST + specify prefix directory for installed bdw-gc + package. Equivalent to + --with-target-bdw-gc-include=PATH/include plus + --with-target-bdw-gc-lib=PATH/lib + --with-target-bdw-gc-include=PATHLIST + specify directories for installed bdw-gc include + files + --with-target-bdw-gc-lib=PATHLIST + specify directories for installed bdw-gc library + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L if you have libraries in a + nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if + you have headers in a nonstandard directory + CPP C preprocessor + CCAS assembler compiler command (defaults to CC) + CCASFLAGS assembler compiler flags (defaults to CFLAGS) + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +Report bugs to the package provider. +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +package-unused configure version-unused +generated by GNU Autoconf 2.69 + +Copyright (C) 2012 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## + +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_compile + +# ac_fn_c_try_cpp LINENO +# ---------------------- +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_cpp + +# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists, giving a warning if it cannot be compiled using +# the include files in INCLUDES and setting the cache variable VAR +# accordingly. +ac_fn_c_check_header_mongrel () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if eval \${$3+:} false; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +else + # Is the header compilable? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 +$as_echo_n "checking $2 usability... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_header_compiler=yes +else + ac_header_compiler=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } + +# Is the header present? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 +$as_echo_n "checking $2 presence... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <$2> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + ac_header_preproc=yes +else + ac_header_preproc=no +fi +rm -f conftest.err conftest.i conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( + yes:no: ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; + no:yes:* ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=\$ac_header_compiler" +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_mongrel + +# ac_fn_c_try_run LINENO +# ---------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes +# that executables *can* be run. +ac_fn_c_try_run () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then : + ac_retval=0 +else + $as_echo "$as_me: program exited with status $ac_status" >&5 + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=$ac_status +fi + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_run + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_link + +# ac_fn_c_check_func LINENO FUNC VAR +# ---------------------------------- +# Tests whether FUNC exists, setting the cache variable VAR accordingly +ac_fn_c_check_func () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Define $2 to an innocuous variant, in case declares $2. + For example, HP-UX 11i declares gettimeofday. */ +#define $2 innocuous_$2 + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $2 (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $2 + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $2 (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$2 || defined __stub___$2 +choke me +#endif + +int +main () +{ +return $2 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_func +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by package-unused $as_me version-unused, which was +generated by GNU Autoconf 2.69. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + $as_echo "## ---------------- ## +## Cache variables. ## +## ---------------- ##" + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + $as_echo "## ----------------- ## +## Output variables. ## +## ----------------- ##" + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + $as_echo "## ------------------- ## +## File substitutions. ## +## ------------------- ##" + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + $as_echo "## ----------- ## +## confdefs.h. ## +## ----------- ##" + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +$as_echo "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site +fi +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" \ + || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + + + + +ac_config_headers="$ac_config_headers config.h" + + +# Add --enable-multilib to configure, which defaults to enable. +# Default to --enable-multilib +# Check whether --enable-multilib was given. +if test "${enable_multilib+set}" = set; then : + enableval=$enable_multilib; case "$enableval" in + yes) multilib=yes ;; + no) multilib=no ;; + *) as_fn_error $? "bad value $enableval for multilib option" "$LINENO" 5 ;; + esac +else + multilib=yes +fi + + +# We may get other options which we leave undocumented: +# --with-target-subdir, --with-multisrctop, --with-multisubdir +# See config-ml.in if you want the gory details. + +if test "$srcdir" = "."; then + if test "$with_target_subdir" != "."; then + multi_basedir="$srcdir/$with_multisrctop../.." + else + multi_basedir="$srcdir/$with_multisrctop.." + fi +else + multi_basedir="$srcdir/.." +fi + + +# Even if the default multilib is not a cross compilation, +# it may be that some of the other multilibs are. +if test $cross_compiling = no && test $multilib = yes \ + && test "x${with_multisubdir}" != x ; then + cross_compiling=maybe +fi + +ac_config_commands="$ac_config_commands default-1" + + +if test "${multilib}" = "yes"; then + multilib_arg="--enable-multilib" +else + multilib_arg= +fi + +# Cope with compilers, in subsequent tests, that at this stage may not +# be able to build executables. + + +# Enable extensions to C or POSIX on hosts that normally disable the +# extensions. This should be called before any macros that run the C +# compiler. +ac_aux_dir= +for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do + if test -f "$ac_dir/install-sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f "$ac_dir/install.sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + elif test -f "$ac_dir/shtool"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/shtool install -c" + break + fi +done +if test -z "$ac_aux_dir"; then + as_fn_error $? "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5 +fi + +# These three variables are undocumented and unsupported, +# and are intended to be withdrawn in a future Autoconf release. +# They can cause serious problems if a builder's source tree is in a directory +# whose full name contains unusual characters. +ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. +ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. +ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. + + +# Expand $ac_aux_dir to an absolute path. +am_aux_dir=`cd "$ac_aux_dir" && pwd` + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi + + +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +printf ("hello world\n"); + ; + return 0; +} +_ACEOF +# FIXME: Cleanup? +if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 + (eval $ac_link) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + gcc_no_link=no +else + gcc_no_link=yes +fi +if test x$gcc_no_link = xyes; then + # Setting cross_compile will disable run tests; it will + # also disable AC_CHECK_FILE but that's generally + # correct if we can't link. + cross_compiling=yes + EXEEXT= +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +$as_echo_n "checking whether the C compiler works... " >&6; } +ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else + ac_file='' +fi +if test -z "$ac_file"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +$as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +$as_echo_n "checking for C compiler default output file name... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +$as_echo "$ac_file" >&6; } +ac_exeext=$ac_cv_exeext + +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +$as_echo_n "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + break;; + * ) break;; + esac +done +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest conftest$ac_cv_exeext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +$as_echo "$ac_cv_exeext" >&6; } + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +FILE *f = fopen ("conftest.out", "w"); + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +ac_clean_files="$ac_clean_files conftest.out" +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +$as_echo_n "checking whether we are cross compiling... " >&6; } +if test "$cross_compiling" != yes; then + { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if { ac_try='./conftest$ac_cv_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details" "$LINENO" 5; } + fi + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +$as_echo "$cross_compiling" >&6; } + +rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +ac_clean_files=$ac_clean_files_save +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +$as_echo_n "checking for suffix of object files... " >&6; } +if ${ac_cv_objext+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +$as_echo "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if ${ac_cv_c_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if ${ac_cv_prog_cc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +else + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC understands -c and -o together" >&5 +$as_echo_n "checking whether $CC understands -c and -o together... " >&6; } +if ${am_cv_prog_cc_c_o+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF + # Make sure it works both with $CC and with simple cc. + # Following AC_PROG_CC_C_O, we do the test twice because some + # compilers refuse to overwrite an existing .o file with -o, + # though they will create one. + am_cv_prog_cc_c_o=yes + for am_i in 1 2; do + if { echo "$as_me:$LINENO: $CC -c conftest.$ac_ext -o conftest2.$ac_objext" >&5 + ($CC -c conftest.$ac_ext -o conftest2.$ac_objext) >&5 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } \ + && test -f conftest2.$ac_objext; then + : OK + else + am_cv_prog_cc_c_o=no + break + fi + done + rm -f core conftest* + unset am_i +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_prog_cc_c_o" >&5 +$as_echo "$am_cv_prog_cc_c_o" >&6; } +if test "$am_cv_prog_cc_c_o" != yes; then + # Losing compiler, so override with the script. + # FIXME: It is wrong to rewrite CC. + # But if we don't then we get into trouble of one sort or another. + # A longer-term fix would be to have automake use am__CC in this case, + # and then we could set am__CC="\$(top_srcdir)/compile \$(CC)" + CC="$am_aux_dir/compile $CC" +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if ${ac_cv_prog_CPP+:} false; then : + $as_echo_n "(cached) " >&6 +else + # Double quotes because CPP needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +$as_echo "$CPP" >&6; } +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 +$as_echo_n "checking for grep that handles long lines and -e... " >&6; } +if ${ac_cv_path_GREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$GREP"; then + ac_path_GREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in grep ggrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_GREP" || continue +# Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_GREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_GREP"; then + as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_GREP=$GREP +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 +$as_echo "$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 +$as_echo_n "checking for egrep... " >&6; } +if ${ac_cv_path_EGREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 + then ac_cv_path_EGREP="$GREP -E" + else + if test -z "$EGREP"; then + ac_path_EGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in egrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP" || continue +# Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_EGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_EGREP"; then + as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_EGREP=$EGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 +$as_echo "$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_EGREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if ${ac_cv_header_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include +#include + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_stdc=yes +else + ac_cv_header_stdc=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. + if test "$cross_compiling" = yes; then : + : +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int +main () +{ + int i; + for (i = 0; i < 256; i++) + if (XOR (islower (i), ISLOWER (i)) + || toupper (i) != TOUPPER (i)) + return 2; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + +else + ac_cv_header_stdc=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } +if test $ac_cv_header_stdc = yes; then + +$as_echo "#define STDC_HEADERS 1" >>confdefs.h + +fi + +# On IRIX 5.3, sys/types and inttypes.h are conflicting. +for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ + inttypes.h stdint.h unistd.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default +" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + + + ac_fn_c_check_header_mongrel "$LINENO" "minix/config.h" "ac_cv_header_minix_config_h" "$ac_includes_default" +if test "x$ac_cv_header_minix_config_h" = xyes; then : + MINIX=yes +else + MINIX= +fi + + + if test "$MINIX" = yes; then + +$as_echo "#define _POSIX_SOURCE 1" >>confdefs.h + + +$as_echo "#define _POSIX_1_SOURCE 2" >>confdefs.h + + +$as_echo "#define _MINIX 1" >>confdefs.h + + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether it is safe to define __EXTENSIONS__" >&5 +$as_echo_n "checking whether it is safe to define __EXTENSIONS__... " >&6; } +if ${ac_cv_safe_to_define___extensions__+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +# define __EXTENSIONS__ 1 + $ac_includes_default +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_safe_to_define___extensions__=yes +else + ac_cv_safe_to_define___extensions__=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_safe_to_define___extensions__" >&5 +$as_echo "$ac_cv_safe_to_define___extensions__" >&6; } + test $ac_cv_safe_to_define___extensions__ = yes && + $as_echo "#define __EXTENSIONS__ 1" >>confdefs.h + + $as_echo "#define _ALL_SOURCE 1" >>confdefs.h + + $as_echo "#define _GNU_SOURCE 1" >>confdefs.h + + $as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h + + $as_echo "#define _TANDEM_SOURCE 1" >>confdefs.h + + + +# Determine the system type and set output variabls to the names of +# the canonical system types. +# +# Do not delete or change the following two lines. For why, and for +# why we are using the obsolete AC_CANONICAL_SYSTEM as ell as the +# recommended AC_CANONICAL_HOST, see +# http://gcc.gnu.org/ml/libstdc++/2003-07/msg00451.html +# Make sure we can run config.sub. +$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || + as_fn_error $? "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5 + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5 +$as_echo_n "checking build system type... " >&6; } +if ${ac_cv_build+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_build_alias=$build_alias +test "x$ac_build_alias" = x && + ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` +test "x$ac_build_alias" = x && + as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5 +ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || + as_fn_error $? "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5 + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5 +$as_echo "$ac_cv_build" >&6; } +case $ac_cv_build in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;; +esac +build=$ac_cv_build +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_build +shift +build_cpu=$1 +build_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +build_os=$* +IFS=$ac_save_IFS +case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5 +$as_echo_n "checking host system type... " >&6; } +if ${ac_cv_host+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "x$host_alias" = x; then + ac_cv_host=$ac_cv_build +else + ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` || + as_fn_error $? "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5 +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5 +$as_echo "$ac_cv_host" >&6; } +case $ac_cv_host in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;; +esac +host=$ac_cv_host +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_host +shift +host_cpu=$1 +host_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +host_os=$* +IFS=$ac_save_IFS +case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking target system type" >&5 +$as_echo_n "checking target system type... " >&6; } +if ${ac_cv_target+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "x$target_alias" = x; then + ac_cv_target=$ac_cv_host +else + ac_cv_target=`$SHELL "$ac_aux_dir/config.sub" $target_alias` || + as_fn_error $? "$SHELL $ac_aux_dir/config.sub $target_alias failed" "$LINENO" 5 +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_target" >&5 +$as_echo "$ac_cv_target" >&6; } +case $ac_cv_target in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical target" "$LINENO" 5;; +esac +target=$ac_cv_target +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_target +shift +target_cpu=$1 +target_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +target_os=$* +IFS=$ac_save_IFS +case $target_os in *\ *) target_os=`echo "$target_os" | sed 's/ /-/g'`;; esac + + +# The aliases save the names the user supplied, while $host etc. +# will get canonicalized. +test -n "$target_alias" && + test "$program_prefix$program_suffix$program_transform_name" = \ + NONENONEs,x,x, && + program_prefix=${target_alias}- + +target_alias=${target_alias-$host_alias} + + + +# These macro are for supporting canadian crosses, in which build /= +# host /= target. + case ${build_alias} in + "") build_noncanonical=${build} ;; + *) build_noncanonical=${build_alias} ;; +esac + + case ${host_alias} in + "") host_noncanonical=${build_noncanonical} ;; + *) host_noncanonical=${host_alias} ;; +esac + + + + case ${target_alias} in + "") target_noncanonical=${host_noncanonical} ;; + *) target_noncanonical=${target_alias} ;; +esac + + + + +# post-stage1 host modules use a different CC_FOR_BUILD so, in order to +# have matching libraries, they should use host libraries: Makefile.tpl +# arranges to pass --with-build-libsubdir=$(HOST_SUBDIR). +# However, they still use the build modules, because the corresponding +# host modules (e.g. bison) are only built for the host when bootstrap +# finishes. So: +# - build_subdir is where we find build modules, and never changes. +# - build_libsubdir is where we find build libraries, and can be overridden. + +# Prefix 'build-' so this never conflicts with target_subdir. +build_subdir="build-${build_noncanonical}" + +# Check whether --with-build-libsubdir was given. +if test "${with_build_libsubdir+set}" = set; then : + withval=$with_build_libsubdir; build_libsubdir="$withval" +else + build_libsubdir="$build_subdir" +fi + +# --srcdir=. covers the toplevel, while "test -d" covers the subdirectories +if ( test $srcdir = . && test -d gcc ) \ + || test -d $srcdir/../host-${host_noncanonical}; then + host_subdir="host-${host_noncanonical}" +else + host_subdir=. +fi +# No prefix. +target_subdir=${target_noncanonical} + + +# Initialize Automake with proper options. +am__api_version='1.15' + +# Find a good install program. We prefer a C program (faster), +# so one script is as good as another. But avoid the broken or +# incompatible versions: +# SysV /etc/install, /usr/sbin/install +# SunOS /usr/etc/install +# IRIX /sbin/install +# AIX /bin/install +# AmigaOS /C/install, which installs bootblocks on floppy discs +# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag +# AFS /usr/afsws/bin/install, which mishandles nonexistent args +# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" +# OS/2's system install, which has a completely different semantic +# ./install, which can be erroneously created by make from ./install.sh. +# Reject install programs that cannot install multiple files. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5 +$as_echo_n "checking for a BSD-compatible install... " >&6; } +if test -z "$INSTALL"; then +if ${ac_cv_path_install+:} false; then : + $as_echo_n "(cached) " >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + # Account for people who put trailing slashes in PATH elements. +case $as_dir/ in #(( + ./ | .// | /[cC]/* | \ + /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ + ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \ + /usr/ucb/* ) ;; + *) + # OSF1 and SCO ODT 3.0 have their own names for install. + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then + if test $ac_prog = install && + grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # AIX install. It has an incompatible calling convention. + : + elif test $ac_prog = install && + grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # program-specific install script used by HP pwplus--don't use. + : + else + rm -rf conftest.one conftest.two conftest.dir + echo one > conftest.one + echo two > conftest.two + mkdir conftest.dir + if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" && + test -s conftest.one && test -s conftest.two && + test -s conftest.dir/conftest.one && + test -s conftest.dir/conftest.two + then + ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" + break 3 + fi + fi + fi + done + done + ;; +esac + + done +IFS=$as_save_IFS + +rm -rf conftest.one conftest.two conftest.dir + +fi + if test "${ac_cv_path_install+set}" = set; then + INSTALL=$ac_cv_path_install + else + # As a last resort, use the slow shell script. Don't cache a + # value for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the value is a relative name. + INSTALL=$ac_install_sh + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5 +$as_echo "$INSTALL" >&6; } + +# Use test -z because SunOS4 sh mishandles braces in ${var-val}. +# It thinks the first close brace ends the variable substitution. +test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' + +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' + +test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether build environment is sane" >&5 +$as_echo_n "checking whether build environment is sane... " >&6; } +# Reject unsafe characters in $srcdir or the absolute working directory +# name. Accept space and tab only in the latter. +am_lf=' +' +case `pwd` in + *[\\\"\#\$\&\'\`$am_lf]*) + as_fn_error $? "unsafe absolute working directory name" "$LINENO" 5;; +esac +case $srcdir in + *[\\\"\#\$\&\'\`$am_lf\ \ ]*) + as_fn_error $? "unsafe srcdir value: '$srcdir'" "$LINENO" 5;; +esac + +# Do 'set' in a subshell so we don't clobber the current shell's +# arguments. Must try -L first in case configure is actually a +# symlink; some systems play weird games with the mod time of symlinks +# (eg FreeBSD returns the mod time of the symlink's containing +# directory). +if ( + am_has_slept=no + for am_try in 1 2; do + echo "timestamp, slept: $am_has_slept" > conftest.file + set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null` + if test "$*" = "X"; then + # -L didn't work. + set X `ls -t "$srcdir/configure" conftest.file` + fi + if test "$*" != "X $srcdir/configure conftest.file" \ + && test "$*" != "X conftest.file $srcdir/configure"; then + + # If neither matched, then we have a broken ls. This can happen + # if, for instance, CONFIG_SHELL is bash and it inherits a + # broken ls alias from the environment. This has actually + # happened. Such a system could not be considered "sane". + as_fn_error $? "ls -t appears to fail. Make sure there is not a broken + alias in your environment" "$LINENO" 5 + fi + if test "$2" = conftest.file || test $am_try -eq 2; then + break + fi + # Just in case. + sleep 1 + am_has_slept=yes + done + test "$2" = conftest.file + ) +then + # Ok. + : +else + as_fn_error $? "newly created file is older than distributed files! +Check your system clock" "$LINENO" 5 +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +# If we didn't sleep, we still need to ensure time stamps of config.status and +# generated files are strictly newer. +am_sleep_pid= +if grep 'slept: no' conftest.file >/dev/null 2>&1; then + ( sleep 1 ) & + am_sleep_pid=$! +fi + +rm -f conftest.file + +test "$program_prefix" != NONE && + program_transform_name="s&^&$program_prefix&;$program_transform_name" +# Use a double $ so make ignores it. +test "$program_suffix" != NONE && + program_transform_name="s&\$&$program_suffix&;$program_transform_name" +# Double any \ or $. +# By default was `s,x,x', remove it if useless. +ac_script='s/[\\$]/&&/g;s/;s,x,x,$//' +program_transform_name=`$as_echo "$program_transform_name" | sed "$ac_script"` + +if test x"${MISSING+set}" != xset; then + case $am_aux_dir in + *\ * | *\ *) + MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;; + *) + MISSING="\${SHELL} $am_aux_dir/missing" ;; + esac +fi +# Use eval to expand $SHELL +if eval "$MISSING --is-lightweight"; then + am_missing_run="$MISSING " +else + am_missing_run= + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 'missing' script is too old or missing" >&5 +$as_echo "$as_me: WARNING: 'missing' script is too old or missing" >&2;} +fi + +if test x"${install_sh+set}" != xset; then + case $am_aux_dir in + *\ * | *\ *) + install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;; + *) + install_sh="\${SHELL} $am_aux_dir/install-sh" + esac +fi + +# Installed binaries are usually stripped using 'strip' when the user +# run "make install-strip". However 'strip' might not be the right +# tool to use in cross-compilation environments, therefore Automake +# will honor the 'STRIP' environment variable to overrule this program. +if test "$cross_compiling" != no; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. +set dummy ${ac_tool_prefix}strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_STRIP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$STRIP"; then + ac_cv_prog_STRIP="$STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_STRIP="${ac_tool_prefix}strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +STRIP=$ac_cv_prog_STRIP +if test -n "$STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5 +$as_echo "$STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_STRIP"; then + ac_ct_STRIP=$STRIP + # Extract the first word of "strip", so it can be a program name with args. +set dummy strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_STRIP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_STRIP"; then + ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_STRIP="strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP +if test -n "$ac_ct_STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5 +$as_echo "$ac_ct_STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_STRIP" = x; then + STRIP=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + STRIP=$ac_ct_STRIP + fi +else + STRIP="$ac_cv_prog_STRIP" +fi + +fi +INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s" + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a thread-safe mkdir -p" >&5 +$as_echo_n "checking for a thread-safe mkdir -p... " >&6; } +if test -z "$MKDIR_P"; then + if ${ac_cv_path_mkdir+:} false; then : + $as_echo_n "(cached) " >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/opt/sfw/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in mkdir gmkdir; do + for ac_exec_ext in '' $ac_executable_extensions; do + as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext" || continue + case `"$as_dir/$ac_prog$ac_exec_ext" --version 2>&1` in #( + 'mkdir (GNU coreutils) '* | \ + 'mkdir (coreutils) '* | \ + 'mkdir (fileutils) '4.1*) + ac_cv_path_mkdir=$as_dir/$ac_prog$ac_exec_ext + break 3;; + esac + done + done + done +IFS=$as_save_IFS + +fi + + test -d ./--version && rmdir ./--version + if test "${ac_cv_path_mkdir+set}" = set; then + MKDIR_P="$ac_cv_path_mkdir -p" + else + # As a last resort, use the slow shell script. Don't cache a + # value for MKDIR_P within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the value is a relative name. + MKDIR_P="$ac_install_sh -d" + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $MKDIR_P" >&5 +$as_echo "$MKDIR_P" >&6; } + +for ac_prog in gawk mawk nawk awk +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AWK+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AWK"; then + ac_cv_prog_AWK="$AWK" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AWK="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AWK=$ac_cv_prog_AWK +if test -n "$AWK"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AWK" >&5 +$as_echo "$AWK" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$AWK" && break +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } +set x ${MAKE-make} +ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` +if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat >conftest.make <<\_ACEOF +SHELL = /bin/sh +all: + @echo '@@@%%%=$(MAKE)=@@@%%%' +_ACEOF +# GNU make sometimes prints "make[1]: Entering ...", which would confuse us. +case `${MAKE-make} -f conftest.make 2>/dev/null` in + *@@@%%%=?*=@@@%%%*) + eval ac_cv_prog_make_${ac_make}_set=yes;; + *) + eval ac_cv_prog_make_${ac_make}_set=no;; +esac +rm -f conftest.make +fi +if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + SET_MAKE= +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + SET_MAKE="MAKE=${MAKE-make}" +fi + +rm -rf .tst 2>/dev/null +mkdir .tst 2>/dev/null +if test -d .tst; then + am__leading_dot=. +else + am__leading_dot=_ +fi +rmdir .tst 2>/dev/null + +DEPDIR="${am__leading_dot}deps" + +ac_config_commands="$ac_config_commands depfiles" + + +am_make=${MAKE-make} +cat > confinc << 'END' +am__doit: + @echo this is the am__doit target +.PHONY: am__doit +END +# If we don't find an include directive, just comment out the code. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for style of include used by $am_make" >&5 +$as_echo_n "checking for style of include used by $am_make... " >&6; } +am__include="#" +am__quote= +_am_result=none +# First try GNU make style include. +echo "include confinc" > confmf +# Ignore all kinds of additional output from 'make'. +case `$am_make -s -f confmf 2> /dev/null` in #( +*the\ am__doit\ target*) + am__include=include + am__quote= + _am_result=GNU + ;; +esac +# Now try BSD make style include. +if test "$am__include" = "#"; then + echo '.include "confinc"' > confmf + case `$am_make -s -f confmf 2> /dev/null` in #( + *the\ am__doit\ target*) + am__include=.include + am__quote="\"" + _am_result=BSD + ;; + esac +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $_am_result" >&5 +$as_echo "$_am_result" >&6; } +rm -f confinc confmf + +# Check whether --enable-dependency-tracking was given. +if test "${enable_dependency_tracking+set}" = set; then : + enableval=$enable_dependency_tracking; +fi + +if test "x$enable_dependency_tracking" != xno; then + am_depcomp="$ac_aux_dir/depcomp" + AMDEPBACKSLASH='\' + am__nodep='_no' +fi + if test "x$enable_dependency_tracking" != xno; then + AMDEP_TRUE= + AMDEP_FALSE='#' +else + AMDEP_TRUE='#' + AMDEP_FALSE= +fi + + +# Check whether --enable-silent-rules was given. +if test "${enable_silent_rules+set}" = set; then : + enableval=$enable_silent_rules; +fi + +case $enable_silent_rules in # ((( + yes) AM_DEFAULT_VERBOSITY=0;; + no) AM_DEFAULT_VERBOSITY=1;; + *) AM_DEFAULT_VERBOSITY=1;; +esac +am_make=${MAKE-make} +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $am_make supports nested variables" >&5 +$as_echo_n "checking whether $am_make supports nested variables... " >&6; } +if ${am_cv_make_support_nested_variables+:} false; then : + $as_echo_n "(cached) " >&6 +else + if $as_echo 'TRUE=$(BAR$(V)) +BAR0=false +BAR1=true +V=1 +am__doit: + @$(TRUE) +.PHONY: am__doit' | $am_make -f - >/dev/null 2>&1; then + am_cv_make_support_nested_variables=yes +else + am_cv_make_support_nested_variables=no +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_make_support_nested_variables" >&5 +$as_echo "$am_cv_make_support_nested_variables" >&6; } +if test $am_cv_make_support_nested_variables = yes; then + AM_V='$(V)' + AM_DEFAULT_V='$(AM_DEFAULT_VERBOSITY)' +else + AM_V=$AM_DEFAULT_VERBOSITY + AM_DEFAULT_V=$AM_DEFAULT_VERBOSITY +fi +AM_BACKSLASH='\' + +if test "`cd $srcdir && pwd`" != "`pwd`"; then + # Use -I$(srcdir) only when $(srcdir) != ., so that make's output + # is not polluted with repeated "-I." + am__isrc=' -I$(srcdir)' + # test to see if srcdir already configured + if test -f $srcdir/config.status; then + as_fn_error $? "source directory already configured; run \"make distclean\" there first" "$LINENO" 5 + fi +fi + +# test whether we have cygpath +if test -z "$CYGPATH_W"; then + if (cygpath --version) >/dev/null 2>/dev/null; then + CYGPATH_W='cygpath -w' + else + CYGPATH_W=echo + fi +fi + + +# Define the identity of the package. + PACKAGE='libga68' + VERSION='version-unused' + + +# Some tools Automake needs. + +ACLOCAL=${ACLOCAL-"${am_missing_run}aclocal-${am__api_version}"} + + +AUTOCONF=${AUTOCONF-"${am_missing_run}autoconf"} + + +AUTOMAKE=${AUTOMAKE-"${am_missing_run}automake-${am__api_version}"} + + +AUTOHEADER=${AUTOHEADER-"${am_missing_run}autoheader"} + + +MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"} + +# For better backward compatibility. To be removed once Automake 1.9.x +# dies out for good. For more background, see: +# +# +mkdir_p='$(MKDIR_P)' + +# We need awk for the "check" target (and possibly the TAP driver). The +# system "awk" is bad on some platforms. +# Always define AMTAR for backward compatibility. Yes, it's still used +# in the wild :-( We should find a proper way to deprecate it ... +AMTAR='$${TAR-tar}' + + +# We'll loop over all known methods to create a tar archive until one works. +_am_tools='gnutar pax cpio none' + +am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -' + + + + + +depcc="$CC" am_compiler_list= + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5 +$as_echo_n "checking dependency style of $depcc... " >&6; } +if ${am_cv_CC_dependencies_compiler_type+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then + # We make a subdir and do the tests there. Otherwise we can end up + # making bogus files that we don't know about and never remove. For + # instance it was reported that on HP-UX the gcc test will end up + # making a dummy file named 'D' -- because '-MD' means "put the output + # in D". + rm -rf conftest.dir + mkdir conftest.dir + # Copy depcomp to subdir because otherwise we won't find it if we're + # using a relative directory. + cp "$am_depcomp" conftest.dir + cd conftest.dir + # We will build objects and dependencies in a subdirectory because + # it helps to detect inapplicable dependency modes. For instance + # both Tru64's cc and ICC support -MD to output dependencies as a + # side effect of compilation, but ICC will put the dependencies in + # the current directory while Tru64 will put them in the object + # directory. + mkdir sub + + am_cv_CC_dependencies_compiler_type=none + if test "$am_compiler_list" = ""; then + am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp` + fi + am__universal=false + case " $depcc " in #( + *\ -arch\ *\ -arch\ *) am__universal=true ;; + esac + + for depmode in $am_compiler_list; do + # Setup a source with many dependencies, because some compilers + # like to wrap large dependency lists on column 80 (with \), and + # we should not choose a depcomp mode which is confused by this. + # + # We need to recreate these files for each test, as the compiler may + # overwrite some of them when testing with obscure command lines. + # This happens at least with the AIX C compiler. + : > sub/conftest.c + for i in 1 2 3 4 5 6; do + echo '#include "conftst'$i'.h"' >> sub/conftest.c + # Using ": > sub/conftst$i.h" creates only sub/conftst1.h with + # Solaris 10 /bin/sh. + echo '/* dummy */' > sub/conftst$i.h + done + echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf + + # We check with '-c' and '-o' for the sake of the "dashmstdout" + # mode. It turns out that the SunPro C++ compiler does not properly + # handle '-M -o', and we need to detect this. Also, some Intel + # versions had trouble with output in subdirs. + am__obj=sub/conftest.${OBJEXT-o} + am__minus_obj="-o $am__obj" + case $depmode in + gcc) + # This depmode causes a compiler race in universal mode. + test "$am__universal" = false || continue + ;; + nosideeffect) + # After this tag, mechanisms are not by side-effect, so they'll + # only be used when explicitly requested. + if test "x$enable_dependency_tracking" = xyes; then + continue + else + break + fi + ;; + msvc7 | msvc7msys | msvisualcpp | msvcmsys) + # This compiler won't grok '-c -o', but also, the minuso test has + # not run yet. These depmodes are late enough in the game, and + # so weak that their functioning should not be impacted. + am__obj=conftest.${OBJEXT-o} + am__minus_obj= + ;; + none) break ;; + esac + if depmode=$depmode \ + source=sub/conftest.c object=$am__obj \ + depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ + $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \ + >/dev/null 2>conftest.err && + grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 && + grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && + grep $am__obj sub/conftest.Po > /dev/null 2>&1 && + ${MAKE-make} -s -f confmf > /dev/null 2>&1; then + # icc doesn't choke on unknown options, it will just issue warnings + # or remarks (even with -Werror). So we grep stderr for any message + # that says an option was ignored or not supported. + # When given -MP, icc 7.0 and 7.1 complain thusly: + # icc: Command line warning: ignoring option '-M'; no argument required + # The diagnosis changed in icc 8.0: + # icc: Command line remark: option '-MP' not supported + if (grep 'ignoring option' conftest.err || + grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else + am_cv_CC_dependencies_compiler_type=$depmode + break + fi + fi + done + + cd .. + rm -rf conftest.dir +else + am_cv_CC_dependencies_compiler_type=none +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_CC_dependencies_compiler_type" >&5 +$as_echo "$am_cv_CC_dependencies_compiler_type" >&6; } +CCDEPMODE=depmode=$am_cv_CC_dependencies_compiler_type + + if + test "x$enable_dependency_tracking" != xno \ + && test "$am_cv_CC_dependencies_compiler_type" = gcc3; then + am__fastdepCC_TRUE= + am__fastdepCC_FALSE='#' +else + am__fastdepCC_TRUE='#' + am__fastdepCC_FALSE= +fi + + + +# POSIX will say in a future version that running "rm -f" with no argument +# is OK; and we want to be able to make that assumption in our Makefile +# recipes. So use an aggressive probe to check that the usage we want is +# actually supported "in the wild" to an acceptable degree. +# See automake bug#10828. +# To make any issue more visible, cause the running configure to be aborted +# by default if the 'rm' program in use doesn't match our expectations; the +# user can still override this though. +if rm -f && rm -fr && rm -rf; then : OK; else + cat >&2 <<'END' +Oops! + +Your 'rm' program seems unable to run without file operands specified +on the command line, even when the '-f' option is present. This is contrary +to the behaviour of most rm programs out there, and not conforming with +the upcoming POSIX standard: + +Please tell bug-automake@gnu.org about your system, including the value +of your $PATH and any error possibly output before this message. This +can help us improve future automake versions. + +END + if test x"$ACCEPT_INFERIOR_RM_PROGRAM" = x"yes"; then + echo 'Configuration will proceed anyway, since you have set the' >&2 + echo 'ACCEPT_INFERIOR_RM_PROGRAM variable to "yes"' >&2 + echo >&2 + else + cat >&2 <<'END' +Aborting the configuration process, to ensure you take notice of the issue. + +You can download and install GNU coreutils to get an 'rm' implementation +that behaves properly: . + +If you want to complete the configuration process using your problematic +'rm' anyway, export the environment variable ACCEPT_INFERIOR_RM_PROGRAM +to "yes", and re-run configure. + +END + as_fn_error $? "Your 'rm' program is bad, sorry." "$LINENO" 5 + fi +fi + + +# Tell Autoheader to include templates for PACKAGE and VERSION in +# config.h.in. + + + +# Command-line options. + +# Enable large-file support. +# Check whether --enable-largefile was given. +if test "${enable_largefile+set}" = set; then : + enableval=$enable_largefile; +fi + +if test "$enable_largefile" != no; then + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for special C compiler options needed for large files" >&5 +$as_echo_n "checking for special C compiler options needed for large files... " >&6; } +if ${ac_cv_sys_largefile_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_sys_largefile_CC=no + if test "$GCC" != yes; then + ac_save_CC=$CC + while :; do + # IRIX 6.2 and later do not support large files by default, + # so use the C compiler's -n32 option if that helps. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +int +main () +{ + + ; + return 0; +} +_ACEOF + if ac_fn_c_try_compile "$LINENO"; then : + break +fi +rm -f core conftest.err conftest.$ac_objext + CC="$CC -n32" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_largefile_CC=' -n32'; break +fi +rm -f core conftest.err conftest.$ac_objext + break + done + CC=$ac_save_CC + rm -f conftest.$ac_ext + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_largefile_CC" >&5 +$as_echo "$ac_cv_sys_largefile_CC" >&6; } + if test "$ac_cv_sys_largefile_CC" != no; then + CC=$CC$ac_cv_sys_largefile_CC + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _FILE_OFFSET_BITS value needed for large files" >&5 +$as_echo_n "checking for _FILE_OFFSET_BITS value needed for large files... " >&6; } +if ${ac_cv_sys_file_offset_bits+:} false; then : + $as_echo_n "(cached) " >&6 +else + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_file_offset_bits=no; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _FILE_OFFSET_BITS 64 +#include + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_file_offset_bits=64; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_cv_sys_file_offset_bits=unknown + break +done +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_file_offset_bits" >&5 +$as_echo "$ac_cv_sys_file_offset_bits" >&6; } +case $ac_cv_sys_file_offset_bits in #( + no | unknown) ;; + *) +cat >>confdefs.h <<_ACEOF +#define _FILE_OFFSET_BITS $ac_cv_sys_file_offset_bits +_ACEOF +;; +esac +rm -rf conftest* + if test $ac_cv_sys_file_offset_bits = unknown; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGE_FILES value needed for large files" >&5 +$as_echo_n "checking for _LARGE_FILES value needed for large files... " >&6; } +if ${ac_cv_sys_large_files+:} false; then : + $as_echo_n "(cached) " >&6 +else + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_large_files=no; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#define _LARGE_FILES 1 +#include + /* Check that off_t can represent 2**63 - 1 correctly. + We can't simply define LARGE_OFF_T to be 9223372036854775807, + since some C++ compilers masquerading as C compilers + incorrectly reject 9223372036854775807. */ +#define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) + int off_t_is_large[(LARGE_OFF_T % 2147483629 == 721 + && LARGE_OFF_T % 2147483647 == 1) + ? 1 : -1]; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_sys_large_files=1; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_cv_sys_large_files=unknown + break +done +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_large_files" >&5 +$as_echo "$ac_cv_sys_large_files" >&6; } +case $ac_cv_sys_large_files in #( + no | unknown) ;; + *) +cat >>confdefs.h <<_ACEOF +#define _LARGE_FILES $ac_cv_sys_large_files +_ACEOF +;; +esac +rm -rf conftest* + fi + + +fi + + + +# Check whether --with-cross-host was given. +if test "${with_cross_host+set}" = set; then : + withval=$with_cross_host; +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for --enable-version-specific-runtime-libs" >&5 +$as_echo_n "checking for --enable-version-specific-runtime-libs... " >&6; } +# Check whether --enable-version-specific-runtime-libs was given. +if test "${enable_version_specific_runtime_libs+set}" = set; then : + enableval=$enable_version_specific_runtime_libs; case "$enableval" in + yes) version_specific_libs=yes ;; + no) version_specific_libs=no ;; + *) as_fn_error $? "Unknown argument to enable/disable version-specific libs" "$LINENO" 5;; + esac +else + version_specific_libs=no +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $version_specific_libs" >&5 +$as_echo "$version_specific_libs" >&6; } + + +# Check whether --with-slibdir was given. +if test "${with_slibdir+set}" = set; then : + withval=$with_slibdir; slibdir="$with_slibdir" +else + if test "${version_specific_libs}" = yes; then + slibdir='$(libsubdir)' +elif test -n "$with_cross_host" && test x"$with_cross_host" != x"no"; then + slibdir='$(exec_prefix)/$(host_noncanonical)/lib' +else + slibdir='$(libdir)' +fi +fi + + + +# Calculate toolexeclibdir +# Also toolexecdir, though it's only used in toolexeclibdir +toolexecdir=no +toolexeclibdir=no +case ${version_specific_libs} in + yes) + # Need the gcc compiler version to know where to install libraries + # and header files if --enable-version-specific-runtime-libs option + # is selected. + toolexecdir='$(libdir)/gcc/$(target_noncanonical)' + toolexeclibdir='$(toolexecdir)/$(gcc_version)$(MULTISUBDIR)' + ;; + no) + if test -n "$with_cross_host" && + test x"$with_cross_host" != x"no"; then + # Install a library built with a cross compiler in tooldir, not libdir. + toolexecdir='$(exec_prefix)/$(target_noncanonical)' + toolexeclibdir='$(toolexecdir)/lib' + else + toolexecdir='$(libdir)/gcc-lib/$(target_noncanonical)' + toolexeclibdir='$(libdir)' + fi + multi_os_directory=`$CC -print-multi-os-directory` + case $multi_os_directory in + .) ;; # Avoid trailing /. + *) toolexeclibdir=$toolexeclibdir/$multi_os_directory ;; + esac + ;; +esac + + + +# Add support for --enable-maintainer-mode={yes,no} to configure. + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to enable maintainer-specific portions of Makefiles" >&5 +$as_echo_n "checking whether to enable maintainer-specific portions of Makefiles... " >&6; } + # Check whether --enable-maintainer-mode was given. +if test "${enable_maintainer_mode+set}" = set; then : + enableval=$enable_maintainer_mode; USE_MAINTAINER_MODE=$enableval +else + USE_MAINTAINER_MODE=no +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $USE_MAINTAINER_MODE" >&5 +$as_echo "$USE_MAINTAINER_MODE" >&6; } + if test $USE_MAINTAINER_MODE = yes; then + MAINTAINER_MODE_TRUE= + MAINTAINER_MODE_FALSE='#' +else + MAINTAINER_MODE_TRUE='#' + MAINTAINER_MODE_FALSE= +fi + + MAINT=$MAINTAINER_MODE_TRUE + + + +# We must force CC to /not/ be precious variables; otherwise +# the wrong, non-multilib-adjusted value will be used in multilibs. +# As a side effect, we have to subst CFLAGS ourselves. + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi + + +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if ${ac_cv_c_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if ${ac_cv_prog_cc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +else + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC understands -c and -o together" >&5 +$as_echo_n "checking whether $CC understands -c and -o together... " >&6; } +if ${am_cv_prog_cc_c_o+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF + # Make sure it works both with $CC and with simple cc. + # Following AC_PROG_CC_C_O, we do the test twice because some + # compilers refuse to overwrite an existing .o file with -o, + # though they will create one. + am_cv_prog_cc_c_o=yes + for am_i in 1 2; do + if { echo "$as_me:$LINENO: $CC -c conftest.$ac_ext -o conftest2.$ac_objext" >&5 + ($CC -c conftest.$ac_ext -o conftest2.$ac_objext) >&5 2>&5 + ac_status=$? + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + (exit $ac_status); } \ + && test -f conftest2.$ac_objext; then + : OK + else + am_cv_prog_cc_c_o=no + break + fi + done + rm -f core conftest* + unset am_i +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_prog_cc_c_o" >&5 +$as_echo "$am_cv_prog_cc_c_o" >&6; } +if test "$am_cv_prog_cc_c_o" != yes; then + # Losing compiler, so override with the script. + # FIXME: It is wrong to rewrite CC. + # But if we don't then we get into trouble of one sort or another. + # A longer-term fix would be to have automake use am__CC in this case, + # and then we could set am__CC="\$(top_srcdir)/compile \$(CC)" + CC="$am_aux_dir/compile $CC" +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +# By default we simply use the C compiler to build assembly code. + +test "${CCAS+set}" = set || CCAS=$CC +test "${CCASFLAGS+set}" = set || CCASFLAGS=$CFLAGS + + + +depcc="$CCAS" am_compiler_list= + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5 +$as_echo_n "checking dependency style of $depcc... " >&6; } +if ${am_cv_CCAS_dependencies_compiler_type+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then + # We make a subdir and do the tests there. Otherwise we can end up + # making bogus files that we don't know about and never remove. For + # instance it was reported that on HP-UX the gcc test will end up + # making a dummy file named 'D' -- because '-MD' means "put the output + # in D". + rm -rf conftest.dir + mkdir conftest.dir + # Copy depcomp to subdir because otherwise we won't find it if we're + # using a relative directory. + cp "$am_depcomp" conftest.dir + cd conftest.dir + # We will build objects and dependencies in a subdirectory because + # it helps to detect inapplicable dependency modes. For instance + # both Tru64's cc and ICC support -MD to output dependencies as a + # side effect of compilation, but ICC will put the dependencies in + # the current directory while Tru64 will put them in the object + # directory. + mkdir sub + + am_cv_CCAS_dependencies_compiler_type=none + if test "$am_compiler_list" = ""; then + am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp` + fi + am__universal=false + + + for depmode in $am_compiler_list; do + # Setup a source with many dependencies, because some compilers + # like to wrap large dependency lists on column 80 (with \), and + # we should not choose a depcomp mode which is confused by this. + # + # We need to recreate these files for each test, as the compiler may + # overwrite some of them when testing with obscure command lines. + # This happens at least with the AIX C compiler. + : > sub/conftest.c + for i in 1 2 3 4 5 6; do + echo '#include "conftst'$i'.h"' >> sub/conftest.c + # Using ": > sub/conftst$i.h" creates only sub/conftst1.h with + # Solaris 10 /bin/sh. + echo '/* dummy */' > sub/conftst$i.h + done + echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf + + # We check with '-c' and '-o' for the sake of the "dashmstdout" + # mode. It turns out that the SunPro C++ compiler does not properly + # handle '-M -o', and we need to detect this. Also, some Intel + # versions had trouble with output in subdirs. + am__obj=sub/conftest.${OBJEXT-o} + am__minus_obj="-o $am__obj" + case $depmode in + gcc) + # This depmode causes a compiler race in universal mode. + test "$am__universal" = false || continue + ;; + nosideeffect) + # After this tag, mechanisms are not by side-effect, so they'll + # only be used when explicitly requested. + if test "x$enable_dependency_tracking" = xyes; then + continue + else + break + fi + ;; + msvc7 | msvc7msys | msvisualcpp | msvcmsys) + # This compiler won't grok '-c -o', but also, the minuso test has + # not run yet. These depmodes are late enough in the game, and + # so weak that their functioning should not be impacted. + am__obj=conftest.${OBJEXT-o} + am__minus_obj= + ;; + none) break ;; + esac + if depmode=$depmode \ + source=sub/conftest.c object=$am__obj \ + depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ + $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \ + >/dev/null 2>conftest.err && + grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 && + grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && + grep $am__obj sub/conftest.Po > /dev/null 2>&1 && + ${MAKE-make} -s -f confmf > /dev/null 2>&1; then + # icc doesn't choke on unknown options, it will just issue warnings + # or remarks (even with -Werror). So we grep stderr for any message + # that says an option was ignored or not supported. + # When given -MP, icc 7.0 and 7.1 complain thusly: + # icc: Command line warning: ignoring option '-M'; no argument required + # The diagnosis changed in icc 8.0: + # icc: Command line remark: option '-MP' not supported + if (grep 'ignoring option' conftest.err || + grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else + am_cv_CCAS_dependencies_compiler_type=$depmode + break + fi + fi + done + + cd .. + rm -rf conftest.dir +else + am_cv_CCAS_dependencies_compiler_type=none +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_CCAS_dependencies_compiler_type" >&5 +$as_echo "$am_cv_CCAS_dependencies_compiler_type" >&6; } +CCASDEPMODE=depmode=$am_cv_CCAS_dependencies_compiler_type + + if + test "x$enable_dependency_tracking" != xno \ + && test "$am_cv_CCAS_dependencies_compiler_type" = gcc3; then + am__fastdepCCAS_TRUE= + am__fastdepCCAS_FALSE='#' +else + am__fastdepCCAS_TRUE='#' + am__fastdepCCAS_FALSE= +fi + + + + + +# In order to override CFLAGS_FOR_TARGET, all of our special flags go +# in XCFLAGS. But we need them in CFLAGS during configury. So put them +# in both places for now and restore CFLAGS at the end of config. +save_CFLAGS="$CFLAGS" + +# Find other programs we need. +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. +set dummy ${ac_tool_prefix}ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AR"; then + ac_cv_prog_AR="$AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AR="${ac_tool_prefix}ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AR=$ac_cv_prog_AR +if test -n "$AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 +$as_echo "$AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_AR"; then + ac_ct_AR=$AR + # Extract the first word of "ar", so it can be a program name with args. +set dummy ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_AR"; then + ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_AR="ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_AR=$ac_cv_prog_ac_ct_AR +if test -n "$ac_ct_AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 +$as_echo "$ac_ct_AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_AR" = x; then + AR="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + AR=$ac_ct_AR + fi +else + AR="$ac_cv_prog_AR" +fi + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}nm", so it can be a program name with args. +set dummy ${ac_tool_prefix}nm; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_NM+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$NM"; then + ac_cv_prog_NM="$NM" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_NM="${ac_tool_prefix}nm" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +NM=$ac_cv_prog_NM +if test -n "$NM"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $NM" >&5 +$as_echo "$NM" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_NM"; then + ac_ct_NM=$NM + # Extract the first word of "nm", so it can be a program name with args. +set dummy nm; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_NM+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_NM"; then + ac_cv_prog_ac_ct_NM="$ac_ct_NM" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_NM="nm" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_NM=$ac_cv_prog_ac_ct_NM +if test -n "$ac_ct_NM"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_NM" >&5 +$as_echo "$ac_ct_NM" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_NM" = x; then + NM="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + NM=$ac_ct_NM + fi +else + NM="$ac_cv_prog_NM" +fi + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RANLIB=$ac_cv_prog_RANLIB +if test -n "$RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RANLIB"; then + ac_ct_RANLIB=$RANLIB + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_RANLIB"; then + ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RANLIB="ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB +if test -n "$ac_ct_RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_RANLIB" = x; then + RANLIB="ranlib-not-found-in-path-error" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi +else + RANLIB="$ac_cv_prog_RANLIB" +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } +set x ${MAKE-make} +ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` +if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat >conftest.make <<\_ACEOF +SHELL = /bin/sh +all: + @echo '@@@%%%=$(MAKE)=@@@%%%' +_ACEOF +# GNU make sometimes prints "make[1]: Entering ...", which would confuse us. +case `${MAKE-make} -f conftest.make 2>/dev/null` in + *@@@%%%=?*=@@@%%%*) + eval ac_cv_prog_make_${ac_make}_set=yes;; + *) + eval ac_cv_prog_make_${ac_make}_set=no;; +esac +rm -f conftest.make +fi +if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + SET_MAKE= +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + SET_MAKE="MAKE=${MAKE-make}" +fi + + + +# Initialize libtool. +case `pwd` in + *\ * | *\ *) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&5 +$as_echo "$as_me: WARNING: Libtool does not cope well with whitespace in \`pwd\`" >&2;} ;; +esac + + + +macro_version='2.2.7a' +macro_revision='1.3134' + + + + + + + + + + + + + +ltmain="$ac_aux_dir/ltmain.sh" + +# Backslashify metacharacters that are still active within +# double-quoted strings. +sed_quote_subst='s/\(["`$\\]\)/\\\1/g' + +# Same as above, but do not quote variable references. +double_quote_subst='s/\(["`\\]\)/\\\1/g' + +# Sed substitution to delay expansion of an escaped shell variable in a +# double_quote_subst'ed string. +delay_variable_subst='s/\\\\\\\\\\\$/\\\\\\$/g' + +# Sed substitution to delay expansion of an escaped single quote. +delay_single_quote_subst='s/'\''/'\'\\\\\\\'\''/g' + +# Sed substitution to avoid accidental globbing in evaled expressions +no_glob_subst='s/\*/\\\*/g' + +ECHO='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO +ECHO=$ECHO$ECHO$ECHO$ECHO$ECHO$ECHO + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to print strings" >&5 +$as_echo_n "checking how to print strings... " >&6; } +# Test print first, because it will be a builtin if present. +if test "X`print -r -- -n 2>/dev/null`" = X-n && \ + test "X`print -r -- $ECHO 2>/dev/null`" = "X$ECHO"; then + ECHO='print -r --' +elif test "X`printf %s $ECHO 2>/dev/null`" = "X$ECHO"; then + ECHO='printf %s\n' +else + # Use this function as a fallback that always works. + func_fallback_echo () + { + eval 'cat <<_LTECHO_EOF +$1 +_LTECHO_EOF' + } + ECHO='func_fallback_echo' +fi + +# func_echo_all arg... +# Invoke $ECHO with all args, space-separated. +func_echo_all () +{ + $ECHO "" +} + +case "$ECHO" in + printf*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: printf" >&5 +$as_echo "printf" >&6; } ;; + print*) { $as_echo "$as_me:${as_lineno-$LINENO}: result: print -r" >&5 +$as_echo "print -r" >&6; } ;; + *) { $as_echo "$as_me:${as_lineno-$LINENO}: result: cat" >&5 +$as_echo "cat" >&6; } ;; +esac + + + + + + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a sed that does not truncate output" >&5 +$as_echo_n "checking for a sed that does not truncate output... " >&6; } +if ${ac_cv_path_SED+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_script=s/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa/bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb/ + for ac_i in 1 2 3 4 5 6 7; do + ac_script="$ac_script$as_nl$ac_script" + done + echo "$ac_script" 2>/dev/null | sed 99q >conftest.sed + { ac_script=; unset ac_script;} + if test -z "$SED"; then + ac_path_SED_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in sed gsed; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_SED="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_SED" || continue +# Check for GNU ac_path_SED and select it if it is found. + # Check for GNU $ac_path_SED +case `"$ac_path_SED" --version 2>&1` in +*GNU*) + ac_cv_path_SED="$ac_path_SED" ac_path_SED_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo '' >> "conftest.nl" + "$ac_path_SED" -f conftest.sed < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_SED_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_SED="$ac_path_SED" + ac_path_SED_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_SED_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_SED"; then + as_fn_error $? "no acceptable sed could be found in \$PATH" "$LINENO" 5 + fi +else + ac_cv_path_SED=$SED +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_SED" >&5 +$as_echo "$ac_cv_path_SED" >&6; } + SED="$ac_cv_path_SED" + rm -f conftest.sed + +test -z "$SED" && SED=sed +Xsed="$SED -e 1s/^X//" + + + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fgrep" >&5 +$as_echo_n "checking for fgrep... " >&6; } +if ${ac_cv_path_FGREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if echo 'ab*c' | $GREP -F 'ab*c' >/dev/null 2>&1 + then ac_cv_path_FGREP="$GREP -F" + else + if test -z "$FGREP"; then + ac_path_FGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in fgrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_FGREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_FGREP" || continue +# Check for GNU ac_path_FGREP and select it if it is found. + # Check for GNU $ac_path_FGREP +case `"$ac_path_FGREP" --version 2>&1` in +*GNU*) + ac_cv_path_FGREP="$ac_path_FGREP" ac_path_FGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'FGREP' >> "conftest.nl" + "$ac_path_FGREP" FGREP < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_FGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_FGREP="$ac_path_FGREP" + ac_path_FGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_FGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_FGREP"; then + as_fn_error $? "no acceptable fgrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_FGREP=$FGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_FGREP" >&5 +$as_echo "$ac_cv_path_FGREP" >&6; } + FGREP="$ac_cv_path_FGREP" + + +test -z "$GREP" && GREP=grep + + + + + + + + + + + + + + + + + + + +# Check whether --with-gnu-ld was given. +if test "${with_gnu_ld+set}" = set; then : + withval=$with_gnu_ld; test "$withval" = no || with_gnu_ld=yes +else + with_gnu_ld=no +fi + +ac_prog=ld +if test "$GCC" = yes; then + # Check if gcc -print-prog-name=ld gives a path. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld used by $CC" >&5 +$as_echo_n "checking for ld used by $CC... " >&6; } + case $host in + *-*-mingw*) + # gcc leaves a trailing carriage return which upsets mingw + ac_prog=`($CC -print-prog-name=ld) 2>&5 | tr -d '\015'` ;; + *) + ac_prog=`($CC -print-prog-name=ld) 2>&5` ;; + esac + case $ac_prog in + # Accept absolute paths. + [\\/]* | ?:[\\/]*) + re_direlt='/[^/][^/]*/\.\./' + # Canonicalize the pathname of ld + ac_prog=`$ECHO "$ac_prog"| $SED 's%\\\\%/%g'` + while $ECHO "$ac_prog" | $GREP "$re_direlt" > /dev/null 2>&1; do + ac_prog=`$ECHO $ac_prog| $SED "s%$re_direlt%/%"` + done + test -z "$LD" && LD="$ac_prog" + ;; + "") + # If it fails, then pretend we aren't using GCC. + ac_prog=ld + ;; + *) + # If it is relative, then search for the first ld in PATH. + with_gnu_ld=unknown + ;; + esac +elif test "$with_gnu_ld" = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU ld" >&5 +$as_echo_n "checking for GNU ld... " >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for non-GNU ld" >&5 +$as_echo_n "checking for non-GNU ld... " >&6; } +fi +if ${lt_cv_path_LD+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$LD"; then + lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR + for ac_dir in $PATH; do + IFS="$lt_save_ifs" + test -z "$ac_dir" && ac_dir=. + if test -f "$ac_dir/$ac_prog" || test -f "$ac_dir/$ac_prog$ac_exeext"; then + lt_cv_path_LD="$ac_dir/$ac_prog" + # Check to see if the program is GNU ld. I'd rather use --version, + # but apparently some variants of GNU ld only accept -v. + # Break only if it was the GNU/non-GNU ld that we prefer. + case `"$lt_cv_path_LD" -v 2>&1 &5 +$as_echo "$LD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi +test -z "$LD" && as_fn_error $? "no acceptable ld found in \$PATH" "$LINENO" 5 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if the linker ($LD) is GNU ld" >&5 +$as_echo_n "checking if the linker ($LD) is GNU ld... " >&6; } +if ${lt_cv_prog_gnu_ld+:} false; then : + $as_echo_n "(cached) " >&6 +else + # I'd rather use --version here, but apparently some GNU lds only accept -v. +case `$LD -v 2>&1 &5 +$as_echo "$lt_cv_prog_gnu_ld" >&6; } +with_gnu_ld=$lt_cv_prog_gnu_ld + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for BSD- or MS-compatible name lister (nm)" >&5 +$as_echo_n "checking for BSD- or MS-compatible name lister (nm)... " >&6; } +if ${lt_cv_path_NM+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$NM"; then + # Let the user override the nm to test. + lt_nm_to_check="$NM" + else + lt_nm_to_check="${ac_tool_prefix}nm" + if test -n "$ac_tool_prefix" && test "$build" = "$host"; then + lt_nm_to_check="$lt_nm_to_check nm" + fi + fi + for lt_tmp_nm in "$lt_nm_to_check"; do + lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR + for ac_dir in $PATH /usr/ccs/bin/elf /usr/ccs/bin /usr/ucb /bin; do + IFS="$lt_save_ifs" + test -z "$ac_dir" && ac_dir=. + # Strip out any user-provided options from the nm to test twice, + # the first time to test to see if nm (rather than its options) has + # an explicit path, the second time to yield a file which can be + # nm'ed itself. + tmp_nm_path="`$ECHO "$lt_tmp_nm" | sed 's, -.*$,,'`" + case "$tmp_nm_path" in + */*|*\\*) tmp_nm="$lt_tmp_nm";; + *) tmp_nm="$ac_dir/$lt_tmp_nm";; + esac + tmp_nm_to_nm="`$ECHO "$tmp_nm" | sed 's, -.*$,,'`" + if test -f "$tmp_nm_to_nm" || test -f "$tmp_nm_to_nm$ac_exeext" ; then + # Check to see if the nm accepts a BSD-compat flag. + # Adding the `sed 1q' prevents false positives on HP-UX, which says: + # nm: unknown option "B" ignored + case `"$tmp_nm" -B "$tmp_nm_to_nm" 2>&1 | grep -v '^ *$' | sed '1q'` in + *$tmp_nm*) lt_cv_path_NM="$tmp_nm -B" + break + ;; + *) + case `"$tmp_nm" -p "$tmp_nm_to_nm" 2>&1 | grep -v '^ *$' | sed '1q'` in + *$tmp_nm*) + lt_cv_path_NM="$tmp_nm -p" + break + ;; + *) + lt_cv_path_NM=${lt_cv_path_NM="$tmp_nm"} # keep the first match, but + continue # so that we can try to find one that supports BSD flags + ;; + esac + ;; + esac + fi + done + IFS="$lt_save_ifs" + done + : ${lt_cv_path_NM=no} +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_path_NM" >&5 +$as_echo "$lt_cv_path_NM" >&6; } +if test "$lt_cv_path_NM" != "no"; then + NM="$lt_cv_path_NM" +else + # Didn't find any BSD compatible name lister, look for dumpbin. + if test -n "$DUMPBIN"; then : + # Let the user override the test. + else + if test -n "$ac_tool_prefix"; then + for ac_prog in dumpbin "link -dump" + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_DUMPBIN+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$DUMPBIN"; then + ac_cv_prog_DUMPBIN="$DUMPBIN" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_DUMPBIN="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +DUMPBIN=$ac_cv_prog_DUMPBIN +if test -n "$DUMPBIN"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DUMPBIN" >&5 +$as_echo "$DUMPBIN" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$DUMPBIN" && break + done +fi +if test -z "$DUMPBIN"; then + ac_ct_DUMPBIN=$DUMPBIN + for ac_prog in dumpbin "link -dump" +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_DUMPBIN+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_DUMPBIN"; then + ac_cv_prog_ac_ct_DUMPBIN="$ac_ct_DUMPBIN" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_DUMPBIN="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_DUMPBIN=$ac_cv_prog_ac_ct_DUMPBIN +if test -n "$ac_ct_DUMPBIN"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DUMPBIN" >&5 +$as_echo "$ac_ct_DUMPBIN" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_DUMPBIN" && break +done + + if test "x$ac_ct_DUMPBIN" = x; then + DUMPBIN=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + DUMPBIN=$ac_ct_DUMPBIN + fi +fi + + case `$DUMPBIN -symbols /dev/null 2>&1 | sed '1q'` in + *COFF*) + DUMPBIN="$DUMPBIN -symbols" + ;; + *) + DUMPBIN=: + ;; + esac + fi + + if test "$DUMPBIN" != ":"; then + NM="$DUMPBIN" + fi +fi +test -z "$NM" && NM=nm + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the name lister ($NM) interface" >&5 +$as_echo_n "checking the name lister ($NM) interface... " >&6; } +if ${lt_cv_nm_interface+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_nm_interface="BSD nm" + echo "int some_variable = 0;" > conftest.$ac_ext + (eval echo "\"\$as_me:$LINENO: $ac_compile\"" >&5) + (eval "$ac_compile" 2>conftest.err) + cat conftest.err >&5 + (eval echo "\"\$as_me:$LINENO: $NM \\\"conftest.$ac_objext\\\"\"" >&5) + (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out) + cat conftest.err >&5 + (eval echo "\"\$as_me:$LINENO: output\"" >&5) + cat conftest.out >&5 + if $GREP 'External.*some_variable' conftest.out > /dev/null; then + lt_cv_nm_interface="MS dumpbin" + fi + rm -f conftest* +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_nm_interface" >&5 +$as_echo "$lt_cv_nm_interface" >&6; } + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ln -s works" >&5 +$as_echo_n "checking whether ln -s works... " >&6; } +LN_S=$as_ln_s +if test "$LN_S" = "ln -s"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no, using $LN_S" >&5 +$as_echo "no, using $LN_S" >&6; } +fi + +# find the maximum length of command line arguments +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking the maximum length of command line arguments" >&5 +$as_echo_n "checking the maximum length of command line arguments... " >&6; } +if ${lt_cv_sys_max_cmd_len+:} false; then : + $as_echo_n "(cached) " >&6 +else + i=0 + teststring="ABCD" + + case $build_os in + msdosdjgpp*) + # On DJGPP, this test can blow up pretty badly due to problems in libc + # (any single argument exceeding 2000 bytes causes a buffer overrun + # during glob expansion). Even if it were fixed, the result of this + # check would be larger than it should be. + lt_cv_sys_max_cmd_len=12288; # 12K is about right + ;; + + gnu*) + # Under GNU Hurd, this test is not required because there is + # no limit to the length of command line arguments. + # Libtool will interpret -1 as no limit whatsoever + lt_cv_sys_max_cmd_len=-1; + ;; + + cygwin* | mingw* | cegcc*) + # On Win9x/ME, this test blows up -- it succeeds, but takes + # about 5 minutes as the teststring grows exponentially. + # Worse, since 9x/ME are not pre-emptively multitasking, + # you end up with a "frozen" computer, even though with patience + # the test eventually succeeds (with a max line length of 256k). + # Instead, let's just punt: use the minimum linelength reported by + # all of the supported platforms: 8192 (on NT/2K/XP). + lt_cv_sys_max_cmd_len=8192; + ;; + + mint*) + # On MiNT this can take a long time and run out of memory. + lt_cv_sys_max_cmd_len=8192; + ;; + + amigaos*) + # On AmigaOS with pdksh, this test takes hours, literally. + # So we just punt and use a minimum line length of 8192. + lt_cv_sys_max_cmd_len=8192; + ;; + + netbsd* | freebsd* | openbsd* | darwin* | dragonfly*) + # This has been around since 386BSD, at least. Likely further. + if test -x /sbin/sysctl; then + lt_cv_sys_max_cmd_len=`/sbin/sysctl -n kern.argmax` + elif test -x /usr/sbin/sysctl; then + lt_cv_sys_max_cmd_len=`/usr/sbin/sysctl -n kern.argmax` + else + lt_cv_sys_max_cmd_len=65536 # usable default for all BSDs + fi + # And add a safety zone + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` + ;; + + interix*) + # We know the value 262144 and hardcode it with a safety zone (like BSD) + lt_cv_sys_max_cmd_len=196608 + ;; + + osf*) + # Dr. Hans Ekkehard Plesser reports seeing a kernel panic running configure + # due to this test when exec_disable_arg_limit is 1 on Tru64. It is not + # nice to cause kernel panics so lets avoid the loop below. + # First set a reasonable default. + lt_cv_sys_max_cmd_len=16384 + # + if test -x /sbin/sysconfig; then + case `/sbin/sysconfig -q proc exec_disable_arg_limit` in + *1*) lt_cv_sys_max_cmd_len=-1 ;; + esac + fi + ;; + sco3.2v5*) + lt_cv_sys_max_cmd_len=102400 + ;; + sysv5* | sco5v6* | sysv4.2uw2*) + kargmax=`grep ARG_MAX /etc/conf/cf.d/stune 2>/dev/null` + if test -n "$kargmax"; then + lt_cv_sys_max_cmd_len=`echo $kargmax | sed 's/.*[ ]//'` + else + lt_cv_sys_max_cmd_len=32768 + fi + ;; + *) + lt_cv_sys_max_cmd_len=`(getconf ARG_MAX) 2> /dev/null` + if test -n "$lt_cv_sys_max_cmd_len"; then + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 4` + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \* 3` + else + # Make teststring a little bigger before we do anything with it. + # a 1K string should be a reasonable start. + for i in 1 2 3 4 5 6 7 8 ; do + teststring=$teststring$teststring + done + SHELL=${SHELL-${CONFIG_SHELL-/bin/sh}} + # If test is not a shell built-in, we'll probably end up computing a + # maximum length that is only half of the actual maximum length, but + # we can't tell. + while { test "X"`func_fallback_echo "$teststring$teststring" 2>/dev/null` \ + = "X$teststring$teststring"; } >/dev/null 2>&1 && + test $i != 17 # 1/2 MB should be enough + do + i=`expr $i + 1` + teststring=$teststring$teststring + done + # Only check the string length outside the loop. + lt_cv_sys_max_cmd_len=`expr "X$teststring" : ".*" 2>&1` + teststring= + # Add a significant safety factor because C++ compilers can tack on + # massive amounts of additional arguments before passing them to the + # linker. It appears as though 1/2 is a usable value. + lt_cv_sys_max_cmd_len=`expr $lt_cv_sys_max_cmd_len \/ 2` + fi + ;; + esac + +fi + +if test -n $lt_cv_sys_max_cmd_len ; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_sys_max_cmd_len" >&5 +$as_echo "$lt_cv_sys_max_cmd_len" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5 +$as_echo "none" >&6; } +fi +max_cmd_len=$lt_cv_sys_max_cmd_len + + + + + + +: ${CP="cp -f"} +: ${MV="mv -f"} +: ${RM="rm -f"} + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the shell understands some XSI constructs" >&5 +$as_echo_n "checking whether the shell understands some XSI constructs... " >&6; } +# Try some XSI features +xsi_shell=no +( _lt_dummy="a/b/c" + test "${_lt_dummy##*/},${_lt_dummy%/*},"${_lt_dummy%"$_lt_dummy"}, \ + = c,a/b,, \ + && eval 'test $(( 1 + 1 )) -eq 2 \ + && test "${#_lt_dummy}" -eq 5' ) >/dev/null 2>&1 \ + && xsi_shell=yes +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $xsi_shell" >&5 +$as_echo "$xsi_shell" >&6; } + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the shell understands \"+=\"" >&5 +$as_echo_n "checking whether the shell understands \"+=\"... " >&6; } +lt_shell_append=no +( foo=bar; set foo baz; eval "$1+=\$2" && test "$foo" = barbaz ) \ + >/dev/null 2>&1 \ + && lt_shell_append=yes +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_shell_append" >&5 +$as_echo "$lt_shell_append" >&6; } + + +if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then + lt_unset=unset +else + lt_unset=false +fi + + + + + +# test EBCDIC or ASCII +case `echo X|tr X '\101'` in + A) # ASCII based system + # \n is not interpreted correctly by Solaris 8 /usr/ucb/tr + lt_SP2NL='tr \040 \012' + lt_NL2SP='tr \015\012 \040\040' + ;; + *) # EBCDIC based system + lt_SP2NL='tr \100 \n' + lt_NL2SP='tr \r\n \100\100' + ;; +esac + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $LD option to reload object files" >&5 +$as_echo_n "checking for $LD option to reload object files... " >&6; } +if ${lt_cv_ld_reload_flag+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_ld_reload_flag='-r' +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_reload_flag" >&5 +$as_echo "$lt_cv_ld_reload_flag" >&6; } +reload_flag=$lt_cv_ld_reload_flag +case $reload_flag in +"" | " "*) ;; +*) reload_flag=" $reload_flag" ;; +esac +reload_cmds='$LD$reload_flag -o $output$reload_objs' +case $host_os in + darwin*) + if test "$GCC" = yes; then + reload_cmds='$LTCC $LTCFLAGS -nostdlib ${wl}-r -o $output$reload_objs' + else + reload_cmds='$LD$reload_flag -o $output$reload_objs' + fi + ;; +esac + + + + + + + + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}objdump", so it can be a program name with args. +set dummy ${ac_tool_prefix}objdump; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_OBJDUMP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$OBJDUMP"; then + ac_cv_prog_OBJDUMP="$OBJDUMP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_OBJDUMP="${ac_tool_prefix}objdump" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +OBJDUMP=$ac_cv_prog_OBJDUMP +if test -n "$OBJDUMP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OBJDUMP" >&5 +$as_echo "$OBJDUMP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_OBJDUMP"; then + ac_ct_OBJDUMP=$OBJDUMP + # Extract the first word of "objdump", so it can be a program name with args. +set dummy objdump; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_OBJDUMP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_OBJDUMP"; then + ac_cv_prog_ac_ct_OBJDUMP="$ac_ct_OBJDUMP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_OBJDUMP="objdump" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_OBJDUMP=$ac_cv_prog_ac_ct_OBJDUMP +if test -n "$ac_ct_OBJDUMP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OBJDUMP" >&5 +$as_echo "$ac_ct_OBJDUMP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_OBJDUMP" = x; then + OBJDUMP="false" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + OBJDUMP=$ac_ct_OBJDUMP + fi +else + OBJDUMP="$ac_cv_prog_OBJDUMP" +fi + +test -z "$OBJDUMP" && OBJDUMP=objdump + + + + + + + + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to recognize dependent libraries" >&5 +$as_echo_n "checking how to recognize dependent libraries... " >&6; } +if ${lt_cv_deplibs_check_method+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_file_magic_cmd='$MAGIC_CMD' +lt_cv_file_magic_test_file= +lt_cv_deplibs_check_method='unknown' +# Need to set the preceding variable on all platforms that support +# interlibrary dependencies. +# 'none' -- dependencies not supported. +# `unknown' -- same as none, but documents that we really don't know. +# 'pass_all' -- all dependencies passed with no checks. +# 'test_compile' -- check by making test program. +# 'file_magic [[regex]]' -- check by looking for files in library path +# which responds to the $file_magic_cmd with a given extended regex. +# If you have `file' or equivalent on your system and you're not sure +# whether `pass_all' will *always* work, you probably want this one. + +case $host_os in +aix[4-9]*) + lt_cv_deplibs_check_method=pass_all + ;; + +beos*) + lt_cv_deplibs_check_method=pass_all + ;; + +bsdi[45]*) + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib)' + lt_cv_file_magic_cmd='/usr/bin/file -L' + lt_cv_file_magic_test_file=/shlib/libc.so + ;; + +cygwin*) + # func_win32_libid is a shell function defined in ltmain.sh + lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL' + lt_cv_file_magic_cmd='func_win32_libid' + ;; + +mingw* | pw32*) + # Base MSYS/MinGW do not provide the 'file' command needed by + # func_win32_libid shell function, so use a weaker test based on 'objdump', + # unless we find 'file', for example because we are cross-compiling. + # func_win32_libid assumes BSD nm, so disallow it if using MS dumpbin. + if ( test "$lt_cv_nm_interface" = "BSD nm" && file / ) >/dev/null 2>&1; then + lt_cv_deplibs_check_method='file_magic ^x86 archive import|^x86 DLL' + lt_cv_file_magic_cmd='func_win32_libid' + else + lt_cv_deplibs_check_method='file_magic file format pei*-i386(.*architecture: i386)?' + lt_cv_file_magic_cmd='$OBJDUMP -f' + fi + ;; + +cegcc*) + # use the weaker test based on 'objdump'. See mingw*. + lt_cv_deplibs_check_method='file_magic file format pe-arm-.*little(.*architecture: arm)?' + lt_cv_file_magic_cmd='$OBJDUMP -f' + ;; + +darwin* | rhapsody*) + lt_cv_deplibs_check_method=pass_all + ;; + +freebsd* | dragonfly*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then + case $host_cpu in + i*86 ) + # Not sure whether the presence of OpenBSD here was a mistake. + # Let's accept both of them until this is cleared up. + lt_cv_deplibs_check_method='file_magic (FreeBSD|OpenBSD|DragonFly)/i[3-9]86 (compact )?demand paged shared library' + lt_cv_file_magic_cmd=/usr/bin/file + lt_cv_file_magic_test_file=`echo /usr/lib/libc.so.*` + ;; + esac + else + lt_cv_deplibs_check_method=pass_all + fi + ;; + +gnu*) + lt_cv_deplibs_check_method=pass_all + ;; + +haiku*) + lt_cv_deplibs_check_method=pass_all + ;; + +hpux10.20* | hpux11*) + lt_cv_file_magic_cmd=/usr/bin/file + case $host_cpu in + ia64*) + lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF-[0-9][0-9]) shared object file - IA64' + lt_cv_file_magic_test_file=/usr/lib/hpux32/libc.so + ;; + hppa*64*) + lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|ELF[ -][0-9][0-9])(-bit)?( [LM]SB)? shared object( file)?[, -]* PA-RISC [0-9]\.[0-9]' + lt_cv_file_magic_test_file=/usr/lib/pa20_64/libc.sl + ;; + *) + lt_cv_deplibs_check_method='file_magic (s[0-9][0-9][0-9]|PA-RISC[0-9]\.[0-9]) shared library' + lt_cv_file_magic_test_file=/usr/lib/libc.sl + ;; + esac + ;; + +interix[3-9]*) + # PIC code is broken on Interix 3.x, that's why |\.a not |_pic\.a here + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|\.a)$' + ;; + +irix5* | irix6* | nonstopux*) + case $LD in + *-32|*"-32 ") libmagic=32-bit;; + *-n32|*"-n32 ") libmagic=N32;; + *-64|*"-64 ") libmagic=64-bit;; + *) libmagic=never-match;; + esac + lt_cv_deplibs_check_method=pass_all + ;; + +# This must be Linux ELF. +linux* | k*bsd*-gnu | kopensolaris*-gnu | uclinuxfdpiceabi) + lt_cv_deplibs_check_method=pass_all + ;; + +netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ > /dev/null; then + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$' + else + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so|_pic\.a)$' + fi + ;; + +newos6*) + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (executable|dynamic lib)' + lt_cv_file_magic_cmd=/usr/bin/file + lt_cv_file_magic_test_file=/usr/lib/libnls.so + ;; + +*nto* | *qnx*) + lt_cv_deplibs_check_method=pass_all + ;; + +openbsd*) + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|\.so|_pic\.a)$' + else + lt_cv_deplibs_check_method='match_pattern /lib[^/]+(\.so\.[0-9]+\.[0-9]+|_pic\.a)$' + fi + ;; + +osf3* | osf4* | osf5*) + lt_cv_deplibs_check_method=pass_all + ;; + +rdos*) + lt_cv_deplibs_check_method=pass_all + ;; + +solaris*) + lt_cv_deplibs_check_method=pass_all + ;; + +sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + lt_cv_deplibs_check_method=pass_all + ;; + +sysv4 | sysv4.3*) + case $host_vendor in + motorola) + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [ML]SB (shared object|dynamic lib) M[0-9][0-9]* Version [0-9]' + lt_cv_file_magic_test_file=`echo /usr/lib/libc.so*` + ;; + ncr) + lt_cv_deplibs_check_method=pass_all + ;; + sequent) + lt_cv_file_magic_cmd='/bin/file' + lt_cv_deplibs_check_method='file_magic ELF [0-9][0-9]*-bit [LM]SB (shared object|dynamic lib )' + ;; + sni) + lt_cv_file_magic_cmd='/bin/file' + lt_cv_deplibs_check_method="file_magic ELF [0-9][0-9]*-bit [LM]SB dynamic lib" + lt_cv_file_magic_test_file=/lib/libc.so + ;; + siemens) + lt_cv_deplibs_check_method=pass_all + ;; + pc) + lt_cv_deplibs_check_method=pass_all + ;; + esac + ;; + +tpf*) + lt_cv_deplibs_check_method=pass_all + ;; +vxworks*) + # Assume VxWorks cross toolchains are built on Linux, possibly + # as canadian for Windows hosts. + lt_cv_deplibs_check_method=pass_all + ;; +esac + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_deplibs_check_method" >&5 +$as_echo "$lt_cv_deplibs_check_method" >&6; } +file_magic_cmd=$lt_cv_file_magic_cmd +deplibs_check_method=$lt_cv_deplibs_check_method +test -z "$deplibs_check_method" && deplibs_check_method=unknown + + + + + + + + + + + + + +# Try CLANG_PLUGIN_FILE first since GCC_PLUGIN_OPTION may return the +# wrong plugin_option with clang. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang" >&5 +$as_echo_n "checking for clang... " >&6; } +if ${clang_cv_is_clang+:} false; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#ifdef __clang__ + yes +#endif + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "yes" >/dev/null 2>&1; then : + clang_cv_is_clang=yes +else + clang_cv_is_clang=no +fi +rm -f conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $clang_cv_is_clang" >&5 +$as_echo "$clang_cv_is_clang" >&6; } + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}llvm-config", so it can be a program name with args. +set dummy ${ac_tool_prefix}llvm-config; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_LLVM_CONFIG+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$LLVM_CONFIG"; then + ac_cv_prog_LLVM_CONFIG="$LLVM_CONFIG" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_LLVM_CONFIG="${ac_tool_prefix}llvm-config" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +LLVM_CONFIG=$ac_cv_prog_LLVM_CONFIG +if test -n "$LLVM_CONFIG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LLVM_CONFIG" >&5 +$as_echo "$LLVM_CONFIG" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_LLVM_CONFIG"; then + ac_ct_LLVM_CONFIG=$LLVM_CONFIG + # Extract the first word of "llvm-config", so it can be a program name with args. +set dummy llvm-config; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_LLVM_CONFIG+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_LLVM_CONFIG"; then + ac_cv_prog_ac_ct_LLVM_CONFIG="$ac_ct_LLVM_CONFIG" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_LLVM_CONFIG="llvm-config" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_LLVM_CONFIG=$ac_cv_prog_ac_ct_LLVM_CONFIG +if test -n "$ac_ct_LLVM_CONFIG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_LLVM_CONFIG" >&5 +$as_echo "$ac_ct_LLVM_CONFIG" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_LLVM_CONFIG" = x; then + LLVM_CONFIG="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + LLVM_CONFIG=$ac_ct_LLVM_CONFIG + fi +else + LLVM_CONFIG="$ac_cv_prog_LLVM_CONFIG" +fi + + plugin_file= + if test $clang_cv_is_clang = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for clang plugin file" >&5 +$as_echo_n "checking for clang plugin file... " >&6; } + plugin_names="LLVMgold.so" + for plugin in $plugin_names; do + plugin_file=`${CC} ${CFLAGS} --print-file-name $plugin` + if test "$plugin_file" != "$plugin"; then + break; + fi + if test -n "${LLVM_CONFIG}"; then + plugin_file=`${LLVM_CONFIG} --libdir`/$plugin + if test -f "$plugin_file"; then + break; + fi + fi + plugin_file= + done + if test -z "$plugin_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $plugin_file" >&5 +$as_echo "$plugin_file" >&6; } + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. +set dummy ${ac_tool_prefix}ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AR"; then + ac_cv_prog_AR="$AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AR="${ac_tool_prefix}ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AR=$ac_cv_prog_AR +if test -n "$AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 +$as_echo "$AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_AR"; then + ac_ct_AR=$AR + # Extract the first word of "ar", so it can be a program name with args. +set dummy ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_AR"; then + ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_AR="ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_AR=$ac_cv_prog_ac_ct_AR +if test -n "$ac_ct_AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 +$as_echo "$ac_ct_AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_AR" = x; then + AR="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + AR=$ac_ct_AR + fi +else + AR="$ac_cv_prog_AR" +fi + + if test -z "${AR}"; then + as_fn_error $? "Required archive tool 'ar' not found on PATH." "$LINENO" 5 + fi + plugin_option="--plugin $plugin_file" + touch conftest.c + ${AR} $plugin_option rc conftest.a conftest.c + if test "$?" != 0; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Failed: $AR $plugin_option rc" >&5 +$as_echo "$as_me: WARNING: Failed: $AR $plugin_option rc" >&2;} + plugin_file= + fi + rm -f conftest.* + fi + fi + plugin_file="$plugin_file" + +if test -n "$plugin_file"; then + plugin_option="--plugin $plugin_file" +else + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. +set dummy ${ac_tool_prefix}ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AR"; then + ac_cv_prog_AR="$AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AR="${ac_tool_prefix}ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AR=$ac_cv_prog_AR +if test -n "$AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 +$as_echo "$AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_AR"; then + ac_ct_AR=$AR + # Extract the first word of "ar", so it can be a program name with args. +set dummy ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_AR"; then + ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_AR="ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_AR=$ac_cv_prog_ac_ct_AR +if test -n "$ac_ct_AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 +$as_echo "$ac_ct_AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_AR" = x; then + AR="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + AR=$ac_ct_AR + fi +else + AR="$ac_cv_prog_AR" +fi + +if test -z "${AR}"; then + as_fn_error $? "Required archive tool 'ar' not found on PATH." "$LINENO" 5 +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for -plugin option" >&5 +$as_echo_n "checking for -plugin option... " >&6; } +plugin_names="liblto_plugin.so liblto_plugin-0.dll cyglto_plugin-0.dll" +plugin_option= +for plugin in $plugin_names; do + plugin_so=`${CC} ${CFLAGS} --print-prog-name $plugin` + if test x$plugin_so = x$plugin; then + plugin_so=`${CC} ${CFLAGS} --print-file-name $plugin` + fi + if test x$plugin_so != x$plugin; then + plugin_option="--plugin $plugin_so" + break + fi +done +if test -z "$plugin_option"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $plugin_option" >&5 +$as_echo "$plugin_option" >&6; } + touch conftest.c + ${AR} $plugin_option rc conftest.a conftest.c + if test "$?" != 0; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Failed: $AR $plugin_option rc" >&5 +$as_echo "$as_me: WARNING: Failed: $AR $plugin_option rc" >&2;} + plugin_option= + fi + rm -f conftest.* +fi +plugin_option="$plugin_option" + +fi +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args. +set dummy ${ac_tool_prefix}ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AR"; then + ac_cv_prog_AR="$AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AR="${ac_tool_prefix}ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AR=$ac_cv_prog_AR +if test -n "$AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5 +$as_echo "$AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_AR"; then + ac_ct_AR=$AR + # Extract the first word of "ar", so it can be a program name with args. +set dummy ar; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_AR+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_AR"; then + ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_AR="ar" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_AR=$ac_cv_prog_ac_ct_AR +if test -n "$ac_ct_AR"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5 +$as_echo "$ac_ct_AR" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_AR" = x; then + AR="false" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + AR=$ac_ct_AR + fi +else + AR="$ac_cv_prog_AR" +fi + +test -z "$AR" && AR=ar +if test -n "$plugin_option"; then + case "$AR" in + *"$plugin_option"*) + ;; + *) + if $AR --help 2>&1 | grep -q "\--plugin"; then + AR="$AR $plugin_option" + fi + ;; + esac +fi +test -z "$AR_FLAGS" && AR_FLAGS=cru + + + + + + + + + + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. +set dummy ${ac_tool_prefix}strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_STRIP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$STRIP"; then + ac_cv_prog_STRIP="$STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_STRIP="${ac_tool_prefix}strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +STRIP=$ac_cv_prog_STRIP +if test -n "$STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5 +$as_echo "$STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_STRIP"; then + ac_ct_STRIP=$STRIP + # Extract the first word of "strip", so it can be a program name with args. +set dummy strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_STRIP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_STRIP"; then + ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_STRIP="strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP +if test -n "$ac_ct_STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5 +$as_echo "$ac_ct_STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_STRIP" = x; then + STRIP=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + STRIP=$ac_ct_STRIP + fi +else + STRIP="$ac_cv_prog_STRIP" +fi + +test -z "$STRIP" && STRIP=: + + + + + + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RANLIB=$ac_cv_prog_RANLIB +if test -n "$RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RANLIB"; then + ac_ct_RANLIB=$RANLIB + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_RANLIB"; then + ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RANLIB="ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB +if test -n "$ac_ct_RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_RANLIB" = x; then + RANLIB=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi +else + RANLIB="$ac_cv_prog_RANLIB" +fi + +test -z "$RANLIB" && RANLIB=: +if test -n "$plugin_option" && test "$RANLIB" != ":"; then + case "$RANLIB" in + *"$plugin_option"*) + ;; + *) + if $RANLIB --help 2>&1 | grep -q "\--plugin"; then + RANLIB="$RANLIB $plugin_option" + fi + ;; + esac +fi + + + + + + +# Determine commands to create old-style static archives. +old_archive_cmds='$AR $AR_FLAGS $oldlib$oldobjs' +old_postinstall_cmds='chmod 644 $oldlib' +old_postuninstall_cmds= + +if test -n "$RANLIB"; then + case $host_os in + openbsd*) + old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB -t \$oldlib" + ;; + *) + old_postinstall_cmds="$old_postinstall_cmds~\$RANLIB \$oldlib" + ;; + esac + old_archive_cmds="$old_archive_cmds~\$RANLIB \$oldlib" +fi + +case $host_os in + darwin*) + lock_old_archive_extraction=yes ;; + *) + lock_old_archive_extraction=no ;; +esac + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +# If no C compiler was specified, use CC. +LTCC=${LTCC-"$CC"} + +# If no C compiler flags were specified, use CFLAGS. +LTCFLAGS=${LTCFLAGS-"$CFLAGS"} + +# Allow CC to be a program name with arguments. +compiler=$CC + + +# Check for command to grab the raw symbol name followed by C symbol from nm. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking command to parse $NM output from $compiler object" >&5 +$as_echo_n "checking command to parse $NM output from $compiler object... " >&6; } +if ${lt_cv_sys_global_symbol_pipe+:} false; then : + $as_echo_n "(cached) " >&6 +else + +# These are sane defaults that work on at least a few old systems. +# [They come from Ultrix. What could be older than Ultrix?!! ;)] + +# Character class describing NM global symbol codes. +symcode='[BCDEGRST]' + +# Regexp to match symbols that can be accessed directly from C. +sympat='\([_A-Za-z][_A-Za-z0-9]*\)' + +# Define system-specific variables. +case $host_os in +aix*) + symcode='[BCDT]' + ;; +cygwin* | mingw* | pw32* | cegcc*) + symcode='[ABCDGISTW]' + ;; +hpux*) + if test "$host_cpu" = ia64; then + symcode='[ABCDEGRST]' + fi + ;; +irix* | nonstopux*) + symcode='[BCDEGRST]' + ;; +osf*) + symcode='[BCDEGQRST]' + ;; +solaris*) + symcode='[BCDRT]' + ;; +sco3.2v5*) + symcode='[DT]' + ;; +sysv4.2uw2*) + symcode='[DT]' + ;; +sysv5* | sco5v6* | unixware* | OpenUNIX*) + symcode='[ABDT]' + ;; +sysv4) + symcode='[DFNSTU]' + ;; +esac + +# If we're using GNU nm, then use its standard symbol codes. +case `$NM -V 2>&1` in +*GNU* | *'with BFD'*) + symcode='[ABCDGIRSTW]' ;; +esac + +# Transform an extracted symbol line into a proper C declaration. +# Some systems (esp. on ia64) link data and code symbols differently, +# so use this general approach. +lt_cv_sys_global_symbol_to_cdecl="sed -n -e 's/^T .* \(.*\)$/extern int \1();/p' -e 's/^$symcode* .* \(.*\)$/extern char \1;/p'" + +# Transform an extracted symbol line into symbol name and symbol address +lt_cv_sys_global_symbol_to_c_name_address="sed -n -e 's/^: \([^ ]*\) $/ {\\\"\1\\\", (void *) 0},/p' -e 's/^$symcode* \([^ ]*\) \([^ ]*\)$/ {\"\2\", (void *) \&\2},/p'" +lt_cv_sys_global_symbol_to_c_name_address_lib_prefix="sed -n -e 's/^: \([^ ]*\) $/ {\\\"\1\\\", (void *) 0},/p' -e 's/^$symcode* \([^ ]*\) \(lib[^ ]*\)$/ {\"\2\", (void *) \&\2},/p' -e 's/^$symcode* \([^ ]*\) \([^ ]*\)$/ {\"lib\2\", (void *) \&\2},/p'" + +# Handle CRLF in mingw tool chain +opt_cr= +case $build_os in +mingw*) + opt_cr=`$ECHO 'x\{0,1\}' | tr x '\015'` # option cr in regexp + ;; +esac + +# Try without a prefix underscore, then with it. +for ac_symprfx in "" "_"; do + + # Transform symcode, sympat, and symprfx into a raw symbol and a C symbol. + symxfrm="\\1 $ac_symprfx\\2 \\2" + + # Write the raw and C identifiers. + if test "$lt_cv_nm_interface" = "MS dumpbin"; then + # Fake it for dumpbin and say T for any non-static function + # and D for any global variable. + # Also find C++ and __fastcall symbols from MSVC++, + # which start with @ or ?. + lt_cv_sys_global_symbol_pipe="$AWK '"\ +" {last_section=section; section=\$ 3};"\ +" /Section length .*#relocs.*(pick any)/{hide[last_section]=1};"\ +" \$ 0!~/External *\|/{next};"\ +" / 0+ UNDEF /{next}; / UNDEF \([^|]\)*()/{next};"\ +" {if(hide[section]) next};"\ +" {f=0}; \$ 0~/\(\).*\|/{f=1}; {printf f ? \"T \" : \"D \"};"\ +" {split(\$ 0, a, /\||\r/); split(a[2], s)};"\ +" s[1]~/^[@?]/{print s[1], s[1]; next};"\ +" s[1]~prfx {split(s[1],t,\"@\"); print t[1], substr(t[1],length(prfx))}"\ +" ' prfx=^$ac_symprfx" + else + lt_cv_sys_global_symbol_pipe="sed -n -e 's/^.*[ ]\($symcode$symcode*\)[ ][ ]*$ac_symprfx$sympat$opt_cr$/$symxfrm/p'" + fi + + # Check to see that the pipe works correctly. + pipe_works=no + + rm -f conftest* + cat > conftest.$ac_ext <<_LT_EOF +#ifdef __cplusplus +extern "C" { +#endif +char nm_test_var; +void nm_test_func(void); +void nm_test_func(void){} +#ifdef __cplusplus +} +#endif +int main(){nm_test_var='a';nm_test_func();return(0);} +_LT_EOF + + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + # Now try to grab the symbols. + nlist=conftest.nm + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist\""; } >&5 + (eval $NM conftest.$ac_objext \| "$lt_cv_sys_global_symbol_pipe" \> $nlist) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s "$nlist"; then + # Try sorting and uniquifying the output. + if sort "$nlist" | uniq > "$nlist"T; then + mv -f "$nlist"T "$nlist" + else + rm -f "$nlist"T + fi + + # Make sure that we snagged all the symbols we need. + if $GREP ' nm_test_var$' "$nlist" >/dev/null; then + if $GREP ' nm_test_func$' "$nlist" >/dev/null; then + cat <<_LT_EOF > conftest.$ac_ext +#ifdef __cplusplus +extern "C" { +#endif + +_LT_EOF + # Now generate the symbol file. + eval "$lt_cv_sys_global_symbol_to_cdecl"' < "$nlist" | $GREP -v main >> conftest.$ac_ext' + + cat <<_LT_EOF >> conftest.$ac_ext + +/* The mapping between symbol names and symbols. */ +const struct { + const char *name; + void *address; +} +lt__PROGRAM__LTX_preloaded_symbols[] = +{ + { "@PROGRAM@", (void *) 0 }, +_LT_EOF + $SED "s/^$symcode$symcode* \(.*\) \(.*\)$/ {\"\2\", (void *) \&\2},/" < "$nlist" | $GREP -v main >> conftest.$ac_ext + cat <<\_LT_EOF >> conftest.$ac_ext + {0, (void *) 0} +}; + +/* This works around a problem in FreeBSD linker */ +#ifdef FREEBSD_WORKAROUND +static const void *lt_preloaded_setup() { + return lt__PROGRAM__LTX_preloaded_symbols; +} +#endif + +#ifdef __cplusplus +} +#endif +_LT_EOF + # Now try linking the two files. + mv conftest.$ac_objext conftstm.$ac_objext + lt_save_LIBS="$LIBS" + lt_save_CFLAGS="$CFLAGS" + LIBS="conftstm.$ac_objext" + CFLAGS="$CFLAGS$lt_prog_compiler_no_builtin_flag" + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 + (eval $ac_link) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s conftest${ac_exeext}; then + pipe_works=yes + fi + LIBS="$lt_save_LIBS" + CFLAGS="$lt_save_CFLAGS" + else + echo "cannot find nm_test_func in $nlist" >&5 + fi + else + echo "cannot find nm_test_var in $nlist" >&5 + fi + else + echo "cannot run $lt_cv_sys_global_symbol_pipe" >&5 + fi + else + echo "$progname: failed program was:" >&5 + cat conftest.$ac_ext >&5 + fi + rm -rf conftest* conftst* + + # Do not use the global_symbol_pipe unless it works. + if test "$pipe_works" = yes; then + break + else + lt_cv_sys_global_symbol_pipe= + fi +done + +fi + +if test -z "$lt_cv_sys_global_symbol_pipe"; then + lt_cv_sys_global_symbol_to_cdecl= +fi +if test -z "$lt_cv_sys_global_symbol_pipe$lt_cv_sys_global_symbol_to_cdecl"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: failed" >&5 +$as_echo "failed" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 +$as_echo "ok" >&6; } +fi + + + + + + + + + + + + + + + + + + + + + + +# Check whether --enable-libtool-lock was given. +if test "${enable_libtool_lock+set}" = set; then : + enableval=$enable_libtool_lock; +fi + +test "x$enable_libtool_lock" != xno && enable_libtool_lock=yes + +# Some flags need to be propagated to the compiler or linker for good +# libtool support. +case $host in +ia64-*-hpux*) + # Find out which ABI we are using. + echo 'int i;' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + case `/usr/bin/file conftest.$ac_objext` in + *ELF-32*) + HPUX_IA64_MODE="32" + ;; + *ELF-64*) + HPUX_IA64_MODE="64" + ;; + esac + fi + rm -rf conftest* + ;; +*-*-irix6*) + # Find out which ABI we are using. + echo '#line '$LINENO' "configure"' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + if test "$lt_cv_prog_gnu_ld" = yes; then + case `/usr/bin/file conftest.$ac_objext` in + *32-bit*) + LD="${LD-ld} -melf32bsmip" + ;; + *N32*) + LD="${LD-ld} -melf32bmipn32" + ;; + *64-bit*) + LD="${LD-ld} -melf64bmip" + ;; + esac + else + case `/usr/bin/file conftest.$ac_objext` in + *32-bit*) + LD="${LD-ld} -32" + ;; + *N32*) + LD="${LD-ld} -n32" + ;; + *64-bit*) + LD="${LD-ld} -64" + ;; + esac + fi + fi + rm -rf conftest* + ;; + +x86_64-*kfreebsd*-gnu|x86_64-*linux*|powerpc*-*linux*| \ +s390*-*linux*|s390*-*tpf*|sparc*-*linux*) + # Find out which ABI we are using. + echo 'int i;' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + case `/usr/bin/file conftest.o` in + *32-bit*) + case $host in + x86_64-*kfreebsd*-gnu) + LD="${LD-ld} -m elf_i386_fbsd" + ;; + x86_64-*linux*) + case `/usr/bin/file conftest.o` in + *x86-64*) + LD="${LD-ld} -m elf32_x86_64" + ;; + *) + LD="${LD-ld} -m elf_i386" + ;; + esac + ;; + powerpc64le-*linux*) + LD="${LD-ld} -m elf32lppclinux" + ;; + powerpc64-*linux*) + LD="${LD-ld} -m elf32ppclinux" + ;; + s390x-*linux*) + LD="${LD-ld} -m elf_s390" + ;; + sparc64-*linux*) + LD="${LD-ld} -m elf32_sparc" + ;; + esac + ;; + *64-bit*) + case $host in + x86_64-*kfreebsd*-gnu) + LD="${LD-ld} -m elf_x86_64_fbsd" + ;; + x86_64-*linux*) + LD="${LD-ld} -m elf_x86_64" + ;; + powerpcle-*linux*) + LD="${LD-ld} -m elf64lppc" + ;; + powerpc-*linux*) + LD="${LD-ld} -m elf64ppc" + ;; + s390*-*linux*|s390*-*tpf*) + LD="${LD-ld} -m elf64_s390" + ;; + sparc*-*linux*) + LD="${LD-ld} -m elf64_sparc" + ;; + esac + ;; + esac + fi + rm -rf conftest* + ;; + +*-*-sco3.2v5*) + # On SCO OpenServer 5, we need -belf to get full-featured binaries. + SAVE_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS -belf" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler needs -belf" >&5 +$as_echo_n "checking whether the C compiler needs -belf... " >&6; } +if ${lt_cv_cc_needs_belf+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + lt_cv_cc_needs_belf=yes +else + lt_cv_cc_needs_belf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_cc_needs_belf" >&5 +$as_echo "$lt_cv_cc_needs_belf" >&6; } + if test x"$lt_cv_cc_needs_belf" != x"yes"; then + # this is probably gcc 2.8.0, egcs 1.0 or newer; no need for -belf + CFLAGS="$SAVE_CFLAGS" + fi + ;; +sparc*-*solaris*) + # Find out which ABI we are using. + echo 'int i;' > conftest.$ac_ext + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then + case `/usr/bin/file conftest.o` in + *64-bit*) + case $lt_cv_prog_gnu_ld in + yes*) LD="${LD-ld} -m elf64_sparc" ;; + *) + if ${LD-ld} -64 -r -o conftest2.o conftest.o >/dev/null 2>&1; then + LD="${LD-ld} -64" + fi + ;; + esac + ;; + esac + fi + rm -rf conftest* + ;; +esac + +need_locks="$enable_libtool_lock" + + + case $host_os in + rhapsody* | darwin*) + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}dsymutil", so it can be a program name with args. +set dummy ${ac_tool_prefix}dsymutil; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_DSYMUTIL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$DSYMUTIL"; then + ac_cv_prog_DSYMUTIL="$DSYMUTIL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_DSYMUTIL="${ac_tool_prefix}dsymutil" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +DSYMUTIL=$ac_cv_prog_DSYMUTIL +if test -n "$DSYMUTIL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DSYMUTIL" >&5 +$as_echo "$DSYMUTIL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_DSYMUTIL"; then + ac_ct_DSYMUTIL=$DSYMUTIL + # Extract the first word of "dsymutil", so it can be a program name with args. +set dummy dsymutil; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_DSYMUTIL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_DSYMUTIL"; then + ac_cv_prog_ac_ct_DSYMUTIL="$ac_ct_DSYMUTIL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_DSYMUTIL="dsymutil" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_DSYMUTIL=$ac_cv_prog_ac_ct_DSYMUTIL +if test -n "$ac_ct_DSYMUTIL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_DSYMUTIL" >&5 +$as_echo "$ac_ct_DSYMUTIL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_DSYMUTIL" = x; then + DSYMUTIL=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + DSYMUTIL=$ac_ct_DSYMUTIL + fi +else + DSYMUTIL="$ac_cv_prog_DSYMUTIL" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}nmedit", so it can be a program name with args. +set dummy ${ac_tool_prefix}nmedit; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_NMEDIT+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$NMEDIT"; then + ac_cv_prog_NMEDIT="$NMEDIT" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_NMEDIT="${ac_tool_prefix}nmedit" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +NMEDIT=$ac_cv_prog_NMEDIT +if test -n "$NMEDIT"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $NMEDIT" >&5 +$as_echo "$NMEDIT" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_NMEDIT"; then + ac_ct_NMEDIT=$NMEDIT + # Extract the first word of "nmedit", so it can be a program name with args. +set dummy nmedit; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_NMEDIT+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_NMEDIT"; then + ac_cv_prog_ac_ct_NMEDIT="$ac_ct_NMEDIT" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_NMEDIT="nmedit" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_NMEDIT=$ac_cv_prog_ac_ct_NMEDIT +if test -n "$ac_ct_NMEDIT"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_NMEDIT" >&5 +$as_echo "$ac_ct_NMEDIT" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_NMEDIT" = x; then + NMEDIT=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + NMEDIT=$ac_ct_NMEDIT + fi +else + NMEDIT="$ac_cv_prog_NMEDIT" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}lipo", so it can be a program name with args. +set dummy ${ac_tool_prefix}lipo; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_LIPO+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$LIPO"; then + ac_cv_prog_LIPO="$LIPO" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_LIPO="${ac_tool_prefix}lipo" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +LIPO=$ac_cv_prog_LIPO +if test -n "$LIPO"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIPO" >&5 +$as_echo "$LIPO" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_LIPO"; then + ac_ct_LIPO=$LIPO + # Extract the first word of "lipo", so it can be a program name with args. +set dummy lipo; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_LIPO+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_LIPO"; then + ac_cv_prog_ac_ct_LIPO="$ac_ct_LIPO" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_LIPO="lipo" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_LIPO=$ac_cv_prog_ac_ct_LIPO +if test -n "$ac_ct_LIPO"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_LIPO" >&5 +$as_echo "$ac_ct_LIPO" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_LIPO" = x; then + LIPO=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + LIPO=$ac_ct_LIPO + fi +else + LIPO="$ac_cv_prog_LIPO" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}otool", so it can be a program name with args. +set dummy ${ac_tool_prefix}otool; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_OTOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$OTOOL"; then + ac_cv_prog_OTOOL="$OTOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_OTOOL="${ac_tool_prefix}otool" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +OTOOL=$ac_cv_prog_OTOOL +if test -n "$OTOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL" >&5 +$as_echo "$OTOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_OTOOL"; then + ac_ct_OTOOL=$OTOOL + # Extract the first word of "otool", so it can be a program name with args. +set dummy otool; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_OTOOL+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_OTOOL"; then + ac_cv_prog_ac_ct_OTOOL="$ac_ct_OTOOL" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_OTOOL="otool" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_OTOOL=$ac_cv_prog_ac_ct_OTOOL +if test -n "$ac_ct_OTOOL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL" >&5 +$as_echo "$ac_ct_OTOOL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_OTOOL" = x; then + OTOOL=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + OTOOL=$ac_ct_OTOOL + fi +else + OTOOL="$ac_cv_prog_OTOOL" +fi + + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}otool64", so it can be a program name with args. +set dummy ${ac_tool_prefix}otool64; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_OTOOL64+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$OTOOL64"; then + ac_cv_prog_OTOOL64="$OTOOL64" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_OTOOL64="${ac_tool_prefix}otool64" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +OTOOL64=$ac_cv_prog_OTOOL64 +if test -n "$OTOOL64"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OTOOL64" >&5 +$as_echo "$OTOOL64" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_OTOOL64"; then + ac_ct_OTOOL64=$OTOOL64 + # Extract the first word of "otool64", so it can be a program name with args. +set dummy otool64; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_OTOOL64+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_OTOOL64"; then + ac_cv_prog_ac_ct_OTOOL64="$ac_ct_OTOOL64" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_OTOOL64="otool64" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_OTOOL64=$ac_cv_prog_ac_ct_OTOOL64 +if test -n "$ac_ct_OTOOL64"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_OTOOL64" >&5 +$as_echo "$ac_ct_OTOOL64" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_OTOOL64" = x; then + OTOOL64=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + OTOOL64=$ac_ct_OTOOL64 + fi +else + OTOOL64="$ac_cv_prog_OTOOL64" +fi + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -single_module linker flag" >&5 +$as_echo_n "checking for -single_module linker flag... " >&6; } +if ${lt_cv_apple_cc_single_mod+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_apple_cc_single_mod=no + if test -z "${LT_MULTI_MODULE}"; then + # By default we will add the -single_module flag. You can override + # by either setting the environment variable LT_MULTI_MODULE + # non-empty at configure time, or by adding -multi_module to the + # link flags. + rm -rf libconftest.dylib* + echo "int foo(void){return 1;}" > conftest.c + echo "$LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ +-dynamiclib -Wl,-single_module conftest.c" >&5 + $LTCC $LTCFLAGS $LDFLAGS -o libconftest.dylib \ + -dynamiclib -Wl,-single_module conftest.c 2>conftest.err + _lt_result=$? + if test -f libconftest.dylib && test ! -s conftest.err && test $_lt_result = 0; then + lt_cv_apple_cc_single_mod=yes + else + cat conftest.err >&5 + fi + rm -rf libconftest.dylib* + rm -f conftest.* + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_apple_cc_single_mod" >&5 +$as_echo "$lt_cv_apple_cc_single_mod" >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -exported_symbols_list linker flag" >&5 +$as_echo_n "checking for -exported_symbols_list linker flag... " >&6; } +if ${lt_cv_ld_exported_symbols_list+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_ld_exported_symbols_list=no + save_LDFLAGS=$LDFLAGS + echo "_main" > conftest.sym + LDFLAGS="$LDFLAGS -Wl,-exported_symbols_list,conftest.sym" + if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + lt_cv_ld_exported_symbols_list=yes +else + lt_cv_ld_exported_symbols_list=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS="$save_LDFLAGS" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_exported_symbols_list" >&5 +$as_echo "$lt_cv_ld_exported_symbols_list" >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -force_load linker flag" >&5 +$as_echo_n "checking for -force_load linker flag... " >&6; } +if ${lt_cv_ld_force_load+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_ld_force_load=no + cat > conftest.c << _LT_EOF +int forced_loaded() { return 2;} +_LT_EOF + echo "$LTCC $LTCFLAGS -c -o conftest.o conftest.c" >&5 + $LTCC $LTCFLAGS -c -o conftest.o conftest.c 2>&5 + echo "$AR cru libconftest.a conftest.o" >&5 + $AR cru libconftest.a conftest.o 2>&5 + cat > conftest.c << _LT_EOF +int main() { return 0;} +_LT_EOF + echo "$LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a" >&5 + $LTCC $LTCFLAGS $LDFLAGS -o conftest conftest.c -Wl,-force_load,./libconftest.a 2>conftest.err + _lt_result=$? + if test -f conftest && test ! -s conftest.err && test $_lt_result = 0 && $GREP forced_load conftest 2>&1 >/dev/null; then + lt_cv_ld_force_load=yes + else + cat conftest.err >&5 + fi + rm -f conftest.err libconftest.a conftest conftest.c + rm -rf conftest.dSYM + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_ld_force_load" >&5 +$as_echo "$lt_cv_ld_force_load" >&6; } + # Allow for Darwin 4-7 (macOS 10.0-10.3) although these are not expect to + # build without first building modern cctools / linker. + case $host_cpu-$host_os in + *-rhapsody* | *-darwin1.[012]) + _lt_dar_allow_undefined='${wl}-undefined ${wl}suppress' ;; + *-darwin1.*) + _lt_dar_allow_undefined='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' ;; + *-darwin*) + # darwin 5.x (macOS 10.1) onwards we only need to adjust when the + # deployment target is forced to an earlier version. + case ${MACOSX_DEPLOYMENT_TARGET-UNSET},$host in + UNSET,*-darwin[89]*|UNSET,*-darwin[12][0-9]*) + ;; + 10.[012][,.]*) + _lt_dar_allow_undefined='${wl}-flat_namespace ${wl}-undefined ${wl}suppress' + ;; + *) + ;; + esac + ;; + esac + if test "$lt_cv_apple_cc_single_mod" = "yes"; then + _lt_dar_single_mod='$single_module' + fi + if test "$lt_cv_ld_exported_symbols_list" = "yes"; then + _lt_dar_export_syms=' ${wl}-exported_symbols_list,$output_objdir/${libname}-symbols.expsym' + else + _lt_dar_export_syms='~$NMEDIT -s $output_objdir/${libname}-symbols.expsym ${lib}' + fi + if test "$DSYMUTIL" != ":" && test "$lt_cv_ld_force_load" = "no"; then + _lt_dsymutil='~$DSYMUTIL $lib || :' + else + _lt_dsymutil= + fi + ;; + esac + +for ac_header in dlfcn.h +do : + ac_fn_c_check_header_compile "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default +" +if test "x$ac_cv_header_dlfcn_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_DLFCN_H 1 +_ACEOF + +fi + +done + + + + + +# Set options + + + + enable_dlopen=no + + + enable_win32_dll=no + + + # Check whether --enable-shared was given. +if test "${enable_shared+set}" = set; then : + enableval=$enable_shared; p=${PACKAGE-default} + case $enableval in + yes) enable_shared=yes ;; + no) enable_shared=no ;; + *) + enable_shared=no + # Look at the argument we got. We use all the common list separators. + lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," + for pkg in $enableval; do + IFS="$lt_save_ifs" + if test "X$pkg" = "X$p"; then + enable_shared=yes + fi + done + IFS="$lt_save_ifs" + ;; + esac +else + enable_shared=yes +fi + + + + + + + + + + # Check whether --enable-static was given. +if test "${enable_static+set}" = set; then : + enableval=$enable_static; p=${PACKAGE-default} + case $enableval in + yes) enable_static=yes ;; + no) enable_static=no ;; + *) + enable_static=no + # Look at the argument we got. We use all the common list separators. + lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," + for pkg in $enableval; do + IFS="$lt_save_ifs" + if test "X$pkg" = "X$p"; then + enable_static=yes + fi + done + IFS="$lt_save_ifs" + ;; + esac +else + enable_static=yes +fi + + + + + + + + + + +# Check whether --with-pic was given. +if test "${with_pic+set}" = set; then : + withval=$with_pic; pic_mode="$withval" +else + pic_mode=default +fi + + +test -z "$pic_mode" && pic_mode=default + + + + + + + + # Check whether --enable-fast-install was given. +if test "${enable_fast_install+set}" = set; then : + enableval=$enable_fast_install; p=${PACKAGE-default} + case $enableval in + yes) enable_fast_install=yes ;; + no) enable_fast_install=no ;; + *) + enable_fast_install=no + # Look at the argument we got. We use all the common list separators. + lt_save_ifs="$IFS"; IFS="${IFS}$PATH_SEPARATOR," + for pkg in $enableval; do + IFS="$lt_save_ifs" + if test "X$pkg" = "X$p"; then + enable_fast_install=yes + fi + done + IFS="$lt_save_ifs" + ;; + esac +else + enable_fast_install=yes +fi + + + + + + + + + + + +# This can be used to rebuild libtool when needed +LIBTOOL_DEPS="$ltmain" + +# Always use our own libtool. +LIBTOOL='$(SHELL) $(top_builddir)/libtool' + + + + + + + + + + + + + + + + + + + + + + + + + + +test -z "$LN_S" && LN_S="ln -s" + + + + + + + + + + + + + + +if test -n "${ZSH_VERSION+set}" ; then + setopt NO_GLOB_SUBST +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for objdir" >&5 +$as_echo_n "checking for objdir... " >&6; } +if ${lt_cv_objdir+:} false; then : + $as_echo_n "(cached) " >&6 +else + rm -f .libs 2>/dev/null +mkdir .libs 2>/dev/null +if test -d .libs; then + lt_cv_objdir=.libs +else + # MS-DOS does not allow filenames that begin with a dot. + lt_cv_objdir=_libs +fi +rmdir .libs 2>/dev/null +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_objdir" >&5 +$as_echo "$lt_cv_objdir" >&6; } +objdir=$lt_cv_objdir + + + + + +cat >>confdefs.h <<_ACEOF +#define LT_OBJDIR "$lt_cv_objdir/" +_ACEOF + + + + +case $host_os in +aix3*) + # AIX sometimes has problems with the GCC collect2 program. For some + # reason, if we set the COLLECT_NAMES environment variable, the problems + # vanish in a puff of smoke. + if test "X${COLLECT_NAMES+set}" != Xset; then + COLLECT_NAMES= + export COLLECT_NAMES + fi + ;; +esac + +# Global variables: +ofile=libtool +can_build_shared=yes + +# All known linkers require a `.a' archive for static linking (except MSVC, +# which needs '.lib'). +libext=a + +with_gnu_ld="$lt_cv_prog_gnu_ld" + +old_CC="$CC" +old_CFLAGS="$CFLAGS" + +# Set sane defaults for various variables +test -z "$CC" && CC=cc +test -z "$LTCC" && LTCC=$CC +test -z "$LTCFLAGS" && LTCFLAGS=$CFLAGS +test -z "$LD" && LD=ld +test -z "$ac_objext" && ac_objext=o + +for cc_temp in $compiler""; do + case $cc_temp in + compile | *[\\/]compile | ccache | *[\\/]ccache ) ;; + distcc | *[\\/]distcc | purify | *[\\/]purify ) ;; + \-*) ;; + *) break;; + esac +done +cc_basename=`$ECHO "$cc_temp" | $SED "s%.*/%%; s%^$host_alias-%%"` + + +# Only perform the check for file, if the check method requires it +test -z "$MAGIC_CMD" && MAGIC_CMD=file +case $deplibs_check_method in +file_magic*) + if test "$file_magic_cmd" = '$MAGIC_CMD'; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${ac_tool_prefix}file" >&5 +$as_echo_n "checking for ${ac_tool_prefix}file... " >&6; } +if ${lt_cv_path_MAGIC_CMD+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $MAGIC_CMD in +[\\/*] | ?:[\\/]*) + lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path. + ;; +*) + lt_save_MAGIC_CMD="$MAGIC_CMD" + lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR + ac_dummy="/usr/bin$PATH_SEPARATOR$PATH" + for ac_dir in $ac_dummy; do + IFS="$lt_save_ifs" + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/${ac_tool_prefix}file; then + lt_cv_path_MAGIC_CMD="$ac_dir/${ac_tool_prefix}file" + if test -n "$file_magic_test_file"; then + case $deplibs_check_method in + "file_magic "*) + file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"` + MAGIC_CMD="$lt_cv_path_MAGIC_CMD" + if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null | + $EGREP "$file_magic_regex" > /dev/null; then + : + else + cat <<_LT_EOF 1>&2 + +*** Warning: the command libtool uses to detect shared libraries, +*** $file_magic_cmd, produces output that libtool cannot recognize. +*** The result is that libtool may fail to recognize shared libraries +*** as such. This will affect the creation of libtool libraries that +*** depend on shared libraries, but programs linked with such libtool +*** libraries will work regardless of this problem. Nevertheless, you +*** may want to report the problem to your system manager and/or to +*** bug-libtool@gnu.org + +_LT_EOF + fi ;; + esac + fi + break + fi + done + IFS="$lt_save_ifs" + MAGIC_CMD="$lt_save_MAGIC_CMD" + ;; +esac +fi + +MAGIC_CMD="$lt_cv_path_MAGIC_CMD" +if test -n "$MAGIC_CMD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5 +$as_echo "$MAGIC_CMD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + + + +if test -z "$lt_cv_path_MAGIC_CMD"; then + if test -n "$ac_tool_prefix"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for file" >&5 +$as_echo_n "checking for file... " >&6; } +if ${lt_cv_path_MAGIC_CMD+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $MAGIC_CMD in +[\\/*] | ?:[\\/]*) + lt_cv_path_MAGIC_CMD="$MAGIC_CMD" # Let the user override the test with a path. + ;; +*) + lt_save_MAGIC_CMD="$MAGIC_CMD" + lt_save_ifs="$IFS"; IFS=$PATH_SEPARATOR + ac_dummy="/usr/bin$PATH_SEPARATOR$PATH" + for ac_dir in $ac_dummy; do + IFS="$lt_save_ifs" + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/file; then + lt_cv_path_MAGIC_CMD="$ac_dir/file" + if test -n "$file_magic_test_file"; then + case $deplibs_check_method in + "file_magic "*) + file_magic_regex=`expr "$deplibs_check_method" : "file_magic \(.*\)"` + MAGIC_CMD="$lt_cv_path_MAGIC_CMD" + if eval $file_magic_cmd \$file_magic_test_file 2> /dev/null | + $EGREP "$file_magic_regex" > /dev/null; then + : + else + cat <<_LT_EOF 1>&2 + +*** Warning: the command libtool uses to detect shared libraries, +*** $file_magic_cmd, produces output that libtool cannot recognize. +*** The result is that libtool may fail to recognize shared libraries +*** as such. This will affect the creation of libtool libraries that +*** depend on shared libraries, but programs linked with such libtool +*** libraries will work regardless of this problem. Nevertheless, you +*** may want to report the problem to your system manager and/or to +*** bug-libtool@gnu.org + +_LT_EOF + fi ;; + esac + fi + break + fi + done + IFS="$lt_save_ifs" + MAGIC_CMD="$lt_save_MAGIC_CMD" + ;; +esac +fi + +MAGIC_CMD="$lt_cv_path_MAGIC_CMD" +if test -n "$MAGIC_CMD"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $MAGIC_CMD" >&5 +$as_echo "$MAGIC_CMD" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + else + MAGIC_CMD=: + fi +fi + + fi + ;; +esac + +# Use C for the default configuration in the libtool script + +lt_save_CC="$CC" +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +# Source file extension for C test sources. +ac_ext=c + +# Object file extension for compiled C test sources. +objext=o +objext=$objext + +# Code to be used in simple compile tests +lt_simple_compile_test_code="int some_variable = 0;" + +# Code to be used in simple link tests +lt_simple_link_test_code='int main(){return(0);}' + + + + + + + +# If no C compiler was specified, use CC. +LTCC=${LTCC-"$CC"} + +# If no C compiler flags were specified, use CFLAGS. +LTCFLAGS=${LTCFLAGS-"$CFLAGS"} + +# Allow CC to be a program name with arguments. +compiler=$CC + +# Save the default compiler, since it gets overwritten when the other +# tags are being tested, and _LT_TAGVAR(compiler, []) is a NOP. +compiler_DEFAULT=$CC + +# save warnings/boilerplate of simple test code +ac_outfile=conftest.$ac_objext +echo "$lt_simple_compile_test_code" >conftest.$ac_ext +eval "$ac_compile" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_compiler_boilerplate=`cat conftest.err` +$RM conftest* + +ac_outfile=conftest.$ac_objext +echo "$lt_simple_link_test_code" >conftest.$ac_ext +eval "$ac_link" 2>&1 >/dev/null | $SED '/^$/d; /^ *+/d' >conftest.err +_lt_linker_boilerplate=`cat conftest.err` +$RM -r conftest* + + +## CAVEAT EMPTOR: +## There is no encapsulation within the following macros, do not change +## the running order or otherwise move them around unless you know exactly +## what you are doing... +if test -n "$compiler"; then + +lt_prog_compiler_no_builtin_flag= + +if test "$GCC" = yes; then + case $cc_basename in + nvcc*) + lt_prog_compiler_no_builtin_flag=' -Xcompiler -fno-builtin' ;; + *) + lt_prog_compiler_no_builtin_flag=' -fno-builtin' ;; + esac + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -fno-rtti -fno-exceptions" >&5 +$as_echo_n "checking if $compiler supports -fno-rtti -fno-exceptions... " >&6; } +if ${lt_cv_prog_compiler_rtti_exceptions+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_rtti_exceptions=no + ac_outfile=conftest.$ac_objext + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + lt_compiler_flag="-fno-rtti -fno-exceptions" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + # The option is referenced via a variable to avoid confusing sed. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>conftest.err) + ac_status=$? + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s "$ac_outfile"; then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings other than the usual output. + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_rtti_exceptions=yes + fi + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_rtti_exceptions" >&5 +$as_echo "$lt_cv_prog_compiler_rtti_exceptions" >&6; } + +if test x"$lt_cv_prog_compiler_rtti_exceptions" = xyes; then + lt_prog_compiler_no_builtin_flag="$lt_prog_compiler_no_builtin_flag -fno-rtti -fno-exceptions" +else + : +fi + +fi + + + + + + + lt_prog_compiler_wl= +lt_prog_compiler_pic= +lt_prog_compiler_static= + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $compiler option to produce PIC" >&5 +$as_echo_n "checking for $compiler option to produce PIC... " >&6; } + + if test "$GCC" = yes; then + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_static='-static' + + case $host_os in + aix*) + # All AIX code is PIC. + if test "$host_cpu" = ia64; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static='-Bstatic' + fi + lt_prog_compiler_pic='-fPIC' + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + lt_prog_compiler_pic='-fPIC' + ;; + m68k) + # FIXME: we need at least 68020 code to build shared libraries, but + # adding the `-m68020' flag to GCC prevents building anything better, + # like `-m68040'. + lt_prog_compiler_pic='-m68020 -resident32 -malways-restore-a4' + ;; + esac + ;; + + beos* | irix5* | irix6* | nonstopux* | osf3* | osf4* | osf5*) + # PIC is the default for these OSes. + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + # Although the cygwin gcc ignores -fPIC, still need this for old-style + # (--disable-auto-import) libraries + lt_prog_compiler_pic='-DDLL_EXPORT' + ;; + + darwin* | rhapsody*) + # PIC is the default on this platform + # Common symbols not allowed in MH_DYLIB files + lt_prog_compiler_pic='-fno-common' + ;; + + haiku*) + # PIC is the default for Haiku. + # The "-static" flag exists, but is broken. + lt_prog_compiler_static= + ;; + + hpux*) + # PIC is the default for 64-bit PA HP-UX, but not for 32-bit + # PA HP-UX. On IA64 HP-UX, PIC is the default but the pic flag + # sets the default TLS model and affects inlining. + case $host_cpu in + hppa*64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic='-fPIC' + ;; + esac + ;; + + interix[3-9]*) + # Interix 3.x gcc -fpic/-fPIC options generate broken code. + # Instead, we relocate shared libraries at runtime. + ;; + + msdosdjgpp*) + # Just because we use GCC doesn't mean we suddenly get shared libraries + # on systems that don't support them. + lt_prog_compiler_can_build_shared=no + enable_shared=no + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic='-fPIC -shared' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + lt_prog_compiler_pic=-Kconform_pic + fi + ;; + + *) + lt_prog_compiler_pic='-fPIC' + ;; + esac + + case $cc_basename in + nvcc*) # Cuda Compiler Driver 2.2 + lt_prog_compiler_wl='-Xlinker ' + lt_prog_compiler_pic='-Xcompiler -fPIC' + ;; + esac + else + # PORTME Check for flag to pass linker flags through the system compiler. + case $host_os in + aix*) + lt_prog_compiler_wl='-Wl,' + if test "$host_cpu" = ia64; then + # AIX 5 now supports IA64 processor + lt_prog_compiler_static='-Bstatic' + else + lt_prog_compiler_static='-bnso -bI:/lib/syscalls.exp' + fi + ;; + + mingw* | cygwin* | pw32* | os2* | cegcc*) + # This hack is so that the source file can tell whether it is being + # built for inclusion in a dll (and should export symbols for example). + lt_prog_compiler_pic='-DDLL_EXPORT' + ;; + + hpux9* | hpux10* | hpux11*) + lt_prog_compiler_wl='-Wl,' + # PIC is the default for IA64 HP-UX and 64-bit HP-UX, but + # not for PA HP-UX. + case $host_cpu in + hppa*64*|ia64*) + # +Z the default + ;; + *) + lt_prog_compiler_pic='+Z' + ;; + esac + # Is there a better lt_prog_compiler_static that works with the bundled CC? + lt_prog_compiler_static='${wl}-a ${wl}archive' + ;; + + irix5* | irix6* | nonstopux*) + lt_prog_compiler_wl='-Wl,' + # PIC (with -KPIC) is the default. + lt_prog_compiler_static='-non_shared' + ;; + + linux* | k*bsd*-gnu | kopensolaris*-gnu) + case $cc_basename in + # old Intel for x86_64 which still supported -KPIC. + ecc*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-static' + ;; + # icc used to be incompatible with GCC. + # ICC 10 doesn't accept -KPIC any more. + icc* | ifort*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-fPIC' + lt_prog_compiler_static='-static' + ;; + # Lahey Fortran 8.1. + lf95*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='--shared' + lt_prog_compiler_static='--static' + ;; + pgcc* | pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group compilers (*not* the Pentium gcc compiler, + # which looks to be a dead project) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-fpic' + lt_prog_compiler_static='-Bstatic' + ;; + ccc*) + lt_prog_compiler_wl='-Wl,' + # All Alpha code is PIC. + lt_prog_compiler_static='-non_shared' + ;; + xl* | bgxl* | bgf* | mpixl*) + # IBM XL C 8.0/Fortran 10.1, 11.1 on PPC and BlueGene + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-qpic' + lt_prog_compiler_static='-qstaticlink' + ;; + *) + case `$CC -V 2>&1 | sed 5q` in + *Sun\ F* | *Sun*Fortran*) + # Sun Fortran 8.3 passes all unrecognized flags to the linker + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + lt_prog_compiler_wl='' + ;; + *Sun\ C*) + # Sun C 5.9 + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + lt_prog_compiler_wl='-Wl,' + ;; + esac + ;; + esac + ;; + + newsos6) + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + ;; + + *nto* | *qnx*) + # QNX uses GNU C++, but need to define -shared option too, otherwise + # it will coredump. + lt_prog_compiler_pic='-fPIC -shared' + ;; + + osf3* | osf4* | osf5*) + lt_prog_compiler_wl='-Wl,' + # All OSF/1 code is PIC. + lt_prog_compiler_static='-non_shared' + ;; + + rdos*) + lt_prog_compiler_static='-non_shared' + ;; + + solaris*) + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + case $cc_basename in + f77* | f90* | f95*) + lt_prog_compiler_wl='-Qoption ld ';; + *) + lt_prog_compiler_wl='-Wl,';; + esac + ;; + + sunos4*) + lt_prog_compiler_wl='-Qoption ld ' + lt_prog_compiler_pic='-PIC' + lt_prog_compiler_static='-Bstatic' + ;; + + sysv4 | sysv4.2uw2* | sysv4.3*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + ;; + + sysv4*MP*) + if test -d /usr/nec ;then + lt_prog_compiler_pic='-Kconform_pic' + lt_prog_compiler_static='-Bstatic' + fi + ;; + + sysv5* | unixware* | sco3.2v5* | sco5v6* | OpenUNIX*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_pic='-KPIC' + lt_prog_compiler_static='-Bstatic' + ;; + + unicos*) + lt_prog_compiler_wl='-Wl,' + lt_prog_compiler_can_build_shared=no + ;; + + uts4*) + lt_prog_compiler_pic='-pic' + lt_prog_compiler_static='-Bstatic' + ;; + + *) + lt_prog_compiler_can_build_shared=no + ;; + esac + fi + +case $host_os in + # For platforms which do not support PIC, -DPIC is meaningless: + *djgpp*) + lt_prog_compiler_pic= + ;; + *) + lt_prog_compiler_pic="$lt_prog_compiler_pic -DPIC" + ;; +esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_prog_compiler_pic" >&5 +$as_echo "$lt_prog_compiler_pic" >&6; } + + + + + + +# +# Check to make sure the PIC flag actually works. +# +if test -n "$lt_prog_compiler_pic"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler PIC flag $lt_prog_compiler_pic works" >&5 +$as_echo_n "checking if $compiler PIC flag $lt_prog_compiler_pic works... " >&6; } +if ${lt_cv_prog_compiler_pic_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_pic_works=no + ac_outfile=conftest.$ac_objext + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + lt_compiler_flag="$lt_prog_compiler_pic -DPIC" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + # The option is referenced via a variable to avoid confusing sed. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>conftest.err) + ac_status=$? + cat conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s "$ac_outfile"; then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings other than the usual output. + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' >conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if test ! -s conftest.er2 || diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_pic_works=yes + fi + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_pic_works" >&5 +$as_echo "$lt_cv_prog_compiler_pic_works" >&6; } + +if test x"$lt_cv_prog_compiler_pic_works" = xyes; then + case $lt_prog_compiler_pic in + "" | " "*) ;; + *) lt_prog_compiler_pic=" $lt_prog_compiler_pic" ;; + esac +else + lt_prog_compiler_pic= + lt_prog_compiler_can_build_shared=no +fi + +fi + + + + + + +# +# Check to make sure the static flag actually works. +# +wl=$lt_prog_compiler_wl eval lt_tmp_static_flag=\"$lt_prog_compiler_static\" +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler static flag $lt_tmp_static_flag works" >&5 +$as_echo_n "checking if $compiler static flag $lt_tmp_static_flag works... " >&6; } +if ${lt_cv_prog_compiler_static_works+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_static_works=no + save_LDFLAGS="$LDFLAGS" + LDFLAGS="$LDFLAGS $lt_tmp_static_flag" + echo "$lt_simple_link_test_code" > conftest.$ac_ext + if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then + # The linker can only warn and ignore the option if not recognized + # So say no if there are warnings + if test -s conftest.err; then + # Append any errors to the config.log. + cat conftest.err 1>&5 + $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler_static_works=yes + fi + else + lt_cv_prog_compiler_static_works=yes + fi + fi + $RM -r conftest* + LDFLAGS="$save_LDFLAGS" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_static_works" >&5 +$as_echo "$lt_cv_prog_compiler_static_works" >&6; } + +if test x"$lt_cv_prog_compiler_static_works" = xyes; then + : +else + lt_prog_compiler_static= +fi + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5 +$as_echo "$lt_cv_prog_compiler_c_o" >&6; } + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $compiler supports -c -o file.$ac_objext" >&5 +$as_echo_n "checking if $compiler supports -c -o file.$ac_objext... " >&6; } +if ${lt_cv_prog_compiler_c_o+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler_c_o=no + $RM -r conftest 2>/dev/null + mkdir conftest + cd conftest + mkdir out + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + lt_compiler_flag="-o out/conftest2.$ac_objext" + # Insert the option either (1) after the last *FLAGS variable, or + # (2) before a word containing "conftest.", or (3) at the end. + # Note that $ac_compile itself does not contain backslashes and begins + # with a dollar sign (not a hyphen), so the echo should work correctly. + lt_compile=`echo "$ac_compile" | $SED \ + -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ + -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ + -e 's:$: $lt_compiler_flag:'` + (eval echo "\"\$as_me:$LINENO: $lt_compile\"" >&5) + (eval "$lt_compile" 2>out/conftest.err) + ac_status=$? + cat out/conftest.err >&5 + echo "$as_me:$LINENO: \$? = $ac_status" >&5 + if (exit $ac_status) && test -s out/conftest2.$ac_objext + then + # The compiler can only warn and ignore the option if not recognized + # So say no if there are warnings + $ECHO "$_lt_compiler_boilerplate" | $SED '/^$/d' > out/conftest.exp + $SED '/^$/d; /^ *+/d' out/conftest.err >out/conftest.er2 + if test ! -s out/conftest.er2 || diff out/conftest.exp out/conftest.er2 >/dev/null; then + lt_cv_prog_compiler_c_o=yes + fi + fi + chmod u+w . 2>&5 + $RM conftest* + # SGI C++ compiler will create directory out/ii_files/ for + # template instantiation + test -d out/ii_files && $RM out/ii_files/* && rmdir out/ii_files + $RM out/* && rmdir out + cd .. + $RM -r conftest + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler_c_o" >&5 +$as_echo "$lt_cv_prog_compiler_c_o" >&6; } + + + + +hard_links="nottested" +if test "$lt_cv_prog_compiler_c_o" = no && test "$need_locks" != no; then + # do not overwrite the value of need_locks provided by the user + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if we can lock with hard links" >&5 +$as_echo_n "checking if we can lock with hard links... " >&6; } + hard_links=yes + $RM conftest* + ln conftest.a conftest.b 2>/dev/null && hard_links=no + touch conftest.a + ln conftest.a conftest.b 2>&5 || hard_links=no + ln conftest.a conftest.b 2>/dev/null && hard_links=no + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $hard_links" >&5 +$as_echo "$hard_links" >&6; } + if test "$hard_links" = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&5 +$as_echo "$as_me: WARNING: \`$CC' does not support \`-c -o', so \`make -j' may be unsafe" >&2;} + need_locks=warn + fi +else + need_locks=no +fi + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the $compiler linker ($LD) supports shared libraries" >&5 +$as_echo_n "checking whether the $compiler linker ($LD) supports shared libraries... " >&6; } + + runpath_var= + allow_undefined_flag= + always_export_symbols=no + archive_cmds= + archive_expsym_cmds= + compiler_needs_object=no + enable_shared_with_static_runtimes=no + export_dynamic_flag_spec= + export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED '\''s/.* //'\'' | sort | uniq > $export_symbols' + hardcode_automatic=no + hardcode_direct=no + hardcode_direct_absolute=no + hardcode_libdir_flag_spec= + hardcode_libdir_flag_spec_ld= + hardcode_libdir_separator= + hardcode_minus_L=no + hardcode_shlibpath_var=unsupported + inherit_rpath=no + link_all_deplibs=unknown + module_cmds= + module_expsym_cmds= + old_archive_from_new_cmds= + old_archive_from_expsyms_cmds= + thread_safe_flag_spec= + whole_archive_flag_spec= + # include_expsyms should be a list of space-separated symbols to be *always* + # included in the symbol list + include_expsyms= + # exclude_expsyms can be an extended regexp of symbols to exclude + # it will be wrapped by ` (' and `)$', so one must not match beginning or + # end of line. Example: `a|bc|.*d.*' will exclude the symbols `a' and `bc', + # as well as any symbol that contains `d'. + exclude_expsyms='_GLOBAL_OFFSET_TABLE_|_GLOBAL__F[ID]_.*' + # Although _GLOBAL_OFFSET_TABLE_ is a valid symbol C name, most a.out + # platforms (ab)use it in PIC code, but their linkers get confused if + # the symbol is explicitly referenced. Since portable code cannot + # rely on this symbol name, it's probably fine to never include it in + # preloaded symbol tables. + # Exclude shared library initialization/finalization symbols. + extract_expsyms_cmds= + + case $host_os in + cygwin* | mingw* | pw32* | cegcc*) + # FIXME: the MSVC++ port hasn't been tested in a loooong time + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++. + if test "$GCC" != yes; then + with_gnu_ld=no + fi + ;; + interix*) + # we just hope/assume this is gcc and not c89 (= MSVC++) + with_gnu_ld=yes + ;; + openbsd*) + with_gnu_ld=no + ;; + esac + + ld_shlibs=yes + + # On some targets, GNU ld is compatible enough with the native linker + # that we're better off using the native interface for both. + lt_use_gnu_ld_interface=no + if test "$with_gnu_ld" = yes; then + case $host_os in + aix*) + # The AIX port of GNU ld has always aspired to compatibility + # with the native linker. However, as the warning in the GNU ld + # block says, versions before 2.19.5* couldn't really create working + # shared libraries, regardless of the interface used. + case `$LD -v 2>&1` in + *\ \(GNU\ Binutils\)\ 2.19.5*) ;; + *\ \(GNU\ Binutils\)\ 2.[2-9]*) ;; + *\ \(GNU\ Binutils\)\ [3-9]*) ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + ;; + *) + lt_use_gnu_ld_interface=yes + ;; + esac + fi + + if test "$lt_use_gnu_ld_interface" = yes; then + # If archive_cmds runs LD, not CC, wlarc should be empty + wlarc='${wl}' + + # Set some defaults for GNU ld with shared library support. These + # are reset later if shared libraries are not supported. Putting them + # here allows them to be overridden if necessary. + runpath_var=LD_RUN_PATH + hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' + export_dynamic_flag_spec='${wl}--export-dynamic' + # ancient GNU ld didn't support --whole-archive et. al. + if $LD --help 2>&1 | $GREP 'no-whole-archive' > /dev/null; then + whole_archive_flag_spec="$wlarc"'--whole-archive$convenience '"$wlarc"'--no-whole-archive' + else + whole_archive_flag_spec= + fi + supports_anon_versioning=no + case `$LD -v 2>&1` in + *GNU\ gold*) supports_anon_versioning=yes ;; + *\ [01].* | *\ 2.[0-9].* | *\ 2.10.*) ;; # catch versions < 2.11 + *\ 2.11.93.0.2\ *) supports_anon_versioning=yes ;; # RH7.3 ... + *\ 2.11.92.0.12\ *) supports_anon_versioning=yes ;; # Mandrake 8.2 ... + *\ 2.11.*) ;; # other 2.11 versions + *) supports_anon_versioning=yes ;; + esac + + # See if GNU ld supports shared libraries. + case $host_os in + aix[3-9]*) + # On AIX/PPC, the GNU linker is very broken + if test "$host_cpu" != ia64; then + ld_shlibs=no + cat <<_LT_EOF 1>&2 + +*** Warning: the GNU linker, at least up to release 2.19, is reported +*** to be unable to reliably create shared libraries on AIX. +*** Therefore, libtool is disabling shared libraries support. If you +*** really care for shared libraries, you may want to install binutils +*** 2.20 or above, or modify your PATH so that a non-GNU linker is found. +*** You will then need to restart the configuration process. + +_LT_EOF + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds='' + ;; + m68k) + archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + ;; + esac + ;; + + beos*) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + allow_undefined_flag=unsupported + # Joseph Beckenbach says some releases of gcc + # support --undefined. This deserves some investigation. FIXME + archive_cmds='$CC -nostart $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + else + ld_shlibs=no + fi + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # _LT_TAGVAR(hardcode_libdir_flag_spec, ) is actually meaningless, + # as there is no search path for DLLs. + hardcode_libdir_flag_spec='-L$libdir' + export_dynamic_flag_spec='${wl}--export-all-symbols' + allow_undefined_flag=unsupported + always_export_symbols=no + enable_shared_with_static_runtimes=yes + export_symbols_cmds='$NM $libobjs $convenience | $global_symbol_pipe | $SED -e '\''/^[BCDGRS][ ]/s/.*[ ]\([^ ]*\)/\1 DATA/'\'' | $SED -e '\''/^[AITW][ ]/s/.*[ ]//'\'' | sort | uniq > $export_symbols' + + if $LD --help 2>&1 | $GREP 'auto-import' > /dev/null; then + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + # If the export-symbols file already is a .def file (1st line + # is EXPORTS), use it as is; otherwise, prepend... + archive_expsym_cmds='if test "x`$SED 1q $export_symbols`" = xEXPORTS; then + cp $export_symbols $output_objdir/$soname.def; + else + echo EXPORTS > $output_objdir/$soname.def; + cat $export_symbols >> $output_objdir/$soname.def; + fi~ + $CC -shared $output_objdir/$soname.def $libobjs $deplibs $compiler_flags -o $output_objdir/$soname ${wl}--enable-auto-image-base -Xlinker --out-implib -Xlinker $lib' + else + ld_shlibs=no + fi + ;; + + haiku*) + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + link_all_deplibs=yes + ;; + + interix[3-9]*) + hardcode_direct=no + hardcode_shlibpath_var=no + hardcode_libdir_flag_spec='${wl}-rpath,$libdir' + export_dynamic_flag_spec='${wl}-E' + # Hack: On Interix 3.x, we cannot compile PIC because of a broken gcc. + # Instead, shared libraries are loaded at an image base (0x10000000 by + # default) and relocated if they conflict, which is a slow very memory + # consuming and fragmenting process. To avoid this, we pick a random, + # 256 KiB-aligned image base between 0x50000000 and 0x6FFC0000 at link + # time. Moving up from 0x10000000 also allows more sbrk(2) space. + archive_cmds='$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + archive_expsym_cmds='sed "s,^,_," $export_symbols >$output_objdir/$soname.expsym~$CC -shared $pic_flag $libobjs $deplibs $compiler_flags ${wl}-h,$soname ${wl}--retain-symbols-file,$output_objdir/$soname.expsym ${wl}--image-base,`expr ${RANDOM-$$} % 4096 / 2 \* 262144 + 1342177280` -o $lib' + ;; + + gnu* | linux* | tpf* | k*bsd*-gnu | kopensolaris*-gnu | uclinuxfdpiceabi) + tmp_diet=no + if test "$host_os" = linux-dietlibc; then + case $cc_basename in + diet\ *) tmp_diet=yes;; # linux-dietlibc with static linking (!diet-dyn) + esac + fi + if $LD --help 2>&1 | $EGREP ': supported targets:.* elf' > /dev/null \ + && test "$tmp_diet" = no + then + tmp_addflag=' $pic_flag' + tmp_sharedflag='-shared' + case $cc_basename,$host_cpu in + pgcc*) # Portland Group C compiler + whole_archive_flag_spec='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive' + tmp_addflag=' $pic_flag' + ;; + pgf77* | pgf90* | pgf95* | pgfortran*) + # Portland Group f77 and f90 compilers + whole_archive_flag_spec='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive' + tmp_addflag=' $pic_flag -Mnomain' ;; + ecc*,ia64* | icc*,ia64*) # Intel C compiler on ia64 + tmp_addflag=' -i_dynamic' ;; + efc*,ia64* | ifort*,ia64*) # Intel Fortran compiler on ia64 + tmp_addflag=' -i_dynamic -nofor_main' ;; + ifc* | ifort*) # Intel Fortran compiler + tmp_addflag=' -nofor_main' ;; + lf95*) # Lahey Fortran 8.1 + whole_archive_flag_spec= + tmp_sharedflag='--shared' ;; + xl[cC]* | bgxl[cC]* | mpixl[cC]*) # IBM XL C 8.0 on PPC (deal with xlf below) + tmp_sharedflag='-qmkshrobj' + tmp_addflag= ;; + nvcc*) # Cuda Compiler Driver 2.2 + whole_archive_flag_spec='${wl}--whole-archive`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive' + compiler_needs_object=yes + ;; + esac + case `$CC -V 2>&1 | sed 5q` in + *Sun\ C*) # Sun C 5.9 + whole_archive_flag_spec='${wl}--whole-archive`new_convenience=; for conv in $convenience\"\"; do test -z \"$conv\" || new_convenience=\"$new_convenience,$conv\"; done; func_echo_all \"$new_convenience\"` ${wl}--no-whole-archive' + compiler_needs_object=yes + tmp_sharedflag='-G' ;; + *Sun\ F*) # Sun Fortran 8.3 + tmp_sharedflag='-G' ;; + esac + archive_cmds='$CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + + if test "x$supports_anon_versioning" = xyes; then + archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $CC '"$tmp_sharedflag""$tmp_addflag"' $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-version-script ${wl}$output_objdir/$libname.ver -o $lib' + fi + + case $cc_basename in + xlf* | bgf* | bgxlf* | mpixlf*) + # IBM XL Fortran 10.1 on PPC cannot create shared libs itself + whole_archive_flag_spec='--whole-archive$convenience --no-whole-archive' + hardcode_libdir_flag_spec= + hardcode_libdir_flag_spec_ld='-rpath $libdir' + archive_cmds='$LD -shared $libobjs $deplibs $compiler_flags -soname $soname -o $lib' + if test "x$supports_anon_versioning" = xyes; then + archive_expsym_cmds='echo "{ global:" > $output_objdir/$libname.ver~ + cat $export_symbols | sed -e "s/\(.*\)/\1;/" >> $output_objdir/$libname.ver~ + echo "local: *; };" >> $output_objdir/$libname.ver~ + $LD -shared $libobjs $deplibs $compiler_flags -soname $soname -version-script $output_objdir/$libname.ver -o $lib' + fi + ;; + esac + else + ld_shlibs=no + fi + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds='$LD -Bshareable $libobjs $deplibs $linker_flags -o $lib' + wlarc= + else + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' + fi + ;; + + solaris*) + if $LD -v 2>&1 | $GREP 'BFD 2\.8' > /dev/null; then + ld_shlibs=no + cat <<_LT_EOF 1>&2 + +*** Warning: The releases 2.8.* of the GNU linker cannot reliably +*** create shared libraries on Solaris systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.9.1 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + elif $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs=no + fi + ;; + + sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX*) + case `$LD -v 2>&1` in + *\ [01].* | *\ 2.[0-9].* | *\ 2.1[0-5].*) + ld_shlibs=no + cat <<_LT_EOF 1>&2 + +*** Warning: Releases of the GNU linker prior to 2.16.91.0.3 can not +*** reliably create shared libraries on SCO systems. Therefore, libtool +*** is disabling shared libraries support. We urge you to upgrade GNU +*** binutils to release 2.16.91.0.3 or newer. Another option is to modify +*** your PATH or compiler configuration so that the native linker is +*** used, and then restart. + +_LT_EOF + ;; + *) + # For security reasons, it is highly recommended that you always + # use absolute paths for naming shared libraries, and exclude the + # DT_RUNPATH tag from executables and libraries. But doing so + # requires that you compile everything twice, which is a pain. + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs=no + fi + ;; + esac + ;; + + sunos4*) + archive_cmds='$LD -assert pure-text -Bshareable -o $lib $libobjs $deplibs $linker_flags' + wlarc= + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + *) + if $LD --help 2>&1 | $GREP ': supported targets:.* elf' > /dev/null; then + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname ${wl}-retain-symbols-file $wl$export_symbols -o $lib' + else + ld_shlibs=no + fi + ;; + esac + + if test "$ld_shlibs" = no; then + runpath_var= + hardcode_libdir_flag_spec= + export_dynamic_flag_spec= + whole_archive_flag_spec= + fi + else + # PORTME fill in a description of your system's linker (not GNU ld) + case $host_os in + aix3*) + allow_undefined_flag=unsupported + always_export_symbols=yes + archive_expsym_cmds='$LD -o $output_objdir/$soname $libobjs $deplibs $linker_flags -bE:$export_symbols -T512 -H512 -bM:SRE~$AR $AR_FLAGS $lib $output_objdir/$soname' + # Note: this linker hardcodes the directories in LIBPATH if there + # are no directories specified by -L. + hardcode_minus_L=yes + if test "$GCC" = yes && test -z "$lt_prog_compiler_static"; then + # Neither direct hardcoding nor static linking is supported with a + # broken collect2. + hardcode_direct=unsupported + fi + ;; + + aix[4-9]*) + if test "$host_cpu" = ia64; then + # On IA64, the linker does run time linking by default, so we don't + # have to do anything special. + aix_use_runtimelinking=no + exp_sym_flag='-Bexport' + no_entry_flag="" + else + # If we're using GNU nm, then we don't want the "-C" option. + # -C means demangle to AIX nm, but means don't demangle with GNU nm + # Also, AIX nm treats weak defined symbols like other global + # defined symbols, whereas GNU nm marks them as "W". + if $NM -V 2>&1 | $GREP 'GNU' > /dev/null; then + export_symbols_cmds='$NM -Bpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "W")) && (substr(\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols' + else + export_symbols_cmds='$NM -BCpg $libobjs $convenience | awk '\''{ if (((\$ 2 == "T") || (\$ 2 == "D") || (\$ 2 == "B") || (\$ 2 == "L")) && (substr(\$ 3,1,1) != ".")) { print \$ 3 } }'\'' | sort -u > $export_symbols' + fi + aix_use_runtimelinking=no + + # Test if we are trying to use run time linking or normal + # AIX style linking. If -brtl is somewhere in LDFLAGS, we + # need to do runtime linking. + case $host_os in aix4.[23]|aix4.[23].*|aix[5-9]*) + for ld_flag in $LDFLAGS; do + if (test $ld_flag = "-brtl" || test $ld_flag = "-Wl,-brtl"); then + aix_use_runtimelinking=yes + break + fi + done + ;; + esac + + exp_sym_flag='-bexport' + no_entry_flag='-bnoentry' + fi + + # When large executables or shared objects are built, AIX ld can + # have problems creating the table of contents. If linking a library + # or program results in "error TOC overflow" add -mminimal-toc to + # CXXFLAGS/CFLAGS for g++/gcc. In the cases where that is not + # enough to fix the problem, add -Wl,-bbigtoc to LDFLAGS. + + archive_cmds='' + hardcode_direct=yes + hardcode_direct_absolute=yes + hardcode_libdir_separator=':' + link_all_deplibs=yes + file_list_spec='${wl}-f,' + + if test "$GCC" = yes; then + case $host_os in aix4.[012]|aix4.[012].*) + # We only want to do this on AIX 4.2 and lower, the check + # below for broken collect2 doesn't work under 4.3+ + collect2name=`${CC} -print-prog-name=collect2` + if test -f "$collect2name" && + strings "$collect2name" | $GREP resolve_lib_name >/dev/null + then + # We have reworked collect2 + : + else + # We have old collect2 + hardcode_direct=unsupported + # It fails to find uninstalled libraries when the uninstalled + # path is not listed in the libpath. Setting hardcode_minus_L + # to unsupported forces relinking + hardcode_minus_L=yes + hardcode_libdir_flag_spec='-L$libdir' + hardcode_libdir_separator= + fi + ;; + esac + shared_flag='-shared' + if test "$aix_use_runtimelinking" = yes; then + shared_flag="$shared_flag "'${wl}-G' + fi + else + # not using gcc + if test "$host_cpu" = ia64; then + # VisualAge C++, Version 5.5 for AIX 5L for IA-64, Beta 3 Release + # chokes on -Wl,-G. The following line is correct: + shared_flag='-G' + else + if test "$aix_use_runtimelinking" = yes; then + shared_flag='${wl}-G' + else + shared_flag='${wl}-bM:SRE' + fi + fi + fi + + export_dynamic_flag_spec='${wl}-bexpall' + # It seems that -bexpall does not export symbols beginning with + # underscore (_), so it is better to generate a list of symbols to export. + always_export_symbols=yes + if test "$aix_use_runtimelinking" = yes; then + # Warning - without using the other runtime loading flags (-brtl), + # -berok will link without error, but may produce a broken library. + allow_undefined_flag='-berok' + # Determine the default libpath from the value encoded in an + # empty executable. + if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + +lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\(.*\)$/\1/ + p + } + }' +aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` +# Check for a 64-bit object if we didn't find anything. +if test -z "$aix_libpath"; then + aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi + + hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath" + archive_expsym_cmds='$CC -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags `if test "x${allow_undefined_flag}" != "x"; then func_echo_all "${wl}${allow_undefined_flag}"; else :; fi` '"\${wl}$exp_sym_flag:\$export_symbols $shared_flag" + else + if test "$host_cpu" = ia64; then + hardcode_libdir_flag_spec='${wl}-R $libdir:/usr/lib:/lib' + allow_undefined_flag="-z nodefs" + archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs '"\${wl}$no_entry_flag"' $compiler_flags ${wl}${allow_undefined_flag} '"\${wl}$exp_sym_flag:\$export_symbols" + else + # Determine the default libpath from the value encoded in an + # empty executable. + if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + +lt_aix_libpath_sed=' + /Import File Strings/,/^$/ { + /^0/ { + s/^0 *\(.*\)$/\1/ + p + } + }' +aix_libpath=`dump -H conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` +# Check for a 64-bit object if we didn't find anything. +if test -z "$aix_libpath"; then + aix_libpath=`dump -HX64 conftest$ac_exeext 2>/dev/null | $SED -n -e "$lt_aix_libpath_sed"` +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +if test -z "$aix_libpath"; then aix_libpath="/usr/lib:/lib"; fi + + hardcode_libdir_flag_spec='${wl}-blibpath:$libdir:'"$aix_libpath" + # Warning - without using the other run time loading flags, + # -berok will link without error, but may produce a broken library. + no_undefined_flag=' ${wl}-bernotok' + allow_undefined_flag=' ${wl}-berok' + if test "$with_gnu_ld" = yes; then + # We only use this code for GNU lds that support --whole-archive. + whole_archive_flag_spec='${wl}--whole-archive$convenience ${wl}--no-whole-archive' + else + # Exported symbols can be pulled into shared objects from archives + whole_archive_flag_spec='$convenience' + fi + archive_cmds_need_lc=yes + # This is similar to how AIX traditionally builds its shared libraries. + archive_expsym_cmds="\$CC $shared_flag"' -o $output_objdir/$soname $libobjs $deplibs ${wl}-bnoentry $compiler_flags ${wl}-bE:$export_symbols${allow_undefined_flag}~$AR $AR_FLAGS $output_objdir/$libname$release.a $output_objdir/$soname' + fi + fi + ;; + + amigaos*) + case $host_cpu in + powerpc) + # see comment about AmigaOS4 .so support + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname $wl$soname -o $lib' + archive_expsym_cmds='' + ;; + m68k) + archive_cmds='$RM $output_objdir/a2ixlibrary.data~$ECHO "#define NAME $libname" > $output_objdir/a2ixlibrary.data~$ECHO "#define LIBRARY_ID 1" >> $output_objdir/a2ixlibrary.data~$ECHO "#define VERSION $major" >> $output_objdir/a2ixlibrary.data~$ECHO "#define REVISION $revision" >> $output_objdir/a2ixlibrary.data~$AR $AR_FLAGS $lib $libobjs~$RANLIB $lib~(cd $output_objdir && a2ixlibrary -32)' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + ;; + esac + ;; + + bsdi[45]*) + export_dynamic_flag_spec=-rdynamic + ;; + + cygwin* | mingw* | pw32* | cegcc*) + # When not using gcc, we currently assume that we are using + # Microsoft Visual C++. + # hardcode_libdir_flag_spec is actually meaningless, as there is + # no search path for DLLs. + hardcode_libdir_flag_spec=' ' + allow_undefined_flag=unsupported + # Tell ltmain to make .lib files, not .a files. + libext=lib + # Tell ltmain to make .dll files, not .so files. + shrext_cmds=".dll" + # FIXME: Setting linknames here is a bad hack. + archive_cmds='$CC -o $lib $libobjs $compiler_flags `func_echo_all "$deplibs" | $SED '\''s/ -lc$//'\''` -link -dll~linknames=' + # The linker will automatically build a .lib file if we build a DLL. + old_archive_from_new_cmds='true' + # FIXME: Should let the user specify the lib program. + old_archive_cmds='lib -OUT:$oldlib$oldobjs$old_deplibs' + fix_srcfile_path='`cygpath -w "$srcfile"`' + enable_shared_with_static_runtimes=yes + ;; + + darwin* | rhapsody*) + + + + # Publish an arg to allow the user to select that Darwin host (and target) + # libraries should be given install-names like @rpath/libfoo.dylib. This + # requires that the user of the library then adds an 'rpath' to the DSO that + # needs access. + # NOTE: there are defaults below, for systems that support rpaths. The person + # configuring can override the defaults for any system version that supports + # them - they are, however, forced off for system versions without support. + # Check whether --enable-darwin-at-rpath was given. +if test "${enable_darwin_at_rpath+set}" = set; then : + enableval=$enable_darwin_at_rpath; if test "x$enable_darwin_at_rpath" = "xyes"; then + # This is not supported before macOS 10.5 / Darwin9. + case ${MACOSX_DEPLOYMENT_TARGET-UNSET},$host_os in + UNSET,darwin[4-8]*|UNSET,rhapsody*|10.[0-4][,.]*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Darwin @rpath library names are incompatible with OSX versions earlier than 10.5 (rpaths disabled)" >&5 +$as_echo "$as_me: WARNING: Darwin @rpath library names are incompatible with OSX versions earlier than 10.5 (rpaths disabled)" >&2;} + enable_darwin_at_rpath=no + ;; + esac + fi +else + case ${MACOSX_DEPLOYMENT_TARGET-UNSET},$host_os in + # As above, before 10.5 / Darwin9 this does not work. + UNSET,darwin[4-8]*|UNSET,rhapsody*|10.[0-4][,.]*) + enable_darwin_at_rpath=no + ;; + + # We cannot build and test reliably on macOS 10.11+ (Darwin15+) without use + # of rpaths, since runpaths set via DYLD_LIBRARY_PATH are elided by key + # system executables (e.g. /bin/sh). Force rpaths on for these systems. + UNSET,darwin1[5-9]*|UNSET,darwin2*|10.1[1-9][,.]*|1[1-9].*[,.]* ) + { $as_echo "$as_me:${as_lineno-$LINENO}: @rpath library names are needed on macOS versions later than 10.11 (rpaths have been enabled)" >&5 +$as_echo "$as_me: @rpath library names are needed on macOS versions later than 10.11 (rpaths have been enabled)" >&6;} + enable_darwin_at_rpath=yes + ;; + # NOTE: we are not (yet) doing anything for 10.5 .. 10.10, since they can + # work with either DYLD_LIBRARY_PATH or embedded rpaths. + + esac + +fi + + + archive_cmds_need_lc=no + hardcode_direct=no + hardcode_automatic=yes + hardcode_shlibpath_var=unsupported + if test "$lt_cv_ld_force_load" = "yes"; then + whole_archive_flag_spec='`for conv in $convenience\"\"; do test -n \"$conv\" && new_convenience=\"$new_convenience ${wl}-force_load,$conv\"; done; func_echo_all \"$new_convenience\"`' + else + whole_archive_flag_spec='' + fi + link_all_deplibs=yes + allow_undefined_flag="$_lt_dar_allow_undefined" + case $cc_basename in + ifort*) _lt_dar_can_shared=yes ;; + *) _lt_dar_can_shared=$GCC ;; + esac + if test "$_lt_dar_can_shared" = "yes"; then + output_verbose_link_cmd=func_echo_all + _lt_install_name='\$rpath/\$soname' + if test "x$enable_darwin_at_rpath" = "xyes"; then + _lt_install_name='@rpath/\$soname' + fi + archive_cmds="\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name ${_lt_install_name} \$verstring ${_lt_dsymutil}" + module_cmds="\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dsymutil}" + archive_expsym_cmds="sed 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC -dynamiclib \$allow_undefined_flag -o \$lib \$libobjs \$deplibs \$compiler_flags -install_name ${_lt_install_name} \$verstring ${_lt_dar_export_syms}${_lt_dsymutil}" + module_expsym_cmds="sed -e 's,^,_,' < \$export_symbols > \$output_objdir/\${libname}-symbols.expsym~\$CC \$allow_undefined_flag -o \$lib -bundle \$libobjs \$deplibs \$compiler_flags${_lt_dar_export_syms}${_lt_dsymutil}" + + else + ld_shlibs=no + fi + + ;; + + dgux*) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_shlibpath_var=no + ;; + + # FreeBSD 2.2.[012] allows us to include c++rt0.o to get C++ constructor + # support. Future versions do this automatically, but an explicit c++rt0.o + # does not break anything, and helps significantly (at the cost of a little + # extra space). + freebsd2.2*) + archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags /usr/lib/c++rt0.o' + hardcode_libdir_flag_spec='-R$libdir' + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + # Unfortunately, older versions of FreeBSD 2 do not have this feature. + freebsd2.*) + archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=yes + hardcode_minus_L=yes + hardcode_shlibpath_var=no + ;; + + # FreeBSD 3 and greater uses gcc -shared to do shared libraries. + freebsd* | dragonfly*) + archive_cmds='$CC -shared -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec='-R$libdir' + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + hpux9*) + if test "$GCC" = yes; then + archive_cmds='$RM $output_objdir/$soname~$CC -shared -fPIC ${wl}+b ${wl}$install_libdir -o $output_objdir/$soname $libobjs $deplibs $compiler_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' + else + archive_cmds='$RM $output_objdir/$soname~$LD -b +b $install_libdir -o $output_objdir/$soname $libobjs $deplibs $linker_flags~test $output_objdir/$soname = $lib || mv $output_objdir/$soname $lib' + fi + hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' + hardcode_libdir_separator=: + hardcode_direct=yes + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L=yes + export_dynamic_flag_spec='${wl}-E' + ;; + + hpux10*) + if test "$GCC" = yes && test "$with_gnu_ld" = no; then + archive_cmds='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' + fi + if test "$with_gnu_ld" = no; then + hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' + hardcode_libdir_flag_spec_ld='+b $libdir' + hardcode_libdir_separator=: + hardcode_direct=yes + hardcode_direct_absolute=yes + export_dynamic_flag_spec='${wl}-E' + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L=yes + fi + ;; + + hpux11*) + if test "$GCC" = yes && test "$with_gnu_ld" = no; then + case $host_cpu in + hppa*64*) + archive_cmds='$CC -shared ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + archive_cmds='$CC -shared -fPIC ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' + ;; + esac + else + case $host_cpu in + hppa*64*) + archive_cmds='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + ia64*) + archive_cmds='$CC -b ${wl}+h ${wl}$soname ${wl}+nodefaultrpath -o $lib $libobjs $deplibs $compiler_flags' + ;; + *) + + # Older versions of the 11.00 compiler do not understand -b yet + # (HP92453-01 A.11.01.20 doesn't, HP92453-01 B.11.X.35175-35176.GP does) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if $CC understands -b" >&5 +$as_echo_n "checking if $CC understands -b... " >&6; } +if ${lt_cv_prog_compiler__b+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_prog_compiler__b=no + save_LDFLAGS="$LDFLAGS" + LDFLAGS="$LDFLAGS -b" + echo "$lt_simple_link_test_code" > conftest.$ac_ext + if (eval $ac_link 2>conftest.err) && test -s conftest$ac_exeext; then + # The linker can only warn and ignore the option if not recognized + # So say no if there are warnings + if test -s conftest.err; then + # Append any errors to the config.log. + cat conftest.err 1>&5 + $ECHO "$_lt_linker_boilerplate" | $SED '/^$/d' > conftest.exp + $SED '/^$/d; /^ *+/d' conftest.err >conftest.er2 + if diff conftest.exp conftest.er2 >/dev/null; then + lt_cv_prog_compiler__b=yes + fi + else + lt_cv_prog_compiler__b=yes + fi + fi + $RM -r conftest* + LDFLAGS="$save_LDFLAGS" + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_prog_compiler__b" >&5 +$as_echo "$lt_cv_prog_compiler__b" >&6; } + +if test x"$lt_cv_prog_compiler__b" = xyes; then + archive_cmds='$CC -b ${wl}+h ${wl}$soname ${wl}+b ${wl}$install_libdir -o $lib $libobjs $deplibs $compiler_flags' +else + archive_cmds='$LD -b +h $soname +b $install_libdir -o $lib $libobjs $deplibs $linker_flags' +fi + + ;; + esac + fi + if test "$with_gnu_ld" = no; then + hardcode_libdir_flag_spec='${wl}+b ${wl}$libdir' + hardcode_libdir_separator=: + + case $host_cpu in + hppa*64*|ia64*) + hardcode_direct=no + hardcode_shlibpath_var=no + ;; + *) + hardcode_direct=yes + hardcode_direct_absolute=yes + export_dynamic_flag_spec='${wl}-E' + + # hardcode_minus_L: Not really in the search PATH, + # but as the default location of the library. + hardcode_minus_L=yes + ;; + esac + fi + ;; + + irix5* | irix6* | nonstopux*) + if test "$GCC" = yes; then + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' + # Try to use the -exported_symbol ld option, if it does not + # work, assume that -exports_file does not work either and + # implicitly export all symbols. + save_LDFLAGS="$LDFLAGS" + LDFLAGS="$LDFLAGS -shared ${wl}-exported_symbol ${wl}foo ${wl}-update_registry ${wl}/dev/null" + if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +int foo(void) {} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations ${wl}-exports_file ${wl}$export_symbols -o $lib' + +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS="$save_LDFLAGS" + else + archive_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib' + archive_expsym_cmds='$CC -shared $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -exports_file $export_symbols -o $lib' + fi + archive_cmds_need_lc='no' + hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' + hardcode_libdir_separator=: + inherit_rpath=yes + link_all_deplibs=yes + ;; + + netbsd*) + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' # a.out + else + archive_cmds='$LD -shared -o $lib $libobjs $deplibs $linker_flags' # ELF + fi + hardcode_libdir_flag_spec='-R$libdir' + hardcode_direct=yes + hardcode_shlibpath_var=no + ;; + + newsos6) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=yes + hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' + hardcode_libdir_separator=: + hardcode_shlibpath_var=no + ;; + + *nto* | *qnx*) + ;; + + openbsd*) + if test -f /usr/libexec/ld.so; then + hardcode_direct=yes + hardcode_shlibpath_var=no + hardcode_direct_absolute=yes + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then + archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags ${wl}-retain-symbols-file,$export_symbols' + hardcode_libdir_flag_spec='${wl}-rpath,$libdir' + export_dynamic_flag_spec='${wl}-E' + else + case $host_os in + openbsd[01].* | openbsd2.[0-7] | openbsd2.[0-7].*) + archive_cmds='$LD -Bshareable -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec='-R$libdir' + ;; + *) + archive_cmds='$CC -shared $pic_flag -o $lib $libobjs $deplibs $compiler_flags' + hardcode_libdir_flag_spec='${wl}-rpath,$libdir' + ;; + esac + fi + else + ld_shlibs=no + fi + ;; + + os2*) + hardcode_libdir_flag_spec='-L$libdir' + hardcode_minus_L=yes + allow_undefined_flag=unsupported + archive_cmds='$ECHO "LIBRARY $libname INITINSTANCE" > $output_objdir/$libname.def~$ECHO "DESCRIPTION \"$libname\"" >> $output_objdir/$libname.def~echo DATA >> $output_objdir/$libname.def~echo " SINGLE NONSHARED" >> $output_objdir/$libname.def~echo EXPORTS >> $output_objdir/$libname.def~emxexp $libobjs >> $output_objdir/$libname.def~$CC -Zdll -Zcrtdll -o $lib $libobjs $deplibs $compiler_flags $output_objdir/$libname.def' + old_archive_from_new_cmds='emximp -o $output_objdir/$libname.a $output_objdir/$libname.def' + ;; + + osf3*) + if test "$GCC" = yes; then + allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*' + archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' + else + allow_undefined_flag=' -expect_unresolved \*' + archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib' + fi + archive_cmds_need_lc='no' + hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' + hardcode_libdir_separator=: + ;; + + osf4* | osf5*) # as osf3* with the addition of -msym flag + if test "$GCC" = yes; then + allow_undefined_flag=' ${wl}-expect_unresolved ${wl}\*' + archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags ${wl}-msym ${wl}-soname ${wl}$soname `test -n "$verstring" && func_echo_all "${wl}-set_version ${wl}$verstring"` ${wl}-update_registry ${wl}${output_objdir}/so_locations -o $lib' + hardcode_libdir_flag_spec='${wl}-rpath ${wl}$libdir' + else + allow_undefined_flag=' -expect_unresolved \*' + archive_cmds='$CC -shared${allow_undefined_flag} $libobjs $deplibs $compiler_flags -msym -soname $soname `test -n "$verstring" && func_echo_all "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib' + archive_expsym_cmds='for i in `cat $export_symbols`; do printf "%s %s\\n" -exported_symbol "\$i" >> $lib.exp; done; printf "%s\\n" "-hidden">> $lib.exp~ + $CC -shared${allow_undefined_flag} ${wl}-input ${wl}$lib.exp $compiler_flags $libobjs $deplibs -soname $soname `test -n "$verstring" && $ECHO "-set_version $verstring"` -update_registry ${output_objdir}/so_locations -o $lib~$RM $lib.exp' + + # Both c and cxx compiler support -rpath directly + hardcode_libdir_flag_spec='-rpath $libdir' + fi + archive_cmds_need_lc='no' + hardcode_libdir_separator=: + ;; + + solaris*) + no_undefined_flag=' -z defs' + if test "$GCC" = yes; then + wlarc='${wl}' + archive_cmds='$CC -shared ${wl}-z ${wl}text ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -shared ${wl}-z ${wl}text ${wl}-M ${wl}$lib.exp ${wl}-h ${wl}$soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + else + case `$CC -V 2>&1` in + *"Compilers 5.0"*) + wlarc='' + archive_cmds='$LD -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $linker_flags' + archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $LD -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $linker_flags~$RM $lib.exp' + ;; + *) + wlarc='${wl}' + archive_cmds='$CC -G${allow_undefined_flag} -h $soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='echo "{ global:" > $lib.exp~cat $export_symbols | $SED -e "s/\(.*\)/\1;/" >> $lib.exp~echo "local: *; };" >> $lib.exp~ + $CC -G${allow_undefined_flag} -M $lib.exp -h $soname -o $lib $libobjs $deplibs $compiler_flags~$RM $lib.exp' + ;; + esac + fi + hardcode_libdir_flag_spec='-R$libdir' + hardcode_shlibpath_var=no + case $host_os in + solaris2.[0-5] | solaris2.[0-5].*) ;; + *) + # The compiler driver will combine and reorder linker options, + # but understands `-z linker_flag'. GCC discards it without `$wl', + # but is careful enough not to reorder. + # Supported since Solaris 2.6 (maybe 2.5.1?) + if test "$GCC" = yes; then + whole_archive_flag_spec='${wl}-z ${wl}allextract$convenience ${wl}-z ${wl}defaultextract' + else + whole_archive_flag_spec='-z allextract$convenience -z defaultextract' + fi + ;; + esac + link_all_deplibs=yes + ;; + + sunos4*) + if test "x$host_vendor" = xsequent; then + # Use $CC to link under sequent, because it throws in some extra .o + # files that make .init and .fini sections work. + archive_cmds='$CC -G ${wl}-h $soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$LD -assert pure-text -Bstatic -o $lib $libobjs $deplibs $linker_flags' + fi + hardcode_libdir_flag_spec='-L$libdir' + hardcode_direct=yes + hardcode_minus_L=yes + hardcode_shlibpath_var=no + ;; + + sysv4) + case $host_vendor in + sni) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=yes # is this really true??? + ;; + siemens) + ## LD is ld it makes a PLAMLIB + ## CC just makes a GrossModule. + archive_cmds='$LD -G -o $lib $libobjs $deplibs $linker_flags' + reload_cmds='$CC -r -o $output$reload_objs' + hardcode_direct=no + ;; + motorola) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_direct=no #Motorola manual says yes, but my tests say they lie + ;; + esac + runpath_var='LD_RUN_PATH' + hardcode_shlibpath_var=no + ;; + + sysv4.3*) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var=no + export_dynamic_flag_spec='-Bexport' + ;; + + sysv4*MP*) + if test -d /usr/nec; then + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_shlibpath_var=no + runpath_var=LD_RUN_PATH + hardcode_runpath_var=yes + ld_shlibs=yes + fi + ;; + + sysv4*uw2* | sysv5OpenUNIX* | sysv5UnixWare7.[01].[10]* | unixware7* | sco3.2v5.0.[024]*) + no_undefined_flag='${wl}-z,text' + archive_cmds_need_lc=no + hardcode_shlibpath_var=no + runpath_var='LD_RUN_PATH' + + if test "$GCC" = yes; then + archive_cmds='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + sysv5* | sco3.2v5* | sco5v6*) + # Note: We can NOT use -z defs as we might desire, because we do not + # link with -lc, and that would cause any symbols used from libc to + # always be unresolved, which means just about no library would + # ever link correctly. If we're not using GNU ld we use -z text + # though, which does catch some bad symbols but isn't as heavy-handed + # as -z defs. + no_undefined_flag='${wl}-z,text' + allow_undefined_flag='${wl}-z,nodefs' + archive_cmds_need_lc=no + hardcode_shlibpath_var=no + hardcode_libdir_flag_spec='${wl}-R,$libdir' + hardcode_libdir_separator=':' + link_all_deplibs=yes + export_dynamic_flag_spec='${wl}-Bexport' + runpath_var='LD_RUN_PATH' + + if test "$GCC" = yes; then + archive_cmds='$CC -shared ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -shared ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + else + archive_cmds='$CC -G ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + archive_expsym_cmds='$CC -G ${wl}-Bexport:$export_symbols ${wl}-h,$soname -o $lib $libobjs $deplibs $compiler_flags' + fi + ;; + + uts4*) + archive_cmds='$LD -G -h $soname -o $lib $libobjs $deplibs $linker_flags' + hardcode_libdir_flag_spec='-L$libdir' + hardcode_shlibpath_var=no + ;; + + *) + ld_shlibs=no + ;; + esac + + if test x$host_vendor = xsni; then + case $host in + sysv4 | sysv4.2uw2* | sysv4.3* | sysv5*) + export_dynamic_flag_spec='${wl}-Blargedynsym' + ;; + esac + fi + fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ld_shlibs" >&5 +$as_echo "$ld_shlibs" >&6; } +test "$ld_shlibs" = no && can_build_shared=no + +with_gnu_ld=$with_gnu_ld + + + + + + + + + + + + + + + +# +# Do we need to explicitly link libc? +# +case "x$archive_cmds_need_lc" in +x|xyes) + # Assume -lc should be added + archive_cmds_need_lc=yes + + if test "$enable_shared" = yes && test "$GCC" = yes; then + case $archive_cmds in + *'~'*) + # FIXME: we may have to deal with multi-command sequences. + ;; + '$CC '*) + # Test whether the compiler implicitly links with -lc since on some + # systems, -lgcc has to come before -lc. If gcc already passes -lc + # to ld, don't add -lc before -lgcc. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether -lc should be explicitly linked in" >&5 +$as_echo_n "checking whether -lc should be explicitly linked in... " >&6; } +if ${lt_cv_archive_cmds_need_lc+:} false; then : + $as_echo_n "(cached) " >&6 +else + $RM conftest* + echo "$lt_simple_compile_test_code" > conftest.$ac_ext + + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_compile\""; } >&5 + (eval $ac_compile) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } 2>conftest.err; then + soname=conftest + lib=conftest + libobjs=conftest.$ac_objext + deplibs= + wl=$lt_prog_compiler_wl + pic_flag=$lt_prog_compiler_pic + compiler_flags=-v + linker_flags=-v + verstring= + output_objdir=. + libname=conftest + lt_save_allow_undefined_flag=$allow_undefined_flag + allow_undefined_flag= + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1\""; } >&5 + (eval $archive_cmds 2\>\&1 \| $GREP \" -lc \" \>/dev/null 2\>\&1) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + then + lt_cv_archive_cmds_need_lc=no + else + lt_cv_archive_cmds_need_lc=yes + fi + allow_undefined_flag=$lt_save_allow_undefined_flag + else + cat conftest.err 1>&5 + fi + $RM conftest* + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_archive_cmds_need_lc" >&5 +$as_echo "$lt_cv_archive_cmds_need_lc" >&6; } + archive_cmds_need_lc=$lt_cv_archive_cmds_need_lc + ;; + esac + fi + ;; +esac + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking dynamic linker characteristics" >&5 +$as_echo_n "checking dynamic linker characteristics... " >&6; } + +if test "$GCC" = yes; then + case $host_os in + darwin*) lt_awk_arg="/^libraries:/,/LR/" ;; + *) lt_awk_arg="/^libraries:/" ;; + esac + case $host_os in + mingw* | cegcc*) lt_sed_strip_eq="s,=\([A-Za-z]:\),\1,g" ;; + *) lt_sed_strip_eq="s,=/,/,g" ;; + esac + lt_search_path_spec=`$CC -print-search-dirs | awk $lt_awk_arg | $SED -e "s/^libraries://" -e $lt_sed_strip_eq` + case $lt_search_path_spec in + *\;*) + # if the path contains ";" then we assume it to be the separator + # otherwise default to the standard path separator (i.e. ":") - it is + # assumed that no part of a normal pathname contains ";" but that should + # okay in the real world where ";" in dirpaths is itself problematic. + lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED 's/;/ /g'` + ;; + *) + lt_search_path_spec=`$ECHO "$lt_search_path_spec" | $SED "s/$PATH_SEPARATOR/ /g"` + ;; + esac + # Ok, now we have the path, separated by spaces, we can step through it + # and add multilib dir if necessary. + lt_tmp_lt_search_path_spec= + lt_multi_os_dir=`$CC $CPPFLAGS $CFLAGS $LDFLAGS -print-multi-os-directory 2>/dev/null` + for lt_sys_path in $lt_search_path_spec; do + if test -d "$lt_sys_path/$lt_multi_os_dir"; then + lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path/$lt_multi_os_dir" + else + test -d "$lt_sys_path" && \ + lt_tmp_lt_search_path_spec="$lt_tmp_lt_search_path_spec $lt_sys_path" + fi + done + lt_search_path_spec=`$ECHO "$lt_tmp_lt_search_path_spec" | awk ' +BEGIN {RS=" "; FS="/|\n";} { + lt_foo=""; + lt_count=0; + for (lt_i = NF; lt_i > 0; lt_i--) { + if ($lt_i != "" && $lt_i != ".") { + if ($lt_i == "..") { + lt_count++; + } else { + if (lt_count == 0) { + lt_foo="/" $lt_i lt_foo; + } else { + lt_count--; + } + } + } + } + if (lt_foo != "") { lt_freq[lt_foo]++; } + if (lt_freq[lt_foo] == 1) { print lt_foo; } +}'` + # AWK program above erroneously prepends '/' to C:/dos/paths + # for these hosts. + case $host_os in + mingw* | cegcc*) lt_search_path_spec=`$ECHO "$lt_search_path_spec" |\ + $SED 's,/\([A-Za-z]:\),\1,g'` ;; + esac + sys_lib_search_path_spec=`$ECHO "$lt_search_path_spec" | $lt_NL2SP` +else + sys_lib_search_path_spec="/lib /usr/lib /usr/local/lib" +fi +library_names_spec= +libname_spec='lib$name' +soname_spec= +shrext_cmds=".so" +postinstall_cmds= +postuninstall_cmds= +finish_cmds= +finish_eval= +shlibpath_var= +shlibpath_overrides_runpath=unknown +version_type=none +dynamic_linker="$host_os ld.so" +sys_lib_dlsearch_path_spec="/lib /usr/lib" +need_lib_prefix=unknown +hardcode_into_libs=no + +# when you set need_version to no, make sure it does not cause -set_version +# flags to be left without arguments +need_version=unknown + +case $host_os in +aix3*) + version_type=linux + library_names_spec='${libname}${release}${shared_ext}$versuffix $libname.a' + shlibpath_var=LIBPATH + + # AIX 3 has no versioning support, so we append a major version to the name. + soname_spec='${libname}${release}${shared_ext}$major' + ;; + +aix[4-9]*) + version_type=linux + need_lib_prefix=no + need_version=no + hardcode_into_libs=yes + if test "$host_cpu" = ia64; then + # AIX 5 supports IA64 + library_names_spec='${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext}$versuffix $libname${shared_ext}' + shlibpath_var=LD_LIBRARY_PATH + else + # With GCC up to 2.95.x, collect2 would create an import file + # for dependence libraries. The import file would start with + # the line `#! .'. This would cause the generated library to + # depend on `.', always an invalid library. This was fixed in + # development snapshots of GCC prior to 3.0. + case $host_os in + aix4 | aix4.[01] | aix4.[01].*) + if { echo '#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 97)' + echo ' yes ' + echo '#endif'; } | ${CC} -E - | $GREP yes > /dev/null; then + : + else + can_build_shared=no + fi + ;; + esac + # AIX (on Power*) has no versioning support, so currently we can not hardcode correct + # soname into executable. Probably we can add versioning support to + # collect2, so additional links can be useful in future. + if test "$aix_use_runtimelinking" = yes; then + # If using run time linking (on AIX 4.2 or later) use lib.so + # instead of lib.a to let people know that these are not + # typical AIX shared libraries. + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + else + # We preserve .a as extension for shared libraries through AIX4.2 + # and later when we are not doing run time linking. + library_names_spec='${libname}${release}.a $libname.a' + soname_spec='${libname}${release}${shared_ext}$major' + fi + shlibpath_var=LIBPATH + fi + ;; + +amigaos*) + case $host_cpu in + powerpc) + # Since July 2007 AmigaOS4 officially supports .so libraries. + # When compiling the executable, add -use-dynld -Lsobjs: to the compileline. + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + ;; + m68k) + library_names_spec='$libname.ixlibrary $libname.a' + # Create ${libname}_ixlibrary.a entries in /sys/libs. + finish_eval='for lib in `ls $libdir/*.ixlibrary 2>/dev/null`; do libname=`func_echo_all "$lib" | $SED '\''s%^.*/\([^/]*\)\.ixlibrary$%\1%'\''`; test $RM /sys/libs/${libname}_ixlibrary.a; $show "cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a"; cd /sys/libs && $LN_S $lib ${libname}_ixlibrary.a || exit 1; done' + ;; + esac + ;; + +beos*) + library_names_spec='${libname}${shared_ext}' + dynamic_linker="$host_os ld.so" + shlibpath_var=LIBRARY_PATH + ;; + +bsdi[45]*) + version_type=linux + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/shlib /usr/lib /usr/X11/lib /usr/contrib/lib /lib /usr/local/lib" + sys_lib_dlsearch_path_spec="/shlib /usr/lib /usr/local/lib" + # the default ld.so.conf also contains /usr/contrib/lib and + # /usr/X11R6/lib (/usr/X11 is a link to /usr/X11R6), but let us allow + # libtool to hard-code these into programs + ;; + +cygwin* | mingw* | pw32* | cegcc*) + version_type=windows + shrext_cmds=".dll" + need_version=no + need_lib_prefix=no + + case $GCC,$host_os in + yes,cygwin* | yes,mingw* | yes,pw32* | yes,cegcc*) + library_names_spec='$libname.dll.a' + # DLL is installed to $(libdir)/../bin by postinstall_cmds + postinstall_cmds='base_file=`basename \${file}`~ + dlpath=`$SHELL 2>&1 -c '\''. $dir/'\''\${base_file}'\''i; echo \$dlname'\''`~ + dldir=$destdir/`dirname \$dlpath`~ + test -d \$dldir || mkdir -p \$dldir~ + $install_prog $dir/$dlname \$dldir/$dlname~ + chmod a+x \$dldir/$dlname~ + if test -n '\''$stripme'\'' && test -n '\''$striplib'\''; then + eval '\''$striplib \$dldir/$dlname'\'' || exit \$?; + fi' + postuninstall_cmds='dldll=`$SHELL 2>&1 -c '\''. $file; echo \$dlname'\''`~ + dlpath=$dir/\$dldll~ + $RM \$dlpath' + shlibpath_overrides_runpath=yes + + case $host_os in + cygwin*) + # Cygwin DLLs use 'cyg' prefix rather than 'lib' + soname_spec='`echo ${libname} | sed -e 's/^lib/cyg/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' + + sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/lib/w32api" + ;; + mingw* | cegcc*) + # MinGW DLLs use traditional 'lib' prefix + soname_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' + ;; + pw32*) + # pw32 DLLs use 'pw' prefix rather than 'lib' + library_names_spec='`echo ${libname} | sed -e 's/^lib/pw/'``echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext}' + ;; + esac + ;; + + *) + library_names_spec='${libname}`echo ${release} | $SED -e 's/[.]/-/g'`${versuffix}${shared_ext} $libname.lib' + ;; + esac + dynamic_linker='Win32 ld.exe' + # FIXME: first we should search . and the directory the executable is in + shlibpath_var=PATH + ;; + +darwin* | rhapsody*) + dynamic_linker="$host_os dyld" + version_type=darwin + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${major}$shared_ext ${libname}$shared_ext' + soname_spec='${libname}${release}${major}$shared_ext' + shlibpath_overrides_runpath=yes + shlibpath_var=DYLD_LIBRARY_PATH + shrext_cmds='`test .$module = .yes && echo .so || echo .dylib`' + + sys_lib_search_path_spec="$sys_lib_search_path_spec /usr/local/lib" + sys_lib_dlsearch_path_spec='/usr/local/lib /lib /usr/lib' + ;; + +dgux*) + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname$shared_ext' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +freebsd* | dragonfly*) + # DragonFly does not have aout. When/if they implement a new + # versioning mechanism, adjust this. + if test -x /usr/bin/objformat; then + objformat=`/usr/bin/objformat` + else + case $host_os in + freebsd[23].*) objformat=aout ;; + *) objformat=elf ;; + esac + fi + version_type=freebsd-$objformat + case $version_type in + freebsd-elf*) + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}' + need_version=no + need_lib_prefix=no + ;; + freebsd-*) + library_names_spec='${libname}${release}${shared_ext}$versuffix $libname${shared_ext}$versuffix' + need_version=yes + ;; + esac + shlibpath_var=LD_LIBRARY_PATH + case $host_os in + freebsd2.*) + shlibpath_overrides_runpath=yes + ;; + freebsd3.[01]* | freebsdelf3.[01]*) + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + freebsd3.[2-9]* | freebsdelf3.[2-9]* | \ + freebsd4.[0-5] | freebsdelf4.[0-5] | freebsd4.1.1 | freebsdelf4.1.1) + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + *) # from 4.6 on, and DragonFly + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + esac + ;; + +haiku*) + version_type=linux + need_lib_prefix=no + need_version=no + dynamic_linker="$host_os runtime_loader" + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}${major} ${libname}${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LIBRARY_PATH + shlibpath_overrides_runpath=yes + sys_lib_dlsearch_path_spec='/boot/home/config/lib /boot/common/lib /boot/system/lib' + hardcode_into_libs=yes + ;; + +hpux9* | hpux10* | hpux11*) + # Give a soname corresponding to the major version so that dld.sl refuses to + # link against other versions. + version_type=sunos + need_lib_prefix=no + need_version=no + case $host_cpu in + ia64*) + shrext_cmds='.so' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.so" + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + if test "X$HPUX_IA64_MODE" = X32; then + sys_lib_search_path_spec="/usr/lib/hpux32 /usr/local/lib/hpux32 /usr/local/lib" + else + sys_lib_search_path_spec="/usr/lib/hpux64 /usr/local/lib/hpux64" + fi + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + hppa*64*) + shrext_cmds='.sl' + hardcode_into_libs=yes + dynamic_linker="$host_os dld.sl" + shlibpath_var=LD_LIBRARY_PATH # How should we handle SHLIB_PATH + shlibpath_overrides_runpath=yes # Unless +noenvvar is specified. + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + sys_lib_search_path_spec="/usr/lib/pa20_64 /usr/ccs/lib/pa20_64" + sys_lib_dlsearch_path_spec=$sys_lib_search_path_spec + ;; + *) + shrext_cmds='.sl' + dynamic_linker="$host_os dld.sl" + shlibpath_var=SHLIB_PATH + shlibpath_overrides_runpath=no # +s is required to enable SHLIB_PATH + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + ;; + esac + # HP-UX runs *really* slowly unless shared libraries are mode 555, ... + postinstall_cmds='chmod 555 $lib' + # or fails outright, so override atomically: + install_override_mode=555 + ;; + +interix[3-9]*) + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + dynamic_linker='Interix 3.x ld.so.1 (PE, like ELF)' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +irix5* | irix6* | nonstopux*) + case $host_os in + nonstopux*) version_type=nonstopux ;; + *) + if test "$lt_cv_prog_gnu_ld" = yes; then + version_type=linux + else + version_type=irix + fi ;; + esac + need_lib_prefix=no + need_version=no + soname_spec='${libname}${release}${shared_ext}$major' + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${release}${shared_ext} $libname${shared_ext}' + case $host_os in + irix5* | nonstopux*) + libsuff= shlibsuff= + ;; + *) + case $LD in # libtool.m4 will add one of these switches to LD + *-32|*"-32 "|*-melf32bsmip|*"-melf32bsmip ") + libsuff= shlibsuff= libmagic=32-bit;; + *-n32|*"-n32 "|*-melf32bmipn32|*"-melf32bmipn32 ") + libsuff=32 shlibsuff=N32 libmagic=N32;; + *-64|*"-64 "|*-melf64bmip|*"-melf64bmip ") + libsuff=64 shlibsuff=64 libmagic=64-bit;; + *) libsuff= shlibsuff= libmagic=never-match;; + esac + ;; + esac + shlibpath_var=LD_LIBRARY${shlibsuff}_PATH + shlibpath_overrides_runpath=no + sys_lib_search_path_spec="/usr/lib${libsuff} /lib${libsuff} /usr/local/lib${libsuff}" + sys_lib_dlsearch_path_spec="/usr/lib${libsuff} /lib${libsuff}" + hardcode_into_libs=yes + ;; + +# No shared lib support for Linux oldld, aout, or coff. +linux*oldld* | linux*aout* | linux*coff*) + dynamic_linker=no + ;; + +# This must be Linux ELF. + +# uclinux* changes (here and below) have been submitted to the libtool +# project, but have not yet been accepted: they are GCC-local changes +# for the time being. (See +# https://lists.gnu.org/archive/html/libtool-patches/2018-05/msg00000.html) +linux* | k*bsd*-gnu | kopensolaris*-gnu | gnu* | uclinuxfdpiceabi) + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -n $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + + # Some binutils ld are patched to set DT_RUNPATH + if ${lt_cv_shlibpath_overrides_runpath+:} false; then : + $as_echo_n "(cached) " >&6 +else + lt_cv_shlibpath_overrides_runpath=no + save_LDFLAGS=$LDFLAGS + save_libdir=$libdir + eval "libdir=/foo; wl=\"$lt_prog_compiler_wl\"; \ + LDFLAGS=\"\$LDFLAGS $hardcode_libdir_flag_spec\"" + if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + if ($OBJDUMP -p conftest$ac_exeext) 2>/dev/null | grep "RUNPATH.*$libdir" >/dev/null; then : + lt_cv_shlibpath_overrides_runpath=yes +fi +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + LDFLAGS=$save_LDFLAGS + libdir=$save_libdir + +fi + + shlibpath_overrides_runpath=$lt_cv_shlibpath_overrides_runpath + + # This implies no fast_install, which is unacceptable. + # Some rework will be needed to allow for fast_install + # before this can be enabled. + hardcode_into_libs=yes + + # Append ld.so.conf contents to the search path + if test -f /etc/ld.so.conf; then + lt_ld_extra=`awk '/^include / { system(sprintf("cd /etc; cat %s 2>/dev/null", \$2)); skip = 1; } { if (!skip) print \$0; skip = 0; }' < /etc/ld.so.conf | $SED -e 's/#.*//;/^[ ]*hwcap[ ]/d;s/[:, ]/ /g;s/=[^=]*$//;s/=[^= ]* / /g;s/"//g;/^$/d' | tr '\n' ' '` + sys_lib_dlsearch_path_spec="/lib /usr/lib $lt_ld_extra" + fi + + # We used to test for /lib/ld.so.1 and disable shared libraries on + # powerpc, because MkLinux only supported shared libraries with the + # GNU dynamic linker. Since this was broken with cross compilers, + # most powerpc-linux boxes support dynamic linking these days and + # people can always --disable-shared, the test was removed, and we + # assume the GNU/Linux dynamic linker is in use. + dynamic_linker='GNU/Linux ld.so' + ;; + +netbsd*) + version_type=sunos + need_lib_prefix=no + need_version=no + if echo __ELF__ | $CC -E - | $GREP __ELF__ >/dev/null; then + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + dynamic_linker='NetBSD (a.out) ld.so' + else + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major ${libname}${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + dynamic_linker='NetBSD ld.elf_so' + fi + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + ;; + +newsos6) + version_type=linux + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + ;; + +*nto* | *qnx*) + version_type=qnx + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + dynamic_linker='ldqnx.so' + ;; + +openbsd*) + version_type=sunos + sys_lib_dlsearch_path_spec="/usr/lib" + need_lib_prefix=no + # Some older versions of OpenBSD (3.3 at least) *do* need versioned libs. + case $host_os in + openbsd3.3 | openbsd3.3.*) need_version=yes ;; + *) need_version=no ;; + esac + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' + finish_cmds='PATH="\$PATH:/sbin" ldconfig -m $libdir' + shlibpath_var=LD_LIBRARY_PATH + if test -z "`echo __ELF__ | $CC -E - | $GREP __ELF__`" || test "$host_os-$host_cpu" = "openbsd2.8-powerpc"; then + case $host_os in + openbsd2.[89] | openbsd2.[89].*) + shlibpath_overrides_runpath=no + ;; + *) + shlibpath_overrides_runpath=yes + ;; + esac + else + shlibpath_overrides_runpath=yes + fi + ;; + +os2*) + libname_spec='$name' + shrext_cmds=".dll" + need_lib_prefix=no + library_names_spec='$libname${shared_ext} $libname.a' + dynamic_linker='OS/2 ld.exe' + shlibpath_var=LIBPATH + ;; + +osf3* | osf4* | osf5*) + version_type=osf + need_lib_prefix=no + need_version=no + soname_spec='${libname}${release}${shared_ext}$major' + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + shlibpath_var=LD_LIBRARY_PATH + sys_lib_search_path_spec="/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib" + sys_lib_dlsearch_path_spec="$sys_lib_search_path_spec" + ;; + +rdos*) + dynamic_linker=no + ;; + +solaris*) + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + # ldd complains unless libraries are executable + postinstall_cmds='chmod +x $lib' + ;; + +sunos4*) + version_type=sunos + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${shared_ext}$versuffix' + finish_cmds='PATH="\$PATH:/usr/etc" ldconfig $libdir' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + if test "$with_gnu_ld" = yes; then + need_lib_prefix=no + fi + need_version=yes + ;; + +sysv4 | sysv4.3*) + version_type=linux + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + case $host_vendor in + sni) + shlibpath_overrides_runpath=no + need_lib_prefix=no + runpath_var=LD_RUN_PATH + ;; + siemens) + need_lib_prefix=no + ;; + motorola) + need_lib_prefix=no + need_version=no + shlibpath_overrides_runpath=no + sys_lib_search_path_spec='/lib /usr/lib /usr/ccs/lib' + ;; + esac + ;; + +sysv4*MP*) + if test -d /usr/nec ;then + version_type=linux + library_names_spec='$libname${shared_ext}.$versuffix $libname${shared_ext}.$major $libname${shared_ext}' + soname_spec='$libname${shared_ext}.$major' + shlibpath_var=LD_LIBRARY_PATH + fi + ;; + +sysv5* | sco3.2v5* | sco5v6* | unixware* | OpenUNIX* | sysv4*uw2*) + version_type=freebsd-elf + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext} $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=yes + hardcode_into_libs=yes + if test "$with_gnu_ld" = yes; then + sys_lib_search_path_spec='/usr/local/lib /usr/gnu/lib /usr/ccs/lib /usr/lib /lib' + else + sys_lib_search_path_spec='/usr/ccs/lib /usr/lib' + case $host_os in + sco3.2v5*) + sys_lib_search_path_spec="$sys_lib_search_path_spec /lib" + ;; + esac + fi + sys_lib_dlsearch_path_spec='/usr/lib' + ;; + +tpf*) + # TPF is a cross-target only. Preferred cross-host = GNU/Linux. + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + shlibpath_var=LD_LIBRARY_PATH + shlibpath_overrides_runpath=no + hardcode_into_libs=yes + ;; + +uts4*) + version_type=linux + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + shlibpath_var=LD_LIBRARY_PATH + ;; + +# Shared libraries for VwWorks, >= 7 only at this stage +# and (fpic) still incompatible with "large" code models +# in a few configurations. Only for RTP mode in any case, +# and upon explicit request at configure time. +vxworks7*) + dynamic_linker=no + case ${with_multisubdir}-${enable_shared} in + *large*) + ;; + *mrtp*-yes) + version_type=linux + need_lib_prefix=no + need_version=no + library_names_spec='${libname}${release}${shared_ext}$versuffix ${libname}${release}${shared_ext}$major $libname${shared_ext}' + soname_spec='${libname}${release}${shared_ext}$major' + dynamic_linker="$host_os module_loader" + ;; + esac + ;; +*) + dynamic_linker=no + ;; +esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $dynamic_linker" >&5 +$as_echo "$dynamic_linker" >&6; } +test "$dynamic_linker" = no && can_build_shared=no + +variables_saved_for_relink="PATH $shlibpath_var $runpath_var" +if test "$GCC" = yes; then + variables_saved_for_relink="$variables_saved_for_relink GCC_EXEC_PREFIX COMPILER_PATH LIBRARY_PATH" +fi + +if test "${lt_cv_sys_lib_search_path_spec+set}" = set; then + sys_lib_search_path_spec="$lt_cv_sys_lib_search_path_spec" +fi +if test "${lt_cv_sys_lib_dlsearch_path_spec+set}" = set; then + sys_lib_dlsearch_path_spec="$lt_cv_sys_lib_dlsearch_path_spec" +fi + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to hardcode library paths into programs" >&5 +$as_echo_n "checking how to hardcode library paths into programs... " >&6; } +hardcode_action= +if test -n "$hardcode_libdir_flag_spec" || + test -n "$runpath_var" || + test "X$hardcode_automatic" = "Xyes" ; then + + # We can hardcode non-existent directories. + if test "$hardcode_direct" != no && + # If the only mechanism to avoid hardcoding is shlibpath_var, we + # have to relink, otherwise we might link with an installed library + # when we should be linking with a yet-to-be-installed one + ## test "$_LT_TAGVAR(hardcode_shlibpath_var, )" != no && + test "$hardcode_minus_L" != no; then + # Linking always hardcodes the temporary library directory. + hardcode_action=relink + else + # We can link without hardcoding, and we can hardcode nonexisting dirs. + hardcode_action=immediate + fi +else + # We cannot hardcode anything, or else we can only hardcode existing + # directories. + hardcode_action=unsupported +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $hardcode_action" >&5 +$as_echo "$hardcode_action" >&6; } + +if test "$hardcode_action" = relink || + test "$inherit_rpath" = yes; then + # Fast installation is not supported + enable_fast_install=no +elif test "$shlibpath_overrides_runpath" = yes || + test "$enable_shared" = no; then + # Fast installation is not necessary + enable_fast_install=needless +fi + + + + + + + if test "x$enable_dlopen" != xyes; then + enable_dlopen=unknown + enable_dlopen_self=unknown + enable_dlopen_self_static=unknown +else + lt_cv_dlopen=no + lt_cv_dlopen_libs= + + case $host_os in + beos*) + lt_cv_dlopen="load_add_on" + lt_cv_dlopen_libs= + lt_cv_dlopen_self=yes + ;; + + mingw* | pw32* | cegcc*) + lt_cv_dlopen="LoadLibrary" + lt_cv_dlopen_libs= + ;; + + cygwin*) + lt_cv_dlopen="dlopen" + lt_cv_dlopen_libs= + ;; + + darwin*) + # if libdl is installed we need to link against it + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +$as_echo_n "checking for dlopen in -ldl... " >&6; } +if ${ac_cv_lib_dl_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldl $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (); +int +main () +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dl_dlopen=yes +else + ac_cv_lib_dl_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 +$as_echo "$ac_cv_lib_dl_dlopen" >&6; } +if test "x$ac_cv_lib_dl_dlopen" = xyes; then : + lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl" +else + + lt_cv_dlopen="dyld" + lt_cv_dlopen_libs= + lt_cv_dlopen_self=yes + +fi + + ;; + + *) + ac_fn_c_check_func "$LINENO" "shl_load" "ac_cv_func_shl_load" +if test "x$ac_cv_func_shl_load" = xyes; then : + lt_cv_dlopen="shl_load" +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5 +$as_echo_n "checking for shl_load in -ldld... " >&6; } +if ${ac_cv_lib_dld_shl_load+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldld $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char shl_load (); +int +main () +{ +return shl_load (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dld_shl_load=yes +else + ac_cv_lib_dld_shl_load=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5 +$as_echo "$ac_cv_lib_dld_shl_load" >&6; } +if test "x$ac_cv_lib_dld_shl_load" = xyes; then : + lt_cv_dlopen="shl_load" lt_cv_dlopen_libs="-ldld" +else + ac_fn_c_check_func "$LINENO" "dlopen" "ac_cv_func_dlopen" +if test "x$ac_cv_func_dlopen" = xyes; then : + lt_cv_dlopen="dlopen" +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +$as_echo_n "checking for dlopen in -ldl... " >&6; } +if ${ac_cv_lib_dl_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldl $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (); +int +main () +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dl_dlopen=yes +else + ac_cv_lib_dl_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 +$as_echo "$ac_cv_lib_dl_dlopen" >&6; } +if test "x$ac_cv_lib_dl_dlopen" = xyes; then : + lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-ldl" +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -lsvld" >&5 +$as_echo_n "checking for dlopen in -lsvld... " >&6; } +if ${ac_cv_lib_svld_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lsvld $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (); +int +main () +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_svld_dlopen=yes +else + ac_cv_lib_svld_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_svld_dlopen" >&5 +$as_echo "$ac_cv_lib_svld_dlopen" >&6; } +if test "x$ac_cv_lib_svld_dlopen" = xyes; then : + lt_cv_dlopen="dlopen" lt_cv_dlopen_libs="-lsvld" +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dld_link in -ldld" >&5 +$as_echo_n "checking for dld_link in -ldld... " >&6; } +if ${ac_cv_lib_dld_dld_link+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldld $LIBS" +if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dld_link (); +int +main () +{ +return dld_link (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dld_dld_link=yes +else + ac_cv_lib_dld_dld_link=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_dld_link" >&5 +$as_echo "$ac_cv_lib_dld_dld_link" >&6; } +if test "x$ac_cv_lib_dld_dld_link" = xyes; then : + lt_cv_dlopen="dld_link" lt_cv_dlopen_libs="-ldld" +fi + + +fi + + +fi + + +fi + + +fi + + +fi + + ;; + esac + + if test "x$lt_cv_dlopen" != xno; then + enable_dlopen=yes + else + enable_dlopen=no + fi + + case $lt_cv_dlopen in + dlopen) + save_CPPFLAGS="$CPPFLAGS" + test "x$ac_cv_header_dlfcn_h" = xyes && CPPFLAGS="$CPPFLAGS -DHAVE_DLFCN_H" + + save_LDFLAGS="$LDFLAGS" + wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $export_dynamic_flag_spec\" + + save_LIBS="$LIBS" + LIBS="$lt_cv_dlopen_libs $LIBS" + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a program can dlopen itself" >&5 +$as_echo_n "checking whether a program can dlopen itself... " >&6; } +if ${lt_cv_dlopen_self+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + lt_cv_dlopen_self=cross +else + lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 + lt_status=$lt_dlunknown + cat > conftest.$ac_ext <<_LT_EOF +#line 12581 "configure" +#include "confdefs.h" + +#if HAVE_DLFCN_H +#include +#endif + +#include + +#ifdef RTLD_GLOBAL +# define LT_DLGLOBAL RTLD_GLOBAL +#else +# ifdef DL_GLOBAL +# define LT_DLGLOBAL DL_GLOBAL +# else +# define LT_DLGLOBAL 0 +# endif +#endif + +/* We may have to define LT_DLLAZY_OR_NOW in the command line if we + find out it does not work in some platform. */ +#ifndef LT_DLLAZY_OR_NOW +# ifdef RTLD_LAZY +# define LT_DLLAZY_OR_NOW RTLD_LAZY +# else +# ifdef DL_LAZY +# define LT_DLLAZY_OR_NOW DL_LAZY +# else +# ifdef RTLD_NOW +# define LT_DLLAZY_OR_NOW RTLD_NOW +# else +# ifdef DL_NOW +# define LT_DLLAZY_OR_NOW DL_NOW +# else +# define LT_DLLAZY_OR_NOW 0 +# endif +# endif +# endif +# endif +#endif + +/* When -fvisbility=hidden is used, assume the code has been annotated + correspondingly for the symbols needed. */ +#if defined(__GNUC__) && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3)) +void fnord () __attribute__((visibility("default"))); +#endif + +void fnord () { int i=42; } +int main () +{ + void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW); + int status = $lt_dlunknown; + + if (self) + { + if (dlsym (self,"fnord")) status = $lt_dlno_uscore; + else + { + if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore; + else puts (dlerror ()); + } + /* dlclose (self); */ + } + else + puts (dlerror ()); + + return status; +} +_LT_EOF + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 + (eval $ac_link) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s conftest${ac_exeext} 2>/dev/null; then + (./conftest; exit; ) >&5 2>/dev/null + lt_status=$? + case x$lt_status in + x$lt_dlno_uscore) lt_cv_dlopen_self=yes ;; + x$lt_dlneed_uscore) lt_cv_dlopen_self=yes ;; + x$lt_dlunknown|x*) lt_cv_dlopen_self=no ;; + esac + else : + # compilation failed + lt_cv_dlopen_self=no + fi +fi +rm -fr conftest* + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self" >&5 +$as_echo "$lt_cv_dlopen_self" >&6; } + + if test "x$lt_cv_dlopen_self" = xyes; then + wl=$lt_prog_compiler_wl eval LDFLAGS=\"\$LDFLAGS $lt_prog_compiler_static\" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether a statically linked program can dlopen itself" >&5 +$as_echo_n "checking whether a statically linked program can dlopen itself... " >&6; } +if ${lt_cv_dlopen_self_static+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + lt_cv_dlopen_self_static=cross +else + lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 + lt_status=$lt_dlunknown + cat > conftest.$ac_ext <<_LT_EOF +#line 12687 "configure" +#include "confdefs.h" + +#if HAVE_DLFCN_H +#include +#endif + +#include + +#ifdef RTLD_GLOBAL +# define LT_DLGLOBAL RTLD_GLOBAL +#else +# ifdef DL_GLOBAL +# define LT_DLGLOBAL DL_GLOBAL +# else +# define LT_DLGLOBAL 0 +# endif +#endif + +/* We may have to define LT_DLLAZY_OR_NOW in the command line if we + find out it does not work in some platform. */ +#ifndef LT_DLLAZY_OR_NOW +# ifdef RTLD_LAZY +# define LT_DLLAZY_OR_NOW RTLD_LAZY +# else +# ifdef DL_LAZY +# define LT_DLLAZY_OR_NOW DL_LAZY +# else +# ifdef RTLD_NOW +# define LT_DLLAZY_OR_NOW RTLD_NOW +# else +# ifdef DL_NOW +# define LT_DLLAZY_OR_NOW DL_NOW +# else +# define LT_DLLAZY_OR_NOW 0 +# endif +# endif +# endif +# endif +#endif + +/* When -fvisbility=hidden is used, assume the code has been annotated + correspondingly for the symbols needed. */ +#if defined(__GNUC__) && (((__GNUC__ == 3) && (__GNUC_MINOR__ >= 3)) || (__GNUC__ > 3)) +void fnord () __attribute__((visibility("default"))); +#endif + +void fnord () { int i=42; } +int main () +{ + void *self = dlopen (0, LT_DLGLOBAL|LT_DLLAZY_OR_NOW); + int status = $lt_dlunknown; + + if (self) + { + if (dlsym (self,"fnord")) status = $lt_dlno_uscore; + else + { + if (dlsym( self,"_fnord")) status = $lt_dlneed_uscore; + else puts (dlerror ()); + } + /* dlclose (self); */ + } + else + puts (dlerror ()); + + return status; +} +_LT_EOF + if { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_link\""; } >&5 + (eval $ac_link) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && test -s conftest${ac_exeext} 2>/dev/null; then + (./conftest; exit; ) >&5 2>/dev/null + lt_status=$? + case x$lt_status in + x$lt_dlno_uscore) lt_cv_dlopen_self_static=yes ;; + x$lt_dlneed_uscore) lt_cv_dlopen_self_static=yes ;; + x$lt_dlunknown|x*) lt_cv_dlopen_self_static=no ;; + esac + else : + # compilation failed + lt_cv_dlopen_self_static=no + fi +fi +rm -fr conftest* + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $lt_cv_dlopen_self_static" >&5 +$as_echo "$lt_cv_dlopen_self_static" >&6; } + fi + + CPPFLAGS="$save_CPPFLAGS" + LDFLAGS="$save_LDFLAGS" + LIBS="$save_LIBS" + ;; + esac + + case $lt_cv_dlopen_self in + yes|no) enable_dlopen_self=$lt_cv_dlopen_self ;; + *) enable_dlopen_self=unknown ;; + esac + + case $lt_cv_dlopen_self_static in + yes|no) enable_dlopen_self_static=$lt_cv_dlopen_self_static ;; + *) enable_dlopen_self_static=unknown ;; + esac +fi + + + + + + + + + + + + + + + + + +striplib= +old_striplib= +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stripping libraries is possible" >&5 +$as_echo_n "checking whether stripping libraries is possible... " >&6; } +if test -n "$STRIP" && $STRIP -V 2>&1 | $GREP "GNU strip" >/dev/null; then + test -z "$old_striplib" && old_striplib="$STRIP --strip-debug" + test -z "$striplib" && striplib="$STRIP --strip-unneeded" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else +# FIXME - insert some real tests, host_os isn't really good enough + case $host_os in + darwin*) + if test -n "$STRIP" ; then + striplib="$STRIP -x" + old_striplib="$STRIP -S" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + fi + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + ;; + esac +fi + + + + + + + + + + + + + # Report which library types will actually be built + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if libtool supports shared libraries" >&5 +$as_echo_n "checking if libtool supports shared libraries... " >&6; } + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $can_build_shared" >&5 +$as_echo "$can_build_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build shared libraries" >&5 +$as_echo_n "checking whether to build shared libraries... " >&6; } + test "$can_build_shared" = "no" && enable_shared=no + + # On AIX, shared libraries and static libraries use the same namespace, and + # are all built from PIC. + case $host_os in + aix3*) + test "$enable_shared" = yes && enable_static=no + if test -n "$RANLIB"; then + archive_cmds="$archive_cmds~\$RANLIB \$lib" + postinstall_cmds='$RANLIB $lib' + fi + ;; + + aix[4-9]*) + if test "$host_cpu" != ia64 && test "$aix_use_runtimelinking" = no ; then + test "$enable_shared" = yes && enable_static=no + fi + ;; + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_shared" >&5 +$as_echo "$enable_shared" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to build static libraries" >&5 +$as_echo_n "checking whether to build static libraries... " >&6; } + # Make sure either enable_shared or enable_static is yes. + test "$enable_shared" = yes || enable_static=yes + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enable_static" >&5 +$as_echo "$enable_static" >&6; } + + + + +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +CC="$lt_save_CC" + + + + + + + + + + + + + + ac_config_commands="$ac_config_commands libtool" + + + + +# Only expand once: + + + + if test x$enable_darwin_at_rpath = xyes; then + ENABLE_DARWIN_AT_RPATH_TRUE= + ENABLE_DARWIN_AT_RPATH_FALSE='#' +else + ENABLE_DARWIN_AT_RPATH_TRUE='#' + ENABLE_DARWIN_AT_RPATH_FALSE= +fi + + + + + +# Do compilation tests using the C compiler and preprocessor. +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +# Allow the user to set CC_FOR_BUILD in the environment. +CC_FOR_BUILD=${CC_FOR_BUILD:-gcc} + + +# Search for needed functions in host libraries. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing malloc" >&5 +$as_echo_n "checking for library containing malloc... " >&6; } +if ${ac_cv_search_malloc+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_func_search_save_LIBS=$LIBS +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char malloc (); +int +main () +{ +return malloc (); + ; + return 0; +} +_ACEOF +for ac_lib in '' c; do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + fi + if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_search_malloc=$ac_res +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext + if ${ac_cv_search_malloc+:} false; then : + break +fi +done +if ${ac_cv_search_malloc+:} false; then : + +else + ac_cv_search_malloc=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_malloc" >&5 +$as_echo "$ac_cv_search_malloc" >&6; } +ac_res=$ac_cv_search_malloc +if test "$ac_res" != no; then : + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing cosf" >&5 +$as_echo_n "checking for library containing cosf... " >&6; } +if ${ac_cv_search_cosf+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_func_search_save_LIBS=$LIBS +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char cosf (); +int +main () +{ +return cosf (); + ; + return 0; +} +_ACEOF +for ac_lib in '' m; do + if test -z "$ac_lib"; then + ac_res="none required" + else + ac_res=-l$ac_lib + LIBS="-l$ac_lib $ac_func_search_save_LIBS" + fi + if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_search_cosf=$ac_res +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext + if ${ac_cv_search_cosf+:} false; then : + break +fi +done +if ${ac_cv_search_cosf+:} false; then : + +else + ac_cv_search_cosf=no +fi +rm conftest.$ac_ext +LIBS=$ac_func_search_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_cosf" >&5 +$as_echo "$ac_cv_search_cosf" >&6; } +ac_res=$ac_cv_search_cosf +if test "$ac_res" != no; then : + test "$ac_res" = "none required" || LIBS="$ac_res $LIBS" + +fi + + +# Determine what GCC version number to use in filesystem paths. + + get_gcc_base_ver="cat" + +# Check whether --with-gcc-major-version-only was given. +if test "${with_gcc_major_version_only+set}" = set; then : + withval=$with_gcc_major_version_only; if test x$with_gcc_major_version_only = xyes ; then + get_gcc_base_ver="sed -e 's/^\([0-9]*\).*/\1/'" + fi + +fi + + + + +# Add dependencies for libga68.spec file +SPEC_LIBGA68_DEPS="$LIBS" + + +# libga68 soname version +libga68_VERSION=2:0:0 + + +# The Boehm GC + +# Check whether --enable-algol68-gc was given. +if test "${enable_algol68_gc+set}" = set; then : + enableval=$enable_algol68_gc; +else + enable_algol68_gc=no +fi + + +# Check whether --with-target-bdw-gc was given. +if test "${with_target_bdw_gc+set}" = set; then : + withval=$with_target_bdw_gc; +fi + + +# Check whether --with-target-bdw-gc-include was given. +if test "${with_target_bdw_gc_include+set}" = set; then : + withval=$with_target_bdw_gc_include; +fi + + +# Check whether --with-target-bdw-gc-lib was given. +if test "${with_target_bdw_gc_lib+set}" = set; then : + withval=$with_target_bdw_gc_lib; +fi + + +bdw_lib_dir= +case "$enable_algol68_gc" in +no) + use_bdw_gc=no + ;; +*) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bdw garbage collector" >&5 +$as_echo_n "checking for bdw garbage collector... " >&6; } + if test "x$with_target_bdw_gc$with_target_bdw_gc_include$with_target_bdw_gc_lib" = x; then + BDW_GC_CFLAGS= + BDW_GC_LIBS="-lgc" + else + if test "x$with_target_bdw_gc_include" = x && test "x$with_target_bdw_gc_lib" != x; then + as_fn_error $? "found --with-target-bdw-gc-lib but --with-target-bdw-gc-include missing" "$LINENO" 5 + elif test "x$with_target_bdw_gc_include" != x && test "x$with_target_bdw_gc_lib" = x; then + as_fn_error $? "found --with-target-bdw-gc-include but --with-target-bdw-gc-lib missing" "$LINENO" 5 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: using paths configured with --with-target-bdw-gc options" >&5 +$as_echo "using paths configured with --with-target-bdw-gc options" >&6; } + fi + mldir=`${CC-gcc} --print-multi-directory 2>/dev/null` + bdw_val= + if test "x$with_target_bdw_gc" != x; then + for i in `echo $with_target_bdw_gc | tr ',' ' '`; do + case "$i" in + *=*) sd=${i%%=*}; d=${i#*=} ;; + *) sd=.; d=$i ;; + esac + if test "$mldir" = "$sd"; then + bdw_val=$d + fi + done + if test "x$bdw_val" = x; then + as_fn_error $? "no multilib path ($mldir) found in --with-target-bdw-gc" "$LINENO" 5 + fi + bdw_inc_dir="$bdw_val/include" + bdw_lib_dir="$bdw_val/lib" + fi + bdw_val= + if test "x$with_target_bdw_gc_include" != x; then + for i in `echo $with_target_bdw_gc_include | tr ',' ' '`; do + case "$i" in + *=*) sd=${i%%=*}; d=${i#*=} ;; + *) sd=.; d=$i; fallback=$i ;; + esac + if test "$mldir" = "$sd"; then + bdw_val=$d + fi + done + if test "x$bdw_val" = x && test "x$bdw_inc_dir" = x && test "x$fallback" != x; then + bdw_inc_dir="$fallback" + elif test "x$bdw_val" = x; then + as_fn_error $? "no multilib path ($mldir) found in --with-target-bdw-gc-include" "$LINENO" 5 + else + bdw_inc_dir="$bdw_val" + fi + fi + bdw_val= + if test "x$with_target_bdw_gc_lib" != x; then + for i in `echo $with_target_bdw_gc_lib | tr ',' ' '`; do + case "$i" in + *=*) sd=${i%%=*}; d=${i#*=} ;; + *) sd=.; d=$i ;; + esac + if test "$mldir" = "$sd"; then + bdw_val=$d + fi + done + if test "x$bdw_val" = x; then + as_fn_error $? "no multilib path ($mldir) found in --with-target-bdw-gc-lib" "$LINENO" 5 + fi + bdw_lib_dir="$bdw_val" + fi + if test "x$bdw_inc_dir" = x; then + as_fn_error $? "no multilib path ($mldir) found in --with-target-bdw-gc-include" "$LINENO" 5 + fi + if test "x$bdw_lib_dir" = x; then + as_fn_error $? "no multilib path ($mldir) found in --with-target-bdw-gc-lib" "$LINENO" 5 + fi + BDW_GC_CFLAGS="-I$bdw_inc_dir" + if test -f $bdw_lib_dir/libgc.la; then + BDW_GC_LIBS="$bdw_lib_dir/libgc.la" + else + BDW_GC_LIBS="-L$bdw_lib_dir -lgc" + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 +$as_echo "found" >&6; } + fi + + case "$BDW_GC_LIBS" in + *libgc.la) + use_bdw_gc=yes + ;; + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for system boehm-gc" >&5 +$as_echo_n "checking for system boehm-gc... " >&6; } + save_CFLAGS=$CFLAGS + save_LIBS=$LIBS + CFLAGS="$CFLAGS $BDW_GC_CFLAGS" + LIBS="$LIBS $BDW_GC_LIBS" + if test x$gcc_no_link = xyes; then + as_fn_error $? "Link tests are not allowed after GCC_NO_EXECUTABLES." "$LINENO" 5 +fi +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +GC_init() + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + + if test "$cross_compiling" = yes; then : + system_bdw_gc_found=no + +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + int main() { + GC_init(); + return 0; + } + +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + system_bdw_gc_found=yes +else + system_bdw_gc_found=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +else + system_bdw_gc_found=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + CFLAGS=$save_CFLAGS + LIBS=$save_LIBS + if test x$enable_algol68_gc = xauto && test x$system_bdw_gc_found = xno; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: system bdw-gc not found, building libga68 with no GC support" >&5 +$as_echo "$as_me: WARNING: system bdw-gc not found, building libga68 with no GC support" >&2;} + use_bdw_gc=no + elif test x$enable_algol68_gc = xyes && test x$system_bdw_gc_found = xno; then + as_fn_error $? "system bdw-gc required but not found" "$LINENO" 5 + else + use_bdw_gc=yes + { $as_echo "$as_me:${as_lineno-$LINENO}: result: found" >&5 +$as_echo "found" >&6; } + fi + esac +esac + +if test "$use_bdw_gc" = no; then + LIBGA68_GCFLAGS='' + LIBGA68_BOEHM_GC_INCLUDES='' + LIBGA68_BOEHM_GC_LIBS='' +else + LIBGA68_GCFLAGS='-DLIBGA68_WITH_GC=1' + LIBGA68_BOEHM_GC_INCLUDES=$BDW_GC_CFLAGS + LIBGA68_BOEHM_GC_LIBS=$BDW_GC_LIBS + SPEC_LIBGA68_DEPS="$SPEC_LIBGA68_DEPS $BDW_GC_LIBS" +fi + +extra_darwin_ldflags_libga68= +case $host in + *-*-darwin*) + extra_darwin_ldflags_libga68=-Wl,-U,___algol68_main + if test -f $bdw_lib_dir/libgc.a; then + # Darwin wants to link this statically into the library + LIBGA68_BOEHM_GC_LIBS="$bdw_lib_dir/libgc.a" + # No spec entry. + BDW_GC_LIBS= + fi + ;; + *) ;; +esac + + +# Subst some variables used in Makefile.am + + + + +# Output files and be done. + +ac_config_files="$ac_config_files Makefile" + +ac_config_files="$ac_config_files libga68.spec" + +{ $as_echo "$as_me:${as_lineno-$LINENO}: libga68 has been configured." >&5 +$as_echo "$as_me: libga68 has been configured." >&6;} +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +DEFS=-DHAVE_CONFIG_H + +ac_libobjs= +ac_ltlibobjs= +U= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking that generated files are newer than configure" >&5 +$as_echo_n "checking that generated files are newer than configure... " >&6; } + if test -n "$am_sleep_pid"; then + # Hide warnings about reused PIDs. + wait $am_sleep_pid 2>/dev/null + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: done" >&5 +$as_echo "done" >&6; } +if test -z "${AMDEP_TRUE}" && test -z "${AMDEP_FALSE}"; then + as_fn_error $? "conditional \"AMDEP\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${am__fastdepCC_TRUE}" && test -z "${am__fastdepCC_FALSE}"; then + as_fn_error $? "conditional \"am__fastdepCC\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi + if test -n "$EXEEXT"; then + am__EXEEXT_TRUE= + am__EXEEXT_FALSE='#' +else + am__EXEEXT_TRUE='#' + am__EXEEXT_FALSE= +fi + +if test -z "${MAINTAINER_MODE_TRUE}" && test -z "${MAINTAINER_MODE_FALSE}"; then + as_fn_error $? "conditional \"MAINTAINER_MODE\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${am__fastdepCCAS_TRUE}" && test -z "${am__fastdepCCAS_FALSE}"; then + as_fn_error $? "conditional \"am__fastdepCCAS\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${ENABLE_DARWIN_AT_RPATH_TRUE}" && test -z "${ENABLE_DARWIN_AT_RPATH_FALSE}"; then + as_fn_error $? "conditional \"ENABLE_DARWIN_AT_RPATH\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by package-unused $as_me version-unused, which was +generated by GNU Autoconf 2.69. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + +case $ac_config_headers in *" +"*) set x $ac_config_headers; shift; ac_config_headers=$*;; +esac + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" +config_headers="$ac_config_headers" +config_commands="$ac_config_commands" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + --header=FILE[:TEMPLATE] + instantiate the configuration header FILE + +Configuration files: +$config_files + +Configuration headers: +$config_headers + +Configuration commands: +$config_commands + +Report bugs to the package provider." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" +ac_cs_version="\\ +package-unused config.status version-unused +configured by $0, generated by GNU Autoconf 2.69, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2012 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +INSTALL='$INSTALL' +MKDIR_P='$MKDIR_P' +AWK='$AWK' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --header | --heade | --head | --hea ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + as_fn_append CONFIG_HEADERS " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h) + # Conflict between --help and --header + as_fn_error $? "ambiguous option: \`$1' +Try \`$0 --help' for more information.";; + --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# +# INIT-COMMANDS +# + +srcdir="$srcdir" +host="$host" +target="$target" +with_multisubdir="$with_multisubdir" +with_multisrctop="$with_multisrctop" +with_target_subdir="$with_target_subdir" +ac_configure_args="${multilib_arg} ${ac_configure_args}" +multi_basedir="$multi_basedir" +CONFIG_SHELL=${CONFIG_SHELL-/bin/sh} +CC="$CC" +CXX="$CXX" +GFORTRAN="$GFORTRAN" +GDC="$GDC" +AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir" + + +# The HP-UX ksh and POSIX shell print the target directory to stdout +# if CDPATH is set. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +sed_quote_subst='$sed_quote_subst' +double_quote_subst='$double_quote_subst' +delay_variable_subst='$delay_variable_subst' +macro_version='`$ECHO "$macro_version" | $SED "$delay_single_quote_subst"`' +macro_revision='`$ECHO "$macro_revision" | $SED "$delay_single_quote_subst"`' +enable_shared='`$ECHO "$enable_shared" | $SED "$delay_single_quote_subst"`' +enable_static='`$ECHO "$enable_static" | $SED "$delay_single_quote_subst"`' +pic_mode='`$ECHO "$pic_mode" | $SED "$delay_single_quote_subst"`' +enable_fast_install='`$ECHO "$enable_fast_install" | $SED "$delay_single_quote_subst"`' +SHELL='`$ECHO "$SHELL" | $SED "$delay_single_quote_subst"`' +ECHO='`$ECHO "$ECHO" | $SED "$delay_single_quote_subst"`' +host_alias='`$ECHO "$host_alias" | $SED "$delay_single_quote_subst"`' +host='`$ECHO "$host" | $SED "$delay_single_quote_subst"`' +host_os='`$ECHO "$host_os" | $SED "$delay_single_quote_subst"`' +build_alias='`$ECHO "$build_alias" | $SED "$delay_single_quote_subst"`' +build='`$ECHO "$build" | $SED "$delay_single_quote_subst"`' +build_os='`$ECHO "$build_os" | $SED "$delay_single_quote_subst"`' +SED='`$ECHO "$SED" | $SED "$delay_single_quote_subst"`' +Xsed='`$ECHO "$Xsed" | $SED "$delay_single_quote_subst"`' +GREP='`$ECHO "$GREP" | $SED "$delay_single_quote_subst"`' +EGREP='`$ECHO "$EGREP" | $SED "$delay_single_quote_subst"`' +FGREP='`$ECHO "$FGREP" | $SED "$delay_single_quote_subst"`' +LD='`$ECHO "$LD" | $SED "$delay_single_quote_subst"`' +NM='`$ECHO "$NM" | $SED "$delay_single_quote_subst"`' +LN_S='`$ECHO "$LN_S" | $SED "$delay_single_quote_subst"`' +max_cmd_len='`$ECHO "$max_cmd_len" | $SED "$delay_single_quote_subst"`' +ac_objext='`$ECHO "$ac_objext" | $SED "$delay_single_quote_subst"`' +exeext='`$ECHO "$exeext" | $SED "$delay_single_quote_subst"`' +lt_unset='`$ECHO "$lt_unset" | $SED "$delay_single_quote_subst"`' +lt_SP2NL='`$ECHO "$lt_SP2NL" | $SED "$delay_single_quote_subst"`' +lt_NL2SP='`$ECHO "$lt_NL2SP" | $SED "$delay_single_quote_subst"`' +reload_flag='`$ECHO "$reload_flag" | $SED "$delay_single_quote_subst"`' +reload_cmds='`$ECHO "$reload_cmds" | $SED "$delay_single_quote_subst"`' +OBJDUMP='`$ECHO "$OBJDUMP" | $SED "$delay_single_quote_subst"`' +deplibs_check_method='`$ECHO "$deplibs_check_method" | $SED "$delay_single_quote_subst"`' +file_magic_cmd='`$ECHO "$file_magic_cmd" | $SED "$delay_single_quote_subst"`' +AR='`$ECHO "$AR" | $SED "$delay_single_quote_subst"`' +AR_FLAGS='`$ECHO "$AR_FLAGS" | $SED "$delay_single_quote_subst"`' +STRIP='`$ECHO "$STRIP" | $SED "$delay_single_quote_subst"`' +RANLIB='`$ECHO "$RANLIB" | $SED "$delay_single_quote_subst"`' +old_postinstall_cmds='`$ECHO "$old_postinstall_cmds" | $SED "$delay_single_quote_subst"`' +old_postuninstall_cmds='`$ECHO "$old_postuninstall_cmds" | $SED "$delay_single_quote_subst"`' +old_archive_cmds='`$ECHO "$old_archive_cmds" | $SED "$delay_single_quote_subst"`' +lock_old_archive_extraction='`$ECHO "$lock_old_archive_extraction" | $SED "$delay_single_quote_subst"`' +CC='`$ECHO "$CC" | $SED "$delay_single_quote_subst"`' +CFLAGS='`$ECHO "$CFLAGS" | $SED "$delay_single_quote_subst"`' +compiler='`$ECHO "$compiler" | $SED "$delay_single_quote_subst"`' +GCC='`$ECHO "$GCC" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_pipe='`$ECHO "$lt_cv_sys_global_symbol_pipe" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_to_cdecl='`$ECHO "$lt_cv_sys_global_symbol_to_cdecl" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_to_c_name_address='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address" | $SED "$delay_single_quote_subst"`' +lt_cv_sys_global_symbol_to_c_name_address_lib_prefix='`$ECHO "$lt_cv_sys_global_symbol_to_c_name_address_lib_prefix" | $SED "$delay_single_quote_subst"`' +objdir='`$ECHO "$objdir" | $SED "$delay_single_quote_subst"`' +MAGIC_CMD='`$ECHO "$MAGIC_CMD" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_no_builtin_flag='`$ECHO "$lt_prog_compiler_no_builtin_flag" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_wl='`$ECHO "$lt_prog_compiler_wl" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_pic='`$ECHO "$lt_prog_compiler_pic" | $SED "$delay_single_quote_subst"`' +lt_prog_compiler_static='`$ECHO "$lt_prog_compiler_static" | $SED "$delay_single_quote_subst"`' +lt_cv_prog_compiler_c_o='`$ECHO "$lt_cv_prog_compiler_c_o" | $SED "$delay_single_quote_subst"`' +need_locks='`$ECHO "$need_locks" | $SED "$delay_single_quote_subst"`' +DSYMUTIL='`$ECHO "$DSYMUTIL" | $SED "$delay_single_quote_subst"`' +NMEDIT='`$ECHO "$NMEDIT" | $SED "$delay_single_quote_subst"`' +LIPO='`$ECHO "$LIPO" | $SED "$delay_single_quote_subst"`' +OTOOL='`$ECHO "$OTOOL" | $SED "$delay_single_quote_subst"`' +OTOOL64='`$ECHO "$OTOOL64" | $SED "$delay_single_quote_subst"`' +libext='`$ECHO "$libext" | $SED "$delay_single_quote_subst"`' +shrext_cmds='`$ECHO "$shrext_cmds" | $SED "$delay_single_quote_subst"`' +extract_expsyms_cmds='`$ECHO "$extract_expsyms_cmds" | $SED "$delay_single_quote_subst"`' +archive_cmds_need_lc='`$ECHO "$archive_cmds_need_lc" | $SED "$delay_single_quote_subst"`' +enable_shared_with_static_runtimes='`$ECHO "$enable_shared_with_static_runtimes" | $SED "$delay_single_quote_subst"`' +export_dynamic_flag_spec='`$ECHO "$export_dynamic_flag_spec" | $SED "$delay_single_quote_subst"`' +whole_archive_flag_spec='`$ECHO "$whole_archive_flag_spec" | $SED "$delay_single_quote_subst"`' +compiler_needs_object='`$ECHO "$compiler_needs_object" | $SED "$delay_single_quote_subst"`' +old_archive_from_new_cmds='`$ECHO "$old_archive_from_new_cmds" | $SED "$delay_single_quote_subst"`' +old_archive_from_expsyms_cmds='`$ECHO "$old_archive_from_expsyms_cmds" | $SED "$delay_single_quote_subst"`' +archive_cmds='`$ECHO "$archive_cmds" | $SED "$delay_single_quote_subst"`' +archive_expsym_cmds='`$ECHO "$archive_expsym_cmds" | $SED "$delay_single_quote_subst"`' +module_cmds='`$ECHO "$module_cmds" | $SED "$delay_single_quote_subst"`' +module_expsym_cmds='`$ECHO "$module_expsym_cmds" | $SED "$delay_single_quote_subst"`' +with_gnu_ld='`$ECHO "$with_gnu_ld" | $SED "$delay_single_quote_subst"`' +allow_undefined_flag='`$ECHO "$allow_undefined_flag" | $SED "$delay_single_quote_subst"`' +no_undefined_flag='`$ECHO "$no_undefined_flag" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_flag_spec='`$ECHO "$hardcode_libdir_flag_spec" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_flag_spec_ld='`$ECHO "$hardcode_libdir_flag_spec_ld" | $SED "$delay_single_quote_subst"`' +hardcode_libdir_separator='`$ECHO "$hardcode_libdir_separator" | $SED "$delay_single_quote_subst"`' +hardcode_direct='`$ECHO "$hardcode_direct" | $SED "$delay_single_quote_subst"`' +hardcode_direct_absolute='`$ECHO "$hardcode_direct_absolute" | $SED "$delay_single_quote_subst"`' +hardcode_minus_L='`$ECHO "$hardcode_minus_L" | $SED "$delay_single_quote_subst"`' +hardcode_shlibpath_var='`$ECHO "$hardcode_shlibpath_var" | $SED "$delay_single_quote_subst"`' +hardcode_automatic='`$ECHO "$hardcode_automatic" | $SED "$delay_single_quote_subst"`' +inherit_rpath='`$ECHO "$inherit_rpath" | $SED "$delay_single_quote_subst"`' +link_all_deplibs='`$ECHO "$link_all_deplibs" | $SED "$delay_single_quote_subst"`' +fix_srcfile_path='`$ECHO "$fix_srcfile_path" | $SED "$delay_single_quote_subst"`' +always_export_symbols='`$ECHO "$always_export_symbols" | $SED "$delay_single_quote_subst"`' +export_symbols_cmds='`$ECHO "$export_symbols_cmds" | $SED "$delay_single_quote_subst"`' +exclude_expsyms='`$ECHO "$exclude_expsyms" | $SED "$delay_single_quote_subst"`' +include_expsyms='`$ECHO "$include_expsyms" | $SED "$delay_single_quote_subst"`' +prelink_cmds='`$ECHO "$prelink_cmds" | $SED "$delay_single_quote_subst"`' +file_list_spec='`$ECHO "$file_list_spec" | $SED "$delay_single_quote_subst"`' +variables_saved_for_relink='`$ECHO "$variables_saved_for_relink" | $SED "$delay_single_quote_subst"`' +need_lib_prefix='`$ECHO "$need_lib_prefix" | $SED "$delay_single_quote_subst"`' +need_version='`$ECHO "$need_version" | $SED "$delay_single_quote_subst"`' +version_type='`$ECHO "$version_type" | $SED "$delay_single_quote_subst"`' +runpath_var='`$ECHO "$runpath_var" | $SED "$delay_single_quote_subst"`' +shlibpath_var='`$ECHO "$shlibpath_var" | $SED "$delay_single_quote_subst"`' +shlibpath_overrides_runpath='`$ECHO "$shlibpath_overrides_runpath" | $SED "$delay_single_quote_subst"`' +libname_spec='`$ECHO "$libname_spec" | $SED "$delay_single_quote_subst"`' +library_names_spec='`$ECHO "$library_names_spec" | $SED "$delay_single_quote_subst"`' +soname_spec='`$ECHO "$soname_spec" | $SED "$delay_single_quote_subst"`' +install_override_mode='`$ECHO "$install_override_mode" | $SED "$delay_single_quote_subst"`' +postinstall_cmds='`$ECHO "$postinstall_cmds" | $SED "$delay_single_quote_subst"`' +postuninstall_cmds='`$ECHO "$postuninstall_cmds" | $SED "$delay_single_quote_subst"`' +finish_cmds='`$ECHO "$finish_cmds" | $SED "$delay_single_quote_subst"`' +finish_eval='`$ECHO "$finish_eval" | $SED "$delay_single_quote_subst"`' +hardcode_into_libs='`$ECHO "$hardcode_into_libs" | $SED "$delay_single_quote_subst"`' +sys_lib_search_path_spec='`$ECHO "$sys_lib_search_path_spec" | $SED "$delay_single_quote_subst"`' +sys_lib_dlsearch_path_spec='`$ECHO "$sys_lib_dlsearch_path_spec" | $SED "$delay_single_quote_subst"`' +hardcode_action='`$ECHO "$hardcode_action" | $SED "$delay_single_quote_subst"`' +enable_dlopen='`$ECHO "$enable_dlopen" | $SED "$delay_single_quote_subst"`' +enable_dlopen_self='`$ECHO "$enable_dlopen_self" | $SED "$delay_single_quote_subst"`' +enable_dlopen_self_static='`$ECHO "$enable_dlopen_self_static" | $SED "$delay_single_quote_subst"`' +old_striplib='`$ECHO "$old_striplib" | $SED "$delay_single_quote_subst"`' +striplib='`$ECHO "$striplib" | $SED "$delay_single_quote_subst"`' + +LTCC='$LTCC' +LTCFLAGS='$LTCFLAGS' +compiler='$compiler_DEFAULT' + +# A function that is used when there is no print builtin or printf. +func_fallback_echo () +{ + eval 'cat <<_LTECHO_EOF +\$1 +_LTECHO_EOF' +} + +# Quote evaled strings. +for var in SHELL \ +ECHO \ +SED \ +GREP \ +EGREP \ +FGREP \ +LD \ +NM \ +LN_S \ +lt_SP2NL \ +lt_NL2SP \ +reload_flag \ +OBJDUMP \ +deplibs_check_method \ +file_magic_cmd \ +AR \ +AR_FLAGS \ +STRIP \ +RANLIB \ +CC \ +CFLAGS \ +compiler \ +lt_cv_sys_global_symbol_pipe \ +lt_cv_sys_global_symbol_to_cdecl \ +lt_cv_sys_global_symbol_to_c_name_address \ +lt_cv_sys_global_symbol_to_c_name_address_lib_prefix \ +lt_prog_compiler_no_builtin_flag \ +lt_prog_compiler_wl \ +lt_prog_compiler_pic \ +lt_prog_compiler_static \ +lt_cv_prog_compiler_c_o \ +need_locks \ +DSYMUTIL \ +NMEDIT \ +LIPO \ +OTOOL \ +OTOOL64 \ +shrext_cmds \ +export_dynamic_flag_spec \ +whole_archive_flag_spec \ +compiler_needs_object \ +with_gnu_ld \ +allow_undefined_flag \ +no_undefined_flag \ +hardcode_libdir_flag_spec \ +hardcode_libdir_flag_spec_ld \ +hardcode_libdir_separator \ +fix_srcfile_path \ +exclude_expsyms \ +include_expsyms \ +file_list_spec \ +variables_saved_for_relink \ +libname_spec \ +library_names_spec \ +soname_spec \ +install_override_mode \ +finish_eval \ +old_striplib \ +striplib; do + case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in + *[\\\\\\\`\\"\\\$]*) + eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED \\"\\\$sed_quote_subst\\"\\\`\\\\\\"" + ;; + *) + eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\"" + ;; + esac +done + +# Double-quote double-evaled strings. +for var in reload_cmds \ +old_postinstall_cmds \ +old_postuninstall_cmds \ +old_archive_cmds \ +extract_expsyms_cmds \ +old_archive_from_new_cmds \ +old_archive_from_expsyms_cmds \ +archive_cmds \ +archive_expsym_cmds \ +module_cmds \ +module_expsym_cmds \ +export_symbols_cmds \ +prelink_cmds \ +postinstall_cmds \ +postuninstall_cmds \ +finish_cmds \ +sys_lib_search_path_spec \ +sys_lib_dlsearch_path_spec; do + case \`eval \\\\\$ECHO \\\\""\\\\\$\$var"\\\\"\` in + *[\\\\\\\`\\"\\\$]*) + eval "lt_\$var=\\\\\\"\\\`\\\$ECHO \\"\\\$\$var\\" | \\\$SED -e \\"\\\$double_quote_subst\\" -e \\"\\\$sed_quote_subst\\" -e \\"\\\$delay_variable_subst\\"\\\`\\\\\\"" + ;; + *) + eval "lt_\$var=\\\\\\"\\\$\$var\\\\\\"" + ;; + esac +done + +ac_aux_dir='$ac_aux_dir' +xsi_shell='$xsi_shell' +lt_shell_append='$lt_shell_append' + +# See if we are running on zsh, and set the options which allow our +# commands through without removal of \ escapes INIT. +if test -n "\${ZSH_VERSION+set}" ; then + setopt NO_GLOB_SUBST +fi + + + PACKAGE='$PACKAGE' + VERSION='$VERSION' + TIMESTAMP='$TIMESTAMP' + RM='$RM' + ofile='$ofile' + + + + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "config.h") CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;; + "default-1") CONFIG_COMMANDS="$CONFIG_COMMANDS default-1" ;; + "depfiles") CONFIG_COMMANDS="$CONFIG_COMMANDS depfiles" ;; + "libtool") CONFIG_COMMANDS="$CONFIG_COMMANDS libtool" ;; + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "libga68.spec") CONFIG_FILES="$CONFIG_FILES libga68.spec" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files + test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers + test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + +# Set up the scripts for CONFIG_HEADERS section. +# No need to generate them if there are no CONFIG_HEADERS. +# This happens for instance with `./config.status Makefile'. +if test -n "$CONFIG_HEADERS"; then +cat >"$ac_tmp/defines.awk" <<\_ACAWK || +BEGIN { +_ACEOF + +# Transform confdefs.h into an awk script `defines.awk', embedded as +# here-document in config.status, that substitutes the proper values into +# config.h.in to produce config.h. + +# Create a delimiter string that does not exist in confdefs.h, to ease +# handling of long lines. +ac_delim='%!_!# ' +for ac_last_try in false false :; do + ac_tt=`sed -n "/$ac_delim/p" confdefs.h` + if test -z "$ac_tt"; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done + +# For the awk script, D is an array of macro values keyed by name, +# likewise P contains macro parameters if any. Preserve backslash +# newline sequences. + +ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* +sed -n ' +s/.\{148\}/&'"$ac_delim"'/g +t rset +:rset +s/^[ ]*#[ ]*define[ ][ ]*/ / +t def +d +:def +s/\\$// +t bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3"/p +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2"/p +d +:bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3\\\\\\n"\\/p +t cont +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p +t cont +d +:cont +n +s/.\{148\}/&'"$ac_delim"'/g +t clear +:clear +s/\\$// +t bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/"/p +d +:bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p +b cont +' >$CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + for (key in D) D_is_set[key] = 1 + FS = "" +} +/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ { + line = \$ 0 + split(line, arg, " ") + if (arg[1] == "#") { + defundef = arg[2] + mac1 = arg[3] + } else { + defundef = substr(arg[1], 2) + mac1 = arg[2] + } + split(mac1, mac2, "(") #) + macro = mac2[1] + prefix = substr(line, 1, index(line, defundef) - 1) + if (D_is_set[macro]) { + # Preserve the white space surrounding the "#". + print prefix "define", macro P[macro] D[macro] + next + } else { + # Replace #undef with comments. This is necessary, for example, + # in the case of _POSIX_SOURCE, which is predefined and required + # on some systems where configure will not decide to define it. + if (defundef == "undef") { + print "/*", prefix defundef, macro, "*/" + next + } + } +} +{ print } +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + as_fn_error $? "could not setup config headers machinery" "$LINENO" 5 +fi # test -n "$CONFIG_HEADERS" + + +eval set X " :F $CONFIG_FILES :H $CONFIG_HEADERS :C $CONFIG_COMMANDS" +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + + case $INSTALL in + [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; + *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;; + esac + ac_MKDIR_P=$MKDIR_P + case $MKDIR_P in + [\\/$]* | ?:[\\/]* ) ;; + */*) ac_MKDIR_P=$ac_top_build_prefix$MKDIR_P ;; + esac +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +s&@INSTALL@&$ac_INSTALL&;t t +s&@MKDIR_P@&$ac_MKDIR_P&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + :H) + # + # CONFIG_HEADER + # + if test x"$ac_file" != x-; then + { + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" + } >"$ac_tmp/config.h" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 +$as_echo "$as_me: $ac_file is unchanged" >&6;} + else + rm -f "$ac_file" + mv "$ac_tmp/config.h" "$ac_file" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + fi + else + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ + || as_fn_error $? "could not create -" "$LINENO" 5 + fi +# Compute "$ac_file"'s index in $config_headers. +_am_arg="$ac_file" +_am_stamp_count=1 +for _am_header in $config_headers :; do + case $_am_header in + $_am_arg | $_am_arg:* ) + break ;; + * ) + _am_stamp_count=`expr $_am_stamp_count + 1` ;; + esac +done +echo "timestamp for $_am_arg" >`$as_dirname -- "$_am_arg" || +$as_expr X"$_am_arg" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$_am_arg" : 'X\(//\)[^/]' \| \ + X"$_am_arg" : 'X\(//\)$' \| \ + X"$_am_arg" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$_am_arg" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'`/stamp-h$_am_stamp_count + ;; + + :C) { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5 +$as_echo "$as_me: executing $ac_file commands" >&6;} + ;; + esac + + + case $ac_file$ac_mode in + "default-1":C) +# Only add multilib support code if we just rebuilt the top-level +# Makefile. +case " $CONFIG_FILES " in + *" Makefile "*) + ac_file=Makefile . ${multi_basedir}/config-ml.in + ;; +esac ;; + "depfiles":C) test x"$AMDEP_TRUE" != x"" || { + # Older Autoconf quotes --file arguments for eval, but not when files + # are listed without --file. Let's play safe and only enable the eval + # if we detect the quoting. + case $CONFIG_FILES in + *\'*) eval set x "$CONFIG_FILES" ;; + *) set x $CONFIG_FILES ;; + esac + shift + for mf + do + # Strip MF so we end up with the name of the file. + mf=`echo "$mf" | sed -e 's/:.*$//'` + # Check whether this is an Automake generated Makefile or not. + # We used to match only the files named 'Makefile.in', but + # some people rename them; so instead we look at the file content. + # Grep'ing the first line is not enough: some people post-process + # each Makefile.in and add a new line on top of each file to say so. + # Grep'ing the whole file is not good either: AIX grep has a line + # limit of 2048, but all sed's we know have understand at least 4000. + if sed -n 's,^#.*generated by automake.*,X,p' "$mf" | grep X >/dev/null 2>&1; then + dirpart=`$as_dirname -- "$mf" || +$as_expr X"$mf" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$mf" : 'X\(//\)[^/]' \| \ + X"$mf" : 'X\(//\)$' \| \ + X"$mf" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$mf" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + else + continue + fi + # Extract the definition of DEPDIR, am__include, and am__quote + # from the Makefile without running 'make'. + DEPDIR=`sed -n 's/^DEPDIR = //p' < "$mf"` + test -z "$DEPDIR" && continue + am__include=`sed -n 's/^am__include = //p' < "$mf"` + test -z "$am__include" && continue + am__quote=`sed -n 's/^am__quote = //p' < "$mf"` + # Find all dependency output files, they are included files with + # $(DEPDIR) in their names. We invoke sed twice because it is the + # simplest approach to changing $(DEPDIR) to its actual value in the + # expansion. + for file in `sed -n " + s/^$am__include $am__quote\(.*(DEPDIR).*\)$am__quote"'$/\1/p' <"$mf" | \ + sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g'`; do + # Make sure the directory exists. + test -f "$dirpart/$file" && continue + fdir=`$as_dirname -- "$file" || +$as_expr X"$file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$file" : 'X\(//\)[^/]' \| \ + X"$file" : 'X\(//\)$' \| \ + X"$file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir=$dirpart/$fdir; as_fn_mkdir_p + # echo "creating $dirpart/$file" + echo '# dummy' > "$dirpart/$file" + done + done +} + ;; + "libtool":C) + + # See if we are running on zsh, and set the options which allow our + # commands through without removal of \ escapes. + if test -n "${ZSH_VERSION+set}" ; then + setopt NO_GLOB_SUBST + fi + + cfgfile="${ofile}T" + trap "$RM \"$cfgfile\"; exit 1" 1 2 15 + $RM "$cfgfile" + + cat <<_LT_EOF >> "$cfgfile" +#! $SHELL + +# `$ECHO "$ofile" | sed 's%^.*/%%'` - Provide generalized library-building support services. +# Generated automatically by $as_me ($PACKAGE$TIMESTAMP) $VERSION +# Libtool was configured on host `(hostname || uname -n) 2>/dev/null | sed 1q`: +# NOTE: Changes made to this file will be lost: look at ltmain.sh. +# +# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, 2005, +# 2006, 2007, 2008, 2009 Free Software Foundation, Inc. +# Written by Gordon Matzigkeit, 1996 +# +# This file is part of GNU Libtool. +# +# GNU Libtool is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; either version 2 of +# the License, or (at your option) any later version. +# +# As a special exception to the GNU General Public License, +# if you distribute this file as part of a program or library that +# is built using GNU Libtool, you may include this file under the +# same distribution terms that you use for the rest of that program. +# +# GNU Libtool is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GNU Libtool; see the file COPYING. If not, a copy +# can be downloaded from http://www.gnu.org/licenses/gpl.html, or +# obtained by writing to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + + +# The names of the tagged configurations supported by this script. +available_tags="" + +# ### BEGIN LIBTOOL CONFIG + +# Which release of libtool.m4 was used? +macro_version=$macro_version +macro_revision=$macro_revision + +# Whether or not to build shared libraries. +build_libtool_libs=$enable_shared + +# Whether or not to build static libraries. +build_old_libs=$enable_static + +# What type of objects to build. +pic_mode=$pic_mode + +# Whether or not to optimize for fast installation. +fast_install=$enable_fast_install + +# Shell to use when invoking shell scripts. +SHELL=$lt_SHELL + +# An echo program that protects backslashes. +ECHO=$lt_ECHO + +# The host system. +host_alias=$host_alias +host=$host +host_os=$host_os + +# The build system. +build_alias=$build_alias +build=$build +build_os=$build_os + +# A sed program that does not truncate output. +SED=$lt_SED + +# Sed that helps us avoid accidentally triggering echo(1) options like -n. +Xsed="\$SED -e 1s/^X//" + +# A grep program that handles long lines. +GREP=$lt_GREP + +# An ERE matcher. +EGREP=$lt_EGREP + +# A literal string matcher. +FGREP=$lt_FGREP + +# A BSD- or MS-compatible name lister. +NM=$lt_NM + +# Whether we need soft or hard links. +LN_S=$lt_LN_S + +# What is the maximum length of a command? +max_cmd_len=$max_cmd_len + +# Object file suffix (normally "o"). +objext=$ac_objext + +# Executable file suffix (normally ""). +exeext=$exeext + +# whether the shell understands "unset". +lt_unset=$lt_unset + +# turn spaces into newlines. +SP2NL=$lt_lt_SP2NL + +# turn newlines into spaces. +NL2SP=$lt_lt_NL2SP + +# An object symbol dumper. +OBJDUMP=$lt_OBJDUMP + +# Method to check whether dependent libraries are shared objects. +deplibs_check_method=$lt_deplibs_check_method + +# Command to use when deplibs_check_method == "file_magic". +file_magic_cmd=$lt_file_magic_cmd + +# The archiver. +AR=$lt_AR +AR_FLAGS=$lt_AR_FLAGS + +# A symbol stripping program. +STRIP=$lt_STRIP + +# Commands used to install an old-style archive. +RANLIB=$lt_RANLIB +old_postinstall_cmds=$lt_old_postinstall_cmds +old_postuninstall_cmds=$lt_old_postuninstall_cmds + +# Whether to use a lock for old archive extraction. +lock_old_archive_extraction=$lock_old_archive_extraction + +# A C compiler. +LTCC=$lt_CC + +# LTCC compiler flags. +LTCFLAGS=$lt_CFLAGS + +# Take the output of nm and produce a listing of raw symbols and C names. +global_symbol_pipe=$lt_lt_cv_sys_global_symbol_pipe + +# Transform the output of nm in a proper C declaration. +global_symbol_to_cdecl=$lt_lt_cv_sys_global_symbol_to_cdecl + +# Transform the output of nm in a C name address pair. +global_symbol_to_c_name_address=$lt_lt_cv_sys_global_symbol_to_c_name_address + +# Transform the output of nm in a C name address pair when lib prefix is needed. +global_symbol_to_c_name_address_lib_prefix=$lt_lt_cv_sys_global_symbol_to_c_name_address_lib_prefix + +# The name of the directory that contains temporary libtool files. +objdir=$objdir + +# Used to examine libraries when file_magic_cmd begins with "file". +MAGIC_CMD=$MAGIC_CMD + +# Must we lock files when doing compilation? +need_locks=$lt_need_locks + +# Tool to manipulate archived DWARF debug symbol files on Mac OS X. +DSYMUTIL=$lt_DSYMUTIL + +# Tool to change global to local symbols on Mac OS X. +NMEDIT=$lt_NMEDIT + +# Tool to manipulate fat objects and archives on Mac OS X. +LIPO=$lt_LIPO + +# ldd/readelf like tool for Mach-O binaries on Mac OS X. +OTOOL=$lt_OTOOL + +# ldd/readelf like tool for 64 bit Mach-O binaries on Mac OS X 10.4. +OTOOL64=$lt_OTOOL64 + +# Old archive suffix (normally "a"). +libext=$libext + +# Shared library suffix (normally ".so"). +shrext_cmds=$lt_shrext_cmds + +# The commands to extract the exported symbol list from a shared archive. +extract_expsyms_cmds=$lt_extract_expsyms_cmds + +# Variables whose values should be saved in libtool wrapper scripts and +# restored at link time. +variables_saved_for_relink=$lt_variables_saved_for_relink + +# Do we need the "lib" prefix for modules? +need_lib_prefix=$need_lib_prefix + +# Do we need a version for libraries? +need_version=$need_version + +# Library versioning type. +version_type=$version_type + +# Shared library runtime path variable. +runpath_var=$runpath_var + +# Shared library path variable. +shlibpath_var=$shlibpath_var + +# Is shlibpath searched before the hard-coded library search path? +shlibpath_overrides_runpath=$shlibpath_overrides_runpath + +# Format of library name prefix. +libname_spec=$lt_libname_spec + +# List of archive names. First name is the real one, the rest are links. +# The last name is the one that the linker finds with -lNAME +library_names_spec=$lt_library_names_spec + +# The coded name of the library, if different from the real name. +soname_spec=$lt_soname_spec + +# Permission mode override for installation of shared libraries. +install_override_mode=$lt_install_override_mode + +# Command to use after installation of a shared archive. +postinstall_cmds=$lt_postinstall_cmds + +# Command to use after uninstallation of a shared archive. +postuninstall_cmds=$lt_postuninstall_cmds + +# Commands used to finish a libtool library installation in a directory. +finish_cmds=$lt_finish_cmds + +# As "finish_cmds", except a single script fragment to be evaled but +# not shown. +finish_eval=$lt_finish_eval + +# Whether we should hardcode library paths into libraries. +hardcode_into_libs=$hardcode_into_libs + +# Compile-time system search path for libraries. +sys_lib_search_path_spec=$lt_sys_lib_search_path_spec + +# Run-time system search path for libraries. +sys_lib_dlsearch_path_spec=$lt_sys_lib_dlsearch_path_spec + +# Whether dlopen is supported. +dlopen_support=$enable_dlopen + +# Whether dlopen of programs is supported. +dlopen_self=$enable_dlopen_self + +# Whether dlopen of statically linked programs is supported. +dlopen_self_static=$enable_dlopen_self_static + +# Commands to strip libraries. +old_striplib=$lt_old_striplib +striplib=$lt_striplib + + +# The linker used to build libraries. +LD=$lt_LD + +# How to create reloadable object files. +reload_flag=$lt_reload_flag +reload_cmds=$lt_reload_cmds + +# Commands used to build an old-style archive. +old_archive_cmds=$lt_old_archive_cmds + +# A language specific compiler. +CC=$lt_compiler + +# Is the compiler the GNU compiler? +with_gcc=$GCC + +# Compiler flag to turn off builtin functions. +no_builtin_flag=$lt_lt_prog_compiler_no_builtin_flag + +# How to pass a linker flag through the compiler. +wl=$lt_lt_prog_compiler_wl + +# Additional compiler flags for building library objects. +pic_flag=$lt_lt_prog_compiler_pic + +# Compiler flag to prevent dynamic linking. +link_static_flag=$lt_lt_prog_compiler_static + +# Does compiler simultaneously support -c and -o options? +compiler_c_o=$lt_lt_cv_prog_compiler_c_o + +# Whether or not to add -lc for building shared libraries. +build_libtool_need_lc=$archive_cmds_need_lc + +# Whether or not to disallow shared libs when runtime libs are static. +allow_libtool_libs_with_static_runtimes=$enable_shared_with_static_runtimes + +# Compiler flag to allow reflexive dlopens. +export_dynamic_flag_spec=$lt_export_dynamic_flag_spec + +# Compiler flag to generate shared objects directly from archives. +whole_archive_flag_spec=$lt_whole_archive_flag_spec + +# Whether the compiler copes with passing no objects directly. +compiler_needs_object=$lt_compiler_needs_object + +# Create an old-style archive from a shared archive. +old_archive_from_new_cmds=$lt_old_archive_from_new_cmds + +# Create a temporary old-style archive to link instead of a shared archive. +old_archive_from_expsyms_cmds=$lt_old_archive_from_expsyms_cmds + +# Commands used to build a shared archive. +archive_cmds=$lt_archive_cmds +archive_expsym_cmds=$lt_archive_expsym_cmds + +# Commands used to build a loadable module if different from building +# a shared archive. +module_cmds=$lt_module_cmds +module_expsym_cmds=$lt_module_expsym_cmds + +# Whether we are building with GNU ld or not. +with_gnu_ld=$lt_with_gnu_ld + +# Flag that allows shared libraries with undefined symbols to be built. +allow_undefined_flag=$lt_allow_undefined_flag + +# Flag that enforces no undefined symbols. +no_undefined_flag=$lt_no_undefined_flag + +# Flag to hardcode \$libdir into a binary during linking. +# This must work even if \$libdir does not exist +hardcode_libdir_flag_spec=$lt_hardcode_libdir_flag_spec + +# If ld is used when linking, flag to hardcode \$libdir into a binary +# during linking. This must work even if \$libdir does not exist. +hardcode_libdir_flag_spec_ld=$lt_hardcode_libdir_flag_spec_ld + +# Whether we need a single "-rpath" flag with a separated argument. +hardcode_libdir_separator=$lt_hardcode_libdir_separator + +# Set to "yes" if using DIR/libNAME\${shared_ext} during linking hardcodes +# DIR into the resulting binary. +hardcode_direct=$hardcode_direct + +# Set to "yes" if using DIR/libNAME\${shared_ext} during linking hardcodes +# DIR into the resulting binary and the resulting library dependency is +# "absolute",i.e impossible to change by setting \${shlibpath_var} if the +# library is relocated. +hardcode_direct_absolute=$hardcode_direct_absolute + +# Set to "yes" if using the -LDIR flag during linking hardcodes DIR +# into the resulting binary. +hardcode_minus_L=$hardcode_minus_L + +# Set to "yes" if using SHLIBPATH_VAR=DIR during linking hardcodes DIR +# into the resulting binary. +hardcode_shlibpath_var=$hardcode_shlibpath_var + +# Set to "yes" if building a shared library automatically hardcodes DIR +# into the library and all subsequent libraries and executables linked +# against it. +hardcode_automatic=$hardcode_automatic + +# Set to yes if linker adds runtime paths of dependent libraries +# to runtime path list. +inherit_rpath=$inherit_rpath + +# Whether libtool must link a program against all its dependency libraries. +link_all_deplibs=$link_all_deplibs + +# Fix the shell variable \$srcfile for the compiler. +fix_srcfile_path=$lt_fix_srcfile_path + +# Set to "yes" if exported symbols are required. +always_export_symbols=$always_export_symbols + +# The commands to list exported symbols. +export_symbols_cmds=$lt_export_symbols_cmds + +# Symbols that should not be listed in the preloaded symbols. +exclude_expsyms=$lt_exclude_expsyms + +# Symbols that must always be exported. +include_expsyms=$lt_include_expsyms + +# Commands necessary for linking programs (against libraries) with templates. +prelink_cmds=$lt_prelink_cmds + +# Specify filename containing input files. +file_list_spec=$lt_file_list_spec + +# How to hardcode a shared library path into an executable. +hardcode_action=$hardcode_action + +# ### END LIBTOOL CONFIG + +_LT_EOF + + case $host_os in + aix3*) + cat <<\_LT_EOF >> "$cfgfile" +# AIX sometimes has problems with the GCC collect2 program. For some +# reason, if we set the COLLECT_NAMES environment variable, the problems +# vanish in a puff of smoke. +if test "X${COLLECT_NAMES+set}" != Xset; then + COLLECT_NAMES= + export COLLECT_NAMES +fi +_LT_EOF + ;; + esac + + +ltmain="$ac_aux_dir/ltmain.sh" + + + # We use sed instead of cat because bash on DJGPP gets confused if + # if finds mixed CR/LF and LF-only lines. Since sed operates in + # text mode, it properly converts lines to CR/LF. This bash problem + # is reportedly fixed, but why not run on old versions too? + sed '/^# Generated shell functions inserted here/q' "$ltmain" >> "$cfgfile" \ + || (rm -f "$cfgfile"; exit 1) + + case $xsi_shell in + yes) + cat << \_LT_EOF >> "$cfgfile" + +# func_dirname file append nondir_replacement +# Compute the dirname of FILE. If nonempty, add APPEND to the result, +# otherwise set result to NONDIR_REPLACEMENT. +func_dirname () +{ + case ${1} in + */*) func_dirname_result="${1%/*}${2}" ;; + * ) func_dirname_result="${3}" ;; + esac +} + +# func_basename file +func_basename () +{ + func_basename_result="${1##*/}" +} + +# func_dirname_and_basename file append nondir_replacement +# perform func_basename and func_dirname in a single function +# call: +# dirname: Compute the dirname of FILE. If nonempty, +# add APPEND to the result, otherwise set result +# to NONDIR_REPLACEMENT. +# value returned in "$func_dirname_result" +# basename: Compute filename of FILE. +# value retuned in "$func_basename_result" +# Implementation must be kept synchronized with func_dirname +# and func_basename. For efficiency, we do not delegate to +# those functions but instead duplicate the functionality here. +func_dirname_and_basename () +{ + case ${1} in + */*) func_dirname_result="${1%/*}${2}" ;; + * ) func_dirname_result="${3}" ;; + esac + func_basename_result="${1##*/}" +} + +# func_stripname prefix suffix name +# strip PREFIX and SUFFIX off of NAME. +# PREFIX and SUFFIX must not contain globbing or regex special +# characters, hashes, percent signs, but SUFFIX may contain a leading +# dot (in which case that matches only a dot). +func_stripname () +{ + # pdksh 5.2.14 does not do ${X%$Y} correctly if both X and Y are + # positional parameters, so assign one to ordinary parameter first. + func_stripname_result=${3} + func_stripname_result=${func_stripname_result#"${1}"} + func_stripname_result=${func_stripname_result%"${2}"} +} + +# func_opt_split +func_opt_split () +{ + func_opt_split_opt=${1%%=*} + func_opt_split_arg=${1#*=} +} + +# func_lo2o object +func_lo2o () +{ + case ${1} in + *.lo) func_lo2o_result=${1%.lo}.${objext} ;; + *) func_lo2o_result=${1} ;; + esac +} + +# func_xform libobj-or-source +func_xform () +{ + func_xform_result=${1%.*}.lo +} + +# func_arith arithmetic-term... +func_arith () +{ + func_arith_result=$(( $* )) +} + +# func_len string +# STRING may not start with a hyphen. +func_len () +{ + func_len_result=${#1} +} + +_LT_EOF + ;; + *) # Bourne compatible functions. + cat << \_LT_EOF >> "$cfgfile" + +# func_dirname file append nondir_replacement +# Compute the dirname of FILE. If nonempty, add APPEND to the result, +# otherwise set result to NONDIR_REPLACEMENT. +func_dirname () +{ + # Extract subdirectory from the argument. + func_dirname_result=`$ECHO "${1}" | $SED "$dirname"` + if test "X$func_dirname_result" = "X${1}"; then + func_dirname_result="${3}" + else + func_dirname_result="$func_dirname_result${2}" + fi +} + +# func_basename file +func_basename () +{ + func_basename_result=`$ECHO "${1}" | $SED "$basename"` +} + + +# func_stripname prefix suffix name +# strip PREFIX and SUFFIX off of NAME. +# PREFIX and SUFFIX must not contain globbing or regex special +# characters, hashes, percent signs, but SUFFIX may contain a leading +# dot (in which case that matches only a dot). +# func_strip_suffix prefix name +func_stripname () +{ + case ${2} in + .*) func_stripname_result=`$ECHO "${3}" | $SED "s%^${1}%%; s%\\\\${2}\$%%"`;; + *) func_stripname_result=`$ECHO "${3}" | $SED "s%^${1}%%; s%${2}\$%%"`;; + esac +} + +# sed scripts: +my_sed_long_opt='1s/^\(-[^=]*\)=.*/\1/;q' +my_sed_long_arg='1s/^-[^=]*=//' + +# func_opt_split +func_opt_split () +{ + func_opt_split_opt=`$ECHO "${1}" | $SED "$my_sed_long_opt"` + func_opt_split_arg=`$ECHO "${1}" | $SED "$my_sed_long_arg"` +} + +# func_lo2o object +func_lo2o () +{ + func_lo2o_result=`$ECHO "${1}" | $SED "$lo2o"` +} + +# func_xform libobj-or-source +func_xform () +{ + func_xform_result=`$ECHO "${1}" | $SED 's/\.[^.]*$/.lo/'` +} + +# func_arith arithmetic-term... +func_arith () +{ + func_arith_result=`expr "$@"` +} + +# func_len string +# STRING may not start with a hyphen. +func_len () +{ + func_len_result=`expr "$1" : ".*" 2>/dev/null || echo $max_cmd_len` +} + +_LT_EOF +esac + +case $lt_shell_append in + yes) + cat << \_LT_EOF >> "$cfgfile" + +# func_append var value +# Append VALUE to the end of shell variable VAR. +func_append () +{ + eval "$1+=\$2" +} +_LT_EOF + ;; + *) + cat << \_LT_EOF >> "$cfgfile" + +# func_append var value +# Append VALUE to the end of shell variable VAR. +func_append () +{ + eval "$1=\$$1\$2" +} + +_LT_EOF + ;; + esac + + + sed -n '/^# Generated shell functions inserted here/,$p' "$ltmain" >> "$cfgfile" \ + || (rm -f "$cfgfile"; exit 1) + + mv -f "$cfgfile" "$ofile" || + (rm -f "$ofile" && cp "$cfgfile" "$ofile" && rm -f "$cfgfile") + chmod +x "$ofile" + + ;; + + esac +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + From de13ec46e3ab89068510b24b4928ed99304527b3 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:56:00 +0200 Subject: [PATCH 177/373] a68: testsuite: infrastructure Signed-off-by: Jose E. Marchesi gcc/testsuite/ChangeLog * lib/algol68-dg.exp: New file. * lib/algol68-torture.exp: Likewise. * lib/algol68.exp: Likewise. --- gcc/testsuite/lib/algol68-dg.exp | 96 +++++ gcc/testsuite/lib/algol68-torture.exp | 483 ++++++++++++++++++++++++++ gcc/testsuite/lib/algol68.exp | 219 ++++++++++++ 3 files changed, 798 insertions(+) create mode 100644 gcc/testsuite/lib/algol68-dg.exp create mode 100644 gcc/testsuite/lib/algol68-torture.exp create mode 100644 gcc/testsuite/lib/algol68.exp diff --git a/gcc/testsuite/lib/algol68-dg.exp b/gcc/testsuite/lib/algol68-dg.exp new file mode 100644 index 000000000000..5dcfb517c249 --- /dev/null +++ b/gcc/testsuite/lib/algol68-dg.exp @@ -0,0 +1,96 @@ +# Copyright (C) 1997-2024 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +load_lib gcc-dg.exp + +# Define ALGOL68 callbacks for dg.exp. + +proc algol68-dg-test { prog do_what extra_tool_flags } { + return [gcc-dg-test-1 algol68_target_compile $prog $do_what $extra_tool_flags] +} + +proc algol68-dg-prune { system text } { + return [gcc-dg-prune $system $text] +} + +# Global modules options +set MODULES_OPTIONS "" + +# Modified dg-runtest that can cycle through a list of optimization options +# as c-torture does. +proc algol68-dg-runtest { testcases flags default-extra-flags } { + global runtests + global TORTURE_OPTIONS + global MODULES_OPTIONS + + foreach test $testcases { + # If we're only testing specific files and this isn't one of + # them, skip it. + if ![runtest_file_p $runtests $test] { + continue + } + + # look if this is dg-do-run test, in which case + # we cycle through the option list, otherwise we don't + if [expr [search_for $test "dg-do run"]] { + set option_list $TORTURE_OPTIONS + } else { + set option_list [list { -O2 } ] + } + + set nshort [file tail [file dirname $test]]/[file tail $test] + + foreach flags_t $option_list { + verbose "Testing $nshort, $flags $flags_t" 1 + dg-test $test "$MODULES_OPTIONS $flags $flags_t" ${default-extra-flags} + } + } +} + +# Build a series of modules ACCESSed by this test. +# +# The first to dg-modules is a list of module names. The source file +# for a given module MODULE is assumed to be MODULE.a68, and that file +# must reside in the current directory. +# +# The second option to dg-modules, which is optional, can be used to +# specify additional options to be passed to ga68 when it compiles the +# modules. + +proc dg-modules { args } { + + global objdir + global srcdir + global subdir + + if { [llength $args] != 2 && [llength $args] != 3 } { + error "[lindex $args 0]: invalid arguments" + } + set modules [lindex $args 1] + + set module_options {} + if { [llength $args] == 3 } { + set module_options [lindex $args 2] + } + + foreach module $modules { + set srcfile "${module}.a68" + set objfile "${module}.o" + # Compile the module + set comp_output [algol68_target_compile $srcdir/$subdir/$srcfile \ + $objdir/$objfile object $module_options] + } +} diff --git a/gcc/testsuite/lib/algol68-torture.exp b/gcc/testsuite/lib/algol68-torture.exp new file mode 100644 index 000000000000..6da563687d4e --- /dev/null +++ b/gcc/testsuite/lib/algol68-torture.exp @@ -0,0 +1,483 @@ +# Copyright (C) 2009-2024 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +# Please email any bugs, comments, and/or additions to this file to +# the author. + +load_lib dg.exp + +load_lib target-supports.exp + +load_lib target-utils.exp + +# The default option list can be overridden by +# TORTURE_OPTIONS="{ { list1 } ... { listN } }" + +if ![info exists TORTURE_OPTIONS] { + set TORTURE_OPTIONS [list \ + { -O0 } { -O1 } { -O2 } \ + { -O2 -fomit-frame-pointer -finline-functions } \ + { -O2 -fomit-frame-pointer -finline-functions -funroll-loops } \ + { -O2 -fcheck=bounds } \ + { -O2 -fcheck=nil } \ + { -O3 -g } \ + { -Os }] + + if [check_effective_target_lto] { + set TORTURE_OPTIONS \ + [concat $TORTURE_OPTIONS [list {-flto}]] + } +} + +# Location of built modules +set BUILT_MODULES_DIR "" + +# Build a series of modules ACCESSed by this test. +# +# The first to dg-modules is a list of module names. The source file +# for a given module MODULE is assumed to be MODULE.a68, and that file +# must reside in the current directory. +# +# The second option to dg-modules, which is optional, can be used to +# specify additional options to be passed to ga68 when it compiles the +# modules. + +proc dg-modules { args } { + + global objdir + global srcdir + global subdir + global algol68_module_objects + + if { [llength $args] != 2 && [llength $args] != 3 } { + error "[lindex $args 0]: invalid arguments" + } + set modules [lindex $args 1] + + set module_options {} + if { [llength $args] == 3 } { + set module_options [lindex $args 2] + } + + foreach module $modules { + set srcfile "${module}.a68" + set objfile "${module}.o" + # Compile the module + set comp_output [algol68_target_compile $srcdir/$subdir/$srcfile \ + $objdir/$objfile object $module_options] + lappend algol68_module_objects $objfile + } +} + +# +# algol68-torture-compile -- compile an algol68/execute/torture testcase. +# +# SRC is the full pathname of the testcase. +# OPTION is the specific compiler flag we're testing (eg: -O2). +# +proc algol68-torture-compile { src option } { + global output + global srcdir tmpdir + global host_triplet + + set output "$tmpdir/[file tail [file rootname $src]].o" + + regsub "(?q)$srcdir/" $src "" testcase + + # If we couldn't rip $srcdir out of `src' then just do the best we can. + # The point is to reduce the unnecessary noise in the logs. Don't strip + # out too much because different testcases with the same name can confuse + # `test-tool'. + if [string match "/*" $testcase] { + set testcase "[file tail [file dirname $src]]/[file tail $src]" + } + + verbose "Testing $testcase, $option" 1 + + # Run the compiler and get results in comp_output. + set options "" + lappend options "additional_flags=-w $option" + + set comp_output [algol68_target_compile "$src" "$output" object $options] + + # See if we got something bad. + set fatal_signal "*algol68*: Internal compiler error: program*got fatal signal" + + if [string match "$fatal_signal 6" $comp_output] then { + algol68_fail $testcase "Got Signal 6, $option" + catch { remote_file build delete $output } + return + } + + if [string match "$fatal_signal 11" $comp_output] then { + algol68_fail $testcase "Got Signal 11, $option" + catch { remote_file build delete $output } + return + } + + if [regexp -line -- "internal compiler error.*" $comp_output ice] then { + algol68_fail $testcase "$option ($ice)" + catch { remote_file build delete $output } + return + } + + # We shouldn't get these because of -w, but just in case. + if [string match "*algol68*:*warning:*" $comp_output] then { + warning "$testcase: (with warnings) $option" + send_log "$comp_output\n" + unresolved "$testcase, $option" + catch { remote_file build delete $output } + return + } + + # Prune warnings we know are unwanted. + set comp_output [prune_warnings $comp_output] + + # Report if the testcase is not supported. + set unsupported_message [algol68_check_unsupported_p $comp_output] + if { $unsupported_message != "" } { + unsupported "$testcase: $unsupported_message" + catch { remote_file build delete $output } + return + } + + # remove any leftover LF/CR to make sure any output is legit + regsub -all -- "\[\r\n\]*" $comp_output "" comp_output + + # If any message remains, we fail. + if ![string match "" $comp_output] then { + algol68_fail $testcase $option + catch { remote_file build delete $output } + return + } + + algol68_pass $testcase $option + catch { remote_file build delete $output } +} + + +# +# algol68-torture-execute -- compile and execute a testcase. +# +# SRC is the full pathname of the testcase. +# +# If the testcase has an associated .x file, we source that to run the +# test instead. We use .x so that we don't lengthen the existing filename +# to more than 14 chars. +# +proc algol68-torture-execute { src } { + global output + global srcdir tmpdir + global tool + global compiler_conditional_xfail_data + global TORTURE_OPTIONS + global BUILT_MODULES_DIR + global errorCode errorInfo + global algol68_module_objects + global algol68_compile_args + global algol68_execute_args + global dg-extra-tool-flags + + set dg-excess-errors-flag 0 + set dg-messages "" + set dg-extra-tool-flags "" + set dg-final-code "" + + # `dg-output-text' is a list of two elements: pass/fail and text. + # Leave second element off for now (indicates "don't perform test") + set dg-output-text "P" + + # The list of module objects to include in the compilation line + # is built by dg-get-options while processing the { dg-modules } + # marks. See the dg-modules procedure above. + set algol68_module_objects "" + + set tmp [dg-get-options $src] + foreach op $tmp { + verbose "Processing option: $op" 3 + set status [catch $op errmsg] + if { $status != 0 } { + if { 0 && [info exists errorInfo] } { + # This also prints a backtrace which will just confuse + # testcase writers, so it's disabled. + perror "$src: $errorInfo\n" + } else { + perror "$src: $errmsg for \"$op\"\n" + } + perror "$src: $errmsg for \"$op\"" 0 + return + } + } + + # Check for alternate driver. + set additional_flags "" + if [file exists [file rootname $src].x] { + verbose "Using alternate driver [file rootname [file tail $src]].x" 2 + set done_p 0 + catch "set done_p \[source [file rootname $src].x\]" + if { $done_p } { + return + } + } + + # Setup the options for the testcase run. + set option_list $TORTURE_OPTIONS + set executable $tmpdir/[file tail [file rootname $src].x] + regsub "(?q)$srcdir/" $src "" testcase + + if { ! [info exists algol68_compile_args] } { + set algol68_compile_args "" + } + if { ! [info exists algol68_execute_args] } { + set algol68_execute_args "" + } + + # If we couldn't rip $srcdir out of `src' then just do the best we can. + # The point is to reduce the unnecessary noise in the logs. Don't strip + # out too much because different testcases with the same name can confuse + # `test-tool'. + if [string match "/*" $testcase] { + set testcase "[file tail [file dirname $src]]/[file tail $src]" + } + + # Walk the list of options and compile and run the testcase for all + # options that are not explicitly disabled by the .x script (if present). + foreach option $option_list { + + # Torture_{compile,execute}_xfail are set by the .x script. + if [info exists torture_compile_xfail] { + setup_xfail $torture_compile_xfail + } + + # Torture_execute_before_{compile,execute} can be set by the .x script. + if [info exists torture_eval_before_compile] { + set ignore_me [eval $torture_eval_before_compile] + } + + # FIXME: We should make sure that the modules required by this testcase + # exist. If not, the testcase should XFAIL. + + # Compile the testcase. + catch { remote_file build delete $executable } + verbose "Testing $testcase, $option" 1 + + set options "" + lappend options "additional_flags=-w $option" + if { ${dg-extra-tool-flags} != "" } { + lappend options "additional_flags=${dg-extra-tool-flags}" + } + if { $additional_flags != "" } { + lappend options "additional_flags=$additional_flags" + } + if { $algol68_compile_args != "" } { + lappend options "additional_flags=$algol68_compile_args" + } + if { $BUILT_MODULES_DIR != "" } { + lappend options "additional_flags=-I$BUILT_MODULES_DIR" + } + if { $algol68_module_objects != "" } { + lappend options "additional_flags=$algol68_module_objects" + } + set comp_output [algol68_target_compile "$src" "$executable" executable $options] + + # See if we got something bad. + set fatal_signal "*algol68*: Internal compiler error: program*got fatal signal" + + if [string match "$fatal_signal 6" $comp_output] then { + algol68_fail $testcase "Got Signal 6, $option" + catch { remote_file build delete $executable } + continue + } + + if [string match "$fatal_signal 11" $comp_output] then { + algol68_fail $testcase "Got Signal 11, $option" + catch { remote_file build delete $executable } + continue + } + + if [regexp -line -- "internal compiler error.*" $comp_output ice] then { + algol68_fail $testcase "$option ($ice)" + catch { remote_file build delete $executable } + continue + } + + # We shouldn't get these because of -w, but just in case. + if [string match "*algol68*:*warning:*" $comp_output] then { + warning "$testcase: (with warnings) $option" + send_log "$comp_output\n" + unresolved "$testcase, $option" + catch { remote_file build delete $executable } + continue + } + + # Prune warnings we know are unwanted. + set comp_output [prune_warnings $comp_output] + + # Report if the testcase is not supported. + set unsupported_message [algol68_check_unsupported_p $comp_output] + if { $unsupported_message != "" } { + unsupported "$testcase: $unsupported_message" + continue + } elseif ![file exists $executable] { + if ![is3way] { + fail "$testcase compilation, $option" + untested "$testcase execution, $option" + continue + } else { + # FIXME: since we can't test for the existence of a remote + # file without short of doing an remote file list, we assume + # that since we got no output, it must have compiled. + pass "$testcase compilation, $option" + } + } else { + pass "$testcase compilation, $option" + } + + if [info exists torture_execute_xfail] { + setup_xfail $torture_execute_xfail + } + + if [info exists torture_eval_before_execute] { + set ignore_me [eval $torture_eval_before_execute] + } + + # Run the testcase, and analyse the output. + set result [algol68_load "$executable" "$algol68_execute_args" ""] + set status [lindex $result 0] + set output [lindex $result 1] + if { $status eq "pass" } { + pass "$testcase execution test, $option" + verbose "Exec succeeded." 3 + if { [llength ${dg-output-text}] > 1 } { + if { [lindex ${dg-output-text} 0] eq "F" } { + setup_xfail "*-*-*" + } + set texttmp [lindex ${dg-output-text} 1] + if { ![regexp -- $texttmp $output] } { + fail "$testcase output pattern test, $option" + send_log "Output was:\n${output}\nShould match:\n$texttmp\n" + verbose "Failed test for output pattern $texttmp" 3 + } else { + pass "$testcase output pattern test, $option" + verbose "Passed test for output pattern $texttmp" 3 + } + unset texttmp + } + } elseif { $status eq "fail" } { + if {[info exists errorCode]} { + verbose "Exec failed, errorCode: $errorCode" 3 + } else { + verbose "Exec failed, errorCode not defined!" 3 + } + fail "$testcase execution test, $option" + } else { + $status "$testcase execution, $option" + } + catch { remote_file build delete $executable } + } +} + + +# +# search_for_re -- looks for a string match in a file +# +proc search_for_re { file pattern } { + set fd [open $file r] + while { [gets $fd cur_line]>=0 } { + set lower [string tolower $cur_line] + if [regexp "$pattern" $lower] then { + close $fd + return 1 + } + } + close $fd + return 0 +} + + +# +# algol68-torture -- the algol68-torture testcase source file processor +# +# This runs compilation only tests (no execute tests). +# +# SRC is the full pathname of the testcase, or just a file name in which +# case we prepend $srcdir/$subdir. +# +# If the testcase has an associated .x file, we source that to run the +# test instead. We use .x so that we don't lengthen the existing filename +# to more than 14 chars. +# +proc algol68-torture { args } { + global srcdir subdir + global compiler_conditional_xfail_data + global TORTURE_OPTIONS + + set src [lindex $args 0] + if { [llength $args] > 1 } { + set options [lindex $args 1] + } else { + set options "" + } + + # Prepend $srdir/$subdir if missing. + if ![string match "*/*" $src] { + set src "$srcdir/$subdir/$src" + } + + # Check for alternate driver. + if [file exists [file rootname $src].x] { + verbose "Using alternate driver [file rootname [file tail $src]].x" 2 + set done_p 0 + catch "set done_p \[source [file rootname $src].x\]" + if { $done_p } { + return + } + } + + # loop through all the options + set option_list $TORTURE_OPTIONS + foreach option $option_list { + + # torture_compile_xfail is set by the .x script (if present) + if [info exists torture_compile_xfail] { + setup_xfail $torture_compile_xfail + } + + # torture_execute_before_compile is set by the .x script (if present) + if [info exists torture_eval_before_compile] { + set ignore_me [eval $torture_eval_before_compile] + } + + algol68-torture-compile $src "$option $options" + } +} + +# +# add-ieee-options -- add options necessary for 100% ieee conformance. +# +proc add-ieee-options { } { + # Ensure that excess precision does not cause problems. + if { [istarget i?86-*-*] + || [istarget m68k-*-*] } then { + uplevel 1 lappend additional_flags "-ffloat-store" + } + + # Enable full IEEE compliance mode. + if { [istarget alpha*-*-*] + || [istarget sh*-*-*] } then { + uplevel 1 lappend additional_flags "-mieee" + } +} diff --git a/gcc/testsuite/lib/algol68.exp b/gcc/testsuite/lib/algol68.exp new file mode 100644 index 000000000000..a7a0090aa760 --- /dev/null +++ b/gcc/testsuite/lib/algol68.exp @@ -0,0 +1,219 @@ +# Copyright (C) 2012-2024 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +# +# ALGOL68 support library routines +# + +load_lib prune.exp +load_lib gcc-defs.exp +load_lib timeout.exp +load_lib target-libpath.exp + +# +# ALGOL68_UNDER_TEST is the compiler under test. +# + +set algol68_compile_options "" + + +# +# algol68_include_flags -- include flags for the gcc tree structure +# + +proc algol68_include_flags { paths } { + global srcdir + global TESTING_IN_BUILD_TREE + + set flags "" + + if { [is_remote host] || ![info exists TESTING_IN_BUILD_TREE] } { + return "${flags}" + } + + set gccpath ${paths} + + return "$flags" +} + +# +# algol68_link_flags -- linker flags for the gcc tree structure +# + +proc algol68_link_flags { paths } { + global srcdir + global ld_library_path + global shlib_ext + global SHARED_OPTION + global ALGOL68_UNDER_TEST + + set gccpath ${paths} + set libio_dir "" + set flags "" + set ld_library_path "." + set shlib_ext [get_shlib_extension] + set SHARED_OPTION "" + verbose "shared lib extension: $shlib_ext" + + # We need to add options to locate libga68. + set target_wants_B_option 0 + if { [istarget *-*-darwin9* ] || [istarget *-*-darwin\[12\]* ] } { + set target_wants_B_option 1 + } + + if { $gccpath != "" } { + # Path to libga68.spec. + append flags "-B${gccpath}/libga68 " + if { [file exists "${gccpath}/libga68/.libs/libga68.a"] \ + || [file exists "${gccpath}/libga68/.libs/libga68.${shlib_ext}"] } { + if { $target_wants_B_option } { + append flags "-B${gccpath}/libga68/.libs " + } else { + append flags "-L${gccpath}/libga68/.libs " + } + append ld_library_path ":${gccpath}/libga68/.libs" + } + # Static linking is default. If only the shared lib is available adjust + # flags to always use it. If both are available, set SHARED_OPTION which + # will be added to PERMUTE_ARGS + if { [file exists "${gccpath}/libga68/src/.libs/libga68.${shlib_ext}"] } { + if { [file exists "${gccpath}/libga68/src/.libs/libga68.a"] } { + set SHARED_OPTION "-shared-libga68" + } else { +# append flags "-shared-libga68 " + } + } + if [file exists "${gccpath}/libiberty/libiberty.a"] { + append flags "-L${gccpath}/libiberty " + } + append ld_library_path [gcc-set-multilib-library-path $ALGOL68_UNDER_TEST] + } + + set_ld_library_path_env_vars + + return "$flags" +} + +# +# algol68_init -- called at the start of each subdir of tests +# + +proc algol68_init { args } { + global subdir + global algol68_initialized + global base_dir + global tmpdir + global libdir + global gluefile wrap_flags + global objdir srcdir + global ALWAYS_ALGOL68FLAGS + global TOOL_EXECUTABLE TOOL_OPTIONS + global ALGOL68_UNDER_TEST + global TESTING_IN_BUILD_TREE + global gcc_warning_prefix + global gcc_error_prefix + + # We set LC_ALL and LANG to C so that we get the same error messages as expected. + setenv LC_ALL C + setenv LANG C + + if ![info exists ALGOL68_UNDER_TEST] then { + if [info exists TOOL_EXECUTABLE] { + set ALGOL68_UNDER_TEST $TOOL_EXECUTABLE + } else { + if { [is_remote host] || ! [info exists TESTING_IN_BUILD_TREE] } { + set ALGOL68_UNDER_TEST [transform ga68] + } else { + set ALGOL68_UNDER_TEST [findfile $base_dir/../../ga68 "$base_dir/../../ga68 -B$base_dir/../../" [findfile $base_dir/ga68 "$base_dir/ga68 -B$base_dir/" [transform ga68]]] + } + } + } + + if ![is_remote host] { + if { [which $ALGOL68_UNDER_TEST] == 0 } then { + perror "ALGOL68_UNDER_TEST ($ALGOL68_UNDER_TEST) does not exist" + exit 1 + } + } + + if ![info exists tmpdir] { + set tmpdir "/tmp" + } + + if [info exists gluefile] { + unset gluefile + } + + set gcc_warning_prefix "warning:" + set gcc_error_prefix "(fatal )?error:" + + verbose "algol68 is initialized" 3 +} + +# +# algol68_target_compile -- compile a source file +# + +proc algol68_target_compile { source dest type options } { + global tmpdir + global gluefile wrap_flags + global ALWAYS_ALGOL68FLAGS + global ALGOL68_UNDER_TEST + global individual_timeout + global TEST_ALWAYS_FLAGS + + # HACK: guard against infinite loops in the compiler + set individual_timeout 20 + + if { [target_info needs_status_wrapper] != "" && [info exists gluefile] } { + lappend options "libs=${gluefile}" + lappend options "ldflags=${wrap_flags}" + } + + set ALWAYS_ALGOL68FLAGS "" + + # TEST_ALWAYS_FLAGS are flags that should be passed to every + # compilation. They are passed first to allow individual + # tests to override them. + if [info exists TEST_ALWAYS_FLAGS] { + lappend ALWAYS_ALGOL68FLAGS "additional_flags=$TEST_ALWAYS_FLAGS" + } + + if ![is_remote host] { + if [info exists TOOL_OPTIONS] { + lappend ALWAYS_ALGOL68FLAGS "additional_flags=[algol68_include_flags [get_multilibs ${TOOL_OPTIONS}] ]" + lappend ALWAYS_ALGOL68FLAGS "ldflags=[algol68_link_flags [get_multilibs ${TOOL_OPTIONS}] ]" + } else { + lappend ALWAYS_ALGOL68FLAGS "additional_flags=[algol68_include_flags [get_multilibs] ]" + lappend ALWAYS_ALGOL68FLAGS "ldflags=[algol68_link_flags [get_multilibs] ]" + } + } + + if [info exists TOOL_OPTIONS] { + lappend ALWAYS_ALGOL68FLAGS "additional_flags=$TOOL_OPTIONS" + } + + verbose -log "ALWAYS_ALGOL68FLAGS set to $ALWAYS_ALGOL68FLAGS" + + lappend options "timeout=[timeout_value]" + lappend options "compiler=$ALGOL68_UNDER_TEST" + + set options [concat "$ALWAYS_ALGOL68FLAGS" $options] + set options [dg-additional-files-options $options $source $dest $type] + set ret [target_compile $source $dest $type $options] + unset individual_timeout + return $ret +} From e39070324a24aee0c4846becb5973a7b54ad5cce Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:56:27 +0200 Subject: [PATCH 178/373] a68: testsuite: execution tests 1/2 Signed-off-by: Jose E. Marchesi gcc/testsuite/ChangeLog * algol68/execute/abs-bits-1.a68: New file. * algol68/execute/abs-bool-1.a68: Likewise. * algol68/execute/abs-char-1.a68: Likewise. * algol68/execute/abs-int-1.a68: Likewise. * algol68/execute/abs-int-negative-1.a68: Likewise. * algol68/execute/abs-int-negative-gnu-1.a68: Likewise. * algol68/execute/acos-1.a68: Likewise. * algol68/execute/affirm-int-1.a68: Likewise. * algol68/execute/and-bits-1.a68: Likewise. * algol68/execute/andf-1.a68: Likewise. * algol68/execute/ascription-1.a68: Likewise. * algol68/execute/asin-1.a68: Likewise. * algol68/execute/assert-1.a68: Likewise. * algol68/execute/assignation-char-1.a68: Likewise. * algol68/execute/assignation-int-1.a68: Likewise. * algol68/execute/assignation-int-2.a68: Likewise. * algol68/execute/assignation-int-3.a68: Likewise. * algol68/execute/assignation-int-4.a68: Likewise. * algol68/execute/assignation-int-5.a68: Likewise. * algol68/execute/assignation-multiple-1.a68: Likewise. * algol68/execute/assignation-multiple-2.a68: Likewise. * algol68/execute/assignation-struct-1.a68: Likewise. * algol68/execute/assignation-struct-2.a68: Likewise. * algol68/execute/atan-1.a68: Likewise. * algol68/execute/balancing-1.a68: Likewise. * algol68/execute/balancing-rows-1.a68: Likewise. * algol68/execute/bin-1.a68: Likewise. * algol68/execute/bin-negative-1.a68: Likewise. * algol68/execute/bin-negative-gnu-1.a68: Likewise. * algol68/execute/boolops-1.a68: Likewise. * algol68/execute/call-1.a68: Likewise. * algol68/execute/call-2.a68: Likewise. * algol68/execute/case-clause-1.a68: Likewise. * algol68/execute/case-clause-2.a68: Likewise. * algol68/execute/case-clause-3.a68: Likewise. * algol68/execute/case-clause-4.a68: Likewise. * algol68/execute/closed-clause-1.a68: Likewise. * algol68/execute/closed-clause-2.a68: Likewise. * algol68/execute/collateral-clause-1.a68: Likewise. * algol68/execute/collateral-clause-2.a68: Likewise. * algol68/execute/collateral-clause-3.a68: Likewise. * algol68/execute/collateral-clause-4.a68: Likewise. * algol68/execute/collateral-clause-5.a68: Likewise. * algol68/execute/collateral-clause-6.a68: Likewise. * algol68/execute/completer-1.a68: Likewise. * algol68/execute/completer-10.a68: Likewise. * algol68/execute/completer-2.a68: Likewise. * algol68/execute/completer-3.a68: Likewise. * algol68/execute/completer-4.a68: Likewise. * algol68/execute/completer-5.a68: Likewise. * algol68/execute/completer-6.a68: Likewise. * algol68/execute/completer-7.a68: Likewise. * algol68/execute/completer-8.a68: Likewise. * algol68/execute/completer-9.a68: Likewise. * algol68/execute/cond-clause-1.a68: Likewise. * algol68/execute/cond-clause-2.a68: Likewise. * algol68/execute/cond-clause-3.a68: Likewise. * algol68/execute/cond-clause-4.a68: Likewise. * algol68/execute/cond-clause-5.a68: Likewise. * algol68/execute/cond-clause-6.a68: Likewise. * algol68/execute/cond-clause-7.a68: Likewise. * algol68/execute/cond-clause-8.a68: Likewise. * algol68/execute/cond-clause-9.a68: Likewise. * algol68/execute/conformity-clause-1.a68: Likewise. * algol68/execute/conformity-clause-2.a68: Likewise. * algol68/execute/conformity-clause-3.a68: Likewise. * algol68/execute/conformity-clause-4.a68: Likewise. * algol68/execute/conformity-clause-5.a68: Likewise. * algol68/execute/conformity-clause-6.a68: Likewise. * algol68/execute/conformity-clause-7.a68: Likewise. * algol68/execute/conformity-clause-8.a68: Likewise. * algol68/execute/conformity-clause-9.a68: Likewise. * algol68/execute/conj-1.a68: Likewise. * algol68/execute/cos-1.a68: Likewise. * algol68/execute/declarer-1.a68: Likewise. * algol68/execute/declarer-2.a68: Likewise. * algol68/execute/deprocedure-1.a68: Likewise. * algol68/execute/deprocedure-2.a68: Likewise. * algol68/execute/deref-1.a68: Likewise. * algol68/execute/deref-2.a68: Likewise. * algol68/execute/deref-3.a68: Likewise. * algol68/execute/deref-4.a68: Likewise. * algol68/execute/deref-5.a68: Likewise. * algol68/execute/deref-6.a68: Likewise. * algol68/execute/deref-7.a68: Likewise. * algol68/execute/deref-8.a68: Likewise. * algol68/execute/div-int-1.a68: Likewise. * algol68/execute/divab-real-1.a68: Likewise. * algol68/execute/elem-bits-1.a68: Likewise. * algol68/execute/elems-1.a68: Likewise. * algol68/execute/elems-2.a68: Likewise. * algol68/execute/entier-1.a68: Likewise. * algol68/execute/environment-enquiries-1.a68: Likewise. * algol68/execute/environment-enquiries-2.a68: Likewise. * algol68/execute/environment-enquiries-3.a68: Likewise. * algol68/execute/environment-enquiries-4.a68: Likewise. * algol68/execute/environment-enquiries-5.a68: Likewise. * algol68/execute/environment-enquiries-6.a68: Likewise. * algol68/execute/environment-enquiries-7.a68: Likewise. * algol68/execute/environment-enquiries-8.a68: Likewise. * algol68/execute/eq-bits-1.a68: Likewise. * algol68/execute/eq-char-char-1.a68: Likewise. * algol68/execute/eq-int-1.a68: Likewise. * algol68/execute/eq-string-1.a68: Likewise. * algol68/execute/eq-string-stride-1.a68: Likewise. * algol68/execute/execute.exp: Likewise. * algol68/execute/factorial-1.a68: Likewise. * algol68/execute/flat-assignation-1.a68: Likewise. * algol68/execute/flat-assignation-2.a68: Likewise. * algol68/execute/flex-1.a68: Likewise. * algol68/execute/flex-2.a68: Likewise. * algol68/execute/flex-3.a68: Likewise. * algol68/execute/flex-4.a68: Likewise. * algol68/execute/flex-5.a68: Likewise. * algol68/execute/formula-1.a68: Likewise. * algol68/execute/formula-2.a68: Likewise. * algol68/execute/fsize-1.a68: Likewise. * algol68/execute/ge-int-1.a68: Likewise. * algol68/execute/ge-string-stride-1.a68: Likewise. * algol68/execute/gen-flex-1.a68: Likewise. * algol68/execute/gen-heap-1.a68: Likewise. * algol68/execute/gen-heap-2.a68: Likewise. * algol68/execute/gen-heap-3.a68: Likewise. * algol68/execute/gen-heap-bool-1.a68: Likewise. * algol68/execute/gen-heap-int-1.a68: Likewise. * algol68/execute/gen-heap-real-1.a68: Likewise. * algol68/execute/gen-heap-struct-1.a68: Likewise. * algol68/execute/gen-heap-struct-2.a68: Likewise. * algol68/execute/gen-heap-struct-3.a68: Likewise. * algol68/execute/gen-loc-1.a68: Likewise. * algol68/execute/gen-loc-2.a68: Likewise. * algol68/execute/gen-loc-3.a68: Likewise. * algol68/execute/gen-loc-4.a68: Likewise. * algol68/execute/gen-multiple-1.a68: Likewise. * algol68/execute/gen-union-1.a68: Likewise. * algol68/execute/gen-union-2.a68: Likewise. * algol68/execute/gen-union-3.a68: Likewise. * algol68/execute/goto-1.a68: Likewise. * algol68/execute/goto-2.a68: Likewise. * algol68/execute/goto-3.a68: Likewise. * algol68/execute/goto-4.a68: Likewise. * algol68/execute/goto-5.a68: Likewise. * algol68/execute/gt-int-1.a68: Likewise. * algol68/execute/gt-string-stride-1.a68: Likewise. * algol68/execute/i-1.a68: Likewise. * algol68/execute/i-2.a68: Likewise. * algol68/execute/identification-1.a68: Likewise. * algol68/execute/identification-2.a68: Likewise. * algol68/execute/identity-declaration-1.a68: Likewise. * algol68/execute/identity-declaration-2.a68: Likewise. * algol68/execute/identity-declaration-3.a68: Likewise. * algol68/execute/identity-declaration-4.a68: Likewise. * algol68/execute/identity-declaration-5.a68: Likewise. * algol68/execute/identity-declaration-multiple-1.a68: Likewise. * algol68/execute/identity-declaration-multiple-2.a68: Likewise. * algol68/execute/identity-declaration-multiple-3.a68: Likewise. * algol68/execute/identity-declaration-multiple-5.a68: Likewise. * algol68/execute/identity-declaration-multiple-empty-1.a68: Likewise. * algol68/execute/identity-declaration-multiple-empty-2.a68: Likewise. * algol68/execute/identity-declaration-multiple-empty-3.a68: Likewise. * algol68/execute/identity-declaration-multiple-empty-4.a68: Likewise. * algol68/execute/identity-declaration-struct-1.a68: Likewise. * algol68/execute/infinity-1.a68: Likewise. * algol68/execute/le-ge-bits-1.a68: Likewise. * algol68/execute/le-int-1.a68: Likewise. * algol68/execute/le-string-stride-1.a68: Likewise. * algol68/execute/leng-shorten-bits-1.a68: Likewise. * algol68/execute/leng-shorten-ints-1.a68: Likewise. * algol68/execute/leng-shorten-reals-1.a68: Likewise. * algol68/execute/lengths-shorths-1.a68: Likewise. * algol68/execute/lisp-1.a68: Likewise. * algol68/execute/lisp-2.a68: Likewise. * algol68/execute/ln-1.a68: Likewise. * algol68/execute/log-1.a68: Likewise. * algol68/execute/loop-1.a68: Likewise. * algol68/execute/loop-10.a68: Likewise. * algol68/execute/loop-11.a68: Likewise. * algol68/execute/loop-12.a68: Likewise. * algol68/execute/loop-13.a68: Likewise. * algol68/execute/loop-14.a68: Likewise. * algol68/execute/loop-2.a68: Likewise. * algol68/execute/loop-3.a68: Likewise. * algol68/execute/loop-4.a68: Likewise. * algol68/execute/loop-5.a68: Likewise. * algol68/execute/loop-6.a68: Likewise. --- gcc/testsuite/algol68/execute/abs-bits-1.a68 | 7 + gcc/testsuite/algol68/execute/abs-bool-1.a68 | 4 + gcc/testsuite/algol68/execute/abs-char-1.a68 | 3 + gcc/testsuite/algol68/execute/abs-int-1.a68 | 10 ++ .../algol68/execute/abs-int-negative-1.a68 | 4 + .../execute/abs-int-negative-gnu-1.a68 | 4 + gcc/testsuite/algol68/execute/acos-1.a68 | 8 + .../algol68/execute/affirm-int-1.a68 | 10 ++ gcc/testsuite/algol68/execute/and-bits-1.a68 | 18 ++ gcc/testsuite/algol68/execute/andf-1.a68 | 4 + .../algol68/execute/ascription-1.a68 | 12 ++ gcc/testsuite/algol68/execute/asin-1.a68 | 8 + gcc/testsuite/algol68/execute/assert-1.a68 | 3 + .../algol68/execute/assignation-char-1.a68 | 5 + .../algol68/execute/assignation-int-1.a68 | 5 + .../algol68/execute/assignation-int-2.a68 | 5 + .../algol68/execute/assignation-int-3.a68 | 6 + .../algol68/execute/assignation-int-4.a68 | 5 + .../algol68/execute/assignation-int-5.a68 | 6 + .../execute/assignation-multiple-1.a68 | 4 + .../execute/assignation-multiple-2.a68 | 15 ++ .../algol68/execute/assignation-struct-1.a68 | 6 + .../algol68/execute/assignation-struct-2.a68 | 8 + gcc/testsuite/algol68/execute/atan-1.a68 | 8 + gcc/testsuite/algol68/execute/balancing-1.a68 | 12 ++ .../algol68/execute/balancing-rows-1.a68 | 4 + gcc/testsuite/algol68/execute/bin-1.a68 | 6 + .../algol68/execute/bin-negative-1.a68 | 3 + .../algol68/execute/bin-negative-gnu-1.a68 | 3 + gcc/testsuite/algol68/execute/boolops-1.a68 | 18 ++ gcc/testsuite/algol68/execute/call-1.a68 | 19 ++ gcc/testsuite/algol68/execute/call-2.a68 | 21 +++ .../algol68/execute/case-clause-1.a68 | 10 ++ .../algol68/execute/case-clause-2.a68 | 8 + .../algol68/execute/case-clause-3.a68 | 7 + .../algol68/execute/case-clause-4.a68 | 5 + .../algol68/execute/closed-clause-1.a68 | 10 ++ .../algol68/execute/closed-clause-2.a68 | 9 + .../algol68/execute/collateral-clause-1.a68 | 4 + .../algol68/execute/collateral-clause-2.a68 | 9 + .../algol68/execute/collateral-clause-3.a68 | 11 ++ .../algol68/execute/collateral-clause-4.a68 | 3 + .../algol68/execute/collateral-clause-5.a68 | 5 + .../algol68/execute/collateral-clause-6.a68 | 8 + gcc/testsuite/algol68/execute/completer-1.a68 | 9 + .../algol68/execute/completer-10.a68 | 7 + gcc/testsuite/algol68/execute/completer-2.a68 | 7 + gcc/testsuite/algol68/execute/completer-3.a68 | 4 + gcc/testsuite/algol68/execute/completer-4.a68 | 4 + gcc/testsuite/algol68/execute/completer-5.a68 | 5 + gcc/testsuite/algol68/execute/completer-6.a68 | 5 + gcc/testsuite/algol68/execute/completer-7.a68 | 5 + gcc/testsuite/algol68/execute/completer-8.a68 | 5 + gcc/testsuite/algol68/execute/completer-9.a68 | 6 + .../algol68/execute/cond-clause-1.a68 | 5 + .../algol68/execute/cond-clause-2.a68 | 5 + .../algol68/execute/cond-clause-3.a68 | 7 + .../algol68/execute/cond-clause-4.a68 | 3 + .../algol68/execute/cond-clause-5.a68 | 3 + .../algol68/execute/cond-clause-6.a68 | 23 +++ .../algol68/execute/cond-clause-7.a68 | 23 +++ .../algol68/execute/cond-clause-8.a68 | 20 +++ .../algol68/execute/cond-clause-9.a68 | 23 +++ .../algol68/execute/conformity-clause-1.a68 | 10 ++ .../algol68/execute/conformity-clause-2.a68 | 11 ++ .../algol68/execute/conformity-clause-3.a68 | 11 ++ .../algol68/execute/conformity-clause-4.a68 | 7 + .../algol68/execute/conformity-clause-5.a68 | 14 ++ .../algol68/execute/conformity-clause-6.a68 | 8 + .../algol68/execute/conformity-clause-7.a68 | 7 + .../algol68/execute/conformity-clause-8.a68 | 11 ++ .../algol68/execute/conformity-clause-9.a68 | 10 ++ gcc/testsuite/algol68/execute/conj-1.a68 | 9 + gcc/testsuite/algol68/execute/cos-1.a68 | 8 + gcc/testsuite/algol68/execute/declarer-1.a68 | 9 + gcc/testsuite/algol68/execute/declarer-2.a68 | 6 + .../algol68/execute/deprocedure-1.a68 | 5 + .../algol68/execute/deprocedure-2.a68 | 6 + gcc/testsuite/algol68/execute/deref-1.a68 | 5 + gcc/testsuite/algol68/execute/deref-2.a68 | 6 + gcc/testsuite/algol68/execute/deref-3.a68 | 11 ++ gcc/testsuite/algol68/execute/deref-4.a68 | 8 + gcc/testsuite/algol68/execute/deref-5.a68 | 42 +++++ gcc/testsuite/algol68/execute/deref-6.a68 | 48 +++++ gcc/testsuite/algol68/execute/deref-7.a68 | 48 +++++ gcc/testsuite/algol68/execute/deref-8.a68 | 53 ++++++ gcc/testsuite/algol68/execute/div-int-1.a68 | 7 + .../algol68/execute/divab-real-1.a68 | 11 ++ gcc/testsuite/algol68/execute/elem-bits-1.a68 | 18 ++ gcc/testsuite/algol68/execute/elems-1.a68 | 6 + gcc/testsuite/algol68/execute/elems-2.a68 | 7 + gcc/testsuite/algol68/execute/entier-1.a68 | 8 + .../execute/environment-enquiries-1.a68 | 10 ++ .../execute/environment-enquiries-2.a68 | 12 ++ .../execute/environment-enquiries-3.a68 | 9 + .../execute/environment-enquiries-4.a68 | 7 + .../execute/environment-enquiries-5.a68 | 5 + .../execute/environment-enquiries-6.a68 | 7 + .../execute/environment-enquiries-7.a68 | 15 ++ .../execute/environment-enquiries-8.a68 | 6 + gcc/testsuite/algol68/execute/eq-bits-1.a68 | 10 ++ .../algol68/execute/eq-char-char-1.a68 | 4 + gcc/testsuite/algol68/execute/eq-int-1.a68 | 10 ++ gcc/testsuite/algol68/execute/eq-string-1.a68 | 16 ++ .../algol68/execute/eq-string-stride-1.a68 | 6 + gcc/testsuite/algol68/execute/execute.exp | 37 ++++ gcc/testsuite/algol68/execute/factorial-1.a68 | 170 ++++++++++++++++++ .../algol68/execute/flat-assignation-1.a68 | 7 + .../algol68/execute/flat-assignation-2.a68 | 8 + gcc/testsuite/algol68/execute/flex-1.a68 | 5 + gcc/testsuite/algol68/execute/flex-2.a68 | 8 + gcc/testsuite/algol68/execute/flex-3.a68 | 7 + gcc/testsuite/algol68/execute/flex-4.a68 | 6 + gcc/testsuite/algol68/execute/flex-5.a68 | 12 ++ gcc/testsuite/algol68/execute/formula-1.a68 | 9 + gcc/testsuite/algol68/execute/formula-2.a68 | 7 + gcc/testsuite/algol68/execute/fsize-1.a68 | 2 + gcc/testsuite/algol68/execute/ge-int-1.a68 | 10 ++ .../algol68/execute/ge-string-stride-1.a68 | 7 + gcc/testsuite/algol68/execute/gen-flex-1.a68 | 10 ++ gcc/testsuite/algol68/execute/gen-heap-1.a68 | 6 + gcc/testsuite/algol68/execute/gen-heap-2.a68 | 6 + gcc/testsuite/algol68/execute/gen-heap-3.a68 | 5 + .../algol68/execute/gen-heap-bool-1.a68 | 6 + .../algol68/execute/gen-heap-int-1.a68 | 4 + .../algol68/execute/gen-heap-real-1.a68 | 4 + .../algol68/execute/gen-heap-struct-1.a68 | 4 + .../algol68/execute/gen-heap-struct-2.a68 | 5 + .../algol68/execute/gen-heap-struct-3.a68 | 5 + gcc/testsuite/algol68/execute/gen-loc-1.a68 | 6 + gcc/testsuite/algol68/execute/gen-loc-2.a68 | 6 + gcc/testsuite/algol68/execute/gen-loc-3.a68 | 5 + gcc/testsuite/algol68/execute/gen-loc-4.a68 | 8 + .../algol68/execute/gen-multiple-1.a68 | 5 + gcc/testsuite/algol68/execute/gen-union-1.a68 | 17 ++ gcc/testsuite/algol68/execute/gen-union-2.a68 | 20 +++ gcc/testsuite/algol68/execute/gen-union-3.a68 | 14 ++ gcc/testsuite/algol68/execute/goto-1.a68 | 7 + gcc/testsuite/algol68/execute/goto-2.a68 | 5 + gcc/testsuite/algol68/execute/goto-3.a68 | 9 + gcc/testsuite/algol68/execute/goto-4.a68 | 9 + gcc/testsuite/algol68/execute/goto-5.a68 | 20 +++ gcc/testsuite/algol68/execute/gt-int-1.a68 | 10 ++ .../algol68/execute/gt-string-stride-1.a68 | 7 + gcc/testsuite/algol68/execute/i-1.a68 | 6 + gcc/testsuite/algol68/execute/i-2.a68 | 6 + .../algol68/execute/identification-1.a68 | 6 + .../algol68/execute/identification-2.a68 | 14 ++ .../execute/identity-declaration-1.a68 | 6 + .../execute/identity-declaration-2.a68 | 6 + .../execute/identity-declaration-3.a68 | 6 + .../execute/identity-declaration-4.a68 | 5 + .../execute/identity-declaration-5.a68 | 5 + .../identity-declaration-multiple-1.a68 | 4 + .../identity-declaration-multiple-2.a68 | 4 + .../identity-declaration-multiple-3.a68 | 6 + .../identity-declaration-multiple-5.a68 | 4 + .../identity-declaration-multiple-empty-1.a68 | 6 + .../identity-declaration-multiple-empty-2.a68 | 12 ++ .../identity-declaration-multiple-empty-3.a68 | 4 + .../identity-declaration-multiple-empty-4.a68 | 4 + .../execute/identity-declaration-struct-1.a68 | 10 ++ gcc/testsuite/algol68/execute/infinity-1.a68 | 4 + .../algol68/execute/le-ge-bits-1.a68 | 17 ++ gcc/testsuite/algol68/execute/le-int-1.a68 | 10 ++ .../algol68/execute/le-string-stride-1.a68 | 7 + .../algol68/execute/leng-shorten-bits-1.a68 | 7 + .../algol68/execute/leng-shorten-ints-1.a68 | 27 +++ .../algol68/execute/leng-shorten-reals-1.a68 | 17 ++ .../algol68/execute/lengths-shorths-1.a68 | 8 + gcc/testsuite/algol68/execute/lisp-1.a68 | 25 +++ gcc/testsuite/algol68/execute/lisp-2.a68 | 21 +++ gcc/testsuite/algol68/execute/ln-1.a68 | 8 + gcc/testsuite/algol68/execute/log-1.a68 | 8 + gcc/testsuite/algol68/execute/loop-1.a68 | 6 + gcc/testsuite/algol68/execute/loop-10.a68 | 5 + gcc/testsuite/algol68/execute/loop-11.a68 | 6 + gcc/testsuite/algol68/execute/loop-12.a68 | 5 + gcc/testsuite/algol68/execute/loop-13.a68 | 6 + gcc/testsuite/algol68/execute/loop-14.a68 | 7 + gcc/testsuite/algol68/execute/loop-2.a68 | 7 + gcc/testsuite/algol68/execute/loop-3.a68 | 14 ++ gcc/testsuite/algol68/execute/loop-4.a68 | 13 ++ gcc/testsuite/algol68/execute/loop-5.a68 | 7 + gcc/testsuite/algol68/execute/loop-6.a68 | 7 + 185 files changed, 1893 insertions(+) create mode 100644 gcc/testsuite/algol68/execute/abs-bits-1.a68 create mode 100644 gcc/testsuite/algol68/execute/abs-bool-1.a68 create mode 100644 gcc/testsuite/algol68/execute/abs-char-1.a68 create mode 100644 gcc/testsuite/algol68/execute/abs-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/abs-int-negative-1.a68 create mode 100644 gcc/testsuite/algol68/execute/abs-int-negative-gnu-1.a68 create mode 100644 gcc/testsuite/algol68/execute/acos-1.a68 create mode 100644 gcc/testsuite/algol68/execute/affirm-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/and-bits-1.a68 create mode 100644 gcc/testsuite/algol68/execute/andf-1.a68 create mode 100644 gcc/testsuite/algol68/execute/ascription-1.a68 create mode 100644 gcc/testsuite/algol68/execute/asin-1.a68 create mode 100644 gcc/testsuite/algol68/execute/assert-1.a68 create mode 100644 gcc/testsuite/algol68/execute/assignation-char-1.a68 create mode 100644 gcc/testsuite/algol68/execute/assignation-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/assignation-int-2.a68 create mode 100644 gcc/testsuite/algol68/execute/assignation-int-3.a68 create mode 100644 gcc/testsuite/algol68/execute/assignation-int-4.a68 create mode 100644 gcc/testsuite/algol68/execute/assignation-int-5.a68 create mode 100644 gcc/testsuite/algol68/execute/assignation-multiple-1.a68 create mode 100644 gcc/testsuite/algol68/execute/assignation-multiple-2.a68 create mode 100644 gcc/testsuite/algol68/execute/assignation-struct-1.a68 create mode 100644 gcc/testsuite/algol68/execute/assignation-struct-2.a68 create mode 100644 gcc/testsuite/algol68/execute/atan-1.a68 create mode 100644 gcc/testsuite/algol68/execute/balancing-1.a68 create mode 100644 gcc/testsuite/algol68/execute/balancing-rows-1.a68 create mode 100644 gcc/testsuite/algol68/execute/bin-1.a68 create mode 100644 gcc/testsuite/algol68/execute/bin-negative-1.a68 create mode 100644 gcc/testsuite/algol68/execute/bin-negative-gnu-1.a68 create mode 100644 gcc/testsuite/algol68/execute/boolops-1.a68 create mode 100644 gcc/testsuite/algol68/execute/call-1.a68 create mode 100644 gcc/testsuite/algol68/execute/call-2.a68 create mode 100644 gcc/testsuite/algol68/execute/case-clause-1.a68 create mode 100644 gcc/testsuite/algol68/execute/case-clause-2.a68 create mode 100644 gcc/testsuite/algol68/execute/case-clause-3.a68 create mode 100644 gcc/testsuite/algol68/execute/case-clause-4.a68 create mode 100644 gcc/testsuite/algol68/execute/closed-clause-1.a68 create mode 100644 gcc/testsuite/algol68/execute/closed-clause-2.a68 create mode 100644 gcc/testsuite/algol68/execute/collateral-clause-1.a68 create mode 100644 gcc/testsuite/algol68/execute/collateral-clause-2.a68 create mode 100644 gcc/testsuite/algol68/execute/collateral-clause-3.a68 create mode 100644 gcc/testsuite/algol68/execute/collateral-clause-4.a68 create mode 100644 gcc/testsuite/algol68/execute/collateral-clause-5.a68 create mode 100644 gcc/testsuite/algol68/execute/collateral-clause-6.a68 create mode 100644 gcc/testsuite/algol68/execute/completer-1.a68 create mode 100644 gcc/testsuite/algol68/execute/completer-10.a68 create mode 100644 gcc/testsuite/algol68/execute/completer-2.a68 create mode 100644 gcc/testsuite/algol68/execute/completer-3.a68 create mode 100644 gcc/testsuite/algol68/execute/completer-4.a68 create mode 100644 gcc/testsuite/algol68/execute/completer-5.a68 create mode 100644 gcc/testsuite/algol68/execute/completer-6.a68 create mode 100644 gcc/testsuite/algol68/execute/completer-7.a68 create mode 100644 gcc/testsuite/algol68/execute/completer-8.a68 create mode 100644 gcc/testsuite/algol68/execute/completer-9.a68 create mode 100644 gcc/testsuite/algol68/execute/cond-clause-1.a68 create mode 100644 gcc/testsuite/algol68/execute/cond-clause-2.a68 create mode 100644 gcc/testsuite/algol68/execute/cond-clause-3.a68 create mode 100644 gcc/testsuite/algol68/execute/cond-clause-4.a68 create mode 100644 gcc/testsuite/algol68/execute/cond-clause-5.a68 create mode 100644 gcc/testsuite/algol68/execute/cond-clause-6.a68 create mode 100644 gcc/testsuite/algol68/execute/cond-clause-7.a68 create mode 100644 gcc/testsuite/algol68/execute/cond-clause-8.a68 create mode 100644 gcc/testsuite/algol68/execute/cond-clause-9.a68 create mode 100644 gcc/testsuite/algol68/execute/conformity-clause-1.a68 create mode 100644 gcc/testsuite/algol68/execute/conformity-clause-2.a68 create mode 100644 gcc/testsuite/algol68/execute/conformity-clause-3.a68 create mode 100644 gcc/testsuite/algol68/execute/conformity-clause-4.a68 create mode 100644 gcc/testsuite/algol68/execute/conformity-clause-5.a68 create mode 100644 gcc/testsuite/algol68/execute/conformity-clause-6.a68 create mode 100644 gcc/testsuite/algol68/execute/conformity-clause-7.a68 create mode 100644 gcc/testsuite/algol68/execute/conformity-clause-8.a68 create mode 100644 gcc/testsuite/algol68/execute/conformity-clause-9.a68 create mode 100644 gcc/testsuite/algol68/execute/conj-1.a68 create mode 100644 gcc/testsuite/algol68/execute/cos-1.a68 create mode 100644 gcc/testsuite/algol68/execute/declarer-1.a68 create mode 100644 gcc/testsuite/algol68/execute/declarer-2.a68 create mode 100644 gcc/testsuite/algol68/execute/deprocedure-1.a68 create mode 100644 gcc/testsuite/algol68/execute/deprocedure-2.a68 create mode 100644 gcc/testsuite/algol68/execute/deref-1.a68 create mode 100644 gcc/testsuite/algol68/execute/deref-2.a68 create mode 100644 gcc/testsuite/algol68/execute/deref-3.a68 create mode 100644 gcc/testsuite/algol68/execute/deref-4.a68 create mode 100644 gcc/testsuite/algol68/execute/deref-5.a68 create mode 100644 gcc/testsuite/algol68/execute/deref-6.a68 create mode 100644 gcc/testsuite/algol68/execute/deref-7.a68 create mode 100644 gcc/testsuite/algol68/execute/deref-8.a68 create mode 100644 gcc/testsuite/algol68/execute/div-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/divab-real-1.a68 create mode 100644 gcc/testsuite/algol68/execute/elem-bits-1.a68 create mode 100644 gcc/testsuite/algol68/execute/elems-1.a68 create mode 100644 gcc/testsuite/algol68/execute/elems-2.a68 create mode 100644 gcc/testsuite/algol68/execute/entier-1.a68 create mode 100644 gcc/testsuite/algol68/execute/environment-enquiries-1.a68 create mode 100644 gcc/testsuite/algol68/execute/environment-enquiries-2.a68 create mode 100644 gcc/testsuite/algol68/execute/environment-enquiries-3.a68 create mode 100644 gcc/testsuite/algol68/execute/environment-enquiries-4.a68 create mode 100644 gcc/testsuite/algol68/execute/environment-enquiries-5.a68 create mode 100644 gcc/testsuite/algol68/execute/environment-enquiries-6.a68 create mode 100644 gcc/testsuite/algol68/execute/environment-enquiries-7.a68 create mode 100644 gcc/testsuite/algol68/execute/environment-enquiries-8.a68 create mode 100644 gcc/testsuite/algol68/execute/eq-bits-1.a68 create mode 100644 gcc/testsuite/algol68/execute/eq-char-char-1.a68 create mode 100644 gcc/testsuite/algol68/execute/eq-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/eq-string-1.a68 create mode 100644 gcc/testsuite/algol68/execute/eq-string-stride-1.a68 create mode 100644 gcc/testsuite/algol68/execute/execute.exp create mode 100644 gcc/testsuite/algol68/execute/factorial-1.a68 create mode 100644 gcc/testsuite/algol68/execute/flat-assignation-1.a68 create mode 100644 gcc/testsuite/algol68/execute/flat-assignation-2.a68 create mode 100644 gcc/testsuite/algol68/execute/flex-1.a68 create mode 100644 gcc/testsuite/algol68/execute/flex-2.a68 create mode 100644 gcc/testsuite/algol68/execute/flex-3.a68 create mode 100644 gcc/testsuite/algol68/execute/flex-4.a68 create mode 100644 gcc/testsuite/algol68/execute/flex-5.a68 create mode 100644 gcc/testsuite/algol68/execute/formula-1.a68 create mode 100644 gcc/testsuite/algol68/execute/formula-2.a68 create mode 100644 gcc/testsuite/algol68/execute/fsize-1.a68 create mode 100644 gcc/testsuite/algol68/execute/ge-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/ge-string-stride-1.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-flex-1.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-heap-1.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-heap-2.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-heap-3.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-heap-bool-1.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-heap-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-heap-real-1.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-heap-struct-1.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-heap-struct-2.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-heap-struct-3.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-loc-1.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-loc-2.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-loc-3.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-loc-4.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-multiple-1.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-union-1.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-union-2.a68 create mode 100644 gcc/testsuite/algol68/execute/gen-union-3.a68 create mode 100644 gcc/testsuite/algol68/execute/goto-1.a68 create mode 100644 gcc/testsuite/algol68/execute/goto-2.a68 create mode 100644 gcc/testsuite/algol68/execute/goto-3.a68 create mode 100644 gcc/testsuite/algol68/execute/goto-4.a68 create mode 100644 gcc/testsuite/algol68/execute/goto-5.a68 create mode 100644 gcc/testsuite/algol68/execute/gt-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/gt-string-stride-1.a68 create mode 100644 gcc/testsuite/algol68/execute/i-1.a68 create mode 100644 gcc/testsuite/algol68/execute/i-2.a68 create mode 100644 gcc/testsuite/algol68/execute/identification-1.a68 create mode 100644 gcc/testsuite/algol68/execute/identification-2.a68 create mode 100644 gcc/testsuite/algol68/execute/identity-declaration-1.a68 create mode 100644 gcc/testsuite/algol68/execute/identity-declaration-2.a68 create mode 100644 gcc/testsuite/algol68/execute/identity-declaration-3.a68 create mode 100644 gcc/testsuite/algol68/execute/identity-declaration-4.a68 create mode 100644 gcc/testsuite/algol68/execute/identity-declaration-5.a68 create mode 100644 gcc/testsuite/algol68/execute/identity-declaration-multiple-1.a68 create mode 100644 gcc/testsuite/algol68/execute/identity-declaration-multiple-2.a68 create mode 100644 gcc/testsuite/algol68/execute/identity-declaration-multiple-3.a68 create mode 100644 gcc/testsuite/algol68/execute/identity-declaration-multiple-5.a68 create mode 100644 gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-1.a68 create mode 100644 gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-2.a68 create mode 100644 gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-3.a68 create mode 100644 gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-4.a68 create mode 100644 gcc/testsuite/algol68/execute/identity-declaration-struct-1.a68 create mode 100644 gcc/testsuite/algol68/execute/infinity-1.a68 create mode 100644 gcc/testsuite/algol68/execute/le-ge-bits-1.a68 create mode 100644 gcc/testsuite/algol68/execute/le-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/le-string-stride-1.a68 create mode 100644 gcc/testsuite/algol68/execute/leng-shorten-bits-1.a68 create mode 100644 gcc/testsuite/algol68/execute/leng-shorten-ints-1.a68 create mode 100644 gcc/testsuite/algol68/execute/leng-shorten-reals-1.a68 create mode 100644 gcc/testsuite/algol68/execute/lengths-shorths-1.a68 create mode 100644 gcc/testsuite/algol68/execute/lisp-1.a68 create mode 100644 gcc/testsuite/algol68/execute/lisp-2.a68 create mode 100644 gcc/testsuite/algol68/execute/ln-1.a68 create mode 100644 gcc/testsuite/algol68/execute/log-1.a68 create mode 100644 gcc/testsuite/algol68/execute/loop-1.a68 create mode 100644 gcc/testsuite/algol68/execute/loop-10.a68 create mode 100644 gcc/testsuite/algol68/execute/loop-11.a68 create mode 100644 gcc/testsuite/algol68/execute/loop-12.a68 create mode 100644 gcc/testsuite/algol68/execute/loop-13.a68 create mode 100644 gcc/testsuite/algol68/execute/loop-14.a68 create mode 100644 gcc/testsuite/algol68/execute/loop-2.a68 create mode 100644 gcc/testsuite/algol68/execute/loop-3.a68 create mode 100644 gcc/testsuite/algol68/execute/loop-4.a68 create mode 100644 gcc/testsuite/algol68/execute/loop-5.a68 create mode 100644 gcc/testsuite/algol68/execute/loop-6.a68 diff --git a/gcc/testsuite/algol68/execute/abs-bits-1.a68 b/gcc/testsuite/algol68/execute/abs-bits-1.a68 new file mode 100644 index 000000000000..bdb3a1bef52e --- /dev/null +++ b/gcc/testsuite/algol68/execute/abs-bits-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# ABS for SIZETY BITS # +BEGIN ASSERT (255 = ABS 16rff); + ASSERT (LONG 255 = ABS LONG 16rff); + ASSERT (LONG LONG 255 = ABS LONG LONG 16rff) + # XXX test ABS of negative numbers (extension). # +END diff --git a/gcc/testsuite/algol68/execute/abs-bool-1.a68 b/gcc/testsuite/algol68/execute/abs-bool-1.a68 new file mode 100644 index 000000000000..90ea0d685a34 --- /dev/null +++ b/gcc/testsuite/algol68/execute/abs-bool-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (ABS TRUE /= 0); + ASSERT (ABS FALSE = 0) +END diff --git a/gcc/testsuite/algol68/execute/abs-char-1.a68 b/gcc/testsuite/algol68/execute/abs-char-1.a68 new file mode 100644 index 000000000000..124fb3d473ff --- /dev/null +++ b/gcc/testsuite/algol68/execute/abs-char-1.a68 @@ -0,0 +1,3 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (ABS "a" = 97) +END diff --git a/gcc/testsuite/algol68/execute/abs-int-1.a68 b/gcc/testsuite/algol68/execute/abs-int-1.a68 new file mode 100644 index 000000000000..fa8125a1587b --- /dev/null +++ b/gcc/testsuite/algol68/execute/abs-int-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (ABS 10 = 10); + ASSERT (ABS -10 = 10); + ASSERT (ABS SHORT 10 = SHORT 10); + ASSERT (ABS - SHORT 10 = SHORT 10); + ASSERT (ABS - SHORT SHORT 10 = SHORT SHORT 10); + ASSERT (ABS LONG 10 = LONG 10); + ASSERT (ABS - LONG 10 = LONG 10); + ASSERT (ABS - LONG LONG 10 = LONG LONG 10) +END diff --git a/gcc/testsuite/algol68/execute/abs-int-negative-1.a68 b/gcc/testsuite/algol68/execute/abs-int-negative-1.a68 new file mode 100644 index 000000000000..77973ad220f2 --- /dev/null +++ b/gcc/testsuite/algol68/execute/abs-int-negative-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper -std=algol68" } # +BEGIN SHORT SHORT BITS b = BIN - SHORT SHORT 2; + ASSERT (ABS b = SHORT SHORT INT (SKIP)) +END diff --git a/gcc/testsuite/algol68/execute/abs-int-negative-gnu-1.a68 b/gcc/testsuite/algol68/execute/abs-int-negative-gnu-1.a68 new file mode 100644 index 000000000000..4afe25679e01 --- /dev/null +++ b/gcc/testsuite/algol68/execute/abs-int-negative-gnu-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper -std=gnu68" } # +BEGIN SHORT SHORT BITS b = BIN - SHORT SHORT 2; + ASSERT (ABS b = - SHORT SHORT 2) +END diff --git a/gcc/testsuite/algol68/execute/acos-1.a68 b/gcc/testsuite/algol68/execute/acos-1.a68 new file mode 100644 index 000000000000..6a985cc8a235 --- /dev/null +++ b/gcc/testsuite/algol68/execute/acos-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL r = 1.0; + LONG REAL rr = LONG 45.0; + LONG LONG REAL rrr = LONG LONG 60.0; + ASSERT (arccos (r) = 0.0); + long arccos (rr); + long long arccos (rrr) +END diff --git a/gcc/testsuite/algol68/execute/affirm-int-1.a68 b/gcc/testsuite/algol68/execute/affirm-int-1.a68 new file mode 100644 index 000000000000..4cd065fa2358 --- /dev/null +++ b/gcc/testsuite/algol68/execute/affirm-int-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 10; + LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10; + SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10; + ASSERT (+i = 10); + ASSERT (+ii = LONG 10); + ASSERT (+iii = LONG LONG 10); + ASSERT (+ss = SHORT 10); + ASSERT (+sss = SHORT SHORT 10) +END diff --git a/gcc/testsuite/algol68/execute/and-bits-1.a68 b/gcc/testsuite/algol68/execute/and-bits-1.a68 new file mode 100644 index 000000000000..e6530bcdfb01 --- /dev/null +++ b/gcc/testsuite/algol68/execute/and-bits-1.a68 @@ -0,0 +1,18 @@ +# { dg-options "-fstropping=upper" } # +# AND for SIZETY BITS. # +BEGIN BITS b = 16r0f0f0; + ASSERT ((b AND 16r0f0f) = 16r0); + ASSERT ((b AND 16r00ff) = 16rf0); + LONG BITS bb = LONG 16r0f0f0; + ASSERT ((bb AND LONG 16r0f0f) = LONG 16r0); + ASSERT ((bb AND LONG 16r00ff) = LONG 16rf0); + LONG LONG BITS bbb = LONG LONG 16r0f0f0; + ASSERT ((bbb AND LONG LONG 16r0f0f) = LONG LONG 16r0); + ASSERT ((bbb AND LONG LONG 16r00ff) = LONG LONG 16rf0); + SHORT BITS ss = SHORT 16r0f0f0; + ASSERT ((ss AND SHORT 16r0f0f) = SHORT 16r0); + ASSERT ((ss AND SHORT 16r00ff) = SHORT 16rf0); + SHORT SHORT BITS sss = SHORT SHORT 16r0f0f0; + ASSERT ((sss AND SHORT SHORT 16r0f0f) = SHORT SHORT 16r0); + ASSERT ((sss AND SHORT SHORT 16r00ff) = SHORT SHORT 16rf0) +END diff --git a/gcc/testsuite/algol68/execute/andf-1.a68 b/gcc/testsuite/algol68/execute/andf-1.a68 new file mode 100644 index 000000000000..72667a653bd5 --- /dev/null +++ b/gcc/testsuite/algol68/execute/andf-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 10; + ASSERT (i /= 0 ANDTH i = 10) +END diff --git a/gcc/testsuite/algol68/execute/ascription-1.a68 b/gcc/testsuite/algol68/execute/ascription-1.a68 new file mode 100644 index 000000000000..f6744e322f92 --- /dev/null +++ b/gcc/testsuite/algol68/execute/ascription-1.a68 @@ -0,0 +1,12 @@ +# { dg-options "-fstropping=upper" } # +# Make sure structs are copied when ascribed. # +BEGIN MODE BAR = STRUCT (INT j, REAL r); + MODE FOO = STRUCT (INT i, BAR bar); + + FOO f1 := (10, (20, 3.14)); + FOO f2 = f1; + + j OF bar OF f1 := 200; + ASSERT (j OF bar OF f1 = 200); + ASSERT (j OF bar OF f2 = 20) +END diff --git a/gcc/testsuite/algol68/execute/asin-1.a68 b/gcc/testsuite/algol68/execute/asin-1.a68 new file mode 100644 index 000000000000..114518edfa2c --- /dev/null +++ b/gcc/testsuite/algol68/execute/asin-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL r = 0.0; + LONG REAL rr = LONG 45.0; + LONG LONG REAL rrr = LONG LONG 60.0; + ASSERT (arcsin (r) = 0.0); + long arcsin (rr); + long long arcsin (rrr) +END diff --git a/gcc/testsuite/algol68/execute/assert-1.a68 b/gcc/testsuite/algol68/execute/assert-1.a68 new file mode 100644 index 000000000000..2ed6ea40e7e6 --- /dev/null +++ b/gcc/testsuite/algol68/execute/assert-1.a68 @@ -0,0 +1,3 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (TRUE) +END diff --git a/gcc/testsuite/algol68/execute/assignation-char-1.a68 b/gcc/testsuite/algol68/execute/assignation-char-1.a68 new file mode 100644 index 000000000000..5558ccc140d9 --- /dev/null +++ b/gcc/testsuite/algol68/execute/assignation-char-1.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN CHAR c; + c := "x"; + ASSERT (c = "x") +END diff --git a/gcc/testsuite/algol68/execute/assignation-int-1.a68 b/gcc/testsuite/algol68/execute/assignation-int-1.a68 new file mode 100644 index 000000000000..139d7436ebd6 --- /dev/null +++ b/gcc/testsuite/algol68/execute/assignation-int-1.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i; + i := 20; + ASSERT (i = 20) +END diff --git a/gcc/testsuite/algol68/execute/assignation-int-2.a68 b/gcc/testsuite/algol68/execute/assignation-int-2.a68 new file mode 100644 index 000000000000..cfd384076316 --- /dev/null +++ b/gcc/testsuite/algol68/execute/assignation-int-2.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN x := 100; + INT x; + ASSERT (x = 100) +END diff --git a/gcc/testsuite/algol68/execute/assignation-int-3.a68 b/gcc/testsuite/algol68/execute/assignation-int-3.a68 new file mode 100644 index 000000000000..9b60f7e0a36a --- /dev/null +++ b/gcc/testsuite/algol68/execute/assignation-int-3.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REF INT j = LOC INT; + INT i; + i := j := 20; + ASSERT (i + j = 40) +END diff --git a/gcc/testsuite/algol68/execute/assignation-int-4.a68 b/gcc/testsuite/algol68/execute/assignation-int-4.a68 new file mode 100644 index 000000000000..2aeb35b11477 --- /dev/null +++ b/gcc/testsuite/algol68/execute/assignation-int-4.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REF INT xx; + INT x := 10; + ASSERT ((xx := (x)) = 10) +END diff --git a/gcc/testsuite/algol68/execute/assignation-int-5.a68 b/gcc/testsuite/algol68/execute/assignation-int-5.a68 new file mode 100644 index 000000000000..2b67b21fae2b --- /dev/null +++ b/gcc/testsuite/algol68/execute/assignation-int-5.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 10; + REF INT xx := x; + x := 20; + ASSERT ((xx := (INT j; x)) = 20) +END diff --git a/gcc/testsuite/algol68/execute/assignation-multiple-1.a68 b/gcc/testsuite/algol68/execute/assignation-multiple-1.a68 new file mode 100644 index 000000000000..cf8d78020ef5 --- /dev/null +++ b/gcc/testsuite/algol68/execute/assignation-multiple-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRUCT ([2:3]INT m, [1:5]REAL g) s; + g OF s:= (1.0, 2.0, 3.0, 4.0, 5.0) +END diff --git a/gcc/testsuite/algol68/execute/assignation-multiple-2.a68 b/gcc/testsuite/algol68/execute/assignation-multiple-2.a68 new file mode 100644 index 000000000000..22ff7e119427 --- /dev/null +++ b/gcc/testsuite/algol68/execute/assignation-multiple-2.a68 @@ -0,0 +1,15 @@ +begin [5]struct(char i, real r) foo; + + { The stride in the single dimension of the multiple resulting + from the selection is not the size of a 'char'. } + i of foo := ("a","b","c","d","e"); + puts ((i of foo) + "'n"); + { Via indexing then selection. } + assert (i of foo[1] = "a"); + assert (i of foo[2] = "b"); + assert (i of foo[3] = "c"); + assert (i of foo[4] = "d"); + assert (i of foo[5] = "e"); + { Via selection of multiple. } + assert (i of foo = "abcde"); +end diff --git a/gcc/testsuite/algol68/execute/assignation-struct-1.a68 b/gcc/testsuite/algol68/execute/assignation-struct-1.a68 new file mode 100644 index 000000000000..a2d661b18378 --- /dev/null +++ b/gcc/testsuite/algol68/execute/assignation-struct-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE NODE = STRUCT (INT one, two, three); + NODE top; + top := (10,20,30); + ASSERT (two OF top = 20) +END diff --git a/gcc/testsuite/algol68/execute/assignation-struct-2.a68 b/gcc/testsuite/algol68/execute/assignation-struct-2.a68 new file mode 100644 index 000000000000..61734cc0db65 --- /dev/null +++ b/gcc/testsuite/algol68/execute/assignation-struct-2.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +# Struct containing a multiple, which must be copied when + the struct value is assigned. # +BEGIN MODE FOO = STRUCT (STRING s, INT i); + FOO f1; + f1 := ("foo", 10); + ASSERT (i OF f1 = 10) +END diff --git a/gcc/testsuite/algol68/execute/atan-1.a68 b/gcc/testsuite/algol68/execute/atan-1.a68 new file mode 100644 index 000000000000..bc710c5cdfd8 --- /dev/null +++ b/gcc/testsuite/algol68/execute/atan-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL r = 0.0; + LONG REAL rr = LONG 45.0; + LONG LONG REAL rrr = LONG LONG 60.0; + ASSERT (arctan (r) = 0.0); + long arctan (rr); + long long arctan (rrr) +END diff --git a/gcc/testsuite/algol68/execute/balancing-1.a68 b/gcc/testsuite/algol68/execute/balancing-1.a68 new file mode 100644 index 000000000000..418b0e4efb9e --- /dev/null +++ b/gcc/testsuite/algol68/execute/balancing-1.a68 @@ -0,0 +1,12 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL x, y; + REF REAL xx, yy; + xx := yy := x; + + ASSERT (xx :=: x); + ASSERT (x :=: xx); + ASSERT (xx :/=: yy); + ASSERT (REF REAL (xx) :=: yy); + ASSERT (xx :=: REF REAL (yy)); + ASSERT (REF REAL (xx) :=: REF REAL (yy)) +END diff --git a/gcc/testsuite/algol68/execute/balancing-rows-1.a68 b/gcc/testsuite/algol68/execute/balancing-rows-1.a68 new file mode 100644 index 000000000000..1f69d47259a9 --- /dev/null +++ b/gcc/testsuite/algol68/execute/balancing-rows-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (UPB IF FALSE THEN []INT (1) ELSE [,]REAL (1) FI = 1); + ASSERT (2 UPB CASE 2 IN []INT (1), [,]REAL (1) ESAC = 1) +END diff --git a/gcc/testsuite/algol68/execute/bin-1.a68 b/gcc/testsuite/algol68/execute/bin-1.a68 new file mode 100644 index 000000000000..4fb095fb5dd8 --- /dev/null +++ b/gcc/testsuite/algol68/execute/bin-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# BIN for SIZETY INTs # +BEGIN ASSERT (BIN 255 = 16rff); + ASSERT (BIN LONG 255 = LONG 16rff); + ASSERT (BIN LONG LONG 255 = LONG LONG 16rff) +END diff --git a/gcc/testsuite/algol68/execute/bin-negative-1.a68 b/gcc/testsuite/algol68/execute/bin-negative-1.a68 new file mode 100644 index 000000000000..97c2cf000c3b --- /dev/null +++ b/gcc/testsuite/algol68/execute/bin-negative-1.a68 @@ -0,0 +1,3 @@ +# { dg-options "-fstropping=upper -std=algol68" } # +BEGIN ASSERT (BIN - SHORT SHORT 2 = SHORT SHORT 2r0) +END diff --git a/gcc/testsuite/algol68/execute/bin-negative-gnu-1.a68 b/gcc/testsuite/algol68/execute/bin-negative-gnu-1.a68 new file mode 100644 index 000000000000..41d95533f3c5 --- /dev/null +++ b/gcc/testsuite/algol68/execute/bin-negative-gnu-1.a68 @@ -0,0 +1,3 @@ +# { dg-options "-fstropping=upper -std=gnu68" } # +BEGIN ASSERT (BIN - SHORT SHORT 2 = SHORT SHORT 2r11111110) +END diff --git a/gcc/testsuite/algol68/execute/boolops-1.a68 b/gcc/testsuite/algol68/execute/boolops-1.a68 new file mode 100644 index 000000000000..82600fc2f9a6 --- /dev/null +++ b/gcc/testsuite/algol68/execute/boolops-1.a68 @@ -0,0 +1,18 @@ +# { dg-options "-fstropping=upper" } # +BEGIN BOOL t := TRUE; + BOOL f := FALSE; + ASSERT (NOT t = FALSE); + ASSERT (~t = FALSE); + ASSERT ((t AND t) = TRUE); + ASSERT ((t AND f) = FALSE); + ASSERT ((f AND f) = FALSE); + ASSERT ((f AND t) = FALSE); + ASSERT ((t OR t) = TRUE); + ASSERT ((t OR f) = TRUE); + ASSERT ((f OR f) = FALSE); + ASSERT ((f OR t) = TRUE); + ASSERT ((t XOR t) = FALSE); + ASSERT ((t XOR f) = TRUE); + ASSERT ((f XOR f) = FALSE); + ASSERT ((f XOR t) = TRUE) +END diff --git a/gcc/testsuite/algol68/execute/call-1.a68 b/gcc/testsuite/algol68/execute/call-1.a68 new file mode 100644 index 000000000000..f77113dcc464 --- /dev/null +++ b/gcc/testsuite/algol68/execute/call-1.a68 @@ -0,0 +1,19 @@ +# { dg-options "-fstropping=upper" } # +# Calling a procedure that gets a row of united values. # +BEGIN INT num ints := 0, num reals := 0, num strings := 0; + PROC foo = ([]UNION(INT,REAL,STRING) d) VOID: + BEGIN FOR i TO UPB d + DO CASE d[i] + IN (STRING): num strings +:= 1, + (INT): num ints +:= 1, + (REAL): num reals +:= 1 + ESAC + OD + END; + foo (()); + foo (10); + ASSERT (num ints = 1 AND num reals = 0 AND num strings = 0); + num ints := 0; + foo (("baz", 1, 3.14, 2, 0.0, "foo")); + ASSERT (num ints = 2 AND num reals = 2 AND num strings = 2) +END diff --git a/gcc/testsuite/algol68/execute/call-2.a68 b/gcc/testsuite/algol68/execute/call-2.a68 new file mode 100644 index 000000000000..21a6b252028a --- /dev/null +++ b/gcc/testsuite/algol68/execute/call-2.a68 @@ -0,0 +1,21 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT control := 0; + PROC set control = (PROC(INT)VOID p) VOID: p (100); + PROC setter = (INT i) VOID: control := i; + PROC(INT)VOID setter 2 = (INT i) VOID: control := i + 1; + PROC(INT)VOID setter 3 := setter 2; + PROC(INT)VOID setter 4 := (INT i) VOID: control := i + 2; + REF PROC(INT)VOID setter 5 := setter 4; + set control (setter); + ASSERT (control = 100); + set control (setter 2); + ASSERT (control = 101); + control := 0; + set control (setter 3); + ASSERT (control = 101); + set control (setter 4); + ASSERT (control = 102); + control := 0; + set control (setter 5); + ASSERT (control = 102) +END diff --git a/gcc/testsuite/algol68/execute/case-clause-1.a68 b/gcc/testsuite/algol68/execute/case-clause-1.a68 new file mode 100644 index 000000000000..71566edf9154 --- /dev/null +++ b/gcc/testsuite/algol68/execute/case-clause-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT j := 1; + ASSERT ((j|10,20,30|40) = 10); + j := 2; + ASSERT ((j|10,20,30|40) = 20); + j := 3; + ASSERT ((j|10,20,30|40) = 30); + j := 100; + ASSERT ((j|10,20,30|40) = 40) +END diff --git a/gcc/testsuite/algol68/execute/case-clause-2.a68 b/gcc/testsuite/algol68/execute/case-clause-2.a68 new file mode 100644 index 000000000000..971bdb56207a --- /dev/null +++ b/gcc/testsuite/algol68/execute/case-clause-2.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 2; + ASSERT (CASE INT x = 10; i + IN x + 1, + x + 2, + x + 3 + ESAC = 12) +END diff --git a/gcc/testsuite/algol68/execute/case-clause-3.a68 b/gcc/testsuite/algol68/execute/case-clause-3.a68 new file mode 100644 index 000000000000..3355cefc080f --- /dev/null +++ b/gcc/testsuite/algol68/execute/case-clause-3.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT days, INT month = 2, year = 2024; + days := CASE month + IN 31, (year MOD 4 = 0 AND year MOD 100 /= 0 OR year MOD 400 = 0 | 29 | 28), + 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 ESAC; + ASSERT (days = 29) +END diff --git a/gcc/testsuite/algol68/execute/case-clause-4.a68 b/gcc/testsuite/algol68/execute/case-clause-4.a68 new file mode 100644 index 000000000000..cd69069fa84f --- /dev/null +++ b/gcc/testsuite/algol68/execute/case-clause-4.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT day = 3; + STRING day name = (day | "MONDAY", "TUESDAY", "WEDNESDAY", "THURSDAY", "FRIDAY", "SATURDAY", "SUNDAY"); + ASSERT (day name[1] = "W") +END diff --git a/gcc/testsuite/algol68/execute/closed-clause-1.a68 b/gcc/testsuite/algol68/execute/closed-clause-1.a68 new file mode 100644 index 000000000000..d7602e1ae86b --- /dev/null +++ b/gcc/testsuite/algol68/execute/closed-clause-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL pie, my small real := 0.001; + PROC my sqrt = (REAL r) REAL: r; + BEGIN REAL w := 0, INT i := 1, REAL z = my sqrt (my small real / 2); + loop: w := w + 2 / (i * (i + 2)); + i := i + 4; + IF 1/i > z THEN GO TO loop FI; + pie := 4 * w + END +END diff --git a/gcc/testsuite/algol68/execute/closed-clause-2.a68 b/gcc/testsuite/algol68/execute/closed-clause-2.a68 new file mode 100644 index 000000000000..c6acec88ebdd --- /dev/null +++ b/gcc/testsuite/algol68/execute/closed-clause-2.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL my small real := 0.001; + PROC my sqrt = (REAL r) REAL: r; + REAL res = 4 * (REAL w := 0, INT i := 1; REAL z = my sqrt (my small real / 2); + loop: w := w + 2/(i * (i + 2)); i := i + 4; + IF 1/i > z THEN loop FI; + w); + SKIP +END diff --git a/gcc/testsuite/algol68/execute/collateral-clause-1.a68 b/gcc/testsuite/algol68/execute/collateral-clause-1.a68 new file mode 100644 index 000000000000..d467a424aa2a --- /dev/null +++ b/gcc/testsuite/algol68/execute/collateral-clause-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 10; + (i, i + 1, i + 2) +END diff --git a/gcc/testsuite/algol68/execute/collateral-clause-2.a68 b/gcc/testsuite/algol68/execute/collateral-clause-2.a68 new file mode 100644 index 000000000000..8d9aa6eeb74c --- /dev/null +++ b/gcc/testsuite/algol68/execute/collateral-clause-2.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 10; + ( + BEGIN + (i + 1, i +:= 1, i + 2) + END + ); + ASSERT (i = 11) +END diff --git a/gcc/testsuite/algol68/execute/collateral-clause-3.a68 b/gcc/testsuite/algol68/execute/collateral-clause-3.a68 new file mode 100644 index 000000000000..9af00e7c2db4 --- /dev/null +++ b/gcc/testsuite/algol68/execute/collateral-clause-3.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 10; + ( + i +:= 1; + BEGIN + (i + 1, (i +:= 1, i + 10, i + 11, SKIP), i + 2) + END; + i +:= i + ); + ASSERT (i = 24) +END diff --git a/gcc/testsuite/algol68/execute/collateral-clause-4.a68 b/gcc/testsuite/algol68/execute/collateral-clause-4.a68 new file mode 100644 index 000000000000..2e64fb1787e3 --- /dev/null +++ b/gcc/testsuite/algol68/execute/collateral-clause-4.a68 @@ -0,0 +1,3 @@ +# { dg-options "-fstropping=upper" } # +BEGIN (SKIP,SKIP) +END diff --git a/gcc/testsuite/algol68/execute/collateral-clause-5.a68 b/gcc/testsuite/algol68/execute/collateral-clause-5.a68 new file mode 100644 index 000000000000..c1375a96677a --- /dev/null +++ b/gcc/testsuite/algol68/execute/collateral-clause-5.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x, y, z; + (x := 1, y := 2, z := 3); + ASSERT (x = 1 AND y = 2 AND z = 3) +END diff --git a/gcc/testsuite/algol68/execute/collateral-clause-6.a68 b/gcc/testsuite/algol68/execute/collateral-clause-6.a68 new file mode 100644 index 000000000000..57599afb20e5 --- /dev/null +++ b/gcc/testsuite/algol68/execute/collateral-clause-6.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i; + PROC side = INT: (i := 1; i := 2; i); + PROC add = (INT ii, INT jj) INT: ii + jj; + INT res = add (side, side); + # can be 3 or 4 due to collateral evaluation of arguments. # + ASSERT (res = 3 OR res = 4) +END diff --git a/gcc/testsuite/algol68/execute/completer-1.a68 b/gcc/testsuite/algol68/execute/completer-1.a68 new file mode 100644 index 000000000000..e3b488a7dd0b --- /dev/null +++ b/gcc/testsuite/algol68/execute/completer-1.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i; + BEGIN (i := 20 EXIT +cont: i := 30 + ); + i +:= 1 + END; + ASSERT (i = 21) +END diff --git a/gcc/testsuite/algol68/execute/completer-10.a68 b/gcc/testsuite/algol68/execute/completer-10.a68 new file mode 100644 index 000000000000..18d4f937cf3a --- /dev/null +++ b/gcc/testsuite/algol68/execute/completer-10.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 20; + REF INT xx := x; + REF REF INT xxx; + REF INT i := (x := 10; xxx := xx EXIT foo: xxx EXIT bar: xxx := xx); + ASSERT (i = 10) +END diff --git a/gcc/testsuite/algol68/execute/completer-2.a68 b/gcc/testsuite/algol68/execute/completer-2.a68 new file mode 100644 index 000000000000..fac329ab4bfd --- /dev/null +++ b/gcc/testsuite/algol68/execute/completer-2.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = (foo; + 10 EXIT +foo: 20 EXIT +bar: 30); + ASSERT (i = 20) +END diff --git a/gcc/testsuite/algol68/execute/completer-3.a68 b/gcc/testsuite/algol68/execute/completer-3.a68 new file mode 100644 index 000000000000..6514f2ddc60d --- /dev/null +++ b/gcc/testsuite/algol68/execute/completer-3.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = ((((foo; 10 EXIT foo: 20 EXIT bar: 30)))); + ASSERT (i = 20) +END diff --git a/gcc/testsuite/algol68/execute/completer-4.a68 b/gcc/testsuite/algol68/execute/completer-4.a68 new file mode 100644 index 000000000000..1291e733d730 --- /dev/null +++ b/gcc/testsuite/algol68/execute/completer-4.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := (foo; 10 EXIT foo: 20 EXIT bar: 30); + ASSERT (i = 20) +END diff --git a/gcc/testsuite/algol68/execute/completer-5.a68 b/gcc/testsuite/algol68/execute/completer-5.a68 new file mode 100644 index 000000000000..f6bc6f42719b --- /dev/null +++ b/gcc/testsuite/algol68/execute/completer-5.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x; + REF INT i := (foo; x := 10 EXIT foo: x := 20 EXIT bar: x := 30); + ASSERT (i = 20) +END diff --git a/gcc/testsuite/algol68/execute/completer-6.a68 b/gcc/testsuite/algol68/execute/completer-6.a68 new file mode 100644 index 000000000000..aaf512f4babd --- /dev/null +++ b/gcc/testsuite/algol68/execute/completer-6.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 20; + REF INT i := (foo; x := 10 EXIT foo: x EXIT bar: x := 30); + ASSERT (i = 20) +END diff --git a/gcc/testsuite/algol68/execute/completer-7.a68 b/gcc/testsuite/algol68/execute/completer-7.a68 new file mode 100644 index 000000000000..9ef0e27f6744 --- /dev/null +++ b/gcc/testsuite/algol68/execute/completer-7.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 20; + REF INT i := (x := 10 EXIT foo: x EXIT bar: x := 30); + ASSERT (i = 10) +END diff --git a/gcc/testsuite/algol68/execute/completer-8.a68 b/gcc/testsuite/algol68/execute/completer-8.a68 new file mode 100644 index 000000000000..b73fd13f4c32 --- /dev/null +++ b/gcc/testsuite/algol68/execute/completer-8.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 20; + REF INT i := (x EXIT foo: x EXIT bar: x := 30); + ASSERT (i = 20) +END diff --git a/gcc/testsuite/algol68/execute/completer-9.a68 b/gcc/testsuite/algol68/execute/completer-9.a68 new file mode 100644 index 000000000000..b84f01039816 --- /dev/null +++ b/gcc/testsuite/algol68/execute/completer-9.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 20; + REF INT xx := x; + REF INT i := (xx EXIT foo: xx EXIT bar: xx := x); + ASSERT (i = 20) +END diff --git a/gcc/testsuite/algol68/execute/cond-clause-1.a68 b/gcc/testsuite/algol68/execute/cond-clause-1.a68 new file mode 100644 index 000000000000..059bb8a61179 --- /dev/null +++ b/gcc/testsuite/algol68/execute/cond-clause-1.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 10, x; + IF i > 5 THEN x := i FI; + ASSERT (x = i) +END diff --git a/gcc/testsuite/algol68/execute/cond-clause-2.a68 b/gcc/testsuite/algol68/execute/cond-clause-2.a68 new file mode 100644 index 000000000000..f8e5d5f03710 --- /dev/null +++ b/gcc/testsuite/algol68/execute/cond-clause-2.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 10, x; + IF i < 5 THEN x = i FI; + ASSERT (x /= i) +END diff --git a/gcc/testsuite/algol68/execute/cond-clause-3.a68 b/gcc/testsuite/algol68/execute/cond-clause-3.a68 new file mode 100644 index 000000000000..4e9c685c55fa --- /dev/null +++ b/gcc/testsuite/algol68/execute/cond-clause-3.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 5; + IF i = 5 + THEN 0 + ELSE ASSERT (FALSE); 1 + FI +END diff --git a/gcc/testsuite/algol68/execute/cond-clause-4.a68 b/gcc/testsuite/algol68/execute/cond-clause-4.a68 new file mode 100644 index 000000000000..0e650414fb07 --- /dev/null +++ b/gcc/testsuite/algol68/execute/cond-clause-4.a68 @@ -0,0 +1,3 @@ +# { dg-options "-fstropping=upper" } # +# Declarations in enquiry clause. # +(INT i; i := 3 ; i := 2; i /= i | ASSERT (FALSE); 1 | 0) diff --git a/gcc/testsuite/algol68/execute/cond-clause-5.a68 b/gcc/testsuite/algol68/execute/cond-clause-5.a68 new file mode 100644 index 000000000000..2164c75dc81a --- /dev/null +++ b/gcc/testsuite/algol68/execute/cond-clause-5.a68 @@ -0,0 +1,3 @@ +# { dg-options "-fstropping=upper" } # +# Closed clauses in enquiry clause. # +((INT i; (i := 3 ; i := 2); ((i /= i))) | ASSERT (FALSE); 1 | 0) diff --git a/gcc/testsuite/algol68/execute/cond-clause-6.a68 b/gcc/testsuite/algol68/execute/cond-clause-6.a68 new file mode 100644 index 000000000000..39b4bda31a1f --- /dev/null +++ b/gcc/testsuite/algol68/execute/cond-clause-6.a68 @@ -0,0 +1,23 @@ +# { dg-options "-fstropping=upper" } # +# Nested conditional clauses # +BEGIN + INT i = 10; + IF i > 5 THEN + IF i < 15 THEN + IF i > 11 THEN + ASSERT (FALSE); + 1 + ELSE + 0 + FI + FI + ELSE + IF i > 100 THEN + ASSERT (FALSE); + 1 + ELSE + ASSERT (FALSE); + 1 + FI + FI +END diff --git a/gcc/testsuite/algol68/execute/cond-clause-7.a68 b/gcc/testsuite/algol68/execute/cond-clause-7.a68 new file mode 100644 index 000000000000..3a5af2bdbb04 --- /dev/null +++ b/gcc/testsuite/algol68/execute/cond-clause-7.a68 @@ -0,0 +1,23 @@ +# { dg-options "-fstropping=upper" } # +# Nested conditional clauses # +BEGIN + INT i = 12; + IF i > 5 THEN + IF i < 15 THEN + IF i > 11 THEN + 0 + ELSE + ASSERT (FALSE); + 1 + FI + FI + ELSE + IF i > 100 THEN + ASSERT (FALSE); + 1 + ELSE + ASSERT (FALSE); + 1 + FI + FI +END diff --git a/gcc/testsuite/algol68/execute/cond-clause-8.a68 b/gcc/testsuite/algol68/execute/cond-clause-8.a68 new file mode 100644 index 000000000000..0b3ca04fccba --- /dev/null +++ b/gcc/testsuite/algol68/execute/cond-clause-8.a68 @@ -0,0 +1,20 @@ +# { dg-options "-fstropping=upper" } # +# ELIF # +BEGIN + INT i = 12; + IF i > 20 THEN + 1 + ELIF i > 5 THEN + BEGIN + IF FALSE THEN + ASSERT (FALSE); + 1 + ELSE + 0 + FI + END + ELIF i < 10 THEN + ASSERT (FALSE); + 1 + FI +END diff --git a/gcc/testsuite/algol68/execute/cond-clause-9.a68 b/gcc/testsuite/algol68/execute/cond-clause-9.a68 new file mode 100644 index 000000000000..d0f70e883025 --- /dev/null +++ b/gcc/testsuite/algol68/execute/cond-clause-9.a68 @@ -0,0 +1,23 @@ +# { dg-options "-fstropping=upper" } # +# ELIF with ELSE # +BEGIN + INT i = 12; + IF i > 20 THEN + 1 + ELIF i > 12 THEN + BEGIN + IF FALSE THEN + ASSERT (FALSE); + 1 + ELSE + ASSERT (FALSE); + 1 + FI + END + ELIF i < 10 THEN + ASSERT (FALSE); + 1 + ELSE + 0 + FI +END diff --git a/gcc/testsuite/algol68/execute/conformity-clause-1.a68 b/gcc/testsuite/algol68/execute/conformity-clause-1.a68 new file mode 100644 index 000000000000..d34b7cfeabf5 --- /dev/null +++ b/gcc/testsuite/algol68/execute/conformity-clause-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE DATUM = UNION(INT,REAL,CHAR); + DATUM datum := 10; + INT i = CASE datum + IN (REAL): 2, + (INT i): i + 1, + (CHAR): 3 + ESAC; + ASSERT (i = 11) +END diff --git a/gcc/testsuite/algol68/execute/conformity-clause-2.a68 b/gcc/testsuite/algol68/execute/conformity-clause-2.a68 new file mode 100644 index 000000000000..bfa28bba3d75 --- /dev/null +++ b/gcc/testsuite/algol68/execute/conformity-clause-2.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE DATUM = UNION(INT,REAL,CHAR); + DATUM datum := "X"; + INT i = CASE datum + IN (REAL): 2, + (INT val): val + 1 + OUT INT x = 100; + x + 10 + ESAC; + ASSERT (i = 110) +END diff --git a/gcc/testsuite/algol68/execute/conformity-clause-3.a68 b/gcc/testsuite/algol68/execute/conformity-clause-3.a68 new file mode 100644 index 000000000000..d0703de0c8c7 --- /dev/null +++ b/gcc/testsuite/algol68/execute/conformity-clause-3.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE DATUM = UNION(INT,REAL,CHAR); + DATUM datum := 20; + INT i = CASE INT i = 10; datum + IN (REAL): 2, + (INT val): val + i + OUT INT x = 100; + x + 10 + ESAC; + ASSERT (i = 30) +END diff --git a/gcc/testsuite/algol68/execute/conformity-clause-4.a68 b/gcc/testsuite/algol68/execute/conformity-clause-4.a68 new file mode 100644 index 000000000000..2cac20d50830 --- /dev/null +++ b/gcc/testsuite/algol68/execute/conformity-clause-4.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []UNION(INT,STRING,REAL) datum = (10, 3.14, "foo", 200); + ASSERT (CASE datum[1] IN (INT): 100 ESAC = 100); + ASSERT (CASE datum[2] IN (REAL): 200 ESAC = 200); + ASSERT (CASE datum[3] IN (STRING): 300 ESAC = 300); + ASSERT (CASE datum[4] IN (INT): 400 ESAC = 400) +END diff --git a/gcc/testsuite/algol68/execute/conformity-clause-5.a68 b/gcc/testsuite/algol68/execute/conformity-clause-5.a68 new file mode 100644 index 000000000000..eb6f41ea22e2 --- /dev/null +++ b/gcc/testsuite/algol68/execute/conformity-clause-5.a68 @@ -0,0 +1,14 @@ +# { dg-options "-fstropping=upper" } # +BEGIN UNION(CHAR,BOOL,INT,REAL) cbira := "X"; + IF CASE cbira + IN (BOOL b): b, + (INT i): i > 0, + (REAL r): r > 0 + OUT FALSE + ESAC + THEN # We get here if cbira was not a CHAR and was otherwise + TRUE or >0, as the case may be. + # + ASSERT (FALSE) + FI +END diff --git a/gcc/testsuite/algol68/execute/conformity-clause-6.a68 b/gcc/testsuite/algol68/execute/conformity-clause-6.a68 new file mode 100644 index 000000000000..b3d3d6cf329e --- /dev/null +++ b/gcc/testsuite/algol68/execute/conformity-clause-6.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN UNION (CHAR,BOOL,REAL) cbra = 3.14, UNION (INT,REAL) ira = 10; + IF (cbra | (CHAR): FALSE, (BOOL b): b + |: ira | (INT i): i > 0, (REAL r): r > 0) + THEN SKIP + ELSE ASSERT (FALSE) + FI +END diff --git a/gcc/testsuite/algol68/execute/conformity-clause-7.a68 b/gcc/testsuite/algol68/execute/conformity-clause-7.a68 new file mode 100644 index 000000000000..18122a3dd70c --- /dev/null +++ b/gcc/testsuite/algol68/execute/conformity-clause-7.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN UNION (CHAR,BOOL,REAL) cbra = 3.14, UNION (INT,REAL) ira = -10; + IF (cbra | (CHAR): FALSE, (BOOL b): b + |: ira | (INT i): i > 0, (REAL r): r > 0) + THEN ASSERT (FALSE) + FI +END diff --git a/gcc/testsuite/algol68/execute/conformity-clause-8.a68 b/gcc/testsuite/algol68/execute/conformity-clause-8.a68 new file mode 100644 index 000000000000..2da55f9abdfe --- /dev/null +++ b/gcc/testsuite/algol68/execute/conformity-clause-8.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE JORL = STRUCT (UNION(INT,REAL) i, REF JORL next); + REF JORL p := HEAP JORL := (10, HEAP JORL := (20.0, NIL)); + p := HEAP JORL := (30, p); + INT num ints := 0, num reals := 0; + WHILE REF JORL (p) ISNT NIL + DO CASE i OF p IN (INT): num ints +:= 1, (REAL): num reals +:= 1 ESAC; + p := next OF p + OD; + ASSERT (num ints = 2 AND num reals = 1) +END diff --git a/gcc/testsuite/algol68/execute/conformity-clause-9.a68 b/gcc/testsuite/algol68/execute/conformity-clause-9.a68 new file mode 100644 index 000000000000..55f1fc3eb880 --- /dev/null +++ b/gcc/testsuite/algol68/execute/conformity-clause-9.a68 @@ -0,0 +1,10 @@ +begin union (int, bool, string) foo = 666; + case foo + in (union(int,string) bar): + case bar + in (int i): assert (i = 666), + (string s): assert (false) + esac, + (bool baz): assert (false) + esac +end diff --git a/gcc/testsuite/algol68/execute/conj-1.a68 b/gcc/testsuite/algol68/execute/conj-1.a68 new file mode 100644 index 000000000000..1954d38bf1d0 --- /dev/null +++ b/gcc/testsuite/algol68/execute/conj-1.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN COMPL z = 4.0I5.0; + CONJ z; + LONG COMPL zz = LONG 4.0 I LONG 6.0; + CONJ zz; + LONG LONG COMPL zzz = LONG LONG 4.0 I LONG LONG 7.0; + CONJ zzz; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/cos-1.a68 b/gcc/testsuite/algol68/execute/cos-1.a68 new file mode 100644 index 000000000000..e6b0f69279ac --- /dev/null +++ b/gcc/testsuite/algol68/execute/cos-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL r = 0.0; + LONG REAL rr = LONG 45.0; + LONG LONG REAL rrr = LONG LONG 60.0; + ASSERT (cos (r) = 1.0); + long cos (rr); + long long cos (rrr) +END diff --git a/gcc/testsuite/algol68/execute/declarer-1.a68 b/gcc/testsuite/algol68/execute/declarer-1.a68 new file mode 100644 index 000000000000..61af0816c83c --- /dev/null +++ b/gcc/testsuite/algol68/execute/declarer-1.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +# Tests a jump out of the elaboration of a declarer. # +BEGIN STRING month = CASE 13 + IN "Jan", "Feb","March","April","May","June", + "July","Aug","Sept", "Oct", "Nov","Dec", + stop + ESAC; + ASSERT (FALSE) +END diff --git a/gcc/testsuite/algol68/execute/declarer-2.a68 b/gcc/testsuite/algol68/execute/declarer-2.a68 new file mode 100644 index 000000000000..b474e3e516e9 --- /dev/null +++ b/gcc/testsuite/algol68/execute/declarer-2.a68 @@ -0,0 +1,6 @@ +begin int n := 1; + { The actual-declarer below should be + elaborated only once. } + [1: n +:= 1]real a, b; + assert (n = 2) +end diff --git a/gcc/testsuite/algol68/execute/deprocedure-1.a68 b/gcc/testsuite/algol68/execute/deprocedure-1.a68 new file mode 100644 index 000000000000..17834f481094 --- /dev/null +++ b/gcc/testsuite/algol68/execute/deprocedure-1.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x = 100; + PROC foo = INT: (INT i = 10, j = 20; PROC bar = INT: 100; i + j + bar); + ASSERT (foo = 130) +END diff --git a/gcc/testsuite/algol68/execute/deprocedure-2.a68 b/gcc/testsuite/algol68/execute/deprocedure-2.a68 new file mode 100644 index 000000000000..1f501cf7ab21 --- /dev/null +++ b/gcc/testsuite/algol68/execute/deprocedure-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# Procedure variables. # +BEGIN INT x = 100; + PROC foo := INT: (INT i = 10, j = 20; PROC bar := INT: 100; i + j + bar); + ASSERT (foo = 130) +END diff --git a/gcc/testsuite/algol68/execute/deref-1.a68 b/gcc/testsuite/algol68/execute/deref-1.a68 new file mode 100644 index 000000000000..5bb4d5d373ab --- /dev/null +++ b/gcc/testsuite/algol68/execute/deref-1.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 10; + INT res := (REF INT xx := x; xx); + ASSERT (res = 10) +END diff --git a/gcc/testsuite/algol68/execute/deref-2.a68 b/gcc/testsuite/algol68/execute/deref-2.a68 new file mode 100644 index 000000000000..d49dc4a6987d --- /dev/null +++ b/gcc/testsuite/algol68/execute/deref-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 10; + REF INT xx := x; + x := 20; + ASSERT (xx = 20) +END diff --git a/gcc/testsuite/algol68/execute/deref-3.a68 b/gcc/testsuite/algol68/execute/deref-3.a68 new file mode 100644 index 000000000000..8c077e079bad --- /dev/null +++ b/gcc/testsuite/algol68/execute/deref-3.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 10; + INT y := 20; + REF INT xx := x; + CO This makes xx to refer to y + REF REF INT := REF INT + CO + xx := y; + y := 30; + ASSERT (xx = 30) +END diff --git a/gcc/testsuite/algol68/execute/deref-4.a68 b/gcc/testsuite/algol68/execute/deref-4.a68 new file mode 100644 index 000000000000..59639fd86120 --- /dev/null +++ b/gcc/testsuite/algol68/execute/deref-4.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 10; + INT y := 20; + REF INT xx := x; + # This sets x to the current value of y # + REF INT (xx) := y; + ASSERT (x = 20) +END diff --git a/gcc/testsuite/algol68/execute/deref-5.a68 b/gcc/testsuite/algol68/execute/deref-5.a68 new file mode 100644 index 000000000000..804947f3dd2c --- /dev/null +++ b/gcc/testsuite/algol68/execute/deref-5.a68 @@ -0,0 +1,42 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 10; + REF INT xx := x; + REF REF INT xxx := xx; + ASSERT (x = 10); + ASSERT (xx = 10); + ASSERT (xxx = 10); + ASSERT ((x) = 10); + ASSERT ((xx) = 10); + ASSERT ((xxx) = 10); + ASSERT (x + 1 = 11); + ASSERT (xx + 1 = 11); + ASSERT (xxx + 1 = 11); + ASSERT ((x + 1) = 11); + ASSERT ((xx + 1) = 11); + ASSERT ((xxx + 1) = 11); + ASSERT ((x := x) = 10); + ASSERT ((xx := x) = 10); + ASSERT ((xxx := xx) = 10); + ASSERT ((x := x) + 1 = 11); + ASSERT ((xx := x) + 1 = 11); + ASSERT ((xxx := xx) + 1 = 11); + x := 20; + ASSERT (x = 20); + ASSERT (xx = 20); + ASSERT (xxx = 20); + ASSERT ((x) = 20); + ASSERT ((xx) = 20); + ASSERT ((xxx) = 20); + ASSERT (x + 1 = 21); + ASSERT (xx + 1 = 21); + ASSERT (xxx + 1 = 21); + ASSERT ((x + 1) = 21); + ASSERT ((xx + 1) = 21); + ASSERT ((xxx + 1) = 21); + ASSERT ((x := x) = 20); + ASSERT ((xx := x) = 20); + ASSERT ((xxx := xx) = 20); + ASSERT ((x := x) + 1 = 21); + ASSERT ((xx := x) + 1 = 21); + ASSERT ((xxx := xx) + 1 = 21) +END diff --git a/gcc/testsuite/algol68/execute/deref-6.a68 b/gcc/testsuite/algol68/execute/deref-6.a68 new file mode 100644 index 000000000000..88754d2f58ea --- /dev/null +++ b/gcc/testsuite/algol68/execute/deref-6.a68 @@ -0,0 +1,48 @@ +# { dg-options "-fstropping=upper" } # +# Dereferencing of struct fields. # +BEGIN MODE S = STRUCT (REF INT x, REF REF INT xx, REF REF REF INT xxx); + + INT x := 10; + REF INT xx := x; + REF REF INT xxx := xx; + + S s = (x, xx, xxx); + + ASSERT (x OF s = 10); + ASSERT (xx OF s = 10); + ASSERT (xxx OF s = 10); + ASSERT ((x) = 10); + ASSERT ((xx) = 10); + ASSERT ((xxx) = 10); + ASSERT (x OF s + 1 = 11); + ASSERT (xx OF s + 1 = 11); + ASSERT (xxx OF s + 1 = 11); + ASSERT ((x OF s + 1) = 11); + ASSERT ((xx OF s + 1) = 11); + ASSERT ((xxx OF s + 1) = 11); + ASSERT ((x OF s := x) = 10); + ASSERT ((xx OF s := x) = 10); + ASSERT ((xxx OF s := xx) = 10); + ASSERT ((x OF s := x) + 1 = 11); + ASSERT ((xx OF s := x) + 1 = 11); + ASSERT ((xxx OF s := xx) + 1 = 11); + x OF s := 20; + ASSERT (x OF s = 20); + ASSERT (xx OF s = 20); + ASSERT (xxx OF s = 20); + ASSERT ((x) = 20); + ASSERT ((xx) = 20); + ASSERT ((xxx) = 20); + ASSERT (x OF s + 1 = 21); + ASSERT (xx OF s + 1 = 21); + ASSERT (xxx OF s + 1 = 21); + ASSERT ((x OF s + 1) = 21); + ASSERT ((xx OF s + 1) = 21); + ASSERT ((xxx OF s + 1) = 21); + ASSERT ((x OF s := x) = 20); + ASSERT ((xx OF s := x) = 20); + ASSERT ((xxx OF s := xx) = 20); + ASSERT ((x OF s := x) + 1 = 21); + ASSERT ((xx OF s := x) + 1 = 21); + ASSERT ((xxx OF s := xx) + 1 = 21) +END diff --git a/gcc/testsuite/algol68/execute/deref-7.a68 b/gcc/testsuite/algol68/execute/deref-7.a68 new file mode 100644 index 000000000000..b2acec98f8db --- /dev/null +++ b/gcc/testsuite/algol68/execute/deref-7.a68 @@ -0,0 +1,48 @@ +# { dg-options "-fstropping=upper" } # +# Dereferencing of struct fields. Version with sub-names. # +BEGIN MODE S = STRUCT (INT x, REF INT xx, REF REF INT xxx); + + INT x := 10; + REF INT xx := x; + REF REF INT xxx := xx; + + S s := (x, xx, xxx); + + ASSERT (x OF s = 10); + ASSERT (xx OF s = 10); + ASSERT (xxx OF s = 10); + ASSERT ((x) = 10); + ASSERT ((xx) = 10); + ASSERT ((xxx) = 10); + ASSERT (x OF s + 1 = 11); + ASSERT (xx OF s + 1 = 11); + ASSERT (xxx OF s + 1 = 11); + ASSERT ((x OF s + 1) = 11); + ASSERT ((xx OF s + 1) = 11); + ASSERT ((xxx OF s + 1) = 11); + ASSERT ((x OF s := x) = 10); + ASSERT ((xx OF s := xx) = 10); + ASSERT ((xxx OF s := xxx) = 10); + ASSERT ((x OF s := x) + 1 = 11); + ASSERT ((xx OF s := xx) + 1 = 11); + ASSERT ((xxx OF s := xxx) + 1 = 11); + x := 20; + ASSERT (x OF s = 10); + ASSERT (xx OF s = 20); + ASSERT (xxx OF s = 20); + ASSERT ((x) = 20); + ASSERT ((xx) = 20); + ASSERT ((xxx) = 20); + ASSERT (x OF s + 1 = 11); + ASSERT (xx OF s + 1 = 21); + ASSERT (xxx OF s + 1 = 21); + ASSERT ((x OF s + 1) = 11); + ASSERT ((xx OF s + 1) = 21); + ASSERT ((xxx OF s + 1) = 21); + ASSERT ((x OF s := x) = 20); + ASSERT ((xx OF s := xx) = 20); + ASSERT ((xxx OF s := xxx) = 20); + ASSERT ((x OF s := x) + 1 = 21); + ASSERT ((xx OF s := xx) + 1 = 21); + ASSERT ((xxx OF s := xxx) + 1 = 21) +END diff --git a/gcc/testsuite/algol68/execute/deref-8.a68 b/gcc/testsuite/algol68/execute/deref-8.a68 new file mode 100644 index 000000000000..6d57086a5e14 --- /dev/null +++ b/gcc/testsuite/algol68/execute/deref-8.a68 @@ -0,0 +1,53 @@ +# { dg-options "-fstropping=upper" } # +# Dereferencing of struct fields. Version with sub-names and + explicit assignations instead of initialization in variable declaration. # +BEGIN MODE S = STRUCT (INT x, REF INT xx, REF REF INT xxx); + + INT x := 10; + REF INT xx := x; + REF REF INT xxx := xx; + + S s; + + x OF s := x; + xx OF s := xx; + xxx OF s := xxx; + + ASSERT (x OF s = 10); + ASSERT (xx OF s = 10); + ASSERT (xxx OF s = 10); + ASSERT ((x) = 10); + ASSERT ((xx) = 10); + ASSERT ((xxx) = 10); + ASSERT (x OF s + 1 = 11); + ASSERT (xx OF s + 1 = 11); + ASSERT (xxx OF s + 1 = 11); + ASSERT ((x OF s + 1) = 11); + ASSERT ((xx OF s + 1) = 11); + ASSERT ((xxx OF s + 1) = 11); + ASSERT ((x OF s := x) = 10); + ASSERT ((xx OF s := xx) = 10); + ASSERT ((xxx OF s := xxx) = 10); + ASSERT ((x OF s := x) + 1 = 11); + ASSERT ((xx OF s := xx) + 1 = 11); + ASSERT ((xxx OF s := xxx) + 1 = 11); + x := 20; + ASSERT (x OF s = 10); + ASSERT (xx OF s = 20); + ASSERT (xxx OF s = 20); + ASSERT ((x) = 20); + ASSERT ((xx) = 20); + ASSERT ((xxx) = 20); + ASSERT (x OF s + 1 = 11); + ASSERT (xx OF s + 1 = 21); + ASSERT (xxx OF s + 1 = 21); + ASSERT ((x OF s + 1) = 11); + ASSERT ((xx OF s + 1) = 21); + ASSERT ((xxx OF s + 1) = 21); + ASSERT ((x OF s := x) = 20); + ASSERT ((xx OF s := xx) = 20); + ASSERT ((xxx OF s := xxx) = 20); + ASSERT ((x OF s := x) + 1 = 21); + ASSERT ((xx OF s := xx) + 1 = 21); + ASSERT ((xxx OF s := xxx) + 1 = 21) +END diff --git a/gcc/testsuite/algol68/execute/div-int-1.a68 b/gcc/testsuite/algol68/execute/div-int-1.a68 new file mode 100644 index 000000000000..6a26a7bef029 --- /dev/null +++ b/gcc/testsuite/algol68/execute/div-int-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 10; + LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10; + ASSERT (i / 2 = 5.0); + ASSERT (ii / LONG 2 = LONG 5.0); + ASSERT (iii / LONG LONG 2 = LONG LONG 5.0) +END diff --git a/gcc/testsuite/algol68/execute/divab-real-1.a68 b/gcc/testsuite/algol68/execute/divab-real-1.a68 new file mode 100644 index 000000000000..830ae2e5f8d6 --- /dev/null +++ b/gcc/testsuite/algol68/execute/divab-real-1.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL r := 3.14; + r DIVAB 2.0; + r /:= 2.0; + LONG REAL rr := LONG 3.14; + rr DIVAB LONG 2.0; + rr /:= LONG 2.0; + LONG LONG REAL rrr := LONG LONG 3.14; + rrr DIVAB LONG LONG 2.0; + rrr /:= LONG LONG 2.0 +END diff --git a/gcc/testsuite/algol68/execute/elem-bits-1.a68 b/gcc/testsuite/algol68/execute/elem-bits-1.a68 new file mode 100644 index 000000000000..1529b595e749 --- /dev/null +++ b/gcc/testsuite/algol68/execute/elem-bits-1.a68 @@ -0,0 +1,18 @@ +# { dg-options "-fstropping=upper" } # +# ELEM for SIZETY BITS # +BEGIN BITS b = 2r1010; + ASSERT ((bits width - 1) ELEM b); + ASSERT (NOT ((bits width - 2) ELEM b)); + LONG BITS bb = LONG 2r1010; + ASSERT ((long bits width - 1) ELEM bb); + ASSERT (NOT ((long bits width - 2) ELEM bb)); + LONG LONG BITS bbb = LONG LONG 2r1010; + ASSERT ((long long bits width - 1) ELEM bbb); + ASSERT (NOT ((long long bits width - 2) ELEM bbb)); + SHORT BITS ss = SHORT 2r1010; + ASSERT ((short bits width - 1) ELEM ss); + ASSERT (NOT ((short bits width - 2) ELEM ss)); + SHORT SHORT BITS sss = SHORT SHORT 2r1010; + ASSERT ((short short bits width - 1) ELEM sss); + ASSERT (NOT ((short short bits width - 2) ELEM sss)) +END diff --git a/gcc/testsuite/algol68/execute/elems-1.a68 b/gcc/testsuite/algol68/execute/elems-1.a68 new file mode 100644 index 000000000000..da538fcf24d1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/elems-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (ELEMS "foo" = 3); + ASSERT (ELEMS "" = 0); + ASSERT (1 ELEMS "foo" = 3); + ASSERT (1 ELEMS "" = 0) +END diff --git a/gcc/testsuite/algol68/execute/elems-2.a68 b/gcc/testsuite/algol68/execute/elems-2.a68 new file mode 100644 index 000000000000..0545f4ec67d1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/elems-2.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# Flat and ultra-flat multiples. # +BEGIN [3,10:3]INT arr; + ASSERT (2 ELEMS arr = 0); + [1:0]INT arr2; + ASSERT (ELEMS arr2 = 0) +END diff --git a/gcc/testsuite/algol68/execute/entier-1.a68 b/gcc/testsuite/algol68/execute/entier-1.a68 new file mode 100644 index 000000000000..d7c84e23d3e6 --- /dev/null +++ b/gcc/testsuite/algol68/execute/entier-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL x = 3.14, y = 3.80; + LONG REAL xx = LONG 3.14, yy = LONG 3.80; + LONG LONG REAL xxx = LONG LONG 3.14, yyy = LONG LONG 3.80; + ASSERT (ENTIER x = 3 AND ENTIER y = 3); + ASSERT (ENTIER xx = LONG 3 AND ENTIER yy = LONG 3); + ASSERT (ENTIER xxx = LONG LONG 3 AND ENTIER yyy = LONG LONG 3) +END diff --git a/gcc/testsuite/algol68/execute/environment-enquiries-1.a68 b/gcc/testsuite/algol68/execute/environment-enquiries-1.a68 new file mode 100644 index 000000000000..1601ac099729 --- /dev/null +++ b/gcc/testsuite/algol68/execute/environment-enquiries-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +# Environment enquiries for SIZETY INTs # +BEGIN ASSERT (max int /= 0); + (INT max int = 10; ASSERT (max int = 10)); + ASSERT (long max int >= LENG max int); + ASSERT (long long max int >= LENG long max int); + ASSERT (min int /= 0); + ASSERT (long min int <= LENG min int); + ASSERT (long long min int <= LENG long min int) +END diff --git a/gcc/testsuite/algol68/execute/environment-enquiries-2.a68 b/gcc/testsuite/algol68/execute/environment-enquiries-2.a68 new file mode 100644 index 000000000000..9f9d5fc0b683 --- /dev/null +++ b/gcc/testsuite/algol68/execute/environment-enquiries-2.a68 @@ -0,0 +1,12 @@ +# { dg-options "-fstropping=upper" } # +# Environment enquiries for SIZETY REALs # +BEGIN ASSERT (max real /= 0.0); + ASSERT (long max real >= LENG max real); + ASSERT (long long max real >= LENG long max real); + ASSERT (min real /= 0.0); + ASSERT (long min real <= LENG min real); + ASSERT (long long min real <= LENG long min real); + ASSERT (small real > 0.0); + ASSERT (long small real > LONG 0.0); + ASSERT (long long small real > LONG LONG 0.0) +END diff --git a/gcc/testsuite/algol68/execute/environment-enquiries-3.a68 b/gcc/testsuite/algol68/execute/environment-enquiries-3.a68 new file mode 100644 index 000000000000..7aba4cd4cb18 --- /dev/null +++ b/gcc/testsuite/algol68/execute/environment-enquiries-3.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +# Environment enquiries for SIZETY BITS # +BEGIN ASSERT (bits width > 0); + ASSERT (long bits width >= bits width); + ASSERT (long long bits width >= long bits width); + ASSERT (short bits width <= bits width); + ASSERT (short short bits width <= short bits width) +END + diff --git a/gcc/testsuite/algol68/execute/environment-enquiries-4.a68 b/gcc/testsuite/algol68/execute/environment-enquiries-4.a68 new file mode 100644 index 000000000000..b053ed143476 --- /dev/null +++ b/gcc/testsuite/algol68/execute/environment-enquiries-4.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# Environment enquiries for pi constants. # +BEGIN ASSERT (pi > 3.0 AND pi < 4.0); + ASSERT (long pi > LONG 3.0 AND long pi < LONG 4.0); + ASSERT (long long pi > LONG LONG 3.0 AND long long pi < LONG LONG 4.0) +END + diff --git a/gcc/testsuite/algol68/execute/environment-enquiries-5.a68 b/gcc/testsuite/algol68/execute/environment-enquiries-5.a68 new file mode 100644 index 000000000000..a46879857b60 --- /dev/null +++ b/gcc/testsuite/algol68/execute/environment-enquiries-5.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# Environment enquiries for certain particular characters. # +BEGIN ASSERT (null character /= blank); + ASSERT (max abs char = ABS 16r10ffff) +END diff --git a/gcc/testsuite/algol68/execute/environment-enquiries-6.a68 b/gcc/testsuite/algol68/execute/environment-enquiries-6.a68 new file mode 100644 index 000000000000..a37dd4c2e421 --- /dev/null +++ b/gcc/testsuite/algol68/execute/environment-enquiries-6.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# Environment enquiries for SIZETY BITs # +BEGIN ASSERT (max bits /= 10r0); + # XXX use LENG max bits below # + ASSERT (long max bits >= LONG 10r0); + ASSERT (long long max bits >= LONG LONG 10r0) +END diff --git a/gcc/testsuite/algol68/execute/environment-enquiries-7.a68 b/gcc/testsuite/algol68/execute/environment-enquiries-7.a68 new file mode 100644 index 000000000000..d64a68f28d30 --- /dev/null +++ b/gcc/testsuite/algol68/execute/environment-enquiries-7.a68 @@ -0,0 +1,15 @@ +# { dg-options "-fstropping=upper" } # +# Environment enquiries for widths # +BEGIN ASSERT (int width > 0); + ASSERT (long int width > 0); + ASSERT (long long int width > 0); + ASSERT (short int width > 0); + ASSERT (short short int width > 0); + ASSERT (real width > 0); + ASSERT (long real width > 0); + ASSERT (long long real width > 0) +CO exp width; + long exp width; + long long exp width; +CO +END diff --git a/gcc/testsuite/algol68/execute/environment-enquiries-8.a68 b/gcc/testsuite/algol68/execute/environment-enquiries-8.a68 new file mode 100644 index 000000000000..d464a49d9907 --- /dev/null +++ b/gcc/testsuite/algol68/execute/environment-enquiries-8.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (flip = "T"); + ASSERT (flop = "F"); + ASSERT (error char = "*"); + ASSERT (ABS invalid char = ABS 16rfffd) +END diff --git a/gcc/testsuite/algol68/execute/eq-bits-1.a68 b/gcc/testsuite/algol68/execute/eq-bits-1.a68 new file mode 100644 index 000000000000..b26df33d8b1a --- /dev/null +++ b/gcc/testsuite/algol68/execute/eq-bits-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN BITS b, LONG BITS bb = LONG 16rff, LONG LONG BITS bbb; + SHORT BITS ss = SHORT 16rff, SHORT SHORT BITS sss; + ASSERT (b = 2r0); + ASSERT (bb EQ LONG 8r377); + ASSERT (bbb = LONG LONG 8r0); + ASSERT (ss EQ SHORT 8r377); + ASSERT (sss = SHORT SHORT 8r0) +END + diff --git a/gcc/testsuite/algol68/execute/eq-char-char-1.a68 b/gcc/testsuite/algol68/execute/eq-char-char-1.a68 new file mode 100644 index 000000000000..eb520d2d6a84 --- /dev/null +++ b/gcc/testsuite/algol68/execute/eq-char-char-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT ("a" = "a") +END + diff --git a/gcc/testsuite/algol68/execute/eq-int-1.a68 b/gcc/testsuite/algol68/execute/eq-int-1.a68 new file mode 100644 index 000000000000..399b91aeab75 --- /dev/null +++ b/gcc/testsuite/algol68/execute/eq-int-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 12; + LONG INT ii = LONG 12, LONG LONG INT iii = LONG LONG 12; + SHORT INT s = SHORT 12, SHORT SHORT INT ss = SHORT SHORT 12; + ASSERT (12 = i); + ASSERT (ii = LONG 12); + ASSERT (iii = LONG LONG 12); + ASSERT (s = SHORT 12); + ASSERT (ss = SHORT SHORT 12) +END diff --git a/gcc/testsuite/algol68/execute/eq-string-1.a68 b/gcc/testsuite/algol68/execute/eq-string-1.a68 new file mode 100644 index 000000000000..0242f02bafb0 --- /dev/null +++ b/gcc/testsuite/algol68/execute/eq-string-1.a68 @@ -0,0 +1,16 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRING foo = "foo", bar = "bar", quux = "quux"; + # = # + ASSERT ("" = ""); + ASSERT ("foo" = foo); + ASSERT (NOT (foo = bar)); + ASSERT (NOT (foo = quux)); + ASSERT (NOT (quux = foo)); + # EQ # + ASSERT ("" EQ ""); + ASSERT ("foo" EQ foo); + ASSERT (NOT (foo EQ bar)); + ASSERT (NOT (foo EQ quux)); + ASSERT (NOT (quux EQ foo)) +END + diff --git a/gcc/testsuite/algol68/execute/eq-string-stride-1.a68 b/gcc/testsuite/algol68/execute/eq-string-stride-1.a68 new file mode 100644 index 000000000000..6e9cec79a45f --- /dev/null +++ b/gcc/testsuite/algol68/execute/eq-string-stride-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,]CHAR matrix = (("1", "2", "3"), + ("4", "5", "6"), + ("7", "8", "9")); + ASSERT (matrix[1:3,2] = "258") +END diff --git a/gcc/testsuite/algol68/execute/execute.exp b/gcc/testsuite/algol68/execute/execute.exp new file mode 100644 index 000000000000..60722c7ad097 --- /dev/null +++ b/gcc/testsuite/algol68/execute/execute.exp @@ -0,0 +1,37 @@ +# Copyright (C) 2024 Free Software Foundation, Inc. + +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +# Execute tests, torture testing. + +if $tracelevel then { + strace $tracelevel +} + +load_lib algol68-torture.exp +load_lib torture-options.exp + +torture-init +set-torture-options $TORTURE_OPTIONS + +foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.a68]] { + # If we're only testing specific files and this isn't one of them, skip it. + if ![runtest_file_p $runtests $testcase] then { + continue + } + algol68-torture-execute $testcase + set algol68_compile_args "" +} + +torture-finish diff --git a/gcc/testsuite/algol68/execute/factorial-1.a68 b/gcc/testsuite/algol68/execute/factorial-1.a68 new file mode 100644 index 000000000000..f1fa920ae200 --- /dev/null +++ b/gcc/testsuite/algol68/execute/factorial-1.a68 @@ -0,0 +1,170 @@ +# { dg-options "-fstropping=upper" } # +# The Most Contrived Factorial Program + By John P. Baker + University of Bristol. + + Published in the Algol Bulletin 42. + http://jemarch.net/algol-bulletin-42.pdf + + Version adapted for GCC. +# + +BEGIN INT one = 1, two = 2, three = 3, four = 4, five = 5, + six = 6, seven = 7, eight = 8, nine = 9, ten = 10, + eleven = 11, twelve = 12; + INT a = one; + PRIO ME=5, LOVE=7, MY=7, LORDS=7, LADIES=7, + PIPERS=7, DRUMMERS=7, MAIDS=7, SWANS=7, GEESE=7, + GOLD=7, COLLY=7, FRENCH=7, TURTLE=7, PARTRIDGE=6; + BOOL sent to := TRUE; + OP THE = (BOOL a) BOOL: a, + TWELFTH = (INT a) BOOL: a = twelve, + ELEVENTH = (INT a) BOOL: a = eleven, + TENTH = (INT a) BOOL: a = ten, + NINTH = (INT a) BOOL: a = nine, + EIGHTH = (INT a) BOOL: a = eight, + SEVENTH = (INT a) BOOL: a = seven, + SIXTH = (INT a) BOOL: a = six, + FIFTH = (INT a) BOOL: a = five, + FOURTH = (INT a) BOOL: a = four, + THIRD = (INT a) BOOL: a = three, + SECOND = (INT a) BOOL: a = two, + FIRST = (INT a) BOOL: a = one; + OP ME = (BOOL a, INT b) VOID: SKIP; # XXX when transput done (a|print(b)) # + OP LOVE = (BOOL a, b) BOOL: (a|b|FALSE), + MY = (BOOL a, b) BOOL: a LOVE b; + OP AND = (INT a) INT: a; + MODE DATE = STRUCT (INT day, month); + LOC DATE christmas := (25, 12); + OP LORDS = (INT a, b) INT: a * b, + LADIES = (INT a, b) INT: a * b, + PIPERS = (INT a, b) INT: a * b, + DRUMMERS = (INT a, b) INT: a * b, + MAIDS = (INT a, b) INT: a * b, + SWANS = (INT a, b) INT: a * b, + GEESE = (INT a, b) INT: a * b, + GOLD = (INT a, b) INT: a * b, + COLLY = (INT a, b) INT: a * b, + FRENCH = (INT a, b) INT: a * b, + TURTLE = (INT a, b) INT: a * b; + OP LEAPING = (INT a) INT: a, + DANCING = (INT a) INT: a, + PIPING = (INT a) INT: a, + DRUMMING = (INT a) INT: a, + MILKING = (INT a) INT: a, + SWIMMING = (INT a) INT: a, + LAYING = (INT a) INT: a, + RINGS = (INT a) INT: a, + BIRDS = (INT a) INT: a, + HENS = (INT a) INT: a, + DOVES = (INT a) INT: a; + OP PARTRIDGE = (INT a, b) INT: a + b; + INT in a pear tree = 0; + + # Now we are ready... # + + THE FIRST day OF christmas MY TRUE LOVE sent to ME + a PARTRIDGE in a pear tree; + + THE SECOND day OF christmas MY TRUE LOVE sent to ME + two TURTLE DOVES AND + a PARTRIDGE in a pear tree; + + THE THIRD day OF christmas MY TRUE LOVE sent to ME + three FRENCH HENS + two TURTLE DOVES AND + a PARTRIDGE in a pear tree; + + THE FOURTH day OF christmas MY TRUE LOVE sent to ME + four COLLY BIRDS + three FRENCH HENS + two TURTLE DOVES AND + a PARTRIDGE in a pear tree; + + THE FIFTH day OF christmas MY TRUE LOVE sent to ME + five GOLD RINGS + four COLLY BIRDS + three FRENCH HENS + two TURTLE DOVES AND + a PARTRIDGE in a pear tree; + + THE SIXTH day OF christmas MY TRUE LOVE sent to ME + six GEESE LAYING + five GOLD RINGS + four COLLY BIRDS + three FRENCH HENS + two TURTLE DOVES AND + a PARTRIDGE in a pear tree; + + THE SEVENTH day OF christmas MY TRUE LOVE sent to ME + seven SWANS SWIMMING + six GEESE LAYING + five GOLD RINGS + four COLLY BIRDS + three FRENCH HENS + two TURTLE DOVES AND + a PARTRIDGE in a pear tree; + + THE EIGHTH day OF christmas MY TRUE LOVE sent to ME + eight MAIDS MILKING + seven SWANS SWIMMING + six GEESE LAYING + five GOLD RINGS + four COLLY BIRDS + three FRENCH HENS + two TURTLE DOVES AND + a PARTRIDGE in a pear tree; + + THE NINTH day OF christmas MY TRUE LOVE sent to ME + nine DRUMMERS DRUMMING + eight MAIDS MILKING + seven SWANS SWIMMING + six GEESE LAYING + five GOLD RINGS + four COLLY BIRDS + three FRENCH HENS + two TURTLE DOVES AND + a PARTRIDGE in a pear tree; + + THE TENTH day OF christmas MY TRUE LOVE sent to ME + ten PIPERS PIPING + nine DRUMMERS DRUMMING + eight MAIDS MILKING + seven SWANS SWIMMING + six GEESE LAYING + five GOLD RINGS + four COLLY BIRDS + three FRENCH HENS + two TURTLE DOVES AND + a PARTRIDGE in a pear tree; + + THE ELEVENTH day OF christmas MY TRUE LOVE sent to ME + eleven LADIES DANCING + ten PIPERS PIPING + nine DRUMMERS DRUMMING + eight MAIDS MILKING + seven SWANS SWIMMING + six GEESE LAYING + five GOLD RINGS + four COLLY BIRDS + three FRENCH HENS + two TURTLE DOVES AND + a PARTRIDGE in a pear tree; + + THE TWELFTH day OF christmas MY TRUE LOVE sent to ME + twelve LORDS LEAPING + eleven LADIES DANCING + ten PIPERS PIPING + nine DRUMMERS DRUMMING + eight MAIDS MILKING + seven SWANS SWIMMING + six GEESE LAYING + five GOLD RINGS + four COLLY BIRDS + three FRENCH HENS + two TURTLE DOVES AND + a PARTRIDGE in a pear tree; + + SKIP +END + diff --git a/gcc/testsuite/algol68/execute/flat-assignation-1.a68 b/gcc/testsuite/algol68/execute/flat-assignation-1.a68 new file mode 100644 index 000000000000..bf973564b1f5 --- /dev/null +++ b/gcc/testsuite/algol68/execute/flat-assignation-1.a68 @@ -0,0 +1,7 @@ +{ Assigning to the flexible name replaces the descriptor + as well as the elements. } +begin [10:0]int flat1; + flex[10:-10]int flat2; + flat2 := flat1; + assert (UPB flat2 = 0 AND LWB flat2 = 10) +end diff --git a/gcc/testsuite/algol68/execute/flat-assignation-2.a68 b/gcc/testsuite/algol68/execute/flat-assignation-2.a68 new file mode 100644 index 000000000000..fb7fa82ba687 --- /dev/null +++ b/gcc/testsuite/algol68/execute/flat-assignation-2.a68 @@ -0,0 +1,8 @@ +{ Assigning to the flexible name replaces the descriptor + as well as the elements. } +begin [1:20,10:0]int flat1; + flex[100:200,10:-10]int flat2; + flat2 := flat1; + assert (1 UPB flat2 = 20 AND 1 LWB flat2 = 1); + assert (2 UPB flat2 = 0 AND 2 LWB flat2 = 10) +end diff --git a/gcc/testsuite/algol68/execute/flex-1.a68 b/gcc/testsuite/algol68/execute/flex-1.a68 new file mode 100644 index 000000000000..4e2bc315097c --- /dev/null +++ b/gcc/testsuite/algol68/execute/flex-1.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN FLEX[3]INT list := (1,2,3); + list[2] := 20; + ASSERT (list[2] = 20) +END diff --git a/gcc/testsuite/algol68/execute/flex-2.a68 b/gcc/testsuite/algol68/execute/flex-2.a68 new file mode 100644 index 000000000000..4f18674bc886 --- /dev/null +++ b/gcc/testsuite/algol68/execute/flex-2.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +# Rowing to flexible rows. # +BEGIN FLEX[]INT list = 10; + ASSERT (list[1] = 10); + FLEX[,]INT table = 10; + ASSERT (table[1,1] = 10) +END + diff --git a/gcc/testsuite/algol68/execute/flex-3.a68 b/gcc/testsuite/algol68/execute/flex-3.a68 new file mode 100644 index 000000000000..8ee388557277 --- /dev/null +++ b/gcc/testsuite/algol68/execute/flex-3.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# Slicing flexible names. # +BEGIN FLEX[]INT list = (1,2,3); + FLEX[]INT sliced = list[2:3]; + ASSERT (LWB sliced = 1 AND UPB sliced = 2); + ASSERT (sliced[1] = 2 AND sliced[2] = 3) +END diff --git a/gcc/testsuite/algol68/execute/flex-4.a68 b/gcc/testsuite/algol68/execute/flex-4.a68 new file mode 100644 index 000000000000..d4d7c998f7dc --- /dev/null +++ b/gcc/testsuite/algol68/execute/flex-4.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# Rowing to flexible rows. # +BEGIN FLEX[3]INT list := (1,2,3); + list := (10,20,30,40); + ASSERT (list[4] = 40) +END diff --git a/gcc/testsuite/algol68/execute/flex-5.a68 b/gcc/testsuite/algol68/execute/flex-5.a68 new file mode 100644 index 000000000000..9f9dccc36640 --- /dev/null +++ b/gcc/testsuite/algol68/execute/flex-5.a68 @@ -0,0 +1,12 @@ +# { dg-options "-fstropping=upper" } # +BEGIN FLEX[1:0]INT a; + ASSERT (LWB a = 1 AND UPB a = 0 AND ELEMS a = 0); + a := (1,2,3); + ASSERT (LWB a = 1 AND UPB a = 3 AND a[1] = 1 AND a[2] = 2 AND a[3] = 3); + a := (10,a[2],a[3]); + ASSERT (LWB a = 1 AND UPB a = 3 AND a[1] = 10 AND a[2] = 2 AND a[3] = 3); + a := 100; + ASSERT (LWB a = 1 AND UPB a = 1 AND a[1] = 100); + a := (); + ASSERT (LWB a = 1 AND UPB a = 0 AND ELEMS a = 0) +END diff --git a/gcc/testsuite/algol68/execute/formula-1.a68 b/gcc/testsuite/algol68/execute/formula-1.a68 new file mode 100644 index 000000000000..6d2ba4ef82d1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/formula-1.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN OP JORL = (INT a, b) INT: a + b; + OP JORL = (REAL a, b) REAL: a + b; + OP JORL = ([]CHAR s) INT: ELEMS s; + PRIO JORL = 6; + ASSERT (10 JORL 20 = 30); + ASSERT (REAL r = 3.14 JORL REAL (1); r > 4.13 AND r < 4.15); + ASSERT (JORL "foo" = 3) +END diff --git a/gcc/testsuite/algol68/execute/formula-2.a68 b/gcc/testsuite/algol68/execute/formula-2.a68 new file mode 100644 index 000000000000..5b09f3d870f9 --- /dev/null +++ b/gcc/testsuite/algol68/execute/formula-2.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i; + PROC side = INT: (i := 1; i := 2; i); + INT res = side + side; + # Can be either due to collateral elaboration in the formula above. # + ASSERT (res = 3 OR res = 4) +END diff --git a/gcc/testsuite/algol68/execute/fsize-1.a68 b/gcc/testsuite/algol68/execute/fsize-1.a68 new file mode 100644 index 000000000000..17e3ef2ba9ef --- /dev/null +++ b/gcc/testsuite/algol68/execute/fsize-1.a68 @@ -0,0 +1,2 @@ +begin assert (fsize (-1) = - long long 1) +end diff --git a/gcc/testsuite/algol68/execute/ge-int-1.a68 b/gcc/testsuite/algol68/execute/ge-int-1.a68 new file mode 100644 index 000000000000..9ed95321c095 --- /dev/null +++ b/gcc/testsuite/algol68/execute/ge-int-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 12; + LONG INT ii = LONG 12, LONG LONG INT iii = LONG LONG 12; + SHORT INT s = SHORT 12, SHORT SHORT INT ss = SHORT SHORT 12; + ASSERT (i >= 10); + ASSERT (ii GE LONG 10); + ASSERT (iii >= LONG LONG 12); + ASSERT (s >= SHORT 12); + ASSERT (ss >= SHORT SHORT 10) +END diff --git a/gcc/testsuite/algol68/execute/ge-string-stride-1.a68 b/gcc/testsuite/algol68/execute/ge-string-stride-1.a68 new file mode 100644 index 000000000000..4f51d6ba6fcb --- /dev/null +++ b/gcc/testsuite/algol68/execute/ge-string-stride-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,]CHAR matrix = (("1", "0", "1"), + ("4", "0", "4"), + ("7", "0", "7")); + ASSERT (matrix[1:3,1] >= matrix[1:3,3]); + ASSERT (("1","4","7") >= matrix[1:3,3]) +END diff --git a/gcc/testsuite/algol68/execute/gen-flex-1.a68 b/gcc/testsuite/algol68/execute/gen-flex-1.a68 new file mode 100644 index 000000000000..ce993df27d20 --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-flex-1.a68 @@ -0,0 +1,10 @@ +begin flex[10:-10]int je; + int num_fields = 3; + assert (UPB je = -10 AND LWB je = 10 AND ELEMS je = 0); + + [1:num_fields][1:num_fields]string fields; + for i to num_fields + do for j to num_fields + do assert (fields[i][j] = "") od + od +end diff --git a/gcc/testsuite/algol68/execute/gen-heap-1.a68 b/gcc/testsuite/algol68/execute/gen-heap-1.a68 new file mode 100644 index 000000000000..fdf8df23c6ef --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-heap-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT jorl; + REF INT var = HEAP INT; + var := jorl := 10; + ASSERT (var = 10) +END diff --git a/gcc/testsuite/algol68/execute/gen-heap-2.a68 b/gcc/testsuite/algol68/execute/gen-heap-2.a68 new file mode 100644 index 000000000000..80e3a77676c7 --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-heap-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT jorl; + REF INT var := HEAP INT; + var := jorl := 10; + ASSERT (var = 10) +END diff --git a/gcc/testsuite/algol68/execute/gen-heap-3.a68 b/gcc/testsuite/algol68/execute/gen-heap-3.a68 new file mode 100644 index 000000000000..e2c026b2bc81 --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-heap-3.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT jorl; + INT var := HEAP INT := 15; # The generated name goes away # + ASSERT (var = 15) +END diff --git a/gcc/testsuite/algol68/execute/gen-heap-bool-1.a68 b/gcc/testsuite/algol68/execute/gen-heap-bool-1.a68 new file mode 100644 index 000000000000..d4494f0d7536 --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-heap-bool-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REF BOOL x = HEAP BOOL; + ASSERT (x = FALSE); + x := TRUE; + ASSERT (x = TRUE) +END diff --git a/gcc/testsuite/algol68/execute/gen-heap-int-1.a68 b/gcc/testsuite/algol68/execute/gen-heap-int-1.a68 new file mode 100644 index 000000000000..8500d792cbad --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-heap-int-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REF INT x = HEAP INT := 4; + ASSERT (x = 4) +END diff --git a/gcc/testsuite/algol68/execute/gen-heap-real-1.a68 b/gcc/testsuite/algol68/execute/gen-heap-real-1.a68 new file mode 100644 index 000000000000..3ea6dcb7edfe --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-heap-real-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REF REAL x = HEAP REAL := 4; + ASSERT (x > 3.9 AND x < 4.1) +END diff --git a/gcc/testsuite/algol68/execute/gen-heap-struct-1.a68 b/gcc/testsuite/algol68/execute/gen-heap-struct-1.a68 new file mode 100644 index 000000000000..2c2f9744371a --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-heap-struct-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN HEAP STRUCT(INT i, REAL r) foo; + ASSERT (i OF foo = 0) +END diff --git a/gcc/testsuite/algol68/execute/gen-heap-struct-2.a68 b/gcc/testsuite/algol68/execute/gen-heap-struct-2.a68 new file mode 100644 index 000000000000..0803204d2d89 --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-heap-struct-2.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN HEAP STRUCT([10]INT i, REAL r) foo; + FOR i FROM LWB i OF foo TO UPB i OF foo + DO ASSERT ((i OF foo)[i] = 0) OD +END diff --git a/gcc/testsuite/algol68/execute/gen-heap-struct-3.a68 b/gcc/testsuite/algol68/execute/gen-heap-struct-3.a68 new file mode 100644 index 000000000000..849bbbd6234e --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-heap-struct-3.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN HEAP STRUCT([10]INT i, STRING s) foo; + FOR i FROM LWB i OF foo TO UPB i OF foo + DO ASSERT ((i OF foo)[i] = 0) OD +END diff --git a/gcc/testsuite/algol68/execute/gen-loc-1.a68 b/gcc/testsuite/algol68/execute/gen-loc-1.a68 new file mode 100644 index 000000000000..1a61bbea0a12 --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-loc-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT jorl; + REF INT var = LOC INT; + var := jorl := 10; + ASSERT (var = 10) +END diff --git a/gcc/testsuite/algol68/execute/gen-loc-2.a68 b/gcc/testsuite/algol68/execute/gen-loc-2.a68 new file mode 100644 index 000000000000..fce63efec695 --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-loc-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT jorl; + REF INT var := LOC INT; + var := jorl := 10; + ASSERT (var = 10) +END diff --git a/gcc/testsuite/algol68/execute/gen-loc-3.a68 b/gcc/testsuite/algol68/execute/gen-loc-3.a68 new file mode 100644 index 000000000000..66c3cf1ea0c5 --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-loc-3.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT jorl; + INT var := LOC INT := 15; # The generated name goes away # + ASSERT (var = 15) +END diff --git a/gcc/testsuite/algol68/execute/gen-loc-4.a68 b/gcc/testsuite/algol68/execute/gen-loc-4.a68 new file mode 100644 index 000000000000..6aeb30008e09 --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-loc-4.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE NODE = STRUCT (INT code, REF NODE next); + + NODE top := (10, NIL); + next OF top := LOC NODE := (20, NIL); + ASSERT (code OF top = 10); + ASSERT (code OF next OF top = 20) +END diff --git a/gcc/testsuite/algol68/execute/gen-multiple-1.a68 b/gcc/testsuite/algol68/execute/gen-multiple-1.a68 new file mode 100644 index 000000000000..2be0d96e77e3 --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-multiple-1.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE JORL = [(INT x; x + 1)]INT; + JORL xx; + ASSERT (ELEMS xx = 1 AND xx[1] = 0) +END diff --git a/gcc/testsuite/algol68/execute/gen-union-1.a68 b/gcc/testsuite/algol68/execute/gen-union-1.a68 new file mode 100644 index 000000000000..893da2229061 --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-union-1.a68 @@ -0,0 +1,17 @@ +# { dg-options "-fstropping=upper" } # +BEGIN UNION(INT,REAL,[]INT,CHAR) datux; + ASSERT (CASE datux + IN (INT): 10, + (REAL): 20, + (CHAR): 30, + ([]INT): 40 + ESAC = 0); + []INT ja = (1,2,3); + datux := ja; + ASSERT (CASE datux + IN (INT): 10, + (REAL): 20, + (CHAR): 30, + ([]INT): 40 + ESAC = 40) +END diff --git a/gcc/testsuite/algol68/execute/gen-union-2.a68 b/gcc/testsuite/algol68/execute/gen-union-2.a68 new file mode 100644 index 000000000000..27ab7a8aeb19 --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-union-2.a68 @@ -0,0 +1,20 @@ +# { dg-options "-fstropping=upper" } # +# pr UPPER pr # +BEGIN [10]UNION(INT,REAL,[]INT,CHAR) datux; + FOR i FROM LWB datux TO UPB datux + DO ASSERT (CASE datux[i] + IN (INT): 10, + (REAL): 20, + (CHAR): 30, + ([]INT): 40 + ESAC = 0); + []INT ja = (1,2,3); + datux[i] := ja; + ASSERT (CASE datux[i] + IN (INT): 10, + (REAL): 20, + (CHAR): 30, + ([]INT): 40 + ESAC = 40) + OD +END diff --git a/gcc/testsuite/algol68/execute/gen-union-3.a68 b/gcc/testsuite/algol68/execute/gen-union-3.a68 new file mode 100644 index 000000000000..78c5d0585845 --- /dev/null +++ b/gcc/testsuite/algol68/execute/gen-union-3.a68 @@ -0,0 +1,14 @@ +# { dg-options "-fstropping=upper" } # +# An union generated from SKIP has -1 as overhead. # +BEGIN MODE JSONVAL = UNION (JSONOBJ,JSONSTR), + JSONSTR = STRING, + JSONOBJ = STRUCT (REF JSONFLD fields), + JSONFLD = STRUCT (JSONVAL value, REF JSONFLD next); + + JSONFLD fields; + ASSERT (CASE value OF fields + IN (JSONSTR s): "string", + (JSONOBJ o): "object" + OUT "fuckyou" + ESAC = "fuckyou") +END diff --git a/gcc/testsuite/algol68/execute/goto-1.a68 b/gcc/testsuite/algol68/execute/goto-1.a68 new file mode 100644 index 000000000000..7f61575efb2f --- /dev/null +++ b/gcc/testsuite/algol68/execute/goto-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 0; +beg: IF (i < 5) + THEN i +:= 1; + GOTO beg + FI +END diff --git a/gcc/testsuite/algol68/execute/goto-2.a68 b/gcc/testsuite/algol68/execute/goto-2.a68 new file mode 100644 index 000000000000..7f78215af283 --- /dev/null +++ b/gcc/testsuite/algol68/execute/goto-2.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN GOTO end; + ASSERT(FALSE); +end: SKIP +END diff --git a/gcc/testsuite/algol68/execute/goto-3.a68 b/gcc/testsuite/algol68/execute/goto-3.a68 new file mode 100644 index 000000000000..47573d2f8c1d --- /dev/null +++ b/gcc/testsuite/algol68/execute/goto-3.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN + INT i := 0; + beginning: + IF (i < 5) THEN + i +:= 1; + GO TO beginning + FI +END diff --git a/gcc/testsuite/algol68/execute/goto-4.a68 b/gcc/testsuite/algol68/execute/goto-4.a68 new file mode 100644 index 000000000000..c374ca86c1bf --- /dev/null +++ b/gcc/testsuite/algol68/execute/goto-4.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN + INT i := 0; + beginning: + IF (i < 5) THEN + i +:= 1; + beginning + FI +END diff --git a/gcc/testsuite/algol68/execute/goto-5.a68 b/gcc/testsuite/algol68/execute/goto-5.a68 new file mode 100644 index 000000000000..a5c720e3e63f --- /dev/null +++ b/gcc/testsuite/algol68/execute/goto-5.a68 @@ -0,0 +1,20 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC is prime = (INT m) BOOL: + BEGIN IF m < 2 + THEN puts ("program terminated because m is less than 2\n"); + GOTO stop + FI; + + BOOL factor found := NOT (ODD m OR m = 2); + FOR i FROM 3 BY 2 TO m - 1 WHILE NOT factor found + DO factor found := m MOD i = 0 OD; + factor found + END; + + ASSERT (is prime (1)); + ASSERT (is prime (3)); + ASSERT (is prime (71)); + ASSERT (is prime (97)); + is prime (0); + ASSERT (FALSE) # Should jump to stop in the standard postlude. # +END diff --git a/gcc/testsuite/algol68/execute/gt-int-1.a68 b/gcc/testsuite/algol68/execute/gt-int-1.a68 new file mode 100644 index 000000000000..cd5437b9ff88 --- /dev/null +++ b/gcc/testsuite/algol68/execute/gt-int-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 12; + LONG INT ii = LONG 12, LONG LONG INT iii = LONG LONG 12; + SHORT INT s = SHORT 12, SHORT SHORT INT ss = SHORT SHORT 12; + ASSERT (i > 10); + ASSERT (ii GT LONG 10); + ASSERT (iii > LONG LONG 10); + ASSERT (s > SHORT 10); + ASSERT (ss > SHORT SHORT 10) +END diff --git a/gcc/testsuite/algol68/execute/gt-string-stride-1.a68 b/gcc/testsuite/algol68/execute/gt-string-stride-1.a68 new file mode 100644 index 000000000000..3f0565cf2716 --- /dev/null +++ b/gcc/testsuite/algol68/execute/gt-string-stride-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,]CHAR matrix = (("1", "0", "1"), + ("4", "0", "4"), + ("7", "0", "6")); + ASSERT (matrix[1:3,1] > matrix[1:3,3]); + ASSERT (("1","4","7") > matrix[1:3,3]) +END diff --git a/gcc/testsuite/algol68/execute/i-1.a68 b/gcc/testsuite/algol68/execute/i-1.a68 new file mode 100644 index 000000000000..87b6979c6002 --- /dev/null +++ b/gcc/testsuite/algol68/execute/i-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN COMPL z = 4I5; + LONG COMPL zz = LONG 4 I LONG 6; + LONG LONG COMPL zzz = LONG LONG 4 I LONG LONG7; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/i-2.a68 b/gcc/testsuite/algol68/execute/i-2.a68 new file mode 100644 index 000000000000..455f0096e2e2 --- /dev/null +++ b/gcc/testsuite/algol68/execute/i-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN COMPL z = 4.0I5.0; + LONG COMPL zz = LONG 4.0 I LONG 6.0; + LONG LONG COMPL zzz = LONG LONG 4.0 I LONG LONG 7.0; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/identification-1.a68 b/gcc/testsuite/algol68/execute/identification-1.a68 new file mode 100644 index 000000000000..71cc808cff4a --- /dev/null +++ b/gcc/testsuite/algol68/execute/identification-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC a = REAL: b := c; + REAL b := 1, c := 2; + REAL x := a; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/identification-2.a68 b/gcc/testsuite/algol68/execute/identification-2.a68 new file mode 100644 index 000000000000..8292063373a9 --- /dev/null +++ b/gcc/testsuite/algol68/execute/identification-2.a68 @@ -0,0 +1,14 @@ +# { dg-options "-fstropping=upper" } # +# The identification of c in the assignation marked with XXX works. + In some Algol 68 systems the assignation may fail or result in UB, + because the storage of the REF REAL c doesn't exist yet. In GNU + Algol 68 this works and the value yielded by c is guaranteed to be + zero. +# + +BEGIN REAL b; + b := c; # XXX # + ASSERT (b = 0); + REAL c; + c := b +END diff --git a/gcc/testsuite/algol68/execute/identity-declaration-1.a68 b/gcc/testsuite/algol68/execute/identity-declaration-1.a68 new file mode 100644 index 000000000000..ddfa8f28bcbd --- /dev/null +++ b/gcc/testsuite/algol68/execute/identity-declaration-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 10; + REF INT xx = x := 20; + ASSERT (xx = 20); + SKIP +END diff --git a/gcc/testsuite/algol68/execute/identity-declaration-2.a68 b/gcc/testsuite/algol68/execute/identity-declaration-2.a68 new file mode 100644 index 000000000000..28ba62a9c64b --- /dev/null +++ b/gcc/testsuite/algol68/execute/identity-declaration-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 10; + REF INT xx = x; + ASSERT (xx = 10); + SKIP +END diff --git a/gcc/testsuite/algol68/execute/identity-declaration-3.a68 b/gcc/testsuite/algol68/execute/identity-declaration-3.a68 new file mode 100644 index 000000000000..a694c3a640ef --- /dev/null +++ b/gcc/testsuite/algol68/execute/identity-declaration-3.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 10; + REF INT xx = (x := 20); + ASSERT (xx = 20); + SKIP +END diff --git a/gcc/testsuite/algol68/execute/identity-declaration-4.a68 b/gcc/testsuite/algol68/execute/identity-declaration-4.a68 new file mode 100644 index 000000000000..d60867eff326 --- /dev/null +++ b/gcc/testsuite/algol68/execute/identity-declaration-4.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 10; + REF INT xx = ((x)); + ASSERT (xx = 10) +END diff --git a/gcc/testsuite/algol68/execute/identity-declaration-5.a68 b/gcc/testsuite/algol68/execute/identity-declaration-5.a68 new file mode 100644 index 000000000000..7c29de1b92b6 --- /dev/null +++ b/gcc/testsuite/algol68/execute/identity-declaration-5.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE FOO = STRUCT (STRING s, INT i); + FOO f1 = ("foo", 10); + ASSERT (i OF f1 = 10) +END diff --git a/gcc/testsuite/algol68/execute/identity-declaration-multiple-1.a68 b/gcc/testsuite/algol68/execute/identity-declaration-multiple-1.a68 new file mode 100644 index 000000000000..9864ab975942 --- /dev/null +++ b/gcc/testsuite/algol68/execute/identity-declaration-multiple-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []INT foo = (1,2,3); + ASSERT (ELEMS foo = 3) +END diff --git a/gcc/testsuite/algol68/execute/identity-declaration-multiple-2.a68 b/gcc/testsuite/algol68/execute/identity-declaration-multiple-2.a68 new file mode 100644 index 000000000000..6fd973ee4453 --- /dev/null +++ b/gcc/testsuite/algol68/execute/identity-declaration-multiple-2.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [][]INT foo = ((1,2,3),(4,5,6)); + ASSERT (ELEMS foo = 2) +END diff --git a/gcc/testsuite/algol68/execute/identity-declaration-multiple-3.a68 b/gcc/testsuite/algol68/execute/identity-declaration-multiple-3.a68 new file mode 100644 index 000000000000..2d3b8f3c7bee --- /dev/null +++ b/gcc/testsuite/algol68/execute/identity-declaration-multiple-3.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [3]INT a := (1,2,3); + REF[]INT nn = a; # No copy happens here. # + nn[1] := 200; + ASSERT (a[1] = 200) +END diff --git a/gcc/testsuite/algol68/execute/identity-declaration-multiple-5.a68 b/gcc/testsuite/algol68/execute/identity-declaration-multiple-5.a68 new file mode 100644 index 000000000000..005a3c6c4fbb --- /dev/null +++ b/gcc/testsuite/algol68/execute/identity-declaration-multiple-5.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [:]INT foo = (1,2,3); + ASSERT (ELEMS foo = 3) +END diff --git a/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-1.a68 b/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-1.a68 new file mode 100644 index 000000000000..c8890c27c3d3 --- /dev/null +++ b/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []INT a = (); + ASSERT (UPB a = 0); + ASSERT (LWB a = 1); + ASSERT (ELEMS a = 0) +END diff --git a/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-2.a68 b/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-2.a68 new file mode 100644 index 000000000000..67b5294d15b6 --- /dev/null +++ b/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-2.a68 @@ -0,0 +1,12 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,,]INT a = (); + ASSERT (1 UPB a = 0); + ASSERT (1 LWB a = 1); + ASSERT (1 ELEMS a = 0); + ASSERT (2 UPB a = 0); + ASSERT (2 LWB a = 1); + ASSERT (2 ELEMS a = 0); + ASSERT (3 UPB a = 0); + ASSERT (3 LWB a = 1); + ASSERT (3 ELEMS a = 0) +END diff --git a/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-3.a68 b/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-3.a68 new file mode 100644 index 000000000000..b74761f74739 --- /dev/null +++ b/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-3.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC foo = ([]INT a) VOID: (ASSERT (ELEMS a = 0)); + foo ([]INT()) +END diff --git a/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-4.a68 b/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-4.a68 new file mode 100644 index 000000000000..69bd760298a7 --- /dev/null +++ b/gcc/testsuite/algol68/execute/identity-declaration-multiple-empty-4.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC foo = ([]INT a) VOID: (ASSERT (LWB a = 1 AND UPB a = 0 AND ELEMS a = 0)); + foo (()) +END diff --git a/gcc/testsuite/algol68/execute/identity-declaration-struct-1.a68 b/gcc/testsuite/algol68/execute/identity-declaration-struct-1.a68 new file mode 100644 index 000000000000..58e26b057d06 --- /dev/null +++ b/gcc/testsuite/algol68/execute/identity-declaration-struct-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +# An identity declaration shall make a copy of the struct value being + ascribed. # +BEGIN MODE FOO = STRUCT (STRING s, INT n); + FOO f1 := ("foo", 10); + FOO f2 = f1; + f1 := ("bar", 20); + ASSERT (n OF f1 = 20); + ASSERT (n OF f2 = 10) +END diff --git a/gcc/testsuite/algol68/execute/infinity-1.a68 b/gcc/testsuite/algol68/execute/infinity-1.a68 new file mode 100644 index 000000000000..a7c4fb29ca30 --- /dev/null +++ b/gcc/testsuite/algol68/execute/infinity-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN infinity; + minus infinity +END diff --git a/gcc/testsuite/algol68/execute/le-ge-bits-1.a68 b/gcc/testsuite/algol68/execute/le-ge-bits-1.a68 new file mode 100644 index 000000000000..8b355f1ba457 --- /dev/null +++ b/gcc/testsuite/algol68/execute/le-ge-bits-1.a68 @@ -0,0 +1,17 @@ +# { dg-options "-fstropping=upper" } # +# <= and => for SIZETY BITS # +BEGIN ASSERT (16rff <= 16rffff); + ASSERT (2r101 LE 2r111); + ASSERT (2r111 >= 2r101); + ASSERT (16rffff GE 16rff); + + ASSERT (LONG 16rff <= LONG 16rffff); + ASSERT (LONG 2r101 LE LONG 2r111); + ASSERT (LONG 2r111 >= LONG 2r101); + ASSERT (LONG 16rffff GE LONG 16rff); + + ASSERT (LONG LONG 16rff <= LONG LONG 16rffff); + ASSERT (LONG LONG 2r101 LE LONG LONG 2r111); + ASSERT (LONG LONG 2r111 >= LONG LONG 2r101); + ASSERT (LONG LONG 16rffff GE LONG LONG 16rff) +END diff --git a/gcc/testsuite/algol68/execute/le-int-1.a68 b/gcc/testsuite/algol68/execute/le-int-1.a68 new file mode 100644 index 000000000000..7ad17d308a3d --- /dev/null +++ b/gcc/testsuite/algol68/execute/le-int-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 12; + LONG INT ii = LONG 12, LONG LONG INT iii = LONG LONG 12; + SHORT INT s = SHORT 12, SHORT SHORT INT ss = SHORT SHORT 12; + ASSERT (i <= 13); + ASSERT (ii LE LONG 13); + ASSERT (iii <= LONG LONG 13); + ASSERT (s <= SHORT 12); + ASSERT (ss <= SHORT SHORT 13) +END diff --git a/gcc/testsuite/algol68/execute/le-string-stride-1.a68 b/gcc/testsuite/algol68/execute/le-string-stride-1.a68 new file mode 100644 index 000000000000..b0fab2af55d8 --- /dev/null +++ b/gcc/testsuite/algol68/execute/le-string-stride-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,]CHAR matrix = (("1", "Z", "1"), + ("4", "Y", "4"), + ("7", "X", "9")); + ASSERT (matrix[1:3,1] <= matrix[1:3,3]); + ASSERT (("1","4","9") <= matrix[1:3,3]) +END diff --git a/gcc/testsuite/algol68/execute/leng-shorten-bits-1.a68 b/gcc/testsuite/algol68/execute/leng-shorten-bits-1.a68 new file mode 100644 index 000000000000..58b5d00efa59 --- /dev/null +++ b/gcc/testsuite/algol68/execute/leng-shorten-bits-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# SHORTEN and LENG on SIZETY BITS # +BEGIN ASSERT (LENG 16rff = LONG 16rff); + ASSERT (SHORTEN LONG 16rffff = 16rffff); + ASSERT (LENG LONG 16rffff = LONG LONG 16rffff); + ASSERT (SHORTEN LONG LONG 16rffff = LONG 16rffff) +END diff --git a/gcc/testsuite/algol68/execute/leng-shorten-ints-1.a68 b/gcc/testsuite/algol68/execute/leng-shorten-ints-1.a68 new file mode 100644 index 000000000000..d615f40c2fa2 --- /dev/null +++ b/gcc/testsuite/algol68/execute/leng-shorten-ints-1.a68 @@ -0,0 +1,27 @@ +# { dg-options "-fstropping=upper" } # +# Environment enquiries for SIZETY INTs # +BEGIN # LENG # + (SHORT SHORT INT iii = short short max int; ASSERT (LENG iii = LENG short short max int)); + (SHORT INT ii = short max int; ASSERT (LENG ii = LENG short max int)); + (INT i = max int; ASSERT (LENG i = LENG max int)); + (LONG INT ii = long max int; ASSERT (LENG ii = LENG long max int)); + # SHORTEN # + (SHORT INT i = SHORT 10; SHORT SHORT INT ii = SHORT SHORT 100; ASSERT (ii + SHORTEN i = SHORT SHORT 110)); + IF int shorths > 2 + THEN (SHORT INT ii = LENG short short max int - SHORT 2; + ASSERT (SHORTEN ii = short short max int - SHORT SHORT 2)); + (SHORT INT ii = LENG short short max int + SHORT 1; ASSERT (SHORTEN ii = short short max int)); + (SHORT INT ii = LENG short short min int - SHORT 1; ASSERT (SHORTEN ii = short short min int)) + FI; + (INT i = LENG short max int - 2; ASSERT (SHORTEN i = SHORTEN max int - SHORT 2)); + (INT i = LENG short max int + 1; ASSERT (SHORTEN i = SHORTEN max int)); + (INT i = LENG short min int - 1; ASSERT (SHORTEN i = SHORTEN min int)); + (LONG INT ii = LENG max int - LONG 2; ASSERT (SHORTEN ii = max int - 2)); + (LONG INT ii = LENG max int + LONG 1; ASSERT (SHORTEN ii = max int)); + (LONG INT ii = LENG min int - LONG 1; ASSERT (SHORTEN ii = min int)); + IF int lengths > 2 + THEN (LONG LONG INT ii = LENG long max int - LONG LONG 2; ASSERT (SHORTEN ii = long max int - LONG 2)); + (LONG LONG INT ii = LENG long max int + LONG LONG 1; ASSERT (SHORTEN ii = long max int)); + (LONG LONG INT ii = LENG long min int - LONG LONG 1; ASSERT (SHORTEN ii = long min int)) + FI +END diff --git a/gcc/testsuite/algol68/execute/leng-shorten-reals-1.a68 b/gcc/testsuite/algol68/execute/leng-shorten-reals-1.a68 new file mode 100644 index 000000000000..dd6ed8c590ed --- /dev/null +++ b/gcc/testsuite/algol68/execute/leng-shorten-reals-1.a68 @@ -0,0 +1,17 @@ +# { dg-options "-fstropping=upper" } # +# Environment enquiries for SIZETY REALs # +BEGIN # LENG # + (REAL i = max real; ASSERT (LENG i = LENG max real)); + (LONG REAL ii = long max real; ASSERT (LENG ii = LENG long max real)); + + # SHORTEN # + (LONG REAL ii = LENG max real - LONG 2.0; ASSERT (SHORTEN ii = max real - 2.0)); + (LONG REAL ii = LENG max real + LONG 1.0; ASSERT (SHORTEN ii = max real)); + (LONG REAL ii = LENG min real - LONG 1.0; ASSERT (SHORTEN ii = min real)); + IF (long long max real > LENG long max real) + THEN (LONG LONG REAL ii = LENG long max real - LONG LONG 2.0; + ASSERT (SHORTEN ii = long max real - LONG 2.0)); + (LONG LONG REAL ii = LENG long max real + LONG LONG 1.0; ASSERT (SHORTEN ii = long max real)); + (LONG LONG REAL ii = LENG long min real - LONG LONG 1.0; ASSERT (SHORTEN ii = long min real)) + FI +END diff --git a/gcc/testsuite/algol68/execute/lengths-shorths-1.a68 b/gcc/testsuite/algol68/execute/lengths-shorths-1.a68 new file mode 100644 index 000000000000..f1c892354243 --- /dev/null +++ b/gcc/testsuite/algol68/execute/lengths-shorths-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (int lengths > 0); + ASSERT (int shorths > 0); + ASSERT (bits lengths > 0); + ASSERT (bits shorths > 0); + ASSERT (real lengths > 0); + ASSERT (real shorths > 0) +END diff --git a/gcc/testsuite/algol68/execute/lisp-1.a68 b/gcc/testsuite/algol68/execute/lisp-1.a68 new file mode 100644 index 000000000000..8cec7f6e94e7 --- /dev/null +++ b/gcc/testsuite/algol68/execute/lisp-1.a68 @@ -0,0 +1,25 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT num ints := 0, num chars := 0; + PROC collect stats = (REF CONS tree) VOID: + BEGIN REF CONS e := tree; + WHILE REF CONS (e) ISNT NIL + DO CASE car OF e + IN (CHAR c): num chars +:= 1, + (INT): num ints +:= 1, + (REF CONS s): collect stats (s) + ESAC; + e := cdr OF e + OD + END; + MODE ATOM = UNION (CHAR, INT); + MODE CONS = STRUCT (UNION (ATOM, REF CONS) car, REF CONS cdr); + PROC list = ([]UNION (ATOM, REF CONS) item) REF CONS: + BEGIN REF CONS a := NIL; + FOR i FROM UPB item BY -1 TO 1 + DO a := HEAP CONS := (item[i], a) OD; + a + END; + REF CONS expression := list (("X", "+", list (("Y", "x", 2)))); + collect stats (expression); + ASSERT (num ints = 1 AND num chars = 4) +END diff --git a/gcc/testsuite/algol68/execute/lisp-2.a68 b/gcc/testsuite/algol68/execute/lisp-2.a68 new file mode 100644 index 000000000000..79ae697fd17d --- /dev/null +++ b/gcc/testsuite/algol68/execute/lisp-2.a68 @@ -0,0 +1,21 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT num constants := 0, num vars := 0, num operators := 0; + PROC collect stats = (REF EXPRESSION expr) VOID: + BEGIN CASE left OF expr + IN (INT): num constants +:= 1, + (CHAR): num vars +:= 1, + (REF EXPRESSION s): collect stats (s) + ESAC; + num operators +:= 1; + CASE right OF expr + IN (INT): num constants +:= 1, + (CHAR): num vars +:= 1, + (REF EXPRESSION s): collect stats (s) + ESAC + END; + MODE OPERAND = UNION (CHAR,INT,REF EXPRESSION), + EXPRESSION = STRUCT (OPERAND left, CHAR operator, OPERAND right); + REF EXPRESSION expression := HEAP EXPRESSION := ("X", "+", HEAP EXPRESSION := ("Y", "x", 2)); + collect stats (expression); + ASSERT (num constants = 1 AND num vars = 2 AND num operators = 2) +END diff --git a/gcc/testsuite/algol68/execute/ln-1.a68 b/gcc/testsuite/algol68/execute/ln-1.a68 new file mode 100644 index 000000000000..5c569711bb49 --- /dev/null +++ b/gcc/testsuite/algol68/execute/ln-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL r = 1.0; + LONG REAL rr = LONG 2.0; + LONG LONG REAL rrr = LONG LONG 60.0; + ASSERT (ln (r) = 0.0); + long ln (rr); + long long ln (rrr) +END diff --git a/gcc/testsuite/algol68/execute/log-1.a68 b/gcc/testsuite/algol68/execute/log-1.a68 new file mode 100644 index 000000000000..b1a8d8d11caf --- /dev/null +++ b/gcc/testsuite/algol68/execute/log-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL r = 1.0; + LONG REAL rr = LONG 2.0; + LONG LONG REAL rrr = LONG LONG 60.0; + ASSERT (log (r) = 0.0); + long log (rr); + long long log (rrr) +END diff --git a/gcc/testsuite/algol68/execute/loop-1.a68 b/gcc/testsuite/algol68/execute/loop-1.a68 new file mode 100644 index 000000000000..91e47c09b57e --- /dev/null +++ b/gcc/testsuite/algol68/execute/loop-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 0; + DO i +:= 1; IF i = 5 THEN exit FI + OD; +exit: ASSERT (i = 5) +END diff --git a/gcc/testsuite/algol68/execute/loop-10.a68 b/gcc/testsuite/algol68/execute/loop-10.a68 new file mode 100644 index 000000000000..53e382356fb7 --- /dev/null +++ b/gcc/testsuite/algol68/execute/loop-10.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 0, n := 2; + FOR a FROM n BY 2 TO n + 2 DO i +:= a OD; + ASSERT (i = 2 + 4) +END diff --git a/gcc/testsuite/algol68/execute/loop-11.a68 b/gcc/testsuite/algol68/execute/loop-11.a68 new file mode 100644 index 000000000000..eecaade529b4 --- /dev/null +++ b/gcc/testsuite/algol68/execute/loop-11.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# Negative steps towards minus infinity. # +BEGIN INT i := 0, n := -5; + BY -1 TO n - 1 DO i -:= 1 OD; + ASSERT (i = -8) +END diff --git a/gcc/testsuite/algol68/execute/loop-12.a68 b/gcc/testsuite/algol68/execute/loop-12.a68 new file mode 100644 index 000000000000..ffd34a5945a1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/loop-12.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 0, n := 5; + FOR a TO n WHILE a < 3 DO i +:= 1 OD; + ASSERT (i = 2) +END diff --git a/gcc/testsuite/algol68/execute/loop-13.a68 b/gcc/testsuite/algol68/execute/loop-13.a68 new file mode 100644 index 000000000000..dbbd9b966c89 --- /dev/null +++ b/gcc/testsuite/algol68/execute/loop-13.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 0; + FOR a FROM 2 BY 1 WHILE a <= 10 + DO i +:= 1 OD; + ASSERT (i = 9) +END diff --git a/gcc/testsuite/algol68/execute/loop-14.a68 b/gcc/testsuite/algol68/execute/loop-14.a68 new file mode 100644 index 000000000000..bf06f986adc8 --- /dev/null +++ b/gcc/testsuite/algol68/execute/loop-14.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# The while-part shall not be elaborated if the iterator is exhausted. # +BEGIN STRING s = "abc", INT j := 0; + FOR i TO UPB s WHILE s[i] /= "x" + DO j +:= 1 OD; + ASSERT (j = 3) +END diff --git a/gcc/testsuite/algol68/execute/loop-2.a68 b/gcc/testsuite/algol68/execute/loop-2.a68 new file mode 100644 index 000000000000..a92efb398753 --- /dev/null +++ b/gcc/testsuite/algol68/execute/loop-2.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# While loop. # +BEGIN INT i := 0; + WHILE INT j = 5; i < j + DO i +:= 1 OD; + ASSERT (i = 5) +END diff --git a/gcc/testsuite/algol68/execute/loop-3.a68 b/gcc/testsuite/algol68/execute/loop-3.a68 new file mode 100644 index 000000000000..63b3e203a52c --- /dev/null +++ b/gcc/testsuite/algol68/execute/loop-3.a68 @@ -0,0 +1,14 @@ +# { dg-options "-fstropping=upper" } # +# Nested loops. # +BEGIN INT i := 10, res := 0; + WHILE i > 0 + DO INT j := 10; + WHILE j > 0 + DO res +:= 1; + j -:= 1 + OD; + ASSERT (j = 0); + i -:= 1; + OD; + ASSERT (i = 0 AND res = 100) +END diff --git a/gcc/testsuite/algol68/execute/loop-4.a68 b/gcc/testsuite/algol68/execute/loop-4.a68 new file mode 100644 index 000000000000..491e569b2b97 --- /dev/null +++ b/gcc/testsuite/algol68/execute/loop-4.a68 @@ -0,0 +1,13 @@ +# { dg-options "-fstropping=upper" } # +# Nested loops and j on outside range. # +BEGIN INT i := 10, j := 10, res := 0; + WHILE i > 0 + DO j := 10; + WHILE j > 0 + DO res +:= 1; + j -:= 1 + OD; + i -:= 1 + OD; + ASSERT (i = 0 AND j = 0 AND res = 100) +END diff --git a/gcc/testsuite/algol68/execute/loop-5.a68 b/gcc/testsuite/algol68/execute/loop-5.a68 new file mode 100644 index 000000000000..ca0cae644305 --- /dev/null +++ b/gcc/testsuite/algol68/execute/loop-5.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# Skip in loop. # +BEGIN INT i := 0; + WHILE i +:= 1; i < 10 + DO SKIP OD; + ASSERT (i = 10) +END diff --git a/gcc/testsuite/algol68/execute/loop-6.a68 b/gcc/testsuite/algol68/execute/loop-6.a68 new file mode 100644 index 000000000000..216a5643aec3 --- /dev/null +++ b/gcc/testsuite/algol68/execute/loop-6.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# The range of the while-part shall cover the do-part. # +BEGIN INT i := 0; + WHILE INT incr = 2; i < 10 + DO i +:= incr OD; + ASSERT (i = 10) +END From f34e1dcb984698050a351966f7db5a409bcd1308 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:57:22 +0200 Subject: [PATCH 179/373] a68: testsuite: execution tests 2/2 Signed-off-by: Jose E. Marchesi gcc/testsuite/ChangeLog * algol68/execute/loop-7.a68: New file. * algol68/execute/loop-8.a68: Likewise. * algol68/execute/loop-9.a68: Likewise. * algol68/execute/loop-overflow-underflow.a68: Likewise. * algol68/execute/lt-int-1.a68: Likewise. * algol68/execute/lt-string-stride-1.a68: Likewise. * algol68/execute/lwb-1.a68: Likewise. * algol68/execute/minus-int-1.a68: Likewise. * algol68/execute/minusab-1.a68: Likewise. * algol68/execute/minusab-2.a68: Likewise. * algol68/execute/minusab-3.a68: Likewise. * algol68/execute/minusab-4.a68: Likewise. * algol68/execute/mod-int-1.a68: Likewise. * algol68/execute/modab-1.a68: Likewise. * algol68/execute/modab-2.a68: Likewise. * algol68/execute/mode-indication-1.a68: Likewise. * algol68/execute/mult-char-1.a68: Likewise. * algol68/execute/mult-int-1.a68: Likewise. * algol68/execute/mult-string-1.a68: Likewise. * algol68/execute/mult-string-2.a68: Likewise. * algol68/execute/mult-string-3.a68: Likewise. * algol68/execute/mult-string-4.a68: Likewise. * algol68/execute/multab-1.a68: Likewise. * algol68/execute/multab-2.a68: Likewise. * algol68/execute/multab-3.a68: Likewise. * algol68/execute/mutual-recursion-1.a68: Likewise. * algol68/execute/ne-bits-1.a68: Likewise. * algol68/execute/ne-char-char-1.a68: Likewise. * algol68/execute/ne-int-1.a68: Likewise. * algol68/execute/ne-string-1.a68: Likewise. * algol68/execute/neg-int-1.a68: Likewise. * algol68/execute/not-bits-1.a68: Likewise. * algol68/execute/odd-1.a68: Likewise. * algol68/execute/op-1.a68: Likewise. * algol68/execute/op-2.a68: Likewise. * algol68/execute/op-3.a68: Likewise. * algol68/execute/operator-declaration-1.a68: Likewise. * algol68/execute/or-bits-1.a68: Likewise. * algol68/execute/orf-1.a68: Likewise. * algol68/execute/over-int-1.a68: Likewise. * algol68/execute/overab-1.a68: Likewise. * algol68/execute/overab-2.a68: Likewise. * algol68/execute/particular-program-1.a68: Likewise. * algol68/execute/plus-char-1.a68: Likewise. * algol68/execute/plus-int-1.a68: Likewise. * algol68/execute/plus-string-1.a68: Likewise. * algol68/execute/plus-string-2.a68: Likewise. * algol68/execute/plus-string-stride-1.a68: Likewise. * algol68/execute/plusab-1.a68: Likewise. * algol68/execute/plusab-2.a68: Likewise. * algol68/execute/plusab-3.a68: Likewise. * algol68/execute/plusab-4.a68: Likewise. * algol68/execute/plusab-string-1.a68: Likewise. * algol68/execute/plusto-char-1.a68: Likewise. * algol68/execute/plusto-string-1.a68: Likewise. * algol68/execute/posix-argc-argv-1.a68: Likewise. * algol68/execute/posix-fopen-1.a68: Likewise. * algol68/execute/posix-fputc-fputs-1.a68: Likewise. * algol68/execute/posix-getenv-1.a68: Likewise. * algol68/execute/posix-perror-1.a68: Likewise. * algol68/execute/posix-putchar-1.a68: Likewise. * algol68/execute/posix-stdinouterr-1.a68: Likewise. * algol68/execute/posix-strerror-1.a68: Likewise. * algol68/execute/posix-stride-1.a68: Likewise. * algol68/execute/pow-int-1.a68: Likewise. * algol68/execute/pow-real-1.a68: Likewise. * algol68/execute/proc-1.a68: Likewise. * algol68/execute/proc-10.a68: Likewise. * algol68/execute/proc-12.a68: Likewise. * algol68/execute/proc-13.a68: Likewise. * algol68/execute/proc-14.a68: Likewise. * algol68/execute/proc-15.a68: Likewise. * algol68/execute/proc-16.a68: Likewise. * algol68/execute/proc-17.a68: Likewise. * algol68/execute/proc-18.a68: Likewise. * algol68/execute/proc-19.a68: Likewise. * algol68/execute/proc-2.a68: Likewise. * algol68/execute/proc-20.a68: Likewise. * algol68/execute/proc-21.a68: Likewise. * algol68/execute/proc-22.a68: Likewise. * algol68/execute/proc-23.a68: Likewise. * algol68/execute/proc-25.a68: Likewise. * algol68/execute/proc-26.a68: Likewise. * algol68/execute/proc-27.a68: Likewise. * algol68/execute/proc-28.a68: Likewise. * algol68/execute/proc-29.a68: Likewise. * algol68/execute/proc-3.a68: Likewise. * algol68/execute/proc-4.a68: Likewise. * algol68/execute/proc-5.a68: Likewise. * algol68/execute/proc-6.a68: Likewise. * algol68/execute/proc-7.a68: Likewise. * algol68/execute/proc-8.a68: Likewise. * algol68/execute/procedured-goto-1.a68: Likewise. * algol68/execute/quine.a68: Likewise. * algol68/execute/random-1.a68: Likewise. * algol68/execute/re-im-1.a68: Likewise. * algol68/execute/rela-string-1.a68: Likewise. * algol68/execute/repr-1.a68: Likewise. * algol68/execute/round-1.a68: Likewise. * algol68/execute/row-display-1.a68: Likewise. * algol68/execute/row-display-2.a68: Likewise. * algol68/execute/row-display-3.a68: Likewise. * algol68/execute/row-display-4.a68: Likewise. * algol68/execute/row-display-5.a68: Likewise. * algol68/execute/rowing-1.a68: Likewise. * algol68/execute/rowing-10.a68: Likewise. * algol68/execute/rowing-11.a68: Likewise. * algol68/execute/rowing-12.a68: Likewise. * algol68/execute/rowing-13.a68: Likewise. * algol68/execute/rowing-2.a68: Likewise. * algol68/execute/rowing-3.a68: Likewise. * algol68/execute/rowing-4.a68: Likewise. * algol68/execute/rowing-5.a68: Likewise. * algol68/execute/rowing-6.a68: Likewise. * algol68/execute/rowing-7.a68: Likewise. * algol68/execute/rowing-8.a68: Likewise. * algol68/execute/rowing-9.a68: Likewise. * algol68/execute/selection-1.a68: Likewise. * algol68/execute/selection-2.a68: Likewise. * algol68/execute/selection-3.a68: Likewise. * algol68/execute/selection-4.a68: Likewise. * algol68/execute/selection-5.a68: Likewise. * algol68/execute/selection-multiple-1.a68: Likewise. * algol68/execute/selection-multiple-2.a68: Likewise. * algol68/execute/serial-clause-1.a68: Likewise. * algol68/execute/serial-clause-10.a68: Likewise. * algol68/execute/serial-clause-2.a68: Likewise. * algol68/execute/serial-clause-3.a68: Likewise. * algol68/execute/serial-clause-4.a68: Likewise. * algol68/execute/serial-clause-5.a68: Likewise. * algol68/execute/serial-clause-6.a68: Likewise. * algol68/execute/serial-clause-7.a68: Likewise. * algol68/execute/serial-clause-8.a68: Likewise. * algol68/execute/serial-clause-9.a68: Likewise. * algol68/execute/serial-dsa-1.a68: Likewise. * algol68/execute/serial-dsa-2.a68: Likewise. * algol68/execute/serial-dsa-3.a68: Likewise. * algol68/execute/serial-dsa-4.a68: Likewise. * algol68/execute/serial-dsa-5.a68: Likewise. * algol68/execute/serial-dsa-6.a68: Likewise. * algol68/execute/sign-int-1.a68: Likewise. * algol68/execute/sign-real-1.a68: Likewise. * algol68/execute/sin-1.a68: Likewise. * algol68/execute/skip-1.a68: Likewise. * algol68/execute/skip-2.a68: Likewise. * algol68/execute/skip-struct-1.a68: Likewise. * algol68/execute/slice-indexing-1.a68: Likewise. * algol68/execute/slice-indexing-2.a68: Likewise. * algol68/execute/slice-indexing-3.a68: Likewise. * algol68/execute/slice-indexing-4.a68: Likewise. * algol68/execute/slice-indexing-5.a68: Likewise. * algol68/execute/slice-indexing-6.a68: Likewise. * algol68/execute/slice-indexing-7.a68: Likewise. * algol68/execute/sqrt-1.a68: Likewise. * algol68/execute/string-1.a68: Likewise. * algol68/execute/string-2.a68: Likewise. * algol68/execute/string-4.a68: Likewise. * algol68/execute/string-break-1.a68: Likewise. * algol68/execute/struct-self-1.a68: Likewise. * algol68/execute/struct-self-2.a68: Likewise. * algol68/execute/struct-self-3.a68: Likewise. * algol68/execute/structure-display-1.a68: Likewise. * algol68/execute/structure-display-2.a68: Likewise. * algol68/execute/structure-display-3.a68: Likewise. * algol68/execute/structure-display-4.a68: Likewise. * algol68/execute/structure-display-5.a68: Likewise. * algol68/execute/tan-1.a68: Likewise. * algol68/execute/timesab-string-1.a68: Likewise. * algol68/execute/trimmer-1.a68: Likewise. * algol68/execute/trimmer-10.a68: Likewise. * algol68/execute/trimmer-2.a68: Likewise. * algol68/execute/trimmer-3.a68: Likewise. * algol68/execute/trimmer-4.a68: Likewise. * algol68/execute/trimmer-5.a68: Likewise. * algol68/execute/trimmer-6.a68: Likewise. * algol68/execute/trimmer-7.a68: Likewise. * algol68/execute/trimmer-8.a68: Likewise. * algol68/execute/trimmer-9.a68: Likewise. * algol68/execute/trimmer-matrix-1.a68: Likewise. * algol68/execute/trimmer-matrix-2.a68: Likewise. * algol68/execute/trimmer-matrix-3.a68: Likewise. * algol68/execute/trimmer-matrix-4.a68: Likewise. * algol68/execute/trimmer-matrix-5.a68: Likewise. * algol68/execute/trimmer-matrix-6.a68: Likewise. * algol68/execute/trimmer-name-1.a68: Likewise. * algol68/execute/undefined-1.a68: Likewise. * algol68/execute/undefined-2.a68: Likewise. * algol68/execute/undefined-3.a68: Likewise. * algol68/execute/undefined-4.a68: Likewise. * algol68/execute/undefined-5.a68: Likewise. * algol68/execute/uniting-1.a68: Likewise. * algol68/execute/uniting-2.a68: Likewise. * algol68/execute/uniting-3.a68: Likewise. * algol68/execute/uniting-4.a68: Likewise. * algol68/execute/up-down-bits-1.a68: Likewise. * algol68/execute/upb-1.a68: Likewise. * algol68/execute/vacuum-1.a68: Likewise. * algol68/execute/variable-declaration-1.a68: Likewise. * algol68/execute/variable-declaration-2.a68: Likewise. * algol68/execute/variable-declaration-3.a68: Likewise. * algol68/execute/variable-declaration-4.a68: Likewise. * algol68/execute/variable-declaration-5.a68: Likewise. * algol68/execute/variable-declaration-6.a68: Likewise. * algol68/execute/variable-declaration-heap-1.a68: Likewise. * algol68/execute/variable-declaration-heap-2.a68: Likewise. * algol68/execute/variable-declaration-multiple-1.a68: Likewise. * algol68/execute/variable-declaration-multiple-2.a68: Likewise. * algol68/execute/variable-declaration-multiple-3.a68: Likewise. * algol68/execute/variable-declaration-multiple-4.a68: Likewise. * algol68/execute/variable-declaration-multiple-5.a68: Likewise. * algol68/execute/variable-declaration-multiple-6.a68: Likewise. * algol68/execute/variable-declaration-multiple-7.a68: Likewise. * algol68/execute/variable-declaration-multiple-8.a68: Likewise. * algol68/execute/variable-declaration-multiple-9.a68: Likewise. * algol68/execute/voiding-1.a68: Likewise. * algol68/execute/widening-1.a68: Likewise. * algol68/execute/widening-2.a68: Likewise. * algol68/execute/widening-bits-1.a68: Likewise. * algol68/execute/widening-bits-2.a68: Likewise. * algol68/execute/widening-bits-3.a68: Likewise. * algol68/execute/xor-bits-1.a68: Likewise. * algol68/execute/environment-enquiries-8.a68: Likewise. --- .../execute/environment-enquiries-8.a68 | 2 +- gcc/testsuite/algol68/execute/loop-7.a68 | 5 ++ gcc/testsuite/algol68/execute/loop-8.a68 | 5 ++ gcc/testsuite/algol68/execute/loop-9.a68 | 5 ++ .../execute/loop-overflow-underflow.a68 | 55 +++++++++++++++++++ gcc/testsuite/algol68/execute/lt-int-1.a68 | 10 ++++ .../algol68/execute/lt-string-stride-1.a68 | 7 +++ gcc/testsuite/algol68/execute/lwb-1.a68 | 6 ++ gcc/testsuite/algol68/execute/minus-int-1.a68 | 10 ++++ gcc/testsuite/algol68/execute/minusab-1.a68 | 32 +++++++++++ gcc/testsuite/algol68/execute/minusab-2.a68 | 20 +++++++ gcc/testsuite/algol68/execute/minusab-3.a68 | 5 ++ gcc/testsuite/algol68/execute/minusab-4.a68 | 6 ++ gcc/testsuite/algol68/execute/mod-int-1.a68 | 10 ++++ gcc/testsuite/algol68/execute/modab-1.a68 | 10 ++++ gcc/testsuite/algol68/execute/modab-2.a68 | 5 ++ .../algol68/execute/mode-indication-1.a68 | 10 ++++ gcc/testsuite/algol68/execute/modules/README | 7 +++ .../algol68/execute/modules/execute.exp | 42 ++++++++++++++ .../algol68/execute/modules/module1.a68 | 9 +++ .../algol68/execute/modules/module10.a68 | 7 +++ .../algol68/execute/modules/module11.a68 | 11 ++++ .../algol68/execute/modules/module12.a68 | 5 ++ .../algol68/execute/modules/module13.a68 | 5 ++ .../algol68/execute/modules/module14.a68 | 5 ++ .../algol68/execute/modules/module15.a68 | 8 +++ .../algol68/execute/modules/module16.a68 | 8 +++ .../algol68/execute/modules/module17.a68 | 13 +++++ .../algol68/execute/modules/module3.a68 | 11 ++++ .../algol68/execute/modules/module4.a68 | 4 ++ .../algol68/execute/modules/module5.a68 | 7 +++ .../algol68/execute/modules/module6.a68 | 5 ++ .../algol68/execute/modules/module7.a68 | 10 ++++ .../algol68/execute/modules/module8.a68 | 9 +++ .../algol68/execute/modules/module9.a68 | 8 +++ .../algol68/execute/modules/program-1.a68 | 20 +++++++ .../algol68/execute/modules/program-10.a68 | 6 ++ .../algol68/execute/modules/program-11.a68 | 3 + .../algol68/execute/modules/program-12.a68 | 6 ++ .../algol68/execute/modules/program-15.a68 | 3 + .../algol68/execute/modules/program-16.a68 | 8 +++ .../algol68/execute/modules/program-17.a68 | 7 +++ .../algol68/execute/modules/program-2.a68 | 15 +++++ .../algol68/execute/modules/program-3.a68 | 16 ++++++ .../algol68/execute/modules/program-4.a68 | 7 +++ .../algol68/execute/modules/program-5.a68 | 7 +++ .../algol68/execute/modules/program-6.a68 | 9 +++ .../algol68/execute/modules/program-7.a68 | 3 + .../algol68/execute/modules/program-8.a68 | 3 + gcc/testsuite/algol68/execute/mult-char-1.a68 | 5 ++ gcc/testsuite/algol68/execute/mult-int-1.a68 | 10 ++++ .../algol68/execute/mult-string-1.a68 | 13 +++++ .../algol68/execute/mult-string-2.a68 | 13 +++++ .../algol68/execute/mult-string-3.a68 | 13 +++++ .../algol68/execute/mult-string-4.a68 | 4 ++ gcc/testsuite/algol68/execute/multab-1.a68 | 31 +++++++++++ gcc/testsuite/algol68/execute/multab-2.a68 | 31 +++++++++++ gcc/testsuite/algol68/execute/multab-3.a68 | 6 ++ .../algol68/execute/mutual-recursion-1.a68 | 6 ++ gcc/testsuite/algol68/execute/ne-bits-1.a68 | 9 +++ .../algol68/execute/ne-char-char-1.a68 | 3 + gcc/testsuite/algol68/execute/ne-int-1.a68 | 10 ++++ gcc/testsuite/algol68/execute/ne-string-1.a68 | 15 +++++ gcc/testsuite/algol68/execute/neg-int-1.a68 | 10 ++++ gcc/testsuite/algol68/execute/not-bits-1.a68 | 13 +++++ gcc/testsuite/algol68/execute/odd-1.a68 | 8 +++ gcc/testsuite/algol68/execute/op-1.a68 | 5 ++ gcc/testsuite/algol68/execute/op-2.a68 | 4 ++ gcc/testsuite/algol68/execute/op-3.a68 | 9 +++ .../execute/operator-declaration-1.a68 | 13 +++++ gcc/testsuite/algol68/execute/or-bits-1.a68 | 18 ++++++ gcc/testsuite/algol68/execute/orf-1.a68 | 4 ++ gcc/testsuite/algol68/execute/over-int-1.a68 | 10 ++++ gcc/testsuite/algol68/execute/overab-1.a68 | 12 ++++ gcc/testsuite/algol68/execute/overab-2.a68 | 5 ++ .../algol68/execute/particular-program-1.a68 | 4 ++ gcc/testsuite/algol68/execute/plus-char-1.a68 | 4 ++ gcc/testsuite/algol68/execute/plus-int-1.a68 | 10 ++++ .../algol68/execute/plus-string-1.a68 | 11 ++++ .../algol68/execute/plus-string-2.a68 | 11 ++++ .../algol68/execute/plus-string-stride-1.a68 | 7 +++ gcc/testsuite/algol68/execute/plusab-1.a68 | 34 ++++++++++++ gcc/testsuite/algol68/execute/plusab-2.a68 | 20 +++++++ gcc/testsuite/algol68/execute/plusab-3.a68 | 5 ++ gcc/testsuite/algol68/execute/plusab-4.a68 | 6 ++ .../algol68/execute/plusab-string-1.a68 | 7 +++ .../algol68/execute/plusto-char-1.a68 | 7 +++ .../algol68/execute/plusto-string-1.a68 | 6 ++ .../algol68/execute/posix-argc-argv-1.a68 | 7 +++ .../algol68/execute/posix-fopen-1.a68 | 4 ++ .../algol68/execute/posix-fputc-fputs-1.a68 | 8 +++ .../algol68/execute/posix-getenv-1.a68 | 4 ++ gcc/testsuite/algol68/execute/posix-lseek.a68 | 17 ++++++ .../algol68/execute/posix-perror-1.a68 | 8 +++ .../algol68/execute/posix-putchar-1.a68 | 6 ++ .../algol68/execute/posix-stdinouterr-1.a68 | 5 ++ .../algol68/execute/posix-strerror-1.a68 | 4 ++ .../algol68/execute/posix-stride-1.a68 | 14 +++++ gcc/testsuite/algol68/execute/pow-int-1.a68 | 10 ++++ gcc/testsuite/algol68/execute/pow-real-1.a68 | 7 +++ gcc/testsuite/algol68/execute/proc-1.a68 | 4 ++ gcc/testsuite/algol68/execute/proc-10.a68 | 4 ++ gcc/testsuite/algol68/execute/proc-12.a68 | 6 ++ gcc/testsuite/algol68/execute/proc-13.a68 | 6 ++ gcc/testsuite/algol68/execute/proc-14.a68 | 8 +++ gcc/testsuite/algol68/execute/proc-15.a68 | 8 +++ gcc/testsuite/algol68/execute/proc-16.a68 | 8 +++ gcc/testsuite/algol68/execute/proc-17.a68 | 11 ++++ gcc/testsuite/algol68/execute/proc-18.a68 | 6 ++ gcc/testsuite/algol68/execute/proc-19.a68 | 5 ++ gcc/testsuite/algol68/execute/proc-2.a68 | 6 ++ gcc/testsuite/algol68/execute/proc-20.a68 | 5 ++ gcc/testsuite/algol68/execute/proc-21.a68 | 8 +++ gcc/testsuite/algol68/execute/proc-22.a68 | 7 +++ gcc/testsuite/algol68/execute/proc-23.a68 | 8 +++ gcc/testsuite/algol68/execute/proc-25.a68 | 8 +++ gcc/testsuite/algol68/execute/proc-26.a68 | 6 ++ gcc/testsuite/algol68/execute/proc-27.a68 | 5 ++ gcc/testsuite/algol68/execute/proc-28.a68 | 10 ++++ gcc/testsuite/algol68/execute/proc-29.a68 | 5 ++ gcc/testsuite/algol68/execute/proc-3.a68 | 4 ++ gcc/testsuite/algol68/execute/proc-4.a68 | 5 ++ gcc/testsuite/algol68/execute/proc-5.a68 | 5 ++ gcc/testsuite/algol68/execute/proc-6.a68 | 6 ++ gcc/testsuite/algol68/execute/proc-7.a68 | 5 ++ gcc/testsuite/algol68/execute/proc-8.a68 | 4 ++ .../algol68/execute/procedured-goto-1.a68 | 11 ++++ gcc/testsuite/algol68/execute/quine.a68 | 2 + gcc/testsuite/algol68/execute/random-1.a68 | 7 +++ gcc/testsuite/algol68/execute/re-im-1.a68 | 8 +++ .../algol68/execute/rela-string-1.a68 | 7 +++ gcc/testsuite/algol68/execute/repr-1.a68 | 3 + gcc/testsuite/algol68/execute/round-1.a68 | 8 +++ .../algol68/execute/row-display-1.a68 | 13 +++++ .../algol68/execute/row-display-2.a68 | 13 +++++ .../algol68/execute/row-display-3.a68 | 15 +++++ .../algol68/execute/row-display-4.a68 | 16 ++++++ .../algol68/execute/row-display-5.a68 | 10 ++++ gcc/testsuite/algol68/execute/rowing-1.a68 | 5 ++ gcc/testsuite/algol68/execute/rowing-10.a68 | 8 +++ gcc/testsuite/algol68/execute/rowing-11.a68 | 9 +++ gcc/testsuite/algol68/execute/rowing-12.a68 | 6 ++ gcc/testsuite/algol68/execute/rowing-13.a68 | 6 ++ gcc/testsuite/algol68/execute/rowing-2.a68 | 6 ++ gcc/testsuite/algol68/execute/rowing-3.a68 | 7 +++ gcc/testsuite/algol68/execute/rowing-4.a68 | 8 +++ gcc/testsuite/algol68/execute/rowing-5.a68 | 8 +++ gcc/testsuite/algol68/execute/rowing-6.a68 | 5 ++ gcc/testsuite/algol68/execute/rowing-7.a68 | 6 ++ gcc/testsuite/algol68/execute/rowing-8.a68 | 12 ++++ gcc/testsuite/algol68/execute/rowing-9.a68 | 7 +++ gcc/testsuite/algol68/execute/selection-1.a68 | 7 +++ gcc/testsuite/algol68/execute/selection-2.a68 | 14 +++++ gcc/testsuite/algol68/execute/selection-3.a68 | 12 ++++ gcc/testsuite/algol68/execute/selection-4.a68 | 19 +++++++ gcc/testsuite/algol68/execute/selection-5.a68 | 6 ++ .../algol68/execute/selection-multiple-1.a68 | 12 ++++ .../algol68/execute/selection-multiple-2.a68 | 18 ++++++ .../algol68/execute/serial-clause-1.a68 | 8 +++ .../algol68/execute/serial-clause-10.a68 | 5 ++ .../algol68/execute/serial-clause-2.a68 | 7 +++ .../algol68/execute/serial-clause-3.a68 | 5 ++ .../algol68/execute/serial-clause-4.a68 | 7 +++ .../algol68/execute/serial-clause-5.a68 | 7 +++ .../algol68/execute/serial-clause-6.a68 | 10 ++++ .../algol68/execute/serial-clause-7.a68 | 10 ++++ .../algol68/execute/serial-clause-8.a68 | 10 ++++ .../algol68/execute/serial-clause-9.a68 | 9 +++ .../algol68/execute/serial-dsa-1.a68 | 18 ++++++ .../algol68/execute/serial-dsa-2.a68 | 6 ++ .../algol68/execute/serial-dsa-3.a68 | 12 ++++ .../algol68/execute/serial-dsa-4.a68 | 4 ++ .../algol68/execute/serial-dsa-5.a68 | 3 + .../algol68/execute/serial-dsa-6.a68 | 4 ++ gcc/testsuite/algol68/execute/sign-int-1.a68 | 28 ++++++++++ gcc/testsuite/algol68/execute/sign-real-1.a68 | 17 ++++++ gcc/testsuite/algol68/execute/sin-1.a68 | 8 +++ gcc/testsuite/algol68/execute/skip-1.a68 | 13 +++++ gcc/testsuite/algol68/execute/skip-2.a68 | 7 +++ .../algol68/execute/skip-struct-1.a68 | 7 +++ .../algol68/execute/slice-indexing-1.a68 | 10 ++++ .../algol68/execute/slice-indexing-2.a68 | 10 ++++ .../algol68/execute/slice-indexing-3.a68 | 10 ++++ .../algol68/execute/slice-indexing-4.a68 | 10 ++++ .../algol68/execute/slice-indexing-5.a68 | 4 ++ .../algol68/execute/slice-indexing-6.a68 | 5 ++ .../algol68/execute/slice-indexing-7.a68 | 4 ++ gcc/testsuite/algol68/execute/sqrt-1.a68 | 8 +++ gcc/testsuite/algol68/execute/string-1.a68 | 6 ++ gcc/testsuite/algol68/execute/string-2.a68 | 13 +++++ gcc/testsuite/algol68/execute/string-4.a68 | 6 ++ .../algol68/execute/string-break-1.a68 | 8 +++ .../algol68/execute/struct-self-1.a68 | 5 ++ .../algol68/execute/struct-self-2.a68 | 6 ++ .../algol68/execute/struct-self-3.a68 | 7 +++ .../algol68/execute/structure-display-1.a68 | 9 +++ .../algol68/execute/structure-display-2.a68 | 6 ++ .../algol68/execute/structure-display-3.a68 | 7 +++ .../algol68/execute/structure-display-4.a68 | 8 +++ .../algol68/execute/structure-display-5.a68 | 10 ++++ gcc/testsuite/algol68/execute/tan-1.a68 | 8 +++ .../algol68/execute/timesab-string-1.a68 | 7 +++ gcc/testsuite/algol68/execute/trimmer-1.a68 | 7 +++ gcc/testsuite/algol68/execute/trimmer-10.a68 | 14 +++++ gcc/testsuite/algol68/execute/trimmer-2.a68 | 7 +++ gcc/testsuite/algol68/execute/trimmer-3.a68 | 7 +++ gcc/testsuite/algol68/execute/trimmer-4.a68 | 7 +++ gcc/testsuite/algol68/execute/trimmer-5.a68 | 7 +++ gcc/testsuite/algol68/execute/trimmer-6.a68 | 7 +++ gcc/testsuite/algol68/execute/trimmer-7.a68 | 7 +++ gcc/testsuite/algol68/execute/trimmer-8.a68 | 9 +++ gcc/testsuite/algol68/execute/trimmer-9.a68 | 7 +++ .../algol68/execute/trimmer-matrix-1.a68 | 8 +++ .../algol68/execute/trimmer-matrix-2.a68 | 8 +++ .../algol68/execute/trimmer-matrix-3.a68 | 9 +++ .../algol68/execute/trimmer-matrix-4.a68 | 9 +++ .../algol68/execute/trimmer-matrix-5.a68 | 9 +++ .../algol68/execute/trimmer-matrix-6.a68 | 9 +++ .../algol68/execute/trimmer-name-1.a68 | 7 +++ gcc/testsuite/algol68/execute/undefined-1.a68 | 10 ++++ gcc/testsuite/algol68/execute/undefined-2.a68 | 9 +++ gcc/testsuite/algol68/execute/undefined-3.a68 | 6 ++ gcc/testsuite/algol68/execute/undefined-4.a68 | 8 +++ gcc/testsuite/algol68/execute/undefined-5.a68 | 9 +++ gcc/testsuite/algol68/execute/uniting-1.a68 | 11 ++++ gcc/testsuite/algol68/execute/uniting-2.a68 | 11 ++++ gcc/testsuite/algol68/execute/uniting-3.a68 | 11 ++++ gcc/testsuite/algol68/execute/uniting-4.a68 | 5 ++ .../algol68/execute/up-down-bits-1.a68 | 33 +++++++++++ gcc/testsuite/algol68/execute/upb-1.a68 | 6 ++ gcc/testsuite/algol68/execute/vacuum-1.a68 | 4 ++ .../execute/variable-declaration-1.a68 | 5 ++ .../execute/variable-declaration-2.a68 | 5 ++ .../execute/variable-declaration-3.a68 | 5 ++ .../execute/variable-declaration-4.a68 | 5 ++ .../execute/variable-declaration-5.a68 | 5 ++ .../execute/variable-declaration-6.a68 | 5 ++ .../execute/variable-declaration-heap-1.a68 | 4 ++ .../execute/variable-declaration-heap-2.a68 | 4 ++ .../variable-declaration-multiple-1.a68 | 5 ++ .../variable-declaration-multiple-2.a68 | 6 ++ .../variable-declaration-multiple-3.a68 | 6 ++ .../variable-declaration-multiple-4.a68 | 6 ++ .../variable-declaration-multiple-5.a68 | 8 +++ .../variable-declaration-multiple-6.a68 | 8 +++ .../variable-declaration-multiple-7.a68 | 8 +++ .../variable-declaration-multiple-8.a68 | 10 ++++ .../variable-declaration-multiple-9.a68 | 4 ++ gcc/testsuite/algol68/execute/voiding-1.a68 | 4 ++ gcc/testsuite/algol68/execute/widening-1.a68 | 6 ++ gcc/testsuite/algol68/execute/widening-2.a68 | 6 ++ .../algol68/execute/widening-bits-1.a68 | 7 +++ .../algol68/execute/widening-bits-2.a68 | 7 +++ .../algol68/execute/widening-bits-3.a68 | 7 +++ gcc/testsuite/algol68/execute/xor-bits-1.a68 | 18 ++++++ 255 files changed, 2239 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/algol68/execute/loop-7.a68 create mode 100644 gcc/testsuite/algol68/execute/loop-8.a68 create mode 100644 gcc/testsuite/algol68/execute/loop-9.a68 create mode 100644 gcc/testsuite/algol68/execute/loop-overflow-underflow.a68 create mode 100644 gcc/testsuite/algol68/execute/lt-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/lt-string-stride-1.a68 create mode 100644 gcc/testsuite/algol68/execute/lwb-1.a68 create mode 100644 gcc/testsuite/algol68/execute/minus-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/minusab-1.a68 create mode 100644 gcc/testsuite/algol68/execute/minusab-2.a68 create mode 100644 gcc/testsuite/algol68/execute/minusab-3.a68 create mode 100644 gcc/testsuite/algol68/execute/minusab-4.a68 create mode 100644 gcc/testsuite/algol68/execute/mod-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/modab-1.a68 create mode 100644 gcc/testsuite/algol68/execute/modab-2.a68 create mode 100644 gcc/testsuite/algol68/execute/mode-indication-1.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/README create mode 100644 gcc/testsuite/algol68/execute/modules/execute.exp create mode 100644 gcc/testsuite/algol68/execute/modules/module1.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/module10.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/module11.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/module12.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/module13.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/module14.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/module15.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/module16.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/module17.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/module3.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/module4.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/module5.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/module6.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/module7.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/module8.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/module9.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/program-1.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/program-10.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/program-11.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/program-12.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/program-15.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/program-16.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/program-17.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/program-2.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/program-3.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/program-4.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/program-5.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/program-6.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/program-7.a68 create mode 100644 gcc/testsuite/algol68/execute/modules/program-8.a68 create mode 100644 gcc/testsuite/algol68/execute/mult-char-1.a68 create mode 100644 gcc/testsuite/algol68/execute/mult-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/mult-string-1.a68 create mode 100644 gcc/testsuite/algol68/execute/mult-string-2.a68 create mode 100644 gcc/testsuite/algol68/execute/mult-string-3.a68 create mode 100644 gcc/testsuite/algol68/execute/mult-string-4.a68 create mode 100644 gcc/testsuite/algol68/execute/multab-1.a68 create mode 100644 gcc/testsuite/algol68/execute/multab-2.a68 create mode 100644 gcc/testsuite/algol68/execute/multab-3.a68 create mode 100644 gcc/testsuite/algol68/execute/mutual-recursion-1.a68 create mode 100644 gcc/testsuite/algol68/execute/ne-bits-1.a68 create mode 100644 gcc/testsuite/algol68/execute/ne-char-char-1.a68 create mode 100644 gcc/testsuite/algol68/execute/ne-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/ne-string-1.a68 create mode 100644 gcc/testsuite/algol68/execute/neg-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/not-bits-1.a68 create mode 100644 gcc/testsuite/algol68/execute/odd-1.a68 create mode 100644 gcc/testsuite/algol68/execute/op-1.a68 create mode 100644 gcc/testsuite/algol68/execute/op-2.a68 create mode 100644 gcc/testsuite/algol68/execute/op-3.a68 create mode 100644 gcc/testsuite/algol68/execute/operator-declaration-1.a68 create mode 100644 gcc/testsuite/algol68/execute/or-bits-1.a68 create mode 100644 gcc/testsuite/algol68/execute/orf-1.a68 create mode 100644 gcc/testsuite/algol68/execute/over-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/overab-1.a68 create mode 100644 gcc/testsuite/algol68/execute/overab-2.a68 create mode 100644 gcc/testsuite/algol68/execute/particular-program-1.a68 create mode 100644 gcc/testsuite/algol68/execute/plus-char-1.a68 create mode 100644 gcc/testsuite/algol68/execute/plus-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/plus-string-1.a68 create mode 100644 gcc/testsuite/algol68/execute/plus-string-2.a68 create mode 100644 gcc/testsuite/algol68/execute/plus-string-stride-1.a68 create mode 100644 gcc/testsuite/algol68/execute/plusab-1.a68 create mode 100644 gcc/testsuite/algol68/execute/plusab-2.a68 create mode 100644 gcc/testsuite/algol68/execute/plusab-3.a68 create mode 100644 gcc/testsuite/algol68/execute/plusab-4.a68 create mode 100644 gcc/testsuite/algol68/execute/plusab-string-1.a68 create mode 100644 gcc/testsuite/algol68/execute/plusto-char-1.a68 create mode 100644 gcc/testsuite/algol68/execute/plusto-string-1.a68 create mode 100644 gcc/testsuite/algol68/execute/posix-argc-argv-1.a68 create mode 100644 gcc/testsuite/algol68/execute/posix-fopen-1.a68 create mode 100644 gcc/testsuite/algol68/execute/posix-fputc-fputs-1.a68 create mode 100644 gcc/testsuite/algol68/execute/posix-getenv-1.a68 create mode 100644 gcc/testsuite/algol68/execute/posix-lseek.a68 create mode 100644 gcc/testsuite/algol68/execute/posix-perror-1.a68 create mode 100644 gcc/testsuite/algol68/execute/posix-putchar-1.a68 create mode 100644 gcc/testsuite/algol68/execute/posix-stdinouterr-1.a68 create mode 100644 gcc/testsuite/algol68/execute/posix-strerror-1.a68 create mode 100644 gcc/testsuite/algol68/execute/posix-stride-1.a68 create mode 100644 gcc/testsuite/algol68/execute/pow-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/pow-real-1.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-1.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-10.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-12.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-13.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-14.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-15.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-16.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-17.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-18.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-19.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-2.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-20.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-21.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-22.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-23.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-25.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-26.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-27.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-28.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-29.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-3.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-4.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-5.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-6.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-7.a68 create mode 100644 gcc/testsuite/algol68/execute/proc-8.a68 create mode 100644 gcc/testsuite/algol68/execute/procedured-goto-1.a68 create mode 100644 gcc/testsuite/algol68/execute/quine.a68 create mode 100644 gcc/testsuite/algol68/execute/random-1.a68 create mode 100644 gcc/testsuite/algol68/execute/re-im-1.a68 create mode 100644 gcc/testsuite/algol68/execute/rela-string-1.a68 create mode 100644 gcc/testsuite/algol68/execute/repr-1.a68 create mode 100644 gcc/testsuite/algol68/execute/round-1.a68 create mode 100644 gcc/testsuite/algol68/execute/row-display-1.a68 create mode 100644 gcc/testsuite/algol68/execute/row-display-2.a68 create mode 100644 gcc/testsuite/algol68/execute/row-display-3.a68 create mode 100644 gcc/testsuite/algol68/execute/row-display-4.a68 create mode 100644 gcc/testsuite/algol68/execute/row-display-5.a68 create mode 100644 gcc/testsuite/algol68/execute/rowing-1.a68 create mode 100644 gcc/testsuite/algol68/execute/rowing-10.a68 create mode 100644 gcc/testsuite/algol68/execute/rowing-11.a68 create mode 100644 gcc/testsuite/algol68/execute/rowing-12.a68 create mode 100644 gcc/testsuite/algol68/execute/rowing-13.a68 create mode 100644 gcc/testsuite/algol68/execute/rowing-2.a68 create mode 100644 gcc/testsuite/algol68/execute/rowing-3.a68 create mode 100644 gcc/testsuite/algol68/execute/rowing-4.a68 create mode 100644 gcc/testsuite/algol68/execute/rowing-5.a68 create mode 100644 gcc/testsuite/algol68/execute/rowing-6.a68 create mode 100644 gcc/testsuite/algol68/execute/rowing-7.a68 create mode 100644 gcc/testsuite/algol68/execute/rowing-8.a68 create mode 100644 gcc/testsuite/algol68/execute/rowing-9.a68 create mode 100644 gcc/testsuite/algol68/execute/selection-1.a68 create mode 100644 gcc/testsuite/algol68/execute/selection-2.a68 create mode 100644 gcc/testsuite/algol68/execute/selection-3.a68 create mode 100644 gcc/testsuite/algol68/execute/selection-4.a68 create mode 100644 gcc/testsuite/algol68/execute/selection-5.a68 create mode 100644 gcc/testsuite/algol68/execute/selection-multiple-1.a68 create mode 100644 gcc/testsuite/algol68/execute/selection-multiple-2.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-clause-1.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-clause-10.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-clause-2.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-clause-3.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-clause-4.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-clause-5.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-clause-6.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-clause-7.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-clause-8.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-clause-9.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-dsa-1.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-dsa-2.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-dsa-3.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-dsa-4.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-dsa-5.a68 create mode 100644 gcc/testsuite/algol68/execute/serial-dsa-6.a68 create mode 100644 gcc/testsuite/algol68/execute/sign-int-1.a68 create mode 100644 gcc/testsuite/algol68/execute/sign-real-1.a68 create mode 100644 gcc/testsuite/algol68/execute/sin-1.a68 create mode 100644 gcc/testsuite/algol68/execute/skip-1.a68 create mode 100644 gcc/testsuite/algol68/execute/skip-2.a68 create mode 100644 gcc/testsuite/algol68/execute/skip-struct-1.a68 create mode 100644 gcc/testsuite/algol68/execute/slice-indexing-1.a68 create mode 100644 gcc/testsuite/algol68/execute/slice-indexing-2.a68 create mode 100644 gcc/testsuite/algol68/execute/slice-indexing-3.a68 create mode 100644 gcc/testsuite/algol68/execute/slice-indexing-4.a68 create mode 100644 gcc/testsuite/algol68/execute/slice-indexing-5.a68 create mode 100644 gcc/testsuite/algol68/execute/slice-indexing-6.a68 create mode 100644 gcc/testsuite/algol68/execute/slice-indexing-7.a68 create mode 100644 gcc/testsuite/algol68/execute/sqrt-1.a68 create mode 100644 gcc/testsuite/algol68/execute/string-1.a68 create mode 100644 gcc/testsuite/algol68/execute/string-2.a68 create mode 100644 gcc/testsuite/algol68/execute/string-4.a68 create mode 100644 gcc/testsuite/algol68/execute/string-break-1.a68 create mode 100644 gcc/testsuite/algol68/execute/struct-self-1.a68 create mode 100644 gcc/testsuite/algol68/execute/struct-self-2.a68 create mode 100644 gcc/testsuite/algol68/execute/struct-self-3.a68 create mode 100644 gcc/testsuite/algol68/execute/structure-display-1.a68 create mode 100644 gcc/testsuite/algol68/execute/structure-display-2.a68 create mode 100644 gcc/testsuite/algol68/execute/structure-display-3.a68 create mode 100644 gcc/testsuite/algol68/execute/structure-display-4.a68 create mode 100644 gcc/testsuite/algol68/execute/structure-display-5.a68 create mode 100644 gcc/testsuite/algol68/execute/tan-1.a68 create mode 100644 gcc/testsuite/algol68/execute/timesab-string-1.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-1.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-10.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-2.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-3.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-4.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-5.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-6.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-7.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-8.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-9.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-matrix-1.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-matrix-2.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-matrix-3.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-matrix-4.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-matrix-5.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-matrix-6.a68 create mode 100644 gcc/testsuite/algol68/execute/trimmer-name-1.a68 create mode 100644 gcc/testsuite/algol68/execute/undefined-1.a68 create mode 100644 gcc/testsuite/algol68/execute/undefined-2.a68 create mode 100644 gcc/testsuite/algol68/execute/undefined-3.a68 create mode 100644 gcc/testsuite/algol68/execute/undefined-4.a68 create mode 100644 gcc/testsuite/algol68/execute/undefined-5.a68 create mode 100644 gcc/testsuite/algol68/execute/uniting-1.a68 create mode 100644 gcc/testsuite/algol68/execute/uniting-2.a68 create mode 100644 gcc/testsuite/algol68/execute/uniting-3.a68 create mode 100644 gcc/testsuite/algol68/execute/uniting-4.a68 create mode 100644 gcc/testsuite/algol68/execute/up-down-bits-1.a68 create mode 100644 gcc/testsuite/algol68/execute/upb-1.a68 create mode 100644 gcc/testsuite/algol68/execute/vacuum-1.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-1.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-2.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-3.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-4.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-5.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-6.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-heap-1.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-heap-2.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-multiple-1.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-multiple-2.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-multiple-3.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-multiple-4.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-multiple-5.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-multiple-6.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-multiple-7.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-multiple-8.a68 create mode 100644 gcc/testsuite/algol68/execute/variable-declaration-multiple-9.a68 create mode 100644 gcc/testsuite/algol68/execute/voiding-1.a68 create mode 100644 gcc/testsuite/algol68/execute/widening-1.a68 create mode 100644 gcc/testsuite/algol68/execute/widening-2.a68 create mode 100644 gcc/testsuite/algol68/execute/widening-bits-1.a68 create mode 100644 gcc/testsuite/algol68/execute/widening-bits-2.a68 create mode 100644 gcc/testsuite/algol68/execute/widening-bits-3.a68 create mode 100644 gcc/testsuite/algol68/execute/xor-bits-1.a68 diff --git a/gcc/testsuite/algol68/execute/environment-enquiries-8.a68 b/gcc/testsuite/algol68/execute/environment-enquiries-8.a68 index d464a49d9907..8c2c904793d1 100644 --- a/gcc/testsuite/algol68/execute/environment-enquiries-8.a68 +++ b/gcc/testsuite/algol68/execute/environment-enquiries-8.a68 @@ -2,5 +2,5 @@ BEGIN ASSERT (flip = "T"); ASSERT (flop = "F"); ASSERT (error char = "*"); - ASSERT (ABS invalid char = ABS 16rfffd) + ASSERT (ABS replacement char = ABS 16rfffd) END diff --git a/gcc/testsuite/algol68/execute/loop-7.a68 b/gcc/testsuite/algol68/execute/loop-7.a68 new file mode 100644 index 000000000000..3d5112e1b4b5 --- /dev/null +++ b/gcc/testsuite/algol68/execute/loop-7.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 0, n := 5; + TO n + 1 DO i +:= 1 OD; + ASSERT (i = 6) +END diff --git a/gcc/testsuite/algol68/execute/loop-8.a68 b/gcc/testsuite/algol68/execute/loop-8.a68 new file mode 100644 index 000000000000..e7d090160aea --- /dev/null +++ b/gcc/testsuite/algol68/execute/loop-8.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 0, n := 2; + FOR a TO n + 1 DO i +:= a OD; + ASSERT (i = 1 + 2 + 3) +END diff --git a/gcc/testsuite/algol68/execute/loop-9.a68 b/gcc/testsuite/algol68/execute/loop-9.a68 new file mode 100644 index 000000000000..a101db250f90 --- /dev/null +++ b/gcc/testsuite/algol68/execute/loop-9.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 0, n := 2; + FOR a FROM n TO n + 2 DO i +:= a OD; + ASSERT (i = 2 + 3 + 4) +END diff --git a/gcc/testsuite/algol68/execute/loop-overflow-underflow.a68 b/gcc/testsuite/algol68/execute/loop-overflow-underflow.a68 new file mode 100644 index 000000000000..1ace68aff0f4 --- /dev/null +++ b/gcc/testsuite/algol68/execute/loop-overflow-underflow.a68 @@ -0,0 +1,55 @@ +{ Test for overflow/underflow in loops with implicit and explicit + iterators. } + +begin int count; + + { Overflow. } + count := 0; + by 1 while true do count +:= 1 od; + assert (count = max_int); + + count := 0; + from max_int do count +:= 1 od; + assert (count = 1); + count := 0; + + by max_int do count +:= 1 od; + assert (count = 1); + + count := 0; + for i by max_int do count +:= 1 od; + assert (count = 1); + + count := 0; + by max_int % 2 do count +:= 1 od; + assert (count = 3); + + count := 0; + by max_int - 1 do count +:= 1 od; + assert (count = 2); + + { Underflow. } + count := 0; + by -1 while true do count +:= 1 od; + assert (count = -min_int + 2); + + count := 0; + from min_int by -1 do count +:= 1 od; + assert (count = 1); + count := 0; + + by min_int do count +:= 1 od; + assert (count = 2); + + count := 0; + for i by min_int do count +:= 1 od; + assert (count = 2); + + count := 0; + by min_int % 2 do count +:= 1 od; + assert (count = 3); + + count := 0; + by min_int + 1 do count +:= 1 od; + assert (count = 2) +end diff --git a/gcc/testsuite/algol68/execute/lt-int-1.a68 b/gcc/testsuite/algol68/execute/lt-int-1.a68 new file mode 100644 index 000000000000..c0e93028aa3c --- /dev/null +++ b/gcc/testsuite/algol68/execute/lt-int-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 12; + LONG INT ii = LONG 12, LONG LONG INT iii = LONG LONG 12; + SHORT INT s = SHORT 12, SHORT SHORT INT ss = SHORT SHORT 12; + ASSERT (i < 13); + ASSERT (ii LT LONG 13); + ASSERT (iii < LONG LONG 13); + ASSERT (s < SHORT 13); + ASSERT (ss < SHORT SHORT 13) +END diff --git a/gcc/testsuite/algol68/execute/lt-string-stride-1.a68 b/gcc/testsuite/algol68/execute/lt-string-stride-1.a68 new file mode 100644 index 000000000000..9109f6751a9d --- /dev/null +++ b/gcc/testsuite/algol68/execute/lt-string-stride-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,]CHAR matrix = (("1", "Z", "1"), + ("4", "Y", "4"), + ("7", "X", "9")); + ASSERT (matrix[1:3,1] < matrix[1:3,3]); + ASSERT (("1","4","0") < matrix[1:3,3]) +END diff --git a/gcc/testsuite/algol68/execute/lwb-1.a68 b/gcc/testsuite/algol68/execute/lwb-1.a68 new file mode 100644 index 000000000000..c3dd5940bb12 --- /dev/null +++ b/gcc/testsuite/algol68/execute/lwb-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (LWB "foo" = 1); + ASSERT (LWB "" = 1); + ASSERT (1 LWB "foo" = 1); + ASSERT (1 LWB "" = 1) +END diff --git a/gcc/testsuite/algol68/execute/minus-int-1.a68 b/gcc/testsuite/algol68/execute/minus-int-1.a68 new file mode 100644 index 000000000000..abaf1229ebe8 --- /dev/null +++ b/gcc/testsuite/algol68/execute/minus-int-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 10; + LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10; + SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10; + ASSERT (i - 2 = 8); + ASSERT (ii - LONG 2 = LONG 8); + ASSERT (iii - LONG LONG 2 = LONG LONG 8); + ASSERT (ss - SHORT 2 = SHORT 8); + ASSERT (sss - SHORT SHORT 2 = SHORT SHORT 8) +END diff --git a/gcc/testsuite/algol68/execute/minusab-1.a68 b/gcc/testsuite/algol68/execute/minusab-1.a68 new file mode 100644 index 000000000000..0eb1661cb985 --- /dev/null +++ b/gcc/testsuite/algol68/execute/minusab-1.a68 @@ -0,0 +1,32 @@ +# { dg-options "-fstropping=upper" } # +BEGIN BEGIN INT i := 10; + i -:= 2; + ASSERT (i = 8); + i MINUSAB 2; + ASSERT (i = 6) + END; + BEGIN LONG INT i := LONG 1000; + i -:= LONG 100; + ASSERT (i = LONG 900); + i MINUSAB LONG 100; + ASSERT (i = LONG 800) + END; + BEGIN LONG LONG INT i := LONG LONG 10000; + i -:= LONG LONG 1000; + ASSERT (i = LONG LONG 9000); + i MINUSAB LONG LONG 1000; + ASSERT (i = LONG LONG 8000) + END; + BEGIN SHORT INT i := SHORT 100; + i -:= SHORT 10; + ASSERT (i = SHORT 90); + i MINUSAB SHORT 10; + ASSERT (i = SHORT 80) + END; + BEGIN SHORT SHORT INT i := SHORT SHORT 10; + i -:= SHORT SHORT 1; + ASSERT (i = SHORT SHORT 9); + i MINUSAB SHORT SHORT 2; + ASSERT (i = SHORT SHORT 7) + END +END diff --git a/gcc/testsuite/algol68/execute/minusab-2.a68 b/gcc/testsuite/algol68/execute/minusab-2.a68 new file mode 100644 index 000000000000..2fee755bf6e2 --- /dev/null +++ b/gcc/testsuite/algol68/execute/minusab-2.a68 @@ -0,0 +1,20 @@ +# { dg-options "-fstropping=upper" } # +BEGIN BEGIN REAL i := 10.0; + i -:= 2.0; + ASSERT (i = 8.0); + i MINUSAB 2.0; + ASSERT (i = 6.0) + END; + BEGIN LONG REAL i := LONG 1000.0; + i -:= LONG 100.0; + ASSERT (i = LONG 900.0); + i MINUSAB LONG 100.0; + ASSERT (i = LONG 800.0) + END; + BEGIN LONG LONG REAL i := LONG LONG 10000.0; + i -:= LONG LONG 1000.0; + ASSERT (i = LONG LONG 9000.0); + i MINUSAB LONG LONG 1000.0; + ASSERT (i = LONG LONG 8000.0) + END +END diff --git a/gcc/testsuite/algol68/execute/minusab-3.a68 b/gcc/testsuite/algol68/execute/minusab-3.a68 new file mode 100644 index 000000000000..08d020d3f201 --- /dev/null +++ b/gcc/testsuite/algol68/execute/minusab-3.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT n := 10; + (((n -:= 1))) := 5; + ASSERT (n = 5) +END diff --git a/gcc/testsuite/algol68/execute/minusab-4.a68 b/gcc/testsuite/algol68/execute/minusab-4.a68 new file mode 100644 index 000000000000..4330908f58f8 --- /dev/null +++ b/gcc/testsuite/algol68/execute/minusab-4.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT num ints := 10; + num ints -:= 1; + ASSERT (num ints = 9); + ASSERT ((LOC INT -:= 12) = -12) +END diff --git a/gcc/testsuite/algol68/execute/mod-int-1.a68 b/gcc/testsuite/algol68/execute/mod-int-1.a68 new file mode 100644 index 000000000000..0d8cfe415e4b --- /dev/null +++ b/gcc/testsuite/algol68/execute/mod-int-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 10; + LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10; + SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10; + ASSERT (i %* 3 = 1); + ASSERT (ii %* LONG 3 = LONG 1); + ASSERT (iii %* LONG LONG 3 = LONG LONG 1); + ASSERT (ss %* SHORT 3 = SHORT 1); + ASSERT (sss MOD SHORT SHORT 3 = SHORT SHORT 1) +END diff --git a/gcc/testsuite/algol68/execute/modab-1.a68 b/gcc/testsuite/algol68/execute/modab-1.a68 new file mode 100644 index 000000000000..41c49b089929 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modab-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN (SHORT SHORT INT i := SHORT SHORT 11; i MODAB SHORT SHORT 2; ASSERT (i = SHORT SHORT 1)); + (SHORT INT i := SHORT 11; i MODAB SHORT 2; ASSERT (i = SHORT 1)); + (INT i := 11; i MODAB 2; ASSERT (i = 1)); + (INT i := 11; i %*:= 2; ASSERT (i = 1)); + (LONG INT i := LONG 11; i MODAB LONG 2; ASSERT (i = LONG 1)); + (LONG INT i := LONG 11; i %*:= LONG 2; ASSERT (i = LONG 1)); + (LONG LONG INT i := LONG LONG 11; i MODAB LONG LONG 2; ASSERT (i = LONG LONG 1)); + (LONG LONG INT i := LONG LONG 11; i %*:= LONG LONG 2; ASSERT (i = LONG LONG 1)) +END diff --git a/gcc/testsuite/algol68/execute/modab-2.a68 b/gcc/testsuite/algol68/execute/modab-2.a68 new file mode 100644 index 000000000000..52fc9a12a546 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modab-2.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT n := 10; + (((n MODAB 1))) := 5; + ASSERT (n = 5) +END diff --git a/gcc/testsuite/algol68/execute/mode-indication-1.a68 b/gcc/testsuite/algol68/execute/mode-indication-1.a68 new file mode 100644 index 000000000000..f1dd8c28c92f --- /dev/null +++ b/gcc/testsuite/algol68/execute/mode-indication-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT j; REAL y; + MODE R = REAL; + BEGIN MODE R = INT; + R i := j; + SKIP + END; + R x := y; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/modules/README b/gcc/testsuite/algol68/execute/modules/README new file mode 100644 index 000000000000..a22c97c9ad6f --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/README @@ -0,0 +1,7 @@ +This directory contains tests that require using several packets. + +Files named module*.a68 contain prelude packets, i.e. the definitions +of one or more modules. These are to be referred within test programs +using dg-modules. + +Each program*.a68 file is a testcase. diff --git a/gcc/testsuite/algol68/execute/modules/execute.exp b/gcc/testsuite/algol68/execute/modules/execute.exp new file mode 100644 index 000000000000..cf61857aac11 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/execute.exp @@ -0,0 +1,42 @@ +# Copyright (C) 2024 Free Software Foundation, Inc. + +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +# Execute tests, torture testing. + +if $tracelevel then { + strace $tracelevel +} + +load_lib algol68-torture.exp +load_lib torture-options.exp + +torture-init +set-torture-options $TORTURE_OPTIONS + +# The programs need to be able to find the built modules, which are +# left in objdir. +global BUILT_MODULES_DIR +set BUILT_MODULES_DIR "$objdir" + +foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/program-*.a68]] { + # If we're only testing specific files and this isn't one of them, skip it. + if ![runtest_file_p $runtests $testcase] then { + continue + } + algol68-torture-execute $testcase + set algol68_compile_args "" +} + +torture-finish diff --git a/gcc/testsuite/algol68/execute/modules/module1.a68 b/gcc/testsuite/algol68/execute/modules/module1.a68 new file mode 100644 index 000000000000..f49a747033e0 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module1.a68 @@ -0,0 +1,9 @@ +module Module1 = +def + pub mode MyInt = int; + pub int beast_number := 666; + pub string who = "jemarch"; + puts ("Hello from module'n") +postlude + puts ("Bye from module'n") +fed diff --git a/gcc/testsuite/algol68/execute/modules/module10.a68 b/gcc/testsuite/algol68/execute/modules/module10.a68 new file mode 100644 index 000000000000..5b163ffe1f95 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module10.a68 @@ -0,0 +1,7 @@ +module Module10 = +access Module9, Module3 +def int je = foo; + prio QUUX = 9; + pub Lala bar = (bump; getcounter); {11} + skip +fed diff --git a/gcc/testsuite/algol68/execute/modules/module11.a68 b/gcc/testsuite/algol68/execute/modules/module11.a68 new file mode 100644 index 000000000000..39adb826019c --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module11.a68 @@ -0,0 +1,11 @@ +{ Mixing module texts with revelations and without revelations. } + +module Module11 = + access Module1, Module3 + def pub proc someproc = (int a, b) int: a + b; + skip + postlude + skip + fed, + Foo = def skip postlude skip fed, + Bar = def skip fed diff --git a/gcc/testsuite/algol68/execute/modules/module12.a68 b/gcc/testsuite/algol68/execute/modules/module12.a68 new file mode 100644 index 000000000000..3f849cbb9e65 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module12.a68 @@ -0,0 +1,5 @@ +module Module_12 = +def pub proc foo = (proc(int,string)void cb, int a) void: cb (a, "Foo"); + pub proc bar = (real r) void: skip; + skip +fed diff --git a/gcc/testsuite/algol68/execute/modules/module13.a68 b/gcc/testsuite/algol68/execute/modules/module13.a68 new file mode 100644 index 000000000000..9d66fe150651 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module13.a68 @@ -0,0 +1,5 @@ +module Module_13 = +def + pub mode JSON_Val = struct (int i); + skip +fed diff --git a/gcc/testsuite/algol68/execute/modules/module14.a68 b/gcc/testsuite/algol68/execute/modules/module14.a68 new file mode 100644 index 000000000000..bcb9d2cacd6d --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module14.a68 @@ -0,0 +1,5 @@ +module Module14 = +access Module13 +def pub proc getval = JSON_Val: skip; + skip +fed diff --git a/gcc/testsuite/algol68/execute/modules/module15.a68 b/gcc/testsuite/algol68/execute/modules/module15.a68 new file mode 100644 index 000000000000..5e4208433ec2 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module15.a68 @@ -0,0 +1,8 @@ +module Module15 = +access Module13, Module14 +def pub proc foo = int: + begin JSON_Val val = getval; + i of val + end; + skip +fed diff --git a/gcc/testsuite/algol68/execute/modules/module16.a68 b/gcc/testsuite/algol68/execute/modules/module16.a68 new file mode 100644 index 000000000000..d798d4ff874c --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module16.a68 @@ -0,0 +1,8 @@ +module Module_16 = +def + pub int counter; + skip +postlude + assert (counter = 666); + skip +fed diff --git a/gcc/testsuite/algol68/execute/modules/module17.a68 b/gcc/testsuite/algol68/execute/modules/module17.a68 new file mode 100644 index 000000000000..232ddeb5b91e --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module17.a68 @@ -0,0 +1,13 @@ +module Module = +def + pub int ce_port; + pub string ce_host; + + pub proc ce_connect = void: + myconnect (ce_host, ce_port); + + proc myconnect = (string host, int port) void: + skip; + + skip +fed diff --git a/gcc/testsuite/algol68/execute/modules/module3.a68 b/gcc/testsuite/algol68/execute/modules/module3.a68 new file mode 100644 index 000000000000..d4d2066f2b23 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module3.a68 @@ -0,0 +1,11 @@ +module Module_3 = +def + { variable = 0 in_proc = 1 } pub proc bump = void: counter +:= 1; + { variable = 0 in_proc = 1 } pub proc bumptimes = (int n) void: to n do bump od; + { variable = 1 in_proc = 0 } pub proc vbump := void: counter +:= 1; + { variable = 1 in_proc = 0 } pub proc vbumptimes := (int n) void: to n do vbump od; + { variable = 0 in_proc = 1 } pub proc getcounter = int: counter; + { variable = 0 in_proc = 0 } pub proc int anothergetcounter = getcounter; + int counter := 10; + skip +fed diff --git a/gcc/testsuite/algol68/execute/modules/module4.a68 b/gcc/testsuite/algol68/execute/modules/module4.a68 new file mode 100644 index 000000000000..f4ff315acf6b --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module4.a68 @@ -0,0 +1,4 @@ +module Module_4 = +def pub int ten = 10; + skip +fed diff --git a/gcc/testsuite/algol68/execute/modules/module5.a68 b/gcc/testsuite/algol68/execute/modules/module5.a68 new file mode 100644 index 000000000000..d0b009aa7954 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module5.a68 @@ -0,0 +1,7 @@ +module Module_5 = +def pub prio // = 9; + pub op // = (int a, b) int: a + b; + pub prio LALA = 9; + pub op LALA = (int a, b) int: a - b; + skip +fed diff --git a/gcc/testsuite/algol68/execute/modules/module6.a68 b/gcc/testsuite/algol68/execute/modules/module6.a68 new file mode 100644 index 000000000000..f89d7ac21a77 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module6.a68 @@ -0,0 +1,5 @@ +module Module_6 = +def prio // = 9; { Note priority is not publicized. } + pub op // = (int a, b) int: a + b; + skip +fed diff --git a/gcc/testsuite/algol68/execute/modules/module7.a68 b/gcc/testsuite/algol68/execute/modules/module7.a68 new file mode 100644 index 000000000000..c9c2e078addf --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module7.a68 @@ -0,0 +1,10 @@ +{ This module exports an operator defined in a non-brief operator + declaration. This means the exported symbol is a pointer to a + function and shall be indirected on the accessing side. } + +module Module_7 = +def pub prio MINUS = 9; + pub op (int,int)int MINUS = minus; + proc minus = (int a, b) int: a - b; + skip +fed diff --git a/gcc/testsuite/algol68/execute/modules/module8.a68 b/gcc/testsuite/algol68/execute/modules/module8.a68 new file mode 100644 index 000000000000..693629908b10 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module8.a68 @@ -0,0 +1,9 @@ +module Module_8 = +access Module_1, Module_4 +def + pub proc checks = void: + begin assert (ten = 10); + assert (beast_number = 666) + end; + skip +fed diff --git a/gcc/testsuite/algol68/execute/modules/module9.a68 b/gcc/testsuite/algol68/execute/modules/module9.a68 new file mode 100644 index 000000000000..ed59bb8bfb04 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module9.a68 @@ -0,0 +1,8 @@ +module Module9 = +def pub int foo = 10; + pub prio // = 9; + pub op QUUX = (int a, b) int: a + b; + prio QUUX = 9; + pub mode Lala = int; + skip +fed diff --git a/gcc/testsuite/algol68/execute/modules/program-1.a68 b/gcc/testsuite/algol68/execute/modules/program-1.a68 new file mode 100644 index 000000000000..b385c5698a4e --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-1.a68 @@ -0,0 +1,20 @@ +{ dg-modules "module1" } + +begin string je = access Module1 begin who end; + string ju = access Module1 ( who ); + string ji = access Module1 if true then who else who fi; + string ja = access Module1 (true | who | who); + string aa = access Module1 case 1 in who, "no" esac; + mode United = union (void,int); + string bb = access Module1 case United (10) in (int): who esac; + string cc = access Module1 (1 | who, "no"); + assert (je = "jemarch"); + assert (ju = "jemarch"); + assert (ji = "jemarch"); + assert (ja = "jemarch"); + assert (aa = "jemarch"); + assert (bb = "jemarch"); + assert (cc = "jemarch"); + access Module1 to 1 do assert (who = "jemarch") od; + access Module1 (assert (beast_number = 666)) +end diff --git a/gcc/testsuite/algol68/execute/modules/program-10.a68 b/gcc/testsuite/algol68/execute/modules/program-10.a68 new file mode 100644 index 000000000000..101d065b19e7 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-10.a68 @@ -0,0 +1,6 @@ +{ dg-modules "module3 module9 module10" } + +access Module10 +begin int x = 11; + assert (x = bar) +end diff --git a/gcc/testsuite/algol68/execute/modules/program-11.a68 b/gcc/testsuite/algol68/execute/modules/program-11.a68 new file mode 100644 index 000000000000..ba2e1fe01004 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-11.a68 @@ -0,0 +1,3 @@ +{ dg-modules "module1 module3 module11" } + +access Module11 ( assert (someproc (2, 3) = 5)) diff --git a/gcc/testsuite/algol68/execute/modules/program-12.a68 b/gcc/testsuite/algol68/execute/modules/program-12.a68 new file mode 100644 index 000000000000..a8a6a4c03980 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-12.a68 @@ -0,0 +1,6 @@ +{ dg-modules "module12" } + +access Module_12 +begin proc lala = (int n, string s) void: skip; + foo (lala, 10) +end diff --git a/gcc/testsuite/algol68/execute/modules/program-15.a68 b/gcc/testsuite/algol68/execute/modules/program-15.a68 new file mode 100644 index 000000000000..7b6abafdbaae --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-15.a68 @@ -0,0 +1,3 @@ +{ dg-modules "module13 module14 module15" } + +access Module15 (assert (foo = 0)) diff --git a/gcc/testsuite/algol68/execute/modules/program-16.a68 b/gcc/testsuite/algol68/execute/modules/program-16.a68 new file mode 100644 index 000000000000..dd6ddb6b9413 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-16.a68 @@ -0,0 +1,8 @@ +{ dg-modules module16 } + +access Module_16 +begin assert (counter = 0); + counter := 20; + access Module_16 (assert (counter = 20)); + counter := 666 +end diff --git a/gcc/testsuite/algol68/execute/modules/program-17.a68 b/gcc/testsuite/algol68/execute/modules/program-17.a68 new file mode 100644 index 000000000000..90a1728c68b1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-17.a68 @@ -0,0 +1,7 @@ +{ dg-modules module17 } + +access Module17 +begin ce_port := 8888; + ce_host := "localhost"; + ce_connect +end diff --git a/gcc/testsuite/algol68/execute/modules/program-2.a68 b/gcc/testsuite/algol68/execute/modules/program-2.a68 new file mode 100644 index 000000000000..e0f320c2a9f0 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-2.a68 @@ -0,0 +1,15 @@ +{ dg-modules "module1" } + +begin int x = 1 + access Module1 ( beast_number); + int i = access Module1 ( beast_number ) + 1; + int z = 1 + access Module1 if true then beast_number fi; + int v = access Module1 if true then beast_number fi + 1; + int w = access Module1 if true then beast_number fi + + access Module1 if true then beast_number fi; + assert (i = 667); + assert (x = 667); + assert (z = 667); + assert (v = 667); + assert (w = 666 * 2); + skip +end diff --git a/gcc/testsuite/algol68/execute/modules/program-3.a68 b/gcc/testsuite/algol68/execute/modules/program-3.a68 new file mode 100644 index 000000000000..b1570bd9aed9 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-3.a68 @@ -0,0 +1,16 @@ +{ dg-modules "module3" } + +access Module_3 +begin assert (getcounter = 10); + bump; + assert (getcounter = 11); + bumptimes (3); + assert (getcounter = 14) + { vbump and vbumptimes are set to non-publicized routines + that are local to the module, so it is a scope violation + to call them. } +{ vbump; + assert (getcounter = 15); + vbumptimes (10); + assert (anothergetcounter = 25) } +end diff --git a/gcc/testsuite/algol68/execute/modules/program-4.a68 b/gcc/testsuite/algol68/execute/modules/program-4.a68 new file mode 100644 index 000000000000..f207d9c4b6ac --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-4.a68 @@ -0,0 +1,7 @@ +{ dg-modules "module4" } + +{ The widening coercion "jumps" inside the controlled xclause. } + +begin real realten = access Module_4 (ten); + skip +end diff --git a/gcc/testsuite/algol68/execute/modules/program-5.a68 b/gcc/testsuite/algol68/execute/modules/program-5.a68 new file mode 100644 index 000000000000..afa49f5c1230 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-5.a68 @@ -0,0 +1,7 @@ +{ dg-modules "module5" } + +access Module_5 +begin assert (2 // 3 = 5); + assert (2 LALA 3 = -1); + skip +end diff --git a/gcc/testsuite/algol68/execute/modules/program-6.a68 b/gcc/testsuite/algol68/execute/modules/program-6.a68 new file mode 100644 index 000000000000..05708fada46d --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-6.a68 @@ -0,0 +1,9 @@ +{ dg-modules "module6" } + +{ New priority is given to an importe operator. } + +access Module_6 +begin assert (2 // 3 = 5); + prio // = 9; + skip +end diff --git a/gcc/testsuite/algol68/execute/modules/program-7.a68 b/gcc/testsuite/algol68/execute/modules/program-7.a68 new file mode 100644 index 000000000000..6a5aa494c1db --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-7.a68 @@ -0,0 +1,3 @@ +{ dg-modules "module7" } + +access Module_7 ( assert (2 MINUS 3 = -1) ) diff --git a/gcc/testsuite/algol68/execute/modules/program-8.a68 b/gcc/testsuite/algol68/execute/modules/program-8.a68 new file mode 100644 index 000000000000..4a50e7153e83 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-8.a68 @@ -0,0 +1,3 @@ +{ dg-modules "module1 module4 module8" } + +access Module_8 (checks) diff --git a/gcc/testsuite/algol68/execute/mult-char-1.a68 b/gcc/testsuite/algol68/execute/mult-char-1.a68 new file mode 100644 index 000000000000..0e3c1f4b93f0 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mult-char-1.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT ("a" * 3 = "aaa"); + ASSERT ("" * 1 = ""); + ASSERT ("x" * 0 = "x") +END diff --git a/gcc/testsuite/algol68/execute/mult-int-1.a68 b/gcc/testsuite/algol68/execute/mult-int-1.a68 new file mode 100644 index 000000000000..2da298837793 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mult-int-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 10; + LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10; + SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10; + ASSERT (i * 2 = 20); + ASSERT (ii * LONG 2 = LONG 20); + ASSERT (iii * LONG LONG 2 = LONG LONG 20); + ASSERT (ss * SHORT 2 = SHORT 20); + ASSERT (sss * SHORT SHORT 2 = SHORT SHORT 20) +END diff --git a/gcc/testsuite/algol68/execute/mult-string-1.a68 b/gcc/testsuite/algol68/execute/mult-string-1.a68 new file mode 100644 index 000000000000..b0d49178bd1e --- /dev/null +++ b/gcc/testsuite/algol68/execute/mult-string-1.a68 @@ -0,0 +1,13 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRING foo = "foo"; + ASSERT (foo * -10 = "foo"); + ASSERT (-10 * foo = "foo"); + ASSERT (foo * 0 = "foo"); + ASSERT (0 * foo = "foo"); + ASSERT (foo * 1 = "foo"); + ASSERT (1 * foo = "foo"); + ASSERT (foo * 2 = "foofoo"); + ASSERT (2 * foo = "foofoo"); + ASSERT (foo * 3 = "foofoofoo"); + ASSERT (3 * foo = "foofoofoo") +END diff --git a/gcc/testsuite/algol68/execute/mult-string-2.a68 b/gcc/testsuite/algol68/execute/mult-string-2.a68 new file mode 100644 index 000000000000..670dcbf16d60 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mult-string-2.a68 @@ -0,0 +1,13 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []CHAR foo = ("f","o","o"); + ASSERT (foo * -10 = "foo"); + ASSERT (-10 * foo = "foo"); + ASSERT (foo * 0 = "foo"); + ASSERT (0 * foo = "foo"); + ASSERT (foo * 1 = "foo"); + ASSERT (1 * foo = "foo"); + ASSERT (foo * 2 = "foofoo"); + ASSERT (2 * foo = "foofoo"); + ASSERT (foo * 3 = "foofoofoo"); + ASSERT (3 * foo = "foofoofoo") +END diff --git a/gcc/testsuite/algol68/execute/mult-string-3.a68 b/gcc/testsuite/algol68/execute/mult-string-3.a68 new file mode 100644 index 000000000000..a8d3726d0dfa --- /dev/null +++ b/gcc/testsuite/algol68/execute/mult-string-3.a68 @@ -0,0 +1,13 @@ +# { dg-options "-fstropping=upper" } # +BEGIN FLEX[3]CHAR foo := ("f","o","o"); + ASSERT (foo * -10 = "foo"); + ASSERT (-10 * foo = "foo"); + ASSERT (foo * 0 = "foo"); + ASSERT (0 * foo = "foo"); + ASSERT (foo * 1 = "foo"); + ASSERT (1 * foo = "foo"); + ASSERT (foo * 2 = "foofoo"); + ASSERT (2 * foo = "foofoo"); + ASSERT (foo * 3 = "foofoofoo"); + ASSERT (3 * foo = "foofoofoo") +END diff --git a/gcc/testsuite/algol68/execute/mult-string-4.a68 b/gcc/testsuite/algol68/execute/mult-string-4.a68 new file mode 100644 index 000000000000..d5e1adb66a3b --- /dev/null +++ b/gcc/testsuite/algol68/execute/mult-string-4.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRING foo = "abc"; + ASSERT (foo[] * 2 = "abcabc") +END diff --git a/gcc/testsuite/algol68/execute/multab-1.a68 b/gcc/testsuite/algol68/execute/multab-1.a68 new file mode 100644 index 000000000000..355129baf658 --- /dev/null +++ b/gcc/testsuite/algol68/execute/multab-1.a68 @@ -0,0 +1,31 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 2; + i *:= 2; + ASSERT (i = 4); + i *:= 2; + ASSERT (i = 8); + + SHORT INT s := SHORT 2; + s *:= SHORT 2; + ASSERT (s = SHORT 4); + s *:= SHORT 3; + ASSERT (s = SHORT 12); + + SHORT SHORT INT ss := SHORT SHORT 2; + ss *:= SHORT SHORT 2; + ASSERT (ss = SHORT SHORT 4); + ss *:= SHORT SHORT 3; + ASSERT (ss = SHORT SHORT 12); + + REF LONG INT ii = HEAP LONG INT := LONG 2; + ii *:= LONG 2; + ASSERT (ii = LONG 4); + ii *:= LONG 2; + ASSERT (ii = LONG 8); + + LONG LONG INT iii := LONG LONG 2; + iii *:= LONG LONG 2; + ASSERT (iii = LONG LONG 4); + iii *:= LONG LONG 2; + ASSERT (iii = LONG LONG 8) +END diff --git a/gcc/testsuite/algol68/execute/multab-2.a68 b/gcc/testsuite/algol68/execute/multab-2.a68 new file mode 100644 index 000000000000..dc1485991cd1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/multab-2.a68 @@ -0,0 +1,31 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 2; + i TIMESAB 2; + ASSERT (i = 4); + i TIMESAB 2; + ASSERT (i = 8); + + REF SHORT INT ss = HEAP SHORT INT := SHORT 2; + ss TIMESAB SHORT 2; + ASSERT (ss = SHORT 4); + ss TIMESAB SHORT 2; + ASSERT (ss = SHORT 8); + + SHORT SHORT INT sss := SHORT SHORT 2; + sss TIMESAB SHORT SHORT 2; + ASSERT (sss = SHORT SHORT 4); + sss TIMESAB SHORT SHORT 2; + ASSERT (sss = SHORT SHORT 8); + + REF LONG INT ii = HEAP LONG INT := LONG 2; + ii TIMESAB LONG 2; + ASSERT (ii = LONG 4); + ii TIMESAB LONG 2; + ASSERT (ii = LONG 8); + + LONG LONG INT iii := LONG LONG 2; + iii TIMESAB LONG LONG 2; + ASSERT (iii = LONG LONG 4); + iii TIMESAB LONG LONG 2; + ASSERT (iii = LONG LONG 8) +END diff --git a/gcc/testsuite/algol68/execute/multab-3.a68 b/gcc/testsuite/algol68/execute/multab-3.a68 new file mode 100644 index 000000000000..87d7f42b80b1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/multab-3.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT num ints := 10; + num ints *:= 2; + ASSERT (num ints = 20); + ASSERT ((LOC INT *:= 12) = 0) +END diff --git a/gcc/testsuite/algol68/execute/mutual-recursion-1.a68 b/gcc/testsuite/algol68/execute/mutual-recursion-1.a68 new file mode 100644 index 000000000000..06e01f947ff3 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mutual-recursion-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC is even = (INT n) BOOL: (n = 0 | TRUE | is odd (n - 1)); + PROC is odd = (INT n) BOOL: (n = 0 | FALSE | is even (n - 1)); + ASSERT (is even (20)); + ASSERT (is odd (13)) +END diff --git a/gcc/testsuite/algol68/execute/ne-bits-1.a68 b/gcc/testsuite/algol68/execute/ne-bits-1.a68 new file mode 100644 index 000000000000..49ef81061ae1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/ne-bits-1.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN BITS b, LONG BITS bb = LONG 16rff, LONG LONG BITS bbb; + SHORT BITS ss = SHORT 16rff, SHORT SHORT BITS sss; + ASSERT (b /= 2r1); + ASSERT (bb NE LONG 8r477); + ASSERT (bbb /= LONG LONG 8r2); + ASSERT (ss NE SHORT 8r477); + ASSERT (sss /= SHORT SHORT 8r2) +END diff --git a/gcc/testsuite/algol68/execute/ne-char-char-1.a68 b/gcc/testsuite/algol68/execute/ne-char-char-1.a68 new file mode 100644 index 000000000000..2a5b44fe83ca --- /dev/null +++ b/gcc/testsuite/algol68/execute/ne-char-char-1.a68 @@ -0,0 +1,3 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT ("x" /= "a") +END diff --git a/gcc/testsuite/algol68/execute/ne-int-1.a68 b/gcc/testsuite/algol68/execute/ne-int-1.a68 new file mode 100644 index 000000000000..2c26bd563c59 --- /dev/null +++ b/gcc/testsuite/algol68/execute/ne-int-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 12; + LONG INT ii = LONG 12, LONG LONG INT iii = LONG LONG 12; + SHORT INT s = SHORT 12, SHORT SHORT INT ss = SHORT SHORT 12; + ASSERT (13 /= i); + ASSERT (ii NE LONG 13); + ASSERT (iii /= LONG LONG 13); + ASSERT (s /= SHORT 13); + ASSERT (ss /= SHORT SHORT 13) +END diff --git a/gcc/testsuite/algol68/execute/ne-string-1.a68 b/gcc/testsuite/algol68/execute/ne-string-1.a68 new file mode 100644 index 000000000000..95bd212dce30 --- /dev/null +++ b/gcc/testsuite/algol68/execute/ne-string-1.a68 @@ -0,0 +1,15 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRING foo = "foo", bar = "bar", quux = "quux"; + # /= # + ASSERT (NOT ("" /= "")); + ASSERT (NOT ("foo" /= foo)); + ASSERT (foo /= bar); + ASSERT (foo /= quux); + ASSERT (quux /= foo); + # NE # + ASSERT (NOT ("" NE "")); + ASSERT (NOT ("foo" NE foo)); + ASSERT (foo NE bar); + ASSERT (foo NE quux); + ASSERT (quux NE foo) +END diff --git a/gcc/testsuite/algol68/execute/neg-int-1.a68 b/gcc/testsuite/algol68/execute/neg-int-1.a68 new file mode 100644 index 000000000000..0e66149ef286 --- /dev/null +++ b/gcc/testsuite/algol68/execute/neg-int-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 10; + LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10; + SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10; + ASSERT (-i = -10); + ASSERT (-ii = - LONG 10); + ASSERT (-iii = - LONG LONG 10); + ASSERT (-ss = - SHORT 10); + ASSERT (-sss = - SHORT SHORT 10) +END diff --git a/gcc/testsuite/algol68/execute/not-bits-1.a68 b/gcc/testsuite/algol68/execute/not-bits-1.a68 new file mode 100644 index 000000000000..8334f7f7a7f7 --- /dev/null +++ b/gcc/testsuite/algol68/execute/not-bits-1.a68 @@ -0,0 +1,13 @@ +# { dg-options "-fstropping=upper" } # +# NOT for SIZETY BITS. # +BEGIN BITS b = 16rf0f0; + ASSERT ((NOT b AND 16rffff) = 16r0f0f); + LONG BITS bb = LONG 16rf0f0; + ASSERT ((NOT bb AND LONG 16rffff) = LONG 16r0f0f); + LONG LONG BITS bbb = LONG LONG 16rf0f0; + ASSERT ((NOT bbb AND LONG LONG 16rffff) = LONG LONG 16r0f0f); + SHORT BITS ss = SHORT 16rf0f0; + ASSERT ((NOT ss AND SHORT 16rffff) = SHORT 16r0f0f); + SHORT SHORT BITS sss = SHORT SHORT 16rf0f0; + ASSERT ((NOT sss AND SHORT SHORT 16rffff) = SHORT SHORT 16r0f0f) +END diff --git a/gcc/testsuite/algol68/execute/odd-1.a68 b/gcc/testsuite/algol68/execute/odd-1.a68 new file mode 100644 index 000000000000..893bf0479d01 --- /dev/null +++ b/gcc/testsuite/algol68/execute/odd-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT a = 1; + ASSERT (ODD a); + ASSERT (ODD LONG 3); + ASSERT (NOT ODD LONG LONG 4); + ASSERT (ODD SHORT 3); + ASSERT (NOT ODD SHORT SHORT 4) +END diff --git a/gcc/testsuite/algol68/execute/op-1.a68 b/gcc/testsuite/algol68/execute/op-1.a68 new file mode 100644 index 000000000000..3b63c323ca24 --- /dev/null +++ b/gcc/testsuite/algol68/execute/op-1.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN OP ONEOVER = (REAL a) REAL: 1/a; + REAL x; + x := ONEOVER 3.14 +END diff --git a/gcc/testsuite/algol68/execute/op-2.a68 b/gcc/testsuite/algol68/execute/op-2.a68 new file mode 100644 index 000000000000..c7721719a564 --- /dev/null +++ b/gcc/testsuite/algol68/execute/op-2.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN OP + = (INT a, b) INT: a - -b; + ASSERT (10 + 30 = 40) +END diff --git a/gcc/testsuite/algol68/execute/op-3.a68 b/gcc/testsuite/algol68/execute/op-3.a68 new file mode 100644 index 000000000000..9889a64a3536 --- /dev/null +++ b/gcc/testsuite/algol68/execute/op-3.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN OP MIN = (REAL a, b) REAL: (a < b | a | b), + MIN = (INT a, REAL b) REAL: (a < b | a | b), + MIN = (REAL a, INT b) REAL: a MIN REAL (b); + PRIO MIN = 6; + ASSERT (10.0 MIN 20.0 > 9.9 AND 10.0 MIN 20.0 < 10.1); + ASSERT (10.0 MIN 100 > 9.9 AND 10.0 MIN 100 < 10.1); + ASSERT (100.0 MIN 10 > 9.9 AND 100.0 MIN 10 < 10.1) +END diff --git a/gcc/testsuite/algol68/execute/operator-declaration-1.a68 b/gcc/testsuite/algol68/execute/operator-declaration-1.a68 new file mode 100644 index 000000000000..61f8fa9986b1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/operator-declaration-1.a68 @@ -0,0 +1,13 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT n = 10; + # Note that the priority for the monadic operators gets ignored. # + PRIO JORL = 6, JURL = 6, XXX = 6, YYY = 6; + OP(INT)INT JORL = (n > 10 | (INT a) INT: a + 1 | (INT a) INT: a - 1), + JURL = (n <= 10 | (INT a) INT: a + 1 | (INT a) INT: a - 1); + OP(INT,INT)INT XXX = (INT a, b) INT: a + b, + YYY = (n > 10 | (INT a,b) INT: a * b | (INT a,b) INT: a - b); + ASSERT (JORL 10 = 9); + ASSERT (JURL 10 = 11); + ASSERT (2 XXX 3 = 5); + ASSERT (2 YYY 3 = -1); +END diff --git a/gcc/testsuite/algol68/execute/or-bits-1.a68 b/gcc/testsuite/algol68/execute/or-bits-1.a68 new file mode 100644 index 000000000000..4fc1b06225d7 --- /dev/null +++ b/gcc/testsuite/algol68/execute/or-bits-1.a68 @@ -0,0 +1,18 @@ +# { dg-options "-fstropping=upper" } # +# OR for SIZETY BITS. # +BEGIN BITS b = 16rf0f0; + ASSERT ((b OR 16r0f0f) = 16rffff); + ASSERT ((b OR 16r00ff) = 16rf0ff); + LONG BITS bb = LONG 16rf0f0; + ASSERT ((bb OR LONG 16r0f0f) = LONG 16rffff); + ASSERT ((bb OR LONG 16r00ff) = LONG 16rf0ff); + LONG LONG BITS bbb = LONG LONG 16rf0f0; + ASSERT ((bbb OR LONG LONG 16r0f0f) = LONG LONG 16rffff); + ASSERT ((bbb OR LONG LONG 16r00ff) = LONG LONG 16rf0ff); + SHORT BITS ss = SHORT 16rf0f0; + ASSERT ((ss OR SHORT 16r0f0f) = SHORT 16rffff); + ASSERT ((ss OR SHORT 16r00ff) = SHORT 16rf0ff); + SHORT SHORT BITS sss = SHORT SHORT 16rf0f0; + ASSERT ((sss OR SHORT SHORT 16r0f0f) = SHORT SHORT 16rffff); + ASSERT ((sss OR SHORT SHORT 16r00ff) = SHORT SHORT 16rf0ff) +END diff --git a/gcc/testsuite/algol68/execute/orf-1.a68 b/gcc/testsuite/algol68/execute/orf-1.a68 new file mode 100644 index 000000000000..10f052128bc2 --- /dev/null +++ b/gcc/testsuite/algol68/execute/orf-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 10; + ASSERT (i = 0 OREL i = 10) +END diff --git a/gcc/testsuite/algol68/execute/over-int-1.a68 b/gcc/testsuite/algol68/execute/over-int-1.a68 new file mode 100644 index 000000000000..871effb61a0b --- /dev/null +++ b/gcc/testsuite/algol68/execute/over-int-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 10; + LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10; + SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10; + ASSERT (i % 2 = 5); + ASSERT (ii % LONG 2 = LONG 5); + ASSERT (iii % LONG LONG 2 = LONG LONG 5); + ASSERT (ss % SHORT 2 = SHORT 5); + ASSERT (sss % SHORT SHORT 2 = SHORT SHORT 5) +END diff --git a/gcc/testsuite/algol68/execute/overab-1.a68 b/gcc/testsuite/algol68/execute/overab-1.a68 new file mode 100644 index 000000000000..8edfa1e5fab0 --- /dev/null +++ b/gcc/testsuite/algol68/execute/overab-1.a68 @@ -0,0 +1,12 @@ +# { dg-options "-fstropping=upper" } # +BEGIN (INT i := 11; i OVERAB 2; ASSERT (i = 5)); + (INT i := 11; i %:= 2; ASSERT (i = 5)); + (SHORT INT i := SHORT 11; i OVERAB SHORT 2; ASSERT (i = SHORT 5)); + (SHORT INT i := SHORT 11; i %:= SHORT 2; ASSERT (i = SHORT 5)); + (SHORT SHORT INT i := SHORT SHORT 11; i OVERAB SHORT SHORT 2; ASSERT (i = SHORT SHORT 5)); + (SHORT SHORT INT i := SHORT SHORT 11; i %:= SHORT SHORT 2; ASSERT (i = SHORT SHORT 5)); + (LONG INT i := LONG 11; i OVERAB LONG 2; ASSERT (i = LONG 5)); + (LONG INT i := LONG 11; i %:= LONG 2; ASSERT (i = LONG 5)); + (LONG LONG INT i := LONG LONG 11; i OVERAB LONG LONG 2; ASSERT (i = LONG LONG 5)); + (LONG LONG INT i := LONG LONG 11; i %:= LONG LONG 2; ASSERT (i = LONG LONG 5)) +END diff --git a/gcc/testsuite/algol68/execute/overab-2.a68 b/gcc/testsuite/algol68/execute/overab-2.a68 new file mode 100644 index 000000000000..eec8a1cbfdc8 --- /dev/null +++ b/gcc/testsuite/algol68/execute/overab-2.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT n := 10; + (((n OVERAB 1))) := 5; + ASSERT (n = 5) +END diff --git a/gcc/testsuite/algol68/execute/particular-program-1.a68 b/gcc/testsuite/algol68/execute/particular-program-1.a68 new file mode 100644 index 000000000000..2c490afce04f --- /dev/null +++ b/gcc/testsuite/algol68/execute/particular-program-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +# Particular program with preceding labels. # +jo: ju: +BEGIN SKIP END diff --git a/gcc/testsuite/algol68/execute/plus-char-1.a68 b/gcc/testsuite/algol68/execute/plus-char-1.a68 new file mode 100644 index 000000000000..d017fe08ab8f --- /dev/null +++ b/gcc/testsuite/algol68/execute/plus-char-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT ("a" + "b" = "ab"); + ASSERT ("" + "x" = "x") +END diff --git a/gcc/testsuite/algol68/execute/plus-int-1.a68 b/gcc/testsuite/algol68/execute/plus-int-1.a68 new file mode 100644 index 000000000000..93ea00445ddf --- /dev/null +++ b/gcc/testsuite/algol68/execute/plus-int-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 10; + LONG INT ii = LONG 10, LONG LONG INT iii = LONG LONG 10; + SHORT INT ss = SHORT 10, SHORT SHORT INT sss = SHORT SHORT 10; + ASSERT (i + 2 = 12); + ASSERT (ii + LONG 2 = LONG 12); + ASSERT (iii + LONG LONG 2 = LONG LONG 12); + ASSERT (ss + SHORT 2 = SHORT 12); + ASSERT (sss + SHORT SHORT 2 = SHORT SHORT 12) +END diff --git a/gcc/testsuite/algol68/execute/plus-string-1.a68 b/gcc/testsuite/algol68/execute/plus-string-1.a68 new file mode 100644 index 000000000000..be9edf79de22 --- /dev/null +++ b/gcc/testsuite/algol68/execute/plus-string-1.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRING foo = "foo", bar = "bar", quux = "quux"; + ASSERT ("" + "" = ""); + ASSERT ("" + foo = "foo"); + ASSERT (bar + "" = "bar"); + ASSERT (foo + bar = "foobar"); + STRING res = foo + bar; + ASSERT (LWB res = 1 AND UPB res = 6); + STRING empty = "" + ""; + ASSERT (LWB empty = 1 AND UPB empty = 0) +END diff --git a/gcc/testsuite/algol68/execute/plus-string-2.a68 b/gcc/testsuite/algol68/execute/plus-string-2.a68 new file mode 100644 index 000000000000..6399ee1cf228 --- /dev/null +++ b/gcc/testsuite/algol68/execute/plus-string-2.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC rec parse comment = VOID: + BEGIN STRING content; + done; + 100; + done: + ASSERT (content + "x" = "x") + END; + + rec parse comment +END diff --git a/gcc/testsuite/algol68/execute/plus-string-stride-1.a68 b/gcc/testsuite/algol68/execute/plus-string-stride-1.a68 new file mode 100644 index 000000000000..07fdf79537c4 --- /dev/null +++ b/gcc/testsuite/algol68/execute/plus-string-stride-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,]CHAR matrix = (("1","H","3"), + ("4","O","6"), + ("7","M","9"), + ("8","E","2")); + ASSERT (matrix[1:2,1] + matrix[3:4,3] = "1492") +END diff --git a/gcc/testsuite/algol68/execute/plusab-1.a68 b/gcc/testsuite/algol68/execute/plusab-1.a68 new file mode 100644 index 000000000000..8de4e97b046a --- /dev/null +++ b/gcc/testsuite/algol68/execute/plusab-1.a68 @@ -0,0 +1,34 @@ +# { dg-options "-fstropping=upper" } # +BEGIN BEGIN INT i := 10; + i +:= 2; + ASSERT (i = 12); + i PLUSAB 2; + ASSERT (i = 14) + END; + + BEGIN SHORT INT i := SHORT 1000; + i +:= SHORT 100; + ASSERT (i = SHORT 1100); + i PLUSAB SHORT 100; + ASSERT (i = SHORT 1200) + END; + BEGIN SHORT SHORT INT i := SHORT SHORT 10000; + i +:= SHORT SHORT 1000; + ASSERT (i = SHORT SHORT 11000); + i PLUSAB SHORT SHORT 1000; + ASSERT (i = SHORT SHORT 12000) + END; + + BEGIN LONG INT i := LONG 1000; + i +:= LONG 100; + ASSERT (i = LONG 1100); + i PLUSAB LONG 100; + ASSERT (i = LONG 1200) + END; + BEGIN LONG LONG INT i := LONG LONG 10000; + i +:= LONG LONG 1000; + ASSERT (i = LONG LONG 11000); + i PLUSAB LONG LONG 1000; + ASSERT (i = LONG LONG 12000) + END +END diff --git a/gcc/testsuite/algol68/execute/plusab-2.a68 b/gcc/testsuite/algol68/execute/plusab-2.a68 new file mode 100644 index 000000000000..6db46864d8ae --- /dev/null +++ b/gcc/testsuite/algol68/execute/plusab-2.a68 @@ -0,0 +1,20 @@ +# { dg-options "-fstropping=upper" } # +BEGIN BEGIN REAL i := 10.0; + i +:= 2.0; + ASSERT (i > 11.9); + i PLUSAB 2.0; + ASSERT (i > 13.9) + END; + BEGIN LONG REAL i := LONG 1000.0; + i +:= LONG 100.0; + ASSERT (i > LONG 1099.9); + i PLUSAB LONG 100.0; + ASSERT (i > LONG 1199.9) + END; + BEGIN LONG LONG REAL i := LONG LONG 10000.0; + i +:= LONG LONG 1000.0; + ASSERT (i > LONG LONG 10999.9); + i PLUSAB LONG LONG 1000.0; + ASSERT (i > LONG LONG 11999.9) + END +END diff --git a/gcc/testsuite/algol68/execute/plusab-3.a68 b/gcc/testsuite/algol68/execute/plusab-3.a68 new file mode 100644 index 000000000000..beb63060135d --- /dev/null +++ b/gcc/testsuite/algol68/execute/plusab-3.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT n := 0; + (((n +:= 1))) := 5; + ASSERT (n = 5) +END diff --git a/gcc/testsuite/algol68/execute/plusab-4.a68 b/gcc/testsuite/algol68/execute/plusab-4.a68 new file mode 100644 index 000000000000..adfbc9f7a074 --- /dev/null +++ b/gcc/testsuite/algol68/execute/plusab-4.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT num ints := 0; + num ints +:= 1; + ASSERT (num ints = 1); + ASSERT ((LOC INT +:= 12) = 12) +END diff --git a/gcc/testsuite/algol68/execute/plusab-string-1.a68 b/gcc/testsuite/algol68/execute/plusab-string-1.a68 new file mode 100644 index 000000000000..ec1bd3c45fbb --- /dev/null +++ b/gcc/testsuite/algol68/execute/plusab-string-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRING foo := ""; + foo +:= "foo"; + ASSERT (LWB foo = 1 AND UPB foo = 3 AND foo = "foo"); + foo PLUSAB "bar"; + ASSERT (LWB foo = 1 AND UPB foo = 6 AND foo = "foobar") +END diff --git a/gcc/testsuite/algol68/execute/plusto-char-1.a68 b/gcc/testsuite/algol68/execute/plusto-char-1.a68 new file mode 100644 index 000000000000..79881c07d101 --- /dev/null +++ b/gcc/testsuite/algol68/execute/plusto-char-1.a68 @@ -0,0 +1,7 @@ +begin string foo := "foo"; + char c := "x"; + c PLUSTO foo; + assert (foo = "xfoo"); + c +=: foo; + assert (foo = "xxfoo") +end diff --git a/gcc/testsuite/algol68/execute/plusto-string-1.a68 b/gcc/testsuite/algol68/execute/plusto-string-1.a68 new file mode 100644 index 000000000000..7d5894b0cd47 --- /dev/null +++ b/gcc/testsuite/algol68/execute/plusto-string-1.a68 @@ -0,0 +1,6 @@ +begin string foo := "foo"; + "bar" PLUSTO foo; + assert (foo = "barfoo"); + "quux" +=: foo; + assert (foo = "quuxbarfoo") +end diff --git a/gcc/testsuite/algol68/execute/posix-argc-argv-1.a68 b/gcc/testsuite/algol68/execute/posix-argc-argv-1.a68 new file mode 100644 index 000000000000..a6380380ffe7 --- /dev/null +++ b/gcc/testsuite/algol68/execute/posix-argc-argv-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (argc >= 1); + ASSERT (argv (1000) = ""); + ASSERT (argv (-1) = ""); + FOR i TO argc + DO puts (argv (i)) OD +END diff --git a/gcc/testsuite/algol68/execute/posix-fopen-1.a68 b/gcc/testsuite/algol68/execute/posix-fopen-1.a68 new file mode 100644 index 000000000000..d2a0c406f2b1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/posix-fopen-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT fd = fopen ("doesn''t exist", file o default); + ASSERT (fd = -1) +END diff --git a/gcc/testsuite/algol68/execute/posix-fputc-fputs-1.a68 b/gcc/testsuite/algol68/execute/posix-fputc-fputs-1.a68 new file mode 100644 index 000000000000..bf0af6e6e225 --- /dev/null +++ b/gcc/testsuite/algol68/execute/posix-fputc-fputs-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN fputc (stdout, "X"); + ASSERT (fputs (stdout, "foo") = 3); + fputs (stdout, fputc (stdout, "Y") + "T"); + fputc (stdout, "Z"); + ASSERT (fputs (stdout, "") = 0); + puts ("") +END diff --git a/gcc/testsuite/algol68/execute/posix-getenv-1.a68 b/gcc/testsuite/algol68/execute/posix-getenv-1.a68 new file mode 100644 index 000000000000..d1e690568124 --- /dev/null +++ b/gcc/testsuite/algol68/execute/posix-getenv-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (getenv ("") = ""); + ASSERT (getenv ("DOESNT EXIST FOR SURE") = "") +END diff --git a/gcc/testsuite/algol68/execute/posix-lseek.a68 b/gcc/testsuite/algol68/execute/posix-lseek.a68 new file mode 100644 index 000000000000..8f20dc53d975 --- /dev/null +++ b/gcc/testsuite/algol68/execute/posix-lseek.a68 @@ -0,0 +1,17 @@ +begin int fd = fopen ("../../ga68", file_o_rdonly); + assert (fd /= -1); + assert (errno = 0); + long long int offset; + offset := lseek (fd, long long 0, seek_cur); + assert (offset = long long 0); + assert (errno = 0); + offset := lseek (fd, long long 0, seek_set); + assert (offset = long long 0); + assert (errno = 0); + offset := lseek (fd, long long 0, seek_end); + long long int offset2 = lseek (fd, offset, seek_set); + assert (offset = offset2); + long long int file_size = fsize (fd); + assert (errno = 0); + assert (offset = file_size) +end diff --git a/gcc/testsuite/algol68/execute/posix-perror-1.a68 b/gcc/testsuite/algol68/execute/posix-perror-1.a68 new file mode 100644 index 000000000000..a349dd72ad88 --- /dev/null +++ b/gcc/testsuite/algol68/execute/posix-perror-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +# { dg-output "^something unique: " } # +BEGIN INT fd = fopen ("doesn''t exist", file o default); + IF fd = -1 THEN + ASSERT (strerror (errno) /= ""); + perror ("something unique") + FI +END diff --git a/gcc/testsuite/algol68/execute/posix-putchar-1.a68 b/gcc/testsuite/algol68/execute/posix-putchar-1.a68 new file mode 100644 index 000000000000..01bfbbd371e2 --- /dev/null +++ b/gcc/testsuite/algol68/execute/posix-putchar-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN putchar ("X"); + putchar ("Y"); + putchar ("Z"); + puts ("\n") +END diff --git a/gcc/testsuite/algol68/execute/posix-stdinouterr-1.a68 b/gcc/testsuite/algol68/execute/posix-stdinouterr-1.a68 new file mode 100644 index 000000000000..dc5b373d9380 --- /dev/null +++ b/gcc/testsuite/algol68/execute/posix-stdinouterr-1.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (stdin = 0); + ASSERT (stdout = 1); + ASSERT (stderr = 2) +END diff --git a/gcc/testsuite/algol68/execute/posix-strerror-1.a68 b/gcc/testsuite/algol68/execute/posix-strerror-1.a68 new file mode 100644 index 000000000000..607e40d0b9da --- /dev/null +++ b/gcc/testsuite/algol68/execute/posix-strerror-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT fd = fopen ("doesn''t exist", file o default); + IF fd = -1 THEN ASSERT (strerror (errno) /= "") FI +END diff --git a/gcc/testsuite/algol68/execute/posix-stride-1.a68 b/gcc/testsuite/algol68/execute/posix-stride-1.a68 new file mode 100644 index 000000000000..6e7a79d2640d --- /dev/null +++ b/gcc/testsuite/algol68/execute/posix-stride-1.a68 @@ -0,0 +1,14 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,]CHAR matrix = (("1","H","3"), + ("4","O","6"), + ("7","M","9"), + ("8","E","0")); + []CHAR column = matrix[1:4,2]; + puts (column); + fputs (stdout, matrix[3,2:3]); + puts ("\n"); + fputs (stdout, matrix[1:3,1]); + puts ("\n"); + puts (getenv (matrix[,2])); + perror (matrix[,3]) +END diff --git a/gcc/testsuite/algol68/execute/pow-int-1.a68 b/gcc/testsuite/algol68/execute/pow-int-1.a68 new file mode 100644 index 000000000000..7d929d714ff4 --- /dev/null +++ b/gcc/testsuite/algol68/execute/pow-int-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 2; + LONG INT ii = LONG 2, LONG LONG INT iii = LONG LONG 2; + SHORT INT ss = SHORT 2, SHORT SHORT INT sss = SHORT SHORT 2; + ASSERT (i ** 2 = 4); + ASSERT (ii ** 2 = LONG 4); + ASSERT (iii ** 2 = LONG LONG 4); + ASSERT (ss ** 2 = SHORT 4); + ASSERT (sss ** 2 = SHORT SHORT 4) +END diff --git a/gcc/testsuite/algol68/execute/pow-real-1.a68 b/gcc/testsuite/algol68/execute/pow-real-1.a68 new file mode 100644 index 000000000000..810287064851 --- /dev/null +++ b/gcc/testsuite/algol68/execute/pow-real-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL r0 = 2.0; LONG REAL rr0 = LONG 2.0; LONG LONG REAL rrr0 = LONG LONG 2.0; + REAL r1 = r0 ^ 2; REAL r2 = r0 ^ 3.0; + LONG REAL rr1 = rr0 ^ LONG 2; LONG REAL rr2 = rr0 ^ LONG 3.0; + LONG LONG REAL rrr1 = rrr0 ^ LONG LONG 2; LONG LONG REAL rrr2 = rrr0 ^ LONG LONG 3.0; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/proc-1.a68 b/gcc/testsuite/algol68/execute/proc-1.a68 new file mode 100644 index 000000000000..3085f4b73607 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC foo = INT: 100; + ASSERT (foo = 100) +END diff --git a/gcc/testsuite/algol68/execute/proc-10.a68 b/gcc/testsuite/algol68/execute/proc-10.a68 new file mode 100644 index 000000000000..bcc86d851405 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-10.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC(INT,INT)INT foo = (INT i, j) INT: i + j; + ASSERT (foo (10, 20) = 30) +END diff --git a/gcc/testsuite/algol68/execute/proc-12.a68 b/gcc/testsuite/algol68/execute/proc-12.a68 new file mode 100644 index 000000000000..be75e7948db6 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-12.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC(INT)INT foo = baz; + PROC bar = (INT i) INT: i + 1; + PROC baz = (INT i) INT: i - 1; + ASSERT (foo (10) = 9) +END diff --git a/gcc/testsuite/algol68/execute/proc-13.a68 b/gcc/testsuite/algol68/execute/proc-13.a68 new file mode 100644 index 000000000000..c23c08612c95 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-13.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC is even := (INT n) BOOL: n %* 2 = 0; + ASSERT (is even (40)); + PROC no args := BOOL: TRUE; + ASSERT (no args) +END diff --git a/gcc/testsuite/algol68/execute/proc-14.a68 b/gcc/testsuite/algol68/execute/proc-14.a68 new file mode 100644 index 000000000000..b653bbe148b4 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-14.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC is even := (INT n) BOOL: n %* 2 = 0; + PROC is odd := (INT n) BOOL: n %* 2 /= 0; + PROC(INT)BOOL f = is even; + PROC(INT)BOOL g = is odd; + ASSERT (f (40)); + ASSERT (g (3)) +END diff --git a/gcc/testsuite/algol68/execute/proc-15.a68 b/gcc/testsuite/algol68/execute/proc-15.a68 new file mode 100644 index 000000000000..63c5a557704a --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-15.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +# Nested procedures. # +BEGIN PROC foo = (INT i) INT: + BEGIN PROC bar = (INT i) INT: i - 1; + bar (i) * 10 + END; + ASSERT (foo (10) = 90) +END diff --git a/gcc/testsuite/algol68/execute/proc-16.a68 b/gcc/testsuite/algol68/execute/proc-16.a68 new file mode 100644 index 000000000000..bb1b1e25d89e --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-16.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC bar = (INT i) INT: i - 1; + PROC foo = (INT i) INT: + BEGIN + bar (i) * 10 + END; + ASSERT (foo (10) = 90) +END diff --git a/gcc/testsuite/algol68/execute/proc-17.a68 b/gcc/testsuite/algol68/execute/proc-17.a68 new file mode 100644 index 000000000000..24ac5a8c5eda --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-17.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +# Identity declarations and procedures. # +BEGIN PROC foo = (INT i) INT: i + 1; + ASSERT (foo (10) = 11); + PROC(INT)INT bar = (INT i) INT: i + 1; + ASSERT (bar (10) = 11); + PROC(INT)INT baz = foo; + ASSERT (baz (10) = 11); + PROC(INT)INT quux = IF 10 > 1 THEN baz ELSE foo FI; + ASSERT (quux (10) = 11) +END diff --git a/gcc/testsuite/algol68/execute/proc-18.a68 b/gcc/testsuite/algol68/execute/proc-18.a68 new file mode 100644 index 000000000000..34568828be77 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-18.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC foo = (INT i) INT: i + 1; + PROC(INT)INT bar; + bar := foo; + ASSERT (bar (10) = 11) +END diff --git a/gcc/testsuite/algol68/execute/proc-19.a68 b/gcc/testsuite/algol68/execute/proc-19.a68 new file mode 100644 index 000000000000..0846fdca8dac --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-19.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC foo = (INT i) INT: i + 1; + PROC(INT)INT bar := foo; + ASSERT (bar (10) = 11) +END diff --git a/gcc/testsuite/algol68/execute/proc-2.a68 b/gcc/testsuite/algol68/execute/proc-2.a68 new file mode 100644 index 000000000000..39346fe35677 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# Call a non-variable procedure before declaration. # +BEGIN ASSERT (foo = 100); + PROC foo = INT: 100; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/proc-20.a68 b/gcc/testsuite/algol68/execute/proc-20.a68 new file mode 100644 index 000000000000..3bf66eea53a9 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-20.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC foo := (INT i) INT: i + 1; + PROC(INT)INT bar := foo; + ASSERT (bar (10) = 11) +END diff --git a/gcc/testsuite/algol68/execute/proc-21.a68 b/gcc/testsuite/algol68/execute/proc-21.a68 new file mode 100644 index 000000000000..c1ac9807c23a --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-21.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +# REF REF PROC # +BEGIN PROC foo = (INT i) INT: i + 1; + PROC(INT)INT bar := foo; + REF PROC(INT)INT baz; + baz := bar; + ASSERT (baz (10) = 11) +END diff --git a/gcc/testsuite/algol68/execute/proc-22.a68 b/gcc/testsuite/algol68/execute/proc-22.a68 new file mode 100644 index 000000000000..fa23d531aa51 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-22.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# REF REF PROC # +BEGIN PROC foo = (INT i) INT: i + 1; + PROC(INT)INT bar := foo; + REF PROC(INT)INT baz := bar; + ASSERT (baz (10) = 11) +END diff --git a/gcc/testsuite/algol68/execute/proc-23.a68 b/gcc/testsuite/algol68/execute/proc-23.a68 new file mode 100644 index 000000000000..7fa1257eca7a --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-23.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC increment = (INT a) INT: a + 1; + PROC getproc = PROC(INT)INT: + BEGIN increment + END; + # getproc below gets deprocedured to yield increment. # + ASSERT (getproc (10) = 11) +END diff --git a/gcc/testsuite/algol68/execute/proc-25.a68 b/gcc/testsuite/algol68/execute/proc-25.a68 new file mode 100644 index 000000000000..5b46e8914e6f --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-25.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC increment := (INT a) INT: a + 1; + PROC getproc := PROC(INT)INT: + BEGIN increment + END; + # getproc below gets deprocedured to yield increment. # + ASSERT (getproc (10) = 11) +END diff --git a/gcc/testsuite/algol68/execute/proc-26.a68 b/gcc/testsuite/algol68/execute/proc-26.a68 new file mode 100644 index 000000000000..833cbb34a4b2 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-26.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC sum = (INT a, b) INT: a + b, + minus = (INT a, b) INT: a - b; + ASSERT (sum (1, 2) = 3); + ASSERT (minus (1, 2) = -1) +END diff --git a/gcc/testsuite/algol68/execute/proc-27.a68 b/gcc/testsuite/algol68/execute/proc-27.a68 new file mode 100644 index 000000000000..49c4c6a242c7 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-27.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC reciprocal = (REAL a) REAL: 1/a; + REAL x; + x := reciprocal (3.14) +END diff --git a/gcc/testsuite/algol68/execute/proc-28.a68 b/gcc/testsuite/algol68/execute/proc-28.a68 new file mode 100644 index 000000000000..d909219d72a8 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-28.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC hcf = (INT m, n) INT: + IF m < n + THEN hcf (n, m) + ELIF n = 0 + THEN m + ELSE hcf (n, m MOD n) + FI; + ASSERT (hcf (10, 20) = 10) +END diff --git a/gcc/testsuite/algol68/execute/proc-29.a68 b/gcc/testsuite/algol68/execute/proc-29.a68 new file mode 100644 index 000000000000..51ea5fccf933 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-29.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# A heap proc variable. # +BEGIN HEAP PROC foo := INT: 666; + ASSERT (foo = 666) +END diff --git a/gcc/testsuite/algol68/execute/proc-3.a68 b/gcc/testsuite/algol68/execute/proc-3.a68 new file mode 100644 index 000000000000..bd9ce053485b --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-3.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC foo = (INT i, j) INT: i + j + 1; + ASSERT (foo (10, 11) = 22) +END diff --git a/gcc/testsuite/algol68/execute/proc-4.a68 b/gcc/testsuite/algol68/execute/proc-4.a68 new file mode 100644 index 000000000000..bce68cf3f161 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-4.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (foo (10, 11) = 22); + PROC foo = (INT i, j) INT: i + j + 1; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/proc-5.a68 b/gcc/testsuite/algol68/execute/proc-5.a68 new file mode 100644 index 000000000000..1893dc35179d --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-5.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# Recursive function. # +BEGIN PROC foo = (INT i) INT: (i > 0 | i + foo (i - 1) | 0); + ASSERT (foo (10) = 55) +END diff --git a/gcc/testsuite/algol68/execute/proc-6.a68 b/gcc/testsuite/algol68/execute/proc-6.a68 new file mode 100644 index 000000000000..894f53e05250 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-6.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# Recursive function, used before declared. # +BEGIN ASSERT (foo (10) = 55); + PROC foo = (INT i) INT: BEGIN (i > 0 | i + foo (i - 1) | 0) END; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/proc-7.a68 b/gcc/testsuite/algol68/execute/proc-7.a68 new file mode 100644 index 000000000000..9f39e2d0d043 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-7.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC foo = (INT i) INT: i + 1; + PROC(INT)INT bar = foo; + ASSERT (bar (10) = 11) +END diff --git a/gcc/testsuite/algol68/execute/proc-8.a68 b/gcc/testsuite/algol68/execute/proc-8.a68 new file mode 100644 index 000000000000..ee548c6b3745 --- /dev/null +++ b/gcc/testsuite/algol68/execute/proc-8.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC INT foo = INT: 100; + ASSERT (foo = 100) +END diff --git a/gcc/testsuite/algol68/execute/procedured-goto-1.a68 b/gcc/testsuite/algol68/execute/procedured-goto-1.a68 new file mode 100644 index 000000000000..8d3dc21c782d --- /dev/null +++ b/gcc/testsuite/algol68/execute/procedured-goto-1.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 4; +beg: WHILE i > 0 + DO []PROC VOID table = (l3,l1,l2,end); + table[i]; +l1: puts ("uno\n"); i -:= 1; beg; +l2: puts ("dos\n"); i -:= 1; beg; +l3: puts ("tres\n"); i -:= 1; beg; +end: puts ("cuatro\n"); i -:= 1; beg + OD +END diff --git a/gcc/testsuite/algol68/execute/quine.a68 b/gcc/testsuite/algol68/execute/quine.a68 new file mode 100644 index 000000000000..9fd9e422fdc1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/quine.a68 @@ -0,0 +1,2 @@ +# { dg-options "-fstropping=upper" } # +(STRING a="(STRING a="";puts(2*a[:19]+2*a[19:]);0)";puts(2*a[:19]+2*a[19:])) diff --git a/gcc/testsuite/algol68/execute/random-1.a68 b/gcc/testsuite/algol68/execute/random-1.a68 new file mode 100644 index 000000000000..82cc6e3a576b --- /dev/null +++ b/gcc/testsuite/algol68/execute/random-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN IF random > 0.5 THEN puts ("yes\n") ELSE puts ("no\n") FI; + LONG REAL rr = long random; + IF rr > LONG 0.5 THEN puts ("long yes\n") ELSE puts ("long no\n") FI; + LONG LONG REAL rrr = long long random; + IF rrr > LONG LONG 0.5 THEN puts ("long long yes\n") ELSE puts ("long long no\n") FI +END diff --git a/gcc/testsuite/algol68/execute/re-im-1.a68 b/gcc/testsuite/algol68/execute/re-im-1.a68 new file mode 100644 index 000000000000..7801b769057f --- /dev/null +++ b/gcc/testsuite/algol68/execute/re-im-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN COMPL z = 4.0I5.0; + ASSERT (RE z = 4.0 AND IM z = 5.0); + LONG COMPL zz = LONG 4.0 I LONG 6.0; + ASSERT (RE zz = LONG 4.0 AND IM zz = LONG 6.0); + LONG LONG COMPL zzz = LONG LONG 4.0 I LONG LONG 7.0; + ASSERT (RE zzz = LONG LONG 4.0 AND IM zzz = LONG LONG 7.0) +END diff --git a/gcc/testsuite/algol68/execute/rela-string-1.a68 b/gcc/testsuite/algol68/execute/rela-string-1.a68 new file mode 100644 index 000000000000..92648578dabd --- /dev/null +++ b/gcc/testsuite/algol68/execute/rela-string-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT ("" >= ""); + ASSERT ("" <= ""); + ASSERT ("zzz" > "aaa"); + ASSERT ("zzz" >= "aaa"); + ASSERT ("HelloA" < "HelloB") +END diff --git a/gcc/testsuite/algol68/execute/repr-1.a68 b/gcc/testsuite/algol68/execute/repr-1.a68 new file mode 100644 index 000000000000..2b92a3e7de01 --- /dev/null +++ b/gcc/testsuite/algol68/execute/repr-1.a68 @@ -0,0 +1,3 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (REPR ABS "x" = "x") +END diff --git a/gcc/testsuite/algol68/execute/round-1.a68 b/gcc/testsuite/algol68/execute/round-1.a68 new file mode 100644 index 000000000000..632e38223320 --- /dev/null +++ b/gcc/testsuite/algol68/execute/round-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL x = 3.14, y = 3.80; + LONG REAL xx = LONG 3.14, yy = LONG 3.80; + LONG LONG REAL xxx = LONG LONG 3.14, yyy = LONG LONG 3.80; + ASSERT (ROUND x = 3 AND ROUND y = 4); + ASSERT (ROUND xx = LONG 3 AND ROUND yy = LONG 4); + ASSERT (ROUND xxx = LONG LONG 3 AND ROUND yyy = LONG LONG 4) +END diff --git a/gcc/testsuite/algol68/execute/row-display-1.a68 b/gcc/testsuite/algol68/execute/row-display-1.a68 new file mode 100644 index 000000000000..82540d700dcc --- /dev/null +++ b/gcc/testsuite/algol68/execute/row-display-1.a68 @@ -0,0 +1,13 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []INT foo = (7,8,9); + [,]INT bar = ((1,2,3),(4,5,6),foo); + ASSERT (bar[1,1] = 1); + ASSERT (bar[1,2] = 2); + ASSERT (bar[1,3] = 3); + ASSERT (bar[2,1] = 4); + ASSERT (bar[2,2] = 5); + ASSERT (bar[2,3] = 6); + ASSERT (bar[3,1] = 7); + ASSERT (bar[3,2] = 8); + ASSERT (bar[3,3] = 9) +END diff --git a/gcc/testsuite/algol68/execute/row-display-2.a68 b/gcc/testsuite/algol68/execute/row-display-2.a68 new file mode 100644 index 000000000000..f8a07a4d162a --- /dev/null +++ b/gcc/testsuite/algol68/execute/row-display-2.a68 @@ -0,0 +1,13 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []INT foo = (7,8,9); + [3,3]INT bar := ((1,2,3),(4,5,6),foo); + ASSERT (bar[1,1] = 1); + ASSERT (bar[1,2] = 2); + ASSERT (bar[1,3] = 3); + ASSERT (bar[2,1] = 4); + ASSERT (bar[2,2] = 5); + ASSERT (bar[2,3] = 6); + ASSERT (bar[3,1] = 7); + ASSERT (bar[3,2] = 8); + ASSERT (bar[3,3] = 9) +END diff --git a/gcc/testsuite/algol68/execute/row-display-3.a68 b/gcc/testsuite/algol68/execute/row-display-3.a68 new file mode 100644 index 000000000000..73f3ff82a466 --- /dev/null +++ b/gcc/testsuite/algol68/execute/row-display-3.a68 @@ -0,0 +1,15 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE FOO = STRUCT (INT i, STRING s); + [,]FOO matrix = (((10, "foo"), (20, "bar"), (30, "baz")), + ((40, "uno"), (50, "dos"), (60, "tres")), + ((70, "cuatro"), (80, "cinco"), (90, "seis"))); + ASSERT (i OF matrix[1,1] = 10); + ASSERT (i OF matrix[1,2] = 20); + ASSERT (i OF matrix[1,3] = 30); + ASSERT (i OF matrix[2,1] = 40); + ASSERT (i OF matrix[2,2] = 50); + ASSERT (i OF matrix[2,3] = 60); + ASSERT (i OF matrix[3,1] = 70); + ASSERT (i OF matrix[3,2] = 80); + ASSERT (i OF matrix[3,3] = 90) +END diff --git a/gcc/testsuite/algol68/execute/row-display-4.a68 b/gcc/testsuite/algol68/execute/row-display-4.a68 new file mode 100644 index 000000000000..464d6fb48e78 --- /dev/null +++ b/gcc/testsuite/algol68/execute/row-display-4.a68 @@ -0,0 +1,16 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,][]INT duples = (((1,2), (3,4), (5,6)), + ((7,8), (9,10), (11,12))); + ASSERT (duples[1,1][1] = 1); + ASSERT (duples[1,1][2] = 2); + ASSERT (duples[1,2][1] = 3); + ASSERT (duples[1,2][2] = 4); + ASSERT (duples[1,3][1] = 5); + ASSERT (duples[1,3][2] = 6); + ASSERT (duples[2,1][1] = 7); + ASSERT (duples[2,1][2] = 8); + ASSERT (duples[2,2][1] = 9); + ASSERT (duples[2,2][2] = 10); + ASSERT (duples[2,3][1] = 11); + ASSERT (duples[2,3][2] = 12) +END diff --git a/gcc/testsuite/algol68/execute/row-display-5.a68 b/gcc/testsuite/algol68/execute/row-display-5.a68 new file mode 100644 index 000000000000..9d6b34bd0f73 --- /dev/null +++ b/gcc/testsuite/algol68/execute/row-display-5.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []INT list1 = (1,2,3), + list2 = (4,5,6), + list3 = (7,8,9); + [,]INT matrix = (list1, list2, list3); + [,,]INT cube = (matrix, matrix, matrix); + ASSERT (cube[1,1,1] = 1); + ASSERT (cube[2,2,2] = 5); + ASSERT (cube[3,3,3] = 9) +END diff --git a/gcc/testsuite/algol68/execute/rowing-1.a68 b/gcc/testsuite/algol68/execute/rowing-1.a68 new file mode 100644 index 000000000000..792b7afbb849 --- /dev/null +++ b/gcc/testsuite/algol68/execute/rowing-1.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []INT a = 10; + ASSERT (LWB a = 1 AND UPB a = 1 AND ELEMS a = 1); + ASSERT (a[1] = 10) +END diff --git a/gcc/testsuite/algol68/execute/rowing-10.a68 b/gcc/testsuite/algol68/execute/rowing-10.a68 new file mode 100644 index 000000000000..8ae0caae95de --- /dev/null +++ b/gcc/testsuite/algol68/execute/rowing-10.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 10; + REF[,]INT a = i; + ASSERT (1 LWB a = 1 AND 1 UPB a = 1 AND 1 ELEMS a = 1); + ASSERT (2 LWB a = 1 AND 2 UPB a = 1 AND 2 ELEMS a = 1); + a[1,1] := a[1,1] + 1; + ASSERT (a[1,1] = 11) +END diff --git a/gcc/testsuite/algol68/execute/rowing-11.a68 b/gcc/testsuite/algol68/execute/rowing-11.a68 new file mode 100644 index 000000000000..c34342cf2d42 --- /dev/null +++ b/gcc/testsuite/algol68/execute/rowing-11.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 10; + REF[,,]INT a = i; + ASSERT (1 LWB a = 1 AND 1 UPB a = 1 AND 1 ELEMS a = 1); + ASSERT (2 LWB a = 1 AND 2 UPB a = 1 AND 2 ELEMS a = 1); + ASSERT (3 LWB a = 1 AND 3 UPB a = 1 AND 3 ELEMS a = 1); + a[1,1,1] := a[1,1,1] + 1; + ASSERT (a[1,1,1] = 11) +END diff --git a/gcc/testsuite/algol68/execute/rowing-12.a68 b/gcc/testsuite/algol68/execute/rowing-12.a68 new file mode 100644 index 000000000000..d0bb7b4d7d3d --- /dev/null +++ b/gcc/testsuite/algol68/execute/rowing-12.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# Rowing of NIL yields NIL. # +BEGIN REF INT i = NIL; + REF[]INT a = i; + ASSERT (a :=: NIL) +END diff --git a/gcc/testsuite/algol68/execute/rowing-13.a68 b/gcc/testsuite/algol68/execute/rowing-13.a68 new file mode 100644 index 000000000000..9ac2517b3b1c --- /dev/null +++ b/gcc/testsuite/algol68/execute/rowing-13.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# Rowing of NIL yields NIL. # +BEGIN REF INT i = (NIL); + REF[,,]INT a = (i); + ASSERT (a :=: NIL) +END diff --git a/gcc/testsuite/algol68/execute/rowing-2.a68 b/gcc/testsuite/algol68/execute/rowing-2.a68 new file mode 100644 index 000000000000..d8c66deaa5ee --- /dev/null +++ b/gcc/testsuite/algol68/execute/rowing-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [][]INT a = 10; + ASSERT (a[1][1] = 10); + ASSERT (LWB a = 1 AND UPB a = 1 AND ELEMS a = 1); + ASSERT (LWB a[1] = 1 AND UPB a[1] = 1 AND ELEMS a[1] = 1) +END diff --git a/gcc/testsuite/algol68/execute/rowing-3.a68 b/gcc/testsuite/algol68/execute/rowing-3.a68 new file mode 100644 index 000000000000..bfb8fd30af4c --- /dev/null +++ b/gcc/testsuite/algol68/execute/rowing-3.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [][][]INT a = 10; + ASSERT (a[1][1][1] = 10); + ASSERT (LWB a = 1 AND UPB a = 1 AND ELEMS a = 1); + ASSERT (LWB a[1] = 1 AND UPB a[1] = 1 AND ELEMS a[1] = 1); + ASSERT (LWB a[1][1] = 1 AND UPB a[1][1] = 1 AND ELEMS a[1][1] = 1) +END diff --git a/gcc/testsuite/algol68/execute/rowing-4.a68 b/gcc/testsuite/algol68/execute/rowing-4.a68 new file mode 100644 index 000000000000..0dd540d28d7d --- /dev/null +++ b/gcc/testsuite/algol68/execute/rowing-4.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE FOO = STRUCT (INT i, REAL r); + FOO foo = (10, 3.14); + [][]FOO a = foo; + ASSERT (LWB a = 1 AND UPB a = 1 AND ELEMS a = 1); + ASSERT (LWB a[1] = 1 AND UPB a[1] = 1 AND ELEMS a[1] = 1); + ASSERT (i OF a[1][1] = 10) +END diff --git a/gcc/testsuite/algol68/execute/rowing-5.a68 b/gcc/testsuite/algol68/execute/rowing-5.a68 new file mode 100644 index 000000000000..2172617b640b --- /dev/null +++ b/gcc/testsuite/algol68/execute/rowing-5.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +# Rowing of a name. # +BEGIN INT i := 10; + REF[]INT a = i; + ASSERT (LWB a = 1 AND UPB a = 1 AND ELEMS a = 1); + a[1] := a[1] + 1; + ASSERT (a[1] = 11) +END diff --git a/gcc/testsuite/algol68/execute/rowing-6.a68 b/gcc/testsuite/algol68/execute/rowing-6.a68 new file mode 100644 index 000000000000..9fb050ab5863 --- /dev/null +++ b/gcc/testsuite/algol68/execute/rowing-6.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# Rowing of NIL yields NIL. # +BEGIN REF[]INT a = REF INT(NIL); + ASSERT (a :=: NIL) +END diff --git a/gcc/testsuite/algol68/execute/rowing-7.a68 b/gcc/testsuite/algol68/execute/rowing-7.a68 new file mode 100644 index 000000000000..dde8392f253e --- /dev/null +++ b/gcc/testsuite/algol68/execute/rowing-7.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,]INT a = 10; + ASSERT (1 LWB a = 1 AND 1 UPB a = 1 AND 1 ELEMS a = 1); + ASSERT (2 LWB a = 1 AND 2 UPB a = 1 AND 2 ELEMS a = 1); + ASSERT (a[1,1] = 10) +END diff --git a/gcc/testsuite/algol68/execute/rowing-8.a68 b/gcc/testsuite/algol68/execute/rowing-8.a68 new file mode 100644 index 000000000000..069ee3e21c96 --- /dev/null +++ b/gcc/testsuite/algol68/execute/rowing-8.a68 @@ -0,0 +1,12 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []INT a = 10; + ASSERT (1 LWB a = 1 AND 1 UPB a = 1 AND 1 ELEMS a = 1); + [,]INT aa = a; + ASSERT (1 LWB aa = 1 AND 1 UPB aa = 1 AND 1 ELEMS aa = 1); + ASSERT (2 LWB aa = 1 AND 2 UPB aa = 1 AND 2 ELEMS aa = 1); + [,,]INT aaa = aa; + ASSERT (1 LWB aaa = 1 AND 1 UPB aaa = 1 AND 1 ELEMS aaa = 1); + ASSERT (2 LWB aaa = 1 AND 2 UPB aaa = 1 AND 2 ELEMS aaa = 1); + ASSERT (3 LWB aaa = 1 AND 3 UPB aaa = 1 AND 3 ELEMS aaa = 1); + ASSERT (aaa[1,1,1] = 10) +END diff --git a/gcc/testsuite/algol68/execute/rowing-9.a68 b/gcc/testsuite/algol68/execute/rowing-9.a68 new file mode 100644 index 000000000000..5e347216d30d --- /dev/null +++ b/gcc/testsuite/algol68/execute/rowing-9.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,,]INT aaa = 10; + ASSERT (1 LWB aaa = 1 AND 1 UPB aaa = 1 AND 1 ELEMS aaa = 1); + ASSERT (2 LWB aaa = 1 AND 2 UPB aaa = 1 AND 2 ELEMS aaa = 1); + ASSERT (3 LWB aaa = 1 AND 3 UPB aaa = 1 AND 3 ELEMS aaa = 1); + ASSERT (aaa[1,1,1] = 10) +END diff --git a/gcc/testsuite/algol68/execute/selection-1.a68 b/gcc/testsuite/algol68/execute/selection-1.a68 new file mode 100644 index 000000000000..c7087b2eeab5 --- /dev/null +++ b/gcc/testsuite/algol68/execute/selection-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# Selecting a struct results in a sub-value. # +BEGIN MODE PERSON = STRUCT (INT age, REAL income, INT num children); + PERSON person = (44, 999.99, 0); + ASSERT (age OF person = 44); + ASSERT (num children OF person = 0) +END diff --git a/gcc/testsuite/algol68/execute/selection-2.a68 b/gcc/testsuite/algol68/execute/selection-2.a68 new file mode 100644 index 000000000000..0d7b6c6730b5 --- /dev/null +++ b/gcc/testsuite/algol68/execute/selection-2.a68 @@ -0,0 +1,14 @@ +# { dg-options "-fstropping=upper" } # +# Selecting a struct name results in sub-names. # +BEGIN MODE PERSON = STRUCT (INT age, REAL income, INT num children); + PERSON person; + age OF person := 44; + income OF person := 999.99; + num children OF person := 0; + ASSERT (age OF person = 44); + ASSERT (num children OF person = 0); + REF INT ptr to age := age OF person; + ASSERT (ptr to age = 44); + age OF person := 55; + ASSERT (ptr to age = 55) +END diff --git a/gcc/testsuite/algol68/execute/selection-3.a68 b/gcc/testsuite/algol68/execute/selection-3.a68 new file mode 100644 index 000000000000..8648003ad23b --- /dev/null +++ b/gcc/testsuite/algol68/execute/selection-3.a68 @@ -0,0 +1,12 @@ +# { dg-options "-fstropping=upper" } # +# Structs can be nested in other structs. # +BEGIN MODE INCOME = STRUCT (REAL salary, stock, INT code); + MODE PERSON = STRUCT (INT age, INCOME income, INT num children); + + PERSON person = (44, (999.99, 0.0, 10), 3); + + ASSERT (age OF person = 44); + ASSERT (code OF income OF person = 10); + ASSERT (num children OF person = 3); + ASSERT (num children OF person * code OF income OF person = 30) +END diff --git a/gcc/testsuite/algol68/execute/selection-4.a68 b/gcc/testsuite/algol68/execute/selection-4.a68 new file mode 100644 index 000000000000..9e81db222c1a --- /dev/null +++ b/gcc/testsuite/algol68/execute/selection-4.a68 @@ -0,0 +1,19 @@ +# { dg-options "-fstropping=upper" } # +# Structs can be nested in other structs. Version with subnames. # +BEGIN MODE INCOME = STRUCT (REAL salary, stock, INT code); + MODE PERSON = STRUCT (INT age, INCOME income, INT num children); + + PERSON person; + + age OF person := 44; + salary OF income OF person := 999.99; + stock OF income OF person := 0.0; + num children OF person := 3; + code OF income OF person := num children OF person; + + ASSERT (age OF person = 44); + ASSERT (code OF income OF person = num children OF person); + ASSERT (code OF income OF person = 3); + ASSERT (num children OF person = 3); + ASSERT (num children OF person * code OF income OF person = 9) +END diff --git a/gcc/testsuite/algol68/execute/selection-5.a68 b/gcc/testsuite/algol68/execute/selection-5.a68 new file mode 100644 index 000000000000..fde72d53ade5 --- /dev/null +++ b/gcc/testsuite/algol68/execute/selection-5.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# pr UPPER pr # +BEGIN MODE JORL = STRUCT (INT i, REAL r); + REF JORL jorl = LOC JORL := (10, 3.14); + ASSERT (i OF jorl = 10) +END diff --git a/gcc/testsuite/algol68/execute/selection-multiple-1.a68 b/gcc/testsuite/algol68/execute/selection-multiple-1.a68 new file mode 100644 index 000000000000..1dc67eae28e3 --- /dev/null +++ b/gcc/testsuite/algol68/execute/selection-multiple-1.a68 @@ -0,0 +1,12 @@ +begin [10]struct (int age, string name) persons; + + for i to UPB persons + do age of persons[i] := 20 + i; + name of persons[i] := "x" * i + od; + + for i to UPB name of persons + do assert ((age of persons)[i] = 20 + i); + assert ((name of persons)[i] = "x" * i) + od +end diff --git a/gcc/testsuite/algol68/execute/selection-multiple-2.a68 b/gcc/testsuite/algol68/execute/selection-multiple-2.a68 new file mode 100644 index 000000000000..89f848df60b2 --- /dev/null +++ b/gcc/testsuite/algol68/execute/selection-multiple-2.a68 @@ -0,0 +1,18 @@ +begin [10,5]struct (int age, string name) persons; + + for i to 1 UPB persons + do for j to 2 UPB persons + do age of persons[i,j] := 20 + i + j; + name of persons[i,j] := "x" * (i + j) + od + od; + + assert (1 UPB name of persons = 10); + assert (2 UPB name of persons = 5); + for i to 1 UPB name of persons + do for j to 2 UPB name of persons + do assert ((age of persons)[i,j] = 20 + i + j); + assert ((name of persons)[i,j] = "x" * (i + j)) + od + od +end diff --git a/gcc/testsuite/algol68/execute/serial-clause-1.a68 b/gcc/testsuite/algol68/execute/serial-clause-1.a68 new file mode 100644 index 000000000000..7253f3f4af15 --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-clause-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 10; + BEGIN INT i = 20; # { dg-warning "hides" } # + ASSERT (i = 20); + i + END; + ASSERT (i = 10) +END diff --git a/gcc/testsuite/algol68/execute/serial-clause-10.a68 b/gcc/testsuite/algol68/execute/serial-clause-10.a68 new file mode 100644 index 000000000000..294fc6c7295e --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-clause-10.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# NIL is not voided and can appear in a context requiring VOID. # +BEGIN (NIL); + SKIP +END diff --git a/gcc/testsuite/algol68/execute/serial-clause-2.a68 b/gcc/testsuite/algol68/execute/serial-clause-2.a68 new file mode 100644 index 000000000000..e333c5c22319 --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-clause-2.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN BEGIN ASSERT (i = 0); + i + END; + INT i = 10; + ASSERT (i = 10) +END diff --git a/gcc/testsuite/algol68/execute/serial-clause-3.a68 b/gcc/testsuite/algol68/execute/serial-clause-3.a68 new file mode 100644 index 000000000000..821c4dc9a79d --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-clause-3.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (i = 0); + INT i = 10; + ASSERT (i = 10) +END diff --git a/gcc/testsuite/algol68/execute/serial-clause-4.a68 b/gcc/testsuite/algol68/execute/serial-clause-4.a68 new file mode 100644 index 000000000000..2a03f65a8a1c --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-clause-4.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i := 10; + BEGIN ASSERT (i = 10); + i +:= 1 + END; + ASSERT (i = 11) +END diff --git a/gcc/testsuite/algol68/execute/serial-clause-5.a68 b/gcc/testsuite/algol68/execute/serial-clause-5.a68 new file mode 100644 index 000000000000..89ab26e38f91 --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-clause-5.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN BEGIN ASSERT (i = 0); + i + END; + INT i := 10; + ASSERT (i = 10) +END diff --git a/gcc/testsuite/algol68/execute/serial-clause-6.a68 b/gcc/testsuite/algol68/execute/serial-clause-6.a68 new file mode 100644 index 000000000000..13a132f404c3 --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-clause-6.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT ((INT y := 10; + INT x := 20; + REF INT yy; + (REF INT xx := x; + yy := y; + xx := yy + ) + ) = 10) +END diff --git a/gcc/testsuite/algol68/execute/serial-clause-7.a68 b/gcc/testsuite/algol68/execute/serial-clause-7.a68 new file mode 100644 index 000000000000..a33da4adea44 --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-clause-7.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT ((INT y := 10; + INT x := 20; + REF INT yy; + (REF INT xx := x; + yy := y; + xx + yy + ) + ) = 30) +END diff --git a/gcc/testsuite/algol68/execute/serial-clause-8.a68 b/gcc/testsuite/algol68/execute/serial-clause-8.a68 new file mode 100644 index 000000000000..9d32e85285c3 --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-clause-8.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT ((INT y := 10; + INT x := 20; + REF INT yy; + (REF INT xx := x; + yy := y; + xx + ) + ) = 20) +END diff --git a/gcc/testsuite/algol68/execute/serial-clause-9.a68 b/gcc/testsuite/algol68/execute/serial-clause-9.a68 new file mode 100644 index 000000000000..d8fe7c4d40d9 --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-clause-9.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +# Serial clause with jump at the end. # + +BEGIN INT i := BEGIN BOOL cont := TRUE; + back: cont := FALSE; + IF cont THEN GOTO back FI + END; + ASSERT (i = 0) +END diff --git a/gcc/testsuite/algol68/execute/serial-dsa-1.a68 b/gcc/testsuite/algol68/execute/serial-dsa-1.a68 new file mode 100644 index 000000000000..b27ad8c7793a --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-dsa-1.a68 @@ -0,0 +1,18 @@ +{ This tests stack management for DSA serial clauses. + If it fails a stack overflow happens. } +begin { DSA due to stack allocated multiple. } + to 10000 + do [10000]int foo; + skip + od; + { DSA due to stack allocated multiple. Explicit loc. } + to 10000 + do loc[10000]int foo; + skip + od; + { DSA due to loc generator. } + to 10000 + do ref[]int jorl = loc [10000]int; + skip + od +end diff --git a/gcc/testsuite/algol68/execute/serial-dsa-2.a68 b/gcc/testsuite/algol68/execute/serial-dsa-2.a68 new file mode 100644 index 000000000000..ca8594d29c86 --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-dsa-2.a68 @@ -0,0 +1,6 @@ +{ Check value yielding of DSA serial clauses. } +begin assert ((ref int foo = loc int := 100; + foo) = 100); + []int a = ([10000]int foo; foo[10] := 666; foo); + assert (a[10] = 666) +end diff --git a/gcc/testsuite/algol68/execute/serial-dsa-3.a68 b/gcc/testsuite/algol68/execute/serial-dsa-3.a68 new file mode 100644 index 000000000000..7cb96dde3c6c --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-dsa-3.a68 @@ -0,0 +1,12 @@ +{ The jump to leak should not leak stack. } +begin by 10000 + do + by 10000 + do [10000]int foo; + skip; + goto leak + od; + leak: + skip + od +end diff --git a/gcc/testsuite/algol68/execute/serial-dsa-4.a68 b/gcc/testsuite/algol68/execute/serial-dsa-4.a68 new file mode 100644 index 000000000000..b132af8ba1de --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-dsa-4.a68 @@ -0,0 +1,4 @@ +begin (ref int a = loc int := 10; goto leak; a); +leak: + skip +end diff --git a/gcc/testsuite/algol68/execute/serial-dsa-5.a68 b/gcc/testsuite/algol68/execute/serial-dsa-5.a68 new file mode 100644 index 000000000000..fb57d5ef1e54 --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-dsa-5.a68 @@ -0,0 +1,3 @@ +begin assert ((ref int a = loc int := 10; a) + 1 = 11); + skip +end diff --git a/gcc/testsuite/algol68/execute/serial-dsa-6.a68 b/gcc/testsuite/algol68/execute/serial-dsa-6.a68 new file mode 100644 index 000000000000..fb17d2d64428 --- /dev/null +++ b/gcc/testsuite/algol68/execute/serial-dsa-6.a68 @@ -0,0 +1,4 @@ +{ DSA and completers in a serial clause. } +begin assert ((ref int a = loc int := 10; a exit foo: a +:= 1) + 1 = 11); + skip +end diff --git a/gcc/testsuite/algol68/execute/sign-int-1.a68 b/gcc/testsuite/algol68/execute/sign-int-1.a68 new file mode 100644 index 000000000000..3c6d317e0634 --- /dev/null +++ b/gcc/testsuite/algol68/execute/sign-int-1.a68 @@ -0,0 +1,28 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT zero = 0; + SHORT INT short zero = SHORT 0; + SHORT SHORT INT short short zero = SHORT SHORT 0; + LONG INT long zero = LONG 0; + LONG LONG INT long long zero = LONG LONG 0; + INT ten = 10; + SHORT INT short ten = SHORT 10; + SHORT SHORT INT short short ten = SHORT SHORT 10; + LONG INT long ten = LONG 10; + LONG LONG INT long long ten = LONG LONG 10; + ASSERT (SIGN zero = 0); + ASSERT (SIGN short zero = 0); + ASSERT (SIGN short short zero = 0); + ASSERT (SIGN long zero = 0); + ASSERT (SIGN long long zero = 0); + ASSERT (SIGN ten = 1); + ASSERT (SIGN short ten = 1); + ASSERT (SIGN short short ten = 1); + ASSERT (SIGN long ten = 1); + ASSERT (SIGN long long ten = 1); + ASSERT (SIGN -ten = -1); + ASSERT (SIGN -short ten = -1); + ASSERT (SIGN -short short ten = -1); + ASSERT (SIGN -long ten = -1); + ASSERT (SIGN -long long ten = -1) +END + diff --git a/gcc/testsuite/algol68/execute/sign-real-1.a68 b/gcc/testsuite/algol68/execute/sign-real-1.a68 new file mode 100644 index 000000000000..f15fe963c23e --- /dev/null +++ b/gcc/testsuite/algol68/execute/sign-real-1.a68 @@ -0,0 +1,17 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL zero = 0.0; + LONG REAL long zero = LONG 0.0; + LONG LONG REAL long long zero = LONG LONG 0.0; + REAL ten = 10.0; + LONG REAL long ten = LONG 10.0; + LONG LONG REAL long long ten = LONG LONG 10.0; + ASSERT (SIGN zero = 0); + ASSERT (SIGN long zero = 0); + ASSERT (SIGN long long zero = 0); + ASSERT (SIGN ten = 1); + ASSERT (SIGN long ten = 1); + ASSERT (SIGN long long ten = 1); + ASSERT (SIGN -ten = -1); + ASSERT (SIGN -long ten = -1); + ASSERT (SIGN -long long ten = -1) +END diff --git a/gcc/testsuite/algol68/execute/sin-1.a68 b/gcc/testsuite/algol68/execute/sin-1.a68 new file mode 100644 index 000000000000..aac74f98b02f --- /dev/null +++ b/gcc/testsuite/algol68/execute/sin-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL r = 0.0; + LONG REAL rr = LONG 45.0; + LONG LONG REAL rrr = LONG LONG 60.0; + ASSERT (sin (r) = 0.0); + long sin (rr); + long long sin (rrr) +END diff --git a/gcc/testsuite/algol68/execute/skip-1.a68 b/gcc/testsuite/algol68/execute/skip-1.a68 new file mode 100644 index 000000000000..a36de4ff6a4d --- /dev/null +++ b/gcc/testsuite/algol68/execute/skip-1.a68 @@ -0,0 +1,13 @@ +# { dg-options "-fstropping=upper" } # +# Check SKIPs for INT modes # +BEGIN INT int skip = SKIP; + ASSERT (int skip = 0); + SHORT INT short int skip = SKIP; + ASSERT (short int skip = SHORT 0); + SHORT SHORT INT short short int skip = SKIP; + ASSERT (short short int skip = SHORT SHORT 0); + LONG INT long int skip = SKIP; + ASSERT (long int skip = LONG 0); + LONG LONG INT long long int skip = SKIP; + ASSERT (long long int skip = LONG LONG 0) +END diff --git a/gcc/testsuite/algol68/execute/skip-2.a68 b/gcc/testsuite/algol68/execute/skip-2.a68 new file mode 100644 index 000000000000..5cefe400b9c3 --- /dev/null +++ b/gcc/testsuite/algol68/execute/skip-2.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# Check SKIP values for BOOL and CHAR. # +BEGIN BOOL bool skip = SKIP; + ASSERT (bool skip = FALSE); + CHAR char skip = SKIP; + ASSERT (char skip = " ") +END diff --git a/gcc/testsuite/algol68/execute/skip-struct-1.a68 b/gcc/testsuite/algol68/execute/skip-struct-1.a68 new file mode 100644 index 000000000000..72e9a1137e6e --- /dev/null +++ b/gcc/testsuite/algol68/execute/skip-struct-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE INCOME = STRUCT (REAL salary, stock, INT jorl); + MODE PERSON = STRUCT (INT age, INCOME income, INT num children); + PERSON person = SKIP; + ASSERT (age OF person = 0); + ASSERT (jorl OF income OF person = 0) +END diff --git a/gcc/testsuite/algol68/execute/slice-indexing-1.a68 b/gcc/testsuite/algol68/execute/slice-indexing-1.a68 new file mode 100644 index 000000000000..53d14fa982fe --- /dev/null +++ b/gcc/testsuite/algol68/execute/slice-indexing-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRING foo = "foo"; + ASSERT (foo[1] = "f"); + ASSERT (foo[2] = "o"); + ASSERT (foo[3] = "o"); + STRING bar := "foo"; + ASSERT (bar[1] = "f"); + ASSERT (bar[2] = "o"); + ASSERT (bar[3] = "o") +END diff --git a/gcc/testsuite/algol68/execute/slice-indexing-2.a68 b/gcc/testsuite/algol68/execute/slice-indexing-2.a68 new file mode 100644 index 000000000000..defb675d3a32 --- /dev/null +++ b/gcc/testsuite/algol68/execute/slice-indexing-2.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []INT foo = (1,2,3); + ASSERT (foo[1] = 1); + ASSERT (foo[2] = 2); + ASSERT (foo[3] = 3); + [3]INT bar := (1,2,3); + ASSERT (bar[1] = 1); + ASSERT (bar[2] = 2); + ASSERT (bar[3] = 3) +END diff --git a/gcc/testsuite/algol68/execute/slice-indexing-3.a68 b/gcc/testsuite/algol68/execute/slice-indexing-3.a68 new file mode 100644 index 000000000000..593bd71766eb --- /dev/null +++ b/gcc/testsuite/algol68/execute/slice-indexing-3.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []INT foo = (10,20,30); + ASSERT (foo[1] = 10); + ASSERT (foo[2] = 20); + ASSERT (foo[3] = 30); + [3]INT bar := (100,200,300); + ASSERT (bar[1] = 100); + ASSERT (bar[2] = 200); + ASSERT (bar[3] = 300) +END diff --git a/gcc/testsuite/algol68/execute/slice-indexing-4.a68 b/gcc/testsuite/algol68/execute/slice-indexing-4.a68 new file mode 100644 index 000000000000..bf3a3b18d70e --- /dev/null +++ b/gcc/testsuite/algol68/execute/slice-indexing-4.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE PERSON = STRUCT (INT i, STRING s); + []PERSON persons = ((10, "foo"), (20, "barbar"), (30, "baz")); + puts (s OF persons[1]); + puts (s OF persons[2]); + puts (s OF persons[3]); + ASSERT (i OF persons[1] = 10); + ASSERT (i OF persons[2] = 20); + ASSERT (i OF persons[3] = 30) +END diff --git a/gcc/testsuite/algol68/execute/slice-indexing-5.a68 b/gcc/testsuite/algol68/execute/slice-indexing-5.a68 new file mode 100644 index 000000000000..f236eeffd155 --- /dev/null +++ b/gcc/testsuite/algol68/execute/slice-indexing-5.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRUCT([]INT i, REAL r) s = ((1,2,3), 3.14); + ASSERT ((i OF s)[1] = 1) +END diff --git a/gcc/testsuite/algol68/execute/slice-indexing-6.a68 b/gcc/testsuite/algol68/execute/slice-indexing-6.a68 new file mode 100644 index 000000000000..8d795560deed --- /dev/null +++ b/gcc/testsuite/algol68/execute/slice-indexing-6.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT rsp := 5; + [10]INT run stack; + run stack [(rsp -:= 1) + 1] +END diff --git a/gcc/testsuite/algol68/execute/slice-indexing-7.a68 b/gcc/testsuite/algol68/execute/slice-indexing-7.a68 new file mode 100644 index 000000000000..d3870f6119f9 --- /dev/null +++ b/gcc/testsuite/algol68/execute/slice-indexing-7.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRING s := "foo"; + s[2] := "x" +END diff --git a/gcc/testsuite/algol68/execute/sqrt-1.a68 b/gcc/testsuite/algol68/execute/sqrt-1.a68 new file mode 100644 index 000000000000..725a7727112e --- /dev/null +++ b/gcc/testsuite/algol68/execute/sqrt-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL r = 100.0; + LONG REAL rr = LONG 25.0; + LONG LONG REAL rrr = LONG LONG 25.0; + ASSERT (sqrt (r) = 10.0); + ASSERT (long sqrt (rr) = LONG 5.0); + ASSERT (long long sqrt (rrr) = LONG LONG 5.0) +END diff --git a/gcc/testsuite/algol68/execute/string-1.a68 b/gcc/testsuite/algol68/execute/string-1.a68 new file mode 100644 index 000000000000..28e44fe18fef --- /dev/null +++ b/gcc/testsuite/algol68/execute/string-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRING s = ""; + ASSERT (LWB s = 1 AND UPB s = 0); + STRING t = (); + ASSERT (LWB t = 1 AND UPB t = 0) +END diff --git a/gcc/testsuite/algol68/execute/string-2.a68 b/gcc/testsuite/algol68/execute/string-2.a68 new file mode 100644 index 000000000000..b0b898a51ef1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/string-2.a68 @@ -0,0 +1,13 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRING s; + ASSERT (LWB s = 1 AND UPB s = 0 AND ELEMS s = 0); + s := "foo"; + puts (s); + ASSERT (LWB s = 1 AND UPB s = 3 AND s[1] = "f" AND s[2] = "o" AND s[3] = "o"); + s := "bar"; + puts (s); + ASSERT (LWB s = 1 AND UPB s = 3 AND s[1] = "b" AND s[2] = "a" AND s[3] = "r"); + s := "x"; + ASSERT (LWB s = 1 AND UPB s = 1 AND s[1] = "x"); + puts (s) +END diff --git a/gcc/testsuite/algol68/execute/string-4.a68 b/gcc/testsuite/algol68/execute/string-4.a68 new file mode 100644 index 000000000000..984d6625d909 --- /dev/null +++ b/gcc/testsuite/algol68/execute/string-4.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRING s; + ASSERT (LWB s = 1 AND UPB s = 0 AND ELEMS s = 0); + s +:= "foo"; + ASSERT (LWB s = 1 AND UPB s = 3 AND ELEMS s = 3) +END diff --git a/gcc/testsuite/algol68/execute/string-break-1.a68 b/gcc/testsuite/algol68/execute/string-break-1.a68 new file mode 100644 index 000000000000..e99cfe9ebad4 --- /dev/null +++ b/gcc/testsuite/algol68/execute/string-break-1.a68 @@ -0,0 +1,8 @@ +begin assert (UPB "foo'nbar" = 7 AND "foo'nbar"[4] = REPR 10); + assert (UPB "foo'tbar" = 7 AND "foo'tbar"[4] = REPR 9); + assert (UPB "foo'rbar" = 7 AND "foo'rbar"[4] = REPR 13); + assert (UPB "foo'fbar" = 7 AND "foo'fbar"[4] = REPR 12); + assert (UPB "foo''bar" = 7 AND "foo''bar"[4] = REPR 39); + assert ("'(u0048,u0065,U0000006c,u006c,U0000006f)" = "Hello"); + assert ("'( u0048, u0065, U0000006c,u006c, U0000006f )" = "Hello") +end diff --git a/gcc/testsuite/algol68/execute/struct-self-1.a68 b/gcc/testsuite/algol68/execute/struct-self-1.a68 new file mode 100644 index 000000000000..94622aaecd27 --- /dev/null +++ b/gcc/testsuite/algol68/execute/struct-self-1.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE NODE = STRUCT (INT code, REF NODE next); + NODE top; + ASSERT (next OF top :=: REF NODE (NIL)) +END diff --git a/gcc/testsuite/algol68/execute/struct-self-2.a68 b/gcc/testsuite/algol68/execute/struct-self-2.a68 new file mode 100644 index 000000000000..a1127ebf3b8a --- /dev/null +++ b/gcc/testsuite/algol68/execute/struct-self-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE NODE = STRUCT (INT code, REF NODE next); + NODE top = (20, NIL); + ASSERT (code OF top = 20); + ASSERT (next OF top :=: NIL) +END diff --git a/gcc/testsuite/algol68/execute/struct-self-3.a68 b/gcc/testsuite/algol68/execute/struct-self-3.a68 new file mode 100644 index 000000000000..3829daf68481 --- /dev/null +++ b/gcc/testsuite/algol68/execute/struct-self-3.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE NODE = STRUCT (INT code, REF NODE next); + NODE top := (10, NIL); + NODE next := (20, NIL); + next OF top := next; + ASSERT (code OF next OF top = 20) +END diff --git a/gcc/testsuite/algol68/execute/structure-display-1.a68 b/gcc/testsuite/algol68/execute/structure-display-1.a68 new file mode 100644 index 000000000000..a53c247e1af1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/structure-display-1.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE INCOME = STRUCT (REAL salary, stock, INT code); + MODE PERSON = STRUCT (INT age, INCOME income, INT num children); + INCOME income = (100.0, 200.0, 300); + ASSERT (code OF income = 300); + PERSON person := (24, (1000.0, 2000.0, 3000), 3); + ASSERT (code OF income OF person = 3000); + ASSERT (num children OF person = 3) +END diff --git a/gcc/testsuite/algol68/execute/structure-display-2.a68 b/gcc/testsuite/algol68/execute/structure-display-2.a68 new file mode 100644 index 000000000000..563f979e3218 --- /dev/null +++ b/gcc/testsuite/algol68/execute/structure-display-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE NODE = STRUCT (INT code, REF INT next); + INT val := 20; + NODE top = (10, val); + ASSERT (val = 20) +END diff --git a/gcc/testsuite/algol68/execute/structure-display-3.a68 b/gcc/testsuite/algol68/execute/structure-display-3.a68 new file mode 100644 index 000000000000..178463f60dc8 --- /dev/null +++ b/gcc/testsuite/algol68/execute/structure-display-3.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE FOO = STRUCT (INT i, REF INT j); + INT x := 10; + FOO foo; + foo := (10, x); + ASSERT (j OF foo = 10) +END diff --git a/gcc/testsuite/algol68/execute/structure-display-4.a68 b/gcc/testsuite/algol68/execute/structure-display-4.a68 new file mode 100644 index 000000000000..2a69172b8805 --- /dev/null +++ b/gcc/testsuite/algol68/execute/structure-display-4.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE FOO = STRUCT (INT i, REF INT j); + INT x := 10; + REF INT xx; + FOO foo; + foo := (10, xx := x); + ASSERT (j OF foo = 10) +END diff --git a/gcc/testsuite/algol68/execute/structure-display-5.a68 b/gcc/testsuite/algol68/execute/structure-display-5.a68 new file mode 100644 index 000000000000..0b99113f160c --- /dev/null +++ b/gcc/testsuite/algol68/execute/structure-display-5.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE VEC = STRUCT (REAL xcoord, ycoord, zcoord); + VEC v1, v2, v3; + v1 := (1,1,1); + ASSERT (xcoord OF v1 = 1); + ASSERT (ycoord OF v1 = 1); + ASSERT (zcoord OF v1 = 1); + REAL x = 3.14, i = 3; + v2 := (x + 2, 3.4, i - 3) +END diff --git a/gcc/testsuite/algol68/execute/tan-1.a68 b/gcc/testsuite/algol68/execute/tan-1.a68 new file mode 100644 index 000000000000..a7aede697498 --- /dev/null +++ b/gcc/testsuite/algol68/execute/tan-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL r = 0.0; + LONG REAL rr = LONG 50.0; + LONG LONG REAL rrr = LONG LONG 50.0; + ASSERT (tan (r) = 0.0); + long tan (rr); + long long tan (rrr) +END diff --git a/gcc/testsuite/algol68/execute/timesab-string-1.a68 b/gcc/testsuite/algol68/execute/timesab-string-1.a68 new file mode 100644 index 000000000000..3ff48fe91f53 --- /dev/null +++ b/gcc/testsuite/algol68/execute/timesab-string-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRING foo := "foo"; + foo TIMESAB 1; + ASSERT (foo = "foo"); + foo *:= 3; + ASSERT (foo = "foofoofoo") +END diff --git a/gcc/testsuite/algol68/execute/trimmer-1.a68 b/gcc/testsuite/algol68/execute/trimmer-1.a68 new file mode 100644 index 000000000000..feae4cefb786 --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [2:4]INT arr := []INT(1,2,3)[@2]; + ASSERT (arr[3] = 2 AND arr[4] = 3); + []INT jorl = arr[2:3@20]; + ASSERT (LWB jorl = 20 AND UPB jorl = 21); + ASSERT (jorl[20] = 1 AND jorl [21] = 2) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-10.a68 b/gcc/testsuite/algol68/execute/trimmer-10.a68 new file mode 100644 index 000000000000..66db83af5fb6 --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-10.a68 @@ -0,0 +1,14 @@ +# { dg-options "-fstropping=upper" } # +# Trimming with flat descriptors should lead to flat multiples. # +BEGIN []INT a = (1,2,3); + + ASSERT (UPB a[2:1] < LWB a[2:1]); + ASSERT (UPB a[20:2] < LWB a[20:2]); + + [,]INT aa = ((1,2,3), + (4,5,6), + (7,8,9)); + + ASSERT ((1 UPB aa[1,2:1]) < ((1 LWB aa[1,2:1]))); + ASSERT ((1 UPB aa[1,20:]) < ((1 LWB aa[1,20:]))) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-2.a68 b/gcc/testsuite/algol68/execute/trimmer-2.a68 new file mode 100644 index 000000000000..68996d22bc16 --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-2.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [2:4]INT arr := []INT(1,2,3)[@2]; + ASSERT (arr[3] = 2 AND arr[4] = 3); + []INT jorl = arr[2:3]; + ASSERT (LWB jorl = 1 AND UPB jorl = 2); + ASSERT (jorl[1] = 1 AND jorl [2] = 2) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-3.a68 b/gcc/testsuite/algol68/execute/trimmer-3.a68 new file mode 100644 index 000000000000..8af69db6b8df --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-3.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [2:4]INT arr := []INT(1,2,3)[@2]; + ASSERT (arr[3] = 2 AND arr[4] = 3); + []INT jorl = arr[:@20]; + ASSERT (LWB jorl = 20 AND UPB jorl = 22); + ASSERT (jorl[20] = 1 AND jorl[21] = 2 AND jorl[22] = 3) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-4.a68 b/gcc/testsuite/algol68/execute/trimmer-4.a68 new file mode 100644 index 000000000000..fdcd37094d68 --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-4.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [2:4]INT arr := []INT(1,2,3)[@2]; + ASSERT (arr[3] = 2 AND arr[4] = 3); + []INT jorl = arr[3:]; + ASSERT (LWB jorl = 1 AND UPB jorl = 2); + ASSERT (jorl[1] = 2 AND jorl[2] = 3) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-5.a68 b/gcc/testsuite/algol68/execute/trimmer-5.a68 new file mode 100644 index 000000000000..892fea7d2697 --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-5.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [2:4]INT arr := []INT(1,2,3)[@2]; + ASSERT (arr[3] = 2 AND arr[4] = 3); + []INT jorl = arr[:3 AT 10]; + ASSERT (LWB jorl = 10 AND UPB jorl = 11); + ASSERT (jorl[10] = 1 AND jorl[11] = 2) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-6.a68 b/gcc/testsuite/algol68/execute/trimmer-6.a68 new file mode 100644 index 000000000000..3e9f293e0159 --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-6.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [2:4]INT arr := []INT(1,2,3)[@2]; + ASSERT (arr[3] = 2 AND arr[4] = 3); + []INT jorl = arr[:3@10]; + ASSERT (LWB jorl = 10 AND UPB jorl = 11); + ASSERT (jorl[10] = 1 AND jorl[11] = 2) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-7.a68 b/gcc/testsuite/algol68/execute/trimmer-7.a68 new file mode 100644 index 000000000000..8d3ebf9293f1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-7.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []INT arr = (1,2,3); + ASSERT (arr[2] = 2 AND arr[3] = 3); + []INT jorl = arr[2:3@20]; + ASSERT (LWB jorl = 20 AND UPB jorl = 21); + ASSERT (jorl[20] = 2 AND jorl [21] = 3) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-8.a68 b/gcc/testsuite/algol68/execute/trimmer-8.a68 new file mode 100644 index 000000000000..50842efb27e6 --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-8.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [2:4]INT arr := []INT(1,2,3)[@2]; + ASSERT (arr[3] = 2 AND arr[4] = 3); + [10:11]INT jorl := arr[:3 AT 10]; + ASSERT (LWB jorl = 10 AND UPB jorl = 11); + ASSERT (jorl[10] = 1 AND jorl[11] = 2); + jorl[10] := 100; + ASSERT (jorl[10] = 100 AND jorl[11] = 2) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-9.a68 b/gcc/testsuite/algol68/execute/trimmer-9.a68 new file mode 100644 index 000000000000..aa0d52d2a086 --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-9.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []INT arr = (1,2,3); + ASSERT (arr[2] = 2 AND arr[3] = 3); + []INT jorl = arr[@20]; + ASSERT (LWB jorl = 20 AND UPB jorl = 22); + ASSERT (jorl[20] = 1 AND jorl [21] = 2 AND jorl [22] = 3) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-matrix-1.a68 b/gcc/testsuite/algol68/execute/trimmer-matrix-1.a68 new file mode 100644 index 000000000000..2cec8a858e71 --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-matrix-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,]INT matrix = ((1,2,3), + (4,5,6), + (7,8,9)); + [2]INT column := matrix[3,2:3]; + ASSERT (column[1] = 8); + ASSERT (column[2] = 9) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-matrix-2.a68 b/gcc/testsuite/algol68/execute/trimmer-matrix-2.a68 new file mode 100644 index 000000000000..6ca961fe1be6 --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-matrix-2.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,]INT matrix = ((1,2,3), + (4,5,6), + (7,8,9)); + [2]INT column := matrix[2,1:2]; + ASSERT (column[1] = 4); + ASSERT (column[2] = 5) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-matrix-3.a68 b/gcc/testsuite/algol68/execute/trimmer-matrix-3.a68 new file mode 100644 index 000000000000..5de2bee3a37b --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-matrix-3.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,]INT matrix = ((1,2,3), + (4,5,6), + (7,8,9)); + [3]INT column := matrix[2,1:3]; + ASSERT (column[1] = 4); + ASSERT (column[2] = 5); + ASSERT (column[3] = 6) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-matrix-4.a68 b/gcc/testsuite/algol68/execute/trimmer-matrix-4.a68 new file mode 100644 index 000000000000..71168ad6df84 --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-matrix-4.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,]INT matrix = ((1,2,3), + (4,5,6), + (7,8,9)); + []INT column = matrix[1:3,2]; + ASSERT (LWB column = 1); + ASSERT (UPB column = 3); + ASSERT (column[1] = 2 AND column[2] = 5 AND column[3] = 8) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-matrix-5.a68 b/gcc/testsuite/algol68/execute/trimmer-matrix-5.a68 new file mode 100644 index 000000000000..6d5f69bc53ea --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-matrix-5.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,]INT matrix = ((1,2,3), + (4,5,6), + (7,8,9)); + []INT column = matrix[2:3,2]; + ASSERT (LWB column = 1); + ASSERT (UPB column = 2); + ASSERT (column[1] = 5 AND column[2] = 8) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-matrix-6.a68 b/gcc/testsuite/algol68/execute/trimmer-matrix-6.a68 new file mode 100644 index 000000000000..59a33896bf61 --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-matrix-6.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [,]INT matrix = ((1,2,3), + (4,5,6), + (7,8,9)); + []INT row = matrix[3,1:3]; + ASSERT (LWB row = 1); + ASSERT (UPB row = 3); + ASSERT (row[1] = 7 AND row[2] = 8 AND row[3] = 9) +END diff --git a/gcc/testsuite/algol68/execute/trimmer-name-1.a68 b/gcc/testsuite/algol68/execute/trimmer-name-1.a68 new file mode 100644 index 000000000000..6b4601c64c73 --- /dev/null +++ b/gcc/testsuite/algol68/execute/trimmer-name-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REF[]CHAR t; + PROC foo = VOID: (HEAP[3]CHAR ss := ("1","2","3"); t := ss[1:3]); + foo; + ASSERT (LWB t = 1 AND UPB t = 3); + ASSERT (t[1] = "1" AND t[2] = "2" AND t[3] = "3") +END diff --git a/gcc/testsuite/algol68/execute/undefined-1.a68 b/gcc/testsuite/algol68/execute/undefined-1.a68 new file mode 100644 index 000000000000..af97a0c0e837 --- /dev/null +++ b/gcc/testsuite/algol68/execute/undefined-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +# j's value is undefined (defined to be 0 in GNU Algol) # +BEGIN INT x := 0; + FOR i TO 5 + DO ASSERT (j = 0); + IF j > 20 THEN stop FI; + INT j = x + i; + x +:= 1 + OD +END diff --git a/gcc/testsuite/algol68/execute/undefined-2.a68 b/gcc/testsuite/algol68/execute/undefined-2.a68 new file mode 100644 index 000000000000..54addde1fd00 --- /dev/null +++ b/gcc/testsuite/algol68/execute/undefined-2.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +# The undefined value of the multiple `a' is an empty multiple. # +BEGIN ASSERT (i = 0); + ASSERT (LWB a = 1 AND UPB a = 0 AND ELEMS a = 0); + []INT a = (1, 2, 3); + INT i = 10; + ASSERT (i = 10); + ASSERT (LWB a = 1 AND UPB a = 3 AND ELEMS a = 3) +END diff --git a/gcc/testsuite/algol68/execute/undefined-3.a68 b/gcc/testsuite/algol68/execute/undefined-3.a68 new file mode 100644 index 000000000000..2a746ad7eb44 --- /dev/null +++ b/gcc/testsuite/algol68/execute/undefined-3.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (sum = 1); + PROC sum = INT: i + 1; + INT i = 10; + ASSERT (sum = 11) +END diff --git a/gcc/testsuite/algol68/execute/undefined-4.a68 b/gcc/testsuite/algol68/execute/undefined-4.a68 new file mode 100644 index 000000000000..c602c052bfc8 --- /dev/null +++ b/gcc/testsuite/algol68/execute/undefined-4.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC is even = (INT n) BOOL: (n = zero | TRUE | is odd (n - 1)); + PROC is odd = (INT n) BOOL: (n = zero | FALSE | is even (n - 1)); + ASSERT (is even (20)); + ASSERT (is odd (13)); + INT zero := 0; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/undefined-5.a68 b/gcc/testsuite/algol68/execute/undefined-5.a68 new file mode 100644 index 000000000000..3cbb41416d27 --- /dev/null +++ b/gcc/testsuite/algol68/execute/undefined-5.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC is even = (INT n) BOOL: (n = zero | TRUE | is odd (DECR n)); + PROC is odd = (INT n) BOOL: (n = zero | FALSE | is even (DECR n)); + OP DECR = (INT a) INT: a - 1; + ASSERT (is even (20)); + ASSERT (is odd (13)); + INT zero := 0; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/uniting-1.a68 b/gcc/testsuite/algol68/execute/uniting-1.a68 new file mode 100644 index 000000000000..dee0b50b282f --- /dev/null +++ b/gcc/testsuite/algol68/execute/uniting-1.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +BEGIN UNION(INT,REAL,CHAR) datum := 3.14; + UNION(INT,REAL,[]INT,CHAR) datux; + datux := datum; + ASSERT (CASE datux + IN (INT): 10, + (REAL): 20, + (CHAR c): 30 + ESAC = 20); + SKIP +END diff --git a/gcc/testsuite/algol68/execute/uniting-2.a68 b/gcc/testsuite/algol68/execute/uniting-2.a68 new file mode 100644 index 000000000000..565005010e31 --- /dev/null +++ b/gcc/testsuite/algol68/execute/uniting-2.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +BEGIN UNION(INT,REAL,CHAR) datum := "X"; + UNION(INT,REAL,[]INT,CHAR) datux; + datux := datum; + ASSERT (CASE datux + IN (INT): 10, + (REAL): 20, + (CHAR c): 30 + ESAC = 30); + SKIP +END diff --git a/gcc/testsuite/algol68/execute/uniting-3.a68 b/gcc/testsuite/algol68/execute/uniting-3.a68 new file mode 100644 index 000000000000..cb73c2f85317 --- /dev/null +++ b/gcc/testsuite/algol68/execute/uniting-3.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +BEGIN UNION(INT,REAL,CHAR) datum := 10; + UNION(INT,REAL,[]INT,CHAR) datux; + datux := datum; + ASSERT (CASE datux + IN (INT): 10, + (REAL): 20, + (CHAR c): 30 + ESAC = 10); + SKIP +END diff --git a/gcc/testsuite/algol68/execute/uniting-4.a68 b/gcc/testsuite/algol68/execute/uniting-4.a68 new file mode 100644 index 000000000000..c7b82b8310c4 --- /dev/null +++ b/gcc/testsuite/algol68/execute/uniting-4.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# Uniting STRING to ROWS. # +BEGIN PROC strlen = (STRING s) INT: ELEMS s; + ASSERT (strlen ("foo") = 3) +END diff --git a/gcc/testsuite/algol68/execute/up-down-bits-1.a68 b/gcc/testsuite/algol68/execute/up-down-bits-1.a68 new file mode 100644 index 000000000000..b13c05599e58 --- /dev/null +++ b/gcc/testsuite/algol68/execute/up-down-bits-1.a68 @@ -0,0 +1,33 @@ +# { dg-options "-fstropping=upper" } # +# SHORTEN and LENG on SIZETY BITS # +BEGIN BITS b = 16rff; + ASSERT (b UP 4 = 16rff0); + ASSERT (b SHL 4 = 16rff0); + ASSERT (b DOWN 4 = 16r0f); + ASSERT (b SHR 4 = 16r0f); + + LONG BITS bb = LONG 16rff; + ASSERT (bb UP 4 = LONG 16rff0); + ASSERT (bb SHL 4 = LONG 16rff0); + ASSERT (bb DOWN 4 = LONG 16r0f); + ASSERT (bb SHR 4 = LONG 16r0f); + + LONG LONG BITS bbb = LONG LONG 16rff; + ASSERT (bbb UP 4 = LONG LONG 16rff0); + ASSERT (bbb SHL 4 = LONG LONG 16rff0); + ASSERT (bbb DOWN 4 = LONG LONG 16r0f); + ASSERT (bbb SHR 4 = LONG LONG 16r0f); + + SHORT BITS ss = SHORT 16rff; + ASSERT (ss UP 4 = SHORT 16rff0); + ASSERT (ss SHL 4 = SHORT 16rff0); + ASSERT (ss DOWN 4 = SHORT 16r0f); + ASSERT (ss SHR 4 = SHORT 16r0f); + + SHORT SHORT BITS sss = SHORT SHORT 16r0f; + ASSERT (sss UP 4 = SHORT SHORT 16rf0); + ASSERT (sss SHL 4 = SHORT SHORT 16rf0); + ASSERT (sss DOWN 2 = SHORT SHORT 16r03); + ASSERT (sss SHR 2 = SHORT SHORT 16r03) +END + diff --git a/gcc/testsuite/algol68/execute/upb-1.a68 b/gcc/testsuite/algol68/execute/upb-1.a68 new file mode 100644 index 000000000000..d74ffa5b33b6 --- /dev/null +++ b/gcc/testsuite/algol68/execute/upb-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN ASSERT (UPB "foo" = 3); + ASSERT (1 UPB "foo" = 3); + ASSERT (UPB "" = 0); + ASSERT ((INT i = 1; UPB "") = 0) +END diff --git a/gcc/testsuite/algol68/execute/vacuum-1.a68 b/gcc/testsuite/algol68/execute/vacuum-1.a68 new file mode 100644 index 000000000000..c4472c53c1fe --- /dev/null +++ b/gcc/testsuite/algol68/execute/vacuum-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []INT a = (); + ASSERT (LWB a = 1 AND UPB a = 0) +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-1.a68 b/gcc/testsuite/algol68/execute/variable-declaration-1.a68 new file mode 100644 index 000000000000..0b1f4fce83b6 --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-1.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 10; + REF INT xx := x := 20; + ASSERT (xx = 20) +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-2.a68 b/gcc/testsuite/algol68/execute/variable-declaration-2.a68 new file mode 100644 index 000000000000..6b80f7b82147 --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-2.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 10; + REF INT xx := x; + ASSERT (xx = 10) +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-3.a68 b/gcc/testsuite/algol68/execute/variable-declaration-3.a68 new file mode 100644 index 000000000000..4b1f08023475 --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-3.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 10; + REF INT xx := (x := 20); + ASSERT (xx = 20) +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-4.a68 b/gcc/testsuite/algol68/execute/variable-declaration-4.a68 new file mode 100644 index 000000000000..0c66d9e1fb0d --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-4.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 10; + REF INT xx := ((x)); + ASSERT (xx = 10) +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-5.a68 b/gcc/testsuite/algol68/execute/variable-declaration-5.a68 new file mode 100644 index 000000000000..993bbe7c1fcf --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-5.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT x := 10; + REF REF INT xx := LOC REF INT := x := 20; + ASSERT (xx = 20) +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-6.a68 b/gcc/testsuite/algol68/execute/variable-declaration-6.a68 new file mode 100644 index 000000000000..4f8b1c37ec2a --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-6.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN MODE FOO = STRUCT (STRING s, INT i); + FOO f1 := ("foo", 10); + ASSERT (i OF f1 = 10) +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-heap-1.a68 b/gcc/testsuite/algol68/execute/variable-declaration-heap-1.a68 new file mode 100644 index 000000000000..e7b40a19a99d --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-heap-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN HEAP INT a := 10; + ASSERT (a = 10) +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-heap-2.a68 b/gcc/testsuite/algol68/execute/variable-declaration-heap-2.a68 new file mode 100644 index 000000000000..406e8c570d61 --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-heap-2.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN HEAP INT x, y; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-multiple-1.a68 b/gcc/testsuite/algol68/execute/variable-declaration-multiple-1.a68 new file mode 100644 index 000000000000..17864f9293f8 --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-multiple-1.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [10,3]INT arr; + ASSERT (1 LWB arr = 1 AND 1 UPB arr = 10 AND 1 ELEMS arr = 10); + ASSERT (2 LWB arr = 1 AND 2 UPB arr = 3 AND 2 ELEMS arr = 3) +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-multiple-2.a68 b/gcc/testsuite/algol68/execute/variable-declaration-multiple-2.a68 new file mode 100644 index 000000000000..d400ee87dfd5 --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-multiple-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT n = 10; + [n,3]INT arr; + ASSERT (1 LWB arr = 1 AND 1 UPB arr = 10 AND 1 ELEMS arr = 10); + ASSERT (2 LWB arr = 1 AND 2 UPB arr = 3 AND 2 ELEMS arr = 3) +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-multiple-3.a68 b/gcc/testsuite/algol68/execute/variable-declaration-multiple-3.a68 new file mode 100644 index 000000000000..a006feddce5c --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-multiple-3.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT n := 10, m := 3; + [n,m]INT arr; + ASSERT (1 LWB arr = 1 AND 1 UPB arr = 10 AND 1 ELEMS arr = 10); + ASSERT (2 LWB arr = 1 AND 2 UPB arr = 3 AND 2 ELEMS arr = 3) +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-multiple-4.a68 b/gcc/testsuite/algol68/execute/variable-declaration-multiple-4.a68 new file mode 100644 index 000000000000..8e0467b965f1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-multiple-4.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT n := -4, m := 0; + [n:m,2]INT arr; + ASSERT (1 LWB arr = -4 AND 1 UPB arr = 0 AND 1 ELEMS arr = 5); + ASSERT (2 LWB arr = 1 AND 2 UPB arr = 2 AND 2 ELEMS arr = 2) +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-multiple-5.a68 b/gcc/testsuite/algol68/execute/variable-declaration-multiple-5.a68 new file mode 100644 index 000000000000..0a1889f55cc9 --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-multiple-5.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT n := -4, m := 0; + [n:m,2]INT arr; + FOR i FROM 1 LWB arr TO 1 UPB arr + DO FOR j FROM 2 LWB arr TO 2 UPB arr + DO ASSERT (arr[i,j] = INT(SKIP)) OD + OD +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-multiple-6.a68 b/gcc/testsuite/algol68/execute/variable-declaration-multiple-6.a68 new file mode 100644 index 000000000000..3dde91c5ffc2 --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-multiple-6.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT n := -4, m := 0; + [n:m,2]REF INT arr; + FOR i FROM 1 LWB arr TO 1 UPB arr + DO FOR j FROM 2 LWB arr TO 2 UPB arr + DO ASSERT (REF INT (arr[i,j]) :=: REF INT(SKIP)) OD + OD +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-multiple-7.a68 b/gcc/testsuite/algol68/execute/variable-declaration-multiple-7.a68 new file mode 100644 index 000000000000..75ee9a4516f3 --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-multiple-7.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT n := 2, m := 3; + [n][m]INT arr; + FOR i FROM LWB arr TO UPB arr + DO FOR j FROM LWB arr[i] TO UPB arr[i] + DO ASSERT (arr[i][j] = INT(SKIP)) OD + OD +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-multiple-8.a68 b/gcc/testsuite/algol68/execute/variable-declaration-multiple-8.a68 new file mode 100644 index 000000000000..391d282a9cbb --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-multiple-8.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT n := -4, m := 0; + [10][n:m,2]INT arr; + FOR k FROM LWB arr TO UPB arr + DO FOR i FROM 1 LWB arr[k] TO 1 UPB arr[k] + DO FOR j FROM 2 LWB arr[k] TO 2 UPB arr[k] + DO ASSERT (arr[k][i,j] = INT(SKIP)) OD + OD + OD +END diff --git a/gcc/testsuite/algol68/execute/variable-declaration-multiple-9.a68 b/gcc/testsuite/algol68/execute/variable-declaration-multiple-9.a68 new file mode 100644 index 000000000000..21c20eaed2bd --- /dev/null +++ b/gcc/testsuite/algol68/execute/variable-declaration-multiple-9.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [4]INT x, y; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/voiding-1.a68 b/gcc/testsuite/algol68/execute/voiding-1.a68 new file mode 100644 index 000000000000..ec6088d88fef --- /dev/null +++ b/gcc/testsuite/algol68/execute/voiding-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i; + 2 = i +END diff --git a/gcc/testsuite/algol68/execute/widening-1.a68 b/gcc/testsuite/algol68/execute/widening-1.a68 new file mode 100644 index 000000000000..642b226926e0 --- /dev/null +++ b/gcc/testsuite/algol68/execute/widening-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT i = 10; + REAL foo = i; + ASSERT (foo > 9.9); + ASSERT (foo < 10.1) +END diff --git a/gcc/testsuite/algol68/execute/widening-2.a68 b/gcc/testsuite/algol68/execute/widening-2.a68 new file mode 100644 index 000000000000..9ac6aae53967 --- /dev/null +++ b/gcc/testsuite/algol68/execute/widening-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN LONG INT i = LONG 10; + LONG REAL foo = i; + ASSERT (foo > LONG 9.9); + ASSERT (foo < LONG 10.1) +END diff --git a/gcc/testsuite/algol68/execute/widening-bits-1.a68 b/gcc/testsuite/algol68/execute/widening-bits-1.a68 new file mode 100644 index 000000000000..6940a23cb36e --- /dev/null +++ b/gcc/testsuite/algol68/execute/widening-bits-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# XXX use environment enquiry for actual size of BITS # +BEGIN []BOOL foo = 16rffff; + ASSERT (LWB foo = 1 AND UPB foo = 32); + FOR i TO 16 DO ASSERT (foo[i] = FALSE) OD; + FOR i FROM 17 TO 32 DO ASSERT (foo[i] = TRUE) OD +END diff --git a/gcc/testsuite/algol68/execute/widening-bits-2.a68 b/gcc/testsuite/algol68/execute/widening-bits-2.a68 new file mode 100644 index 000000000000..ea47b7051b10 --- /dev/null +++ b/gcc/testsuite/algol68/execute/widening-bits-2.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# XXX use environment enquiry for actual size of LONG BITS # +BEGIN []BOOL foo = LONG 16rffffffff; + ASSERT (LWB foo = 1 AND UPB foo = 64); + FOR i TO 32 DO ASSERT (foo[i] = FALSE) OD; + FOR i FROM 33 TO 64 DO ASSERT (foo[i] = TRUE) OD +END diff --git a/gcc/testsuite/algol68/execute/widening-bits-3.a68 b/gcc/testsuite/algol68/execute/widening-bits-3.a68 new file mode 100644 index 000000000000..61e49da41e4c --- /dev/null +++ b/gcc/testsuite/algol68/execute/widening-bits-3.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# XXX use environment enquiry for actual size of LONG LONG BITS # +BEGIN []BOOL foo = LONG LONG 16rffffffff; + ASSERT (LWB foo = 1 AND UPB foo = 64); + FOR i TO 32 DO ASSERT (foo[i] = FALSE) OD; + FOR i FROM 33 TO 64 DO ASSERT (foo[i] = TRUE) OD +END diff --git a/gcc/testsuite/algol68/execute/xor-bits-1.a68 b/gcc/testsuite/algol68/execute/xor-bits-1.a68 new file mode 100644 index 000000000000..beeafb592fb6 --- /dev/null +++ b/gcc/testsuite/algol68/execute/xor-bits-1.a68 @@ -0,0 +1,18 @@ +# { dg-options "-fstropping=upper" } # +# XOR for SIZETY BITS. # +BEGIN BITS b = 16rf0f0; + ASSERT ((b XOR 16r0f0f) = 16rffff); + ASSERT ((b XOR 16r00ff) = 16rf00f); + LONG BITS bb = LONG 16rf0f0; + ASSERT ((bb XOR LONG 16r0f0f) = LONG 16rffff); + ASSERT ((bb XOR LONG 16r00ff) = LONG 16rf00f); + LONG LONG BITS bbb = LONG LONG 16rf0f0; + ASSERT ((bbb XOR LONG LONG 16r0f0f) = LONG LONG 16rffff); + ASSERT ((bbb XOR LONG LONG 16r00ff) = LONG LONG 16rf00f); + SHORT BITS ss = SHORT 16rf0f0; + ASSERT ((ss XOR SHORT 16r0f0f) = SHORT 16rffff); + ASSERT ((ss XOR SHORT 16r00ff) = SHORT 16rf00f); + SHORT SHORT BITS sss = SHORT SHORT 16rf0; + ASSERT ((sss XOR SHORT SHORT 16r0f) = SHORT SHORT 16rff); + ASSERT ((sss XOR SHORT SHORT 16rff) = SHORT SHORT 16r0f) +END From 623d5a03bd40c61296aee19874554fa8774cb821 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:57:40 +0200 Subject: [PATCH 180/373] a68: testsuite: compilation tests Signed-off-by: Jose E. Marchesi gcc/testsuite/ChangeLog * algol68/compile/a68includes/goodbye-supper.a68 * algol68/compile/a68includes/goodbye.a68: Likewise. * algol68/compile/a68includes/hello-supper.a68: Likewise. * algol68/compile/a68includes/hello.a68: Likewise. * algol68/compile/actual-bounds-expected-1.a68: Likewise. * algol68/compile/actual-bounds-expected-2.a68: Likewise. * algol68/compile/actual-bounds-expected-3.a68: Likewise. * algol68/compile/balancing-1.a68: Likewise. * algol68/compile/bold-nestable-comment-1.a68: Likewise. * algol68/compile/bold-taggle-1.a68: Likewise. * algol68/compile/brief-nestable-comment-1.a68: Likewise. * algol68/compile/brief-nestable-comment-2.a68: Likewise. * algol68/compile/char-break-1.a68: Likewise. * algol68/compile/compile.exp: Likewise. * algol68/compile/conditional-clause-1.a68: Likewise. * algol68/compile/error-bold-taggle-1.a68: Likewise. * algol68/compile/error-coercion-1.a68: Likewise. * algol68/compile/error-coercion-2.a68: Likewise. * algol68/compile/error-coercion-flex-1.a68: Likewise. * algol68/compile/error-conformance-clause-1.a68: Likewise. * algol68/compile/error-contraction-1.a68: Likewise. * algol68/compile/error-contraction-2.a68: Likewise. * algol68/compile/error-incestuous-union-1.a68: Likewise. * algol68/compile/error-label-after-decl-1.a68: Likewise. * algol68/compile/error-nestable-comments-1.a68: Likewise. * algol68/compile/error-nested-comment-1.a68: Likewise. * algol68/compile/error-no-bounds-allowed-1.a68: Likewise. * algol68/compile/error-string-break-1.a68: Likewise. * algol68/compile/error-string-break-2.a68: Likewise. * algol68/compile/error-string-break-3.a68: Likewise. * algol68/compile/error-string-break-4.a68: Likewise. * algol68/compile/error-string-break-5.a68: Likewise. * algol68/compile/error-string-break-6.a68: Likewise. * algol68/compile/error-string-break-7.a68: Likewise. * algol68/compile/error-supper-1.a68: Likewise. * algol68/compile/error-supper-2.a68: Likewise. * algol68/compile/error-supper-3.a68: Likewise. * algol68/compile/error-supper-4.a68: Likewise. * algol68/compile/error-supper-5.a68: Likewise. * algol68/compile/error-supper-6.a68: Likewise. * algol68/compile/error-underscore-in-mode-1.a68: Likewise. * algol68/compile/error-underscore-in-tag-1.a68: Likewise. * algol68/compile/error-upper-1.a68: Likewise. * algol68/compile/error-widening-1.a68: Likewise. * algol68/compile/error-widening-2.a68: Likewise. * algol68/compile/error-widening-3.a68: Likewise. * algol68/compile/error-widening-4.a68: Likewise. * algol68/compile/error-widening-5.a68: Likewise. * algol68/compile/error-widening-6.a68: Likewise. * algol68/compile/error-widening-7.a68: Likewise. * algol68/compile/error-widening-8.a68: Likewise. * algol68/compile/error-widening-9.a68: Likewise. * algol68/compile/hidden-operators-1.a68: Likewise. * algol68/compile/implicit-widening-1.a68: Likewise. * algol68/compile/include-supper.a68: Likewise. * algol68/compile/include.a68: Likewise. * algol68/compile/labeled-unit-1.a68: Likewise. * algol68/compile/nested-comment-1.a68: Likewise. * algol68/compile/nested-comment-2.a68: Likewise. * algol68/compile/operators-firmly-related.a68: Likewise. * algol68/compile/recursive-modes-1.a68: Likewise. * algol68/compile/recursive-modes-2.a68: Likewise. * algol68/compile/serial-clause-jump-1.a68: Likewise. * algol68/compile/snobol.a68: Likewise. * algol68/compile/supper-1.a68: Likewise. * algol68/compile/supper-10.a68: Likewise. * algol68/compile/supper-11.a68: Likewise. * algol68/compile/supper-12.a68: Likewise. * algol68/compile/supper-13.a68: Likewise. * algol68/compile/supper-2.a68: Likewise. * algol68/compile/supper-3.a68: Likewise. * algol68/compile/supper-4.a68: Likewise. * algol68/compile/supper-5.a68: Likewise. * algol68/compile/supper-6.a68: Likewise. * algol68/compile/supper-7.a68: Likewise. * algol68/compile/supper-8.a68: Likewise. * algol68/compile/supper-9.a68: Likewise. * algol68/compile/uniting-1.a68: Likewise. * algol68/compile/upper-1.a68: Likewise. * algol68/compile/warning-scope-1.a68: Likewise. * algol68/compile/warning-scope-2.a68: Likewise. * algol68/compile/warning-scope-3.a68: Likewise. * algol68/compile/warning-scope-4.a68: Likewise. * algol68/compile/warning-scope-5.a68: Likewise. * algol68/compile/warning-scope-6.a68: Likewise. * algol68/compile/warning-scope-7.a68: Likewise. * algol68/compile/warning-voiding-1.a68: Likewise. * algol68/compile/warning-voiding-2.a68: Likewise. --- .../compile/a68includes/goodbye-supper.a68 | 4 + .../algol68/compile/a68includes/goodbye.a68 | 8 + .../compile/a68includes/hello-supper.a68 | 5 + .../algol68/compile/a68includes/hello.a68 | 8 + .../compile/actual-bounds-expected-1.a68 | 4 + .../compile/actual-bounds-expected-2.a68 | 4 + .../compile/actual-bounds-expected-3.a68 | 6 + gcc/testsuite/algol68/compile/balancing-1.a68 | 7 + .../compile/bold-nestable-comment-1.a68 | 7 + .../algol68/compile/bold-taggle-1.a68 | 6 + .../compile/brief-nestable-comment-1.a68 | 4 + .../compile/brief-nestable-comment-2.a68 | 6 + .../algol68/compile/char-break-1.a68 | 11 + gcc/testsuite/algol68/compile/compile.exp | 34 + .../algol68/compile/conditional-clause-1.a68 | 9 + .../algol68/compile/error-bold-taggle-1.a68 | 6 + .../algol68/compile/error-coercion-1.a68 | 5 + .../algol68/compile/error-coercion-2.a68 | 6 + .../algol68/compile/error-coercion-flex-1.a68 | 8 + .../compile/error-compile-unknown-tag-1.a68 | 8 + .../compile/error-conformance-clause-1.a68 | 8 + .../algol68/compile/error-contraction-1.a68 | 6 + .../algol68/compile/error-contraction-2.a68 | 8 + gcc/testsuite/algol68/compile/error-def-1.a68 | 3 + .../compile/error-incestuous-union-1.a68 | 8 + .../compile/error-label-after-decl-1.a68 | 8 + .../compile/error-mode-stropping-1.a68 | 3 + .../compile/error-mode-stropping-10.a68 | 3 + .../compile/error-mode-stropping-11.a68 | 4 + .../compile/error-mode-stropping-12.a68 | 3 + .../compile/error-mode-stropping-13.a68 | 4 + .../compile/error-mode-stropping-14.a68 | 3 + .../compile/error-mode-stropping-15.a68 | 4 + .../compile/error-mode-stropping-16.a68 | 3 + .../compile/error-mode-stropping-17.a68 | 4 + .../compile/error-mode-stropping-2.a68 | 4 + .../compile/error-mode-stropping-3.a68 | 3 + .../compile/error-mode-stropping-4.a68 | 4 + .../compile/error-mode-stropping-5.a68 | 3 + .../compile/error-mode-stropping-6.a68 | 4 + .../compile/error-mode-stropping-8.a68 | 3 + .../compile/error-mode-stropping-9.a68 | 4 + .../compile/error-module-coercions-1.a68 | 15 + .../compile/error-module-not-found-1.a68 | 4 + .../algol68/compile/error-module-ranges-1.a68 | 13 + .../compile/error-nestable-comments-1.a68 | 9 + .../compile/error-nested-comment-1.a68 | 6 + .../compile/error-no-bounds-allowed-1.a68 | 15 + .../algol68/compile/error-pragmat-1.a68 | 8 + .../compile/error-pragmat-access-1.a68 | 8 + .../compile/error-pragmat-access-2.a68 | 9 + .../algol68/compile/error-pub-loc-1.a68 | 10 + .../compile/error-pub-out-of-def-1.a68 | 13 + .../compile/error-pub-out-of-def-2.a68 | 9 + .../algol68/compile/error-string-break-1.a68 | 4 + .../algol68/compile/error-string-break-2.a68 | 2 + .../algol68/compile/error-string-break-3.a68 | 2 + .../algol68/compile/error-string-break-4.a68 | 2 + .../algol68/compile/error-string-break-5.a68 | 2 + .../algol68/compile/error-string-break-6.a68 | 2 + .../algol68/compile/error-string-break-7.a68 | 2 + .../algol68/compile/error-string-break-8.a68 | 4 + .../algol68/compile/error-stropping-5.a68 | 3 + .../algol68/compile/error-stropping-6.a68 | 4 + .../compile/error-stropping-keyword-1.a68 | 2 + .../compile/error-stropping-keyword-2.a68 | 3 + .../compile/error-stropping-keyword-3.a68 | 2 + .../compile/error-stropping-keyword-4.a68 | 3 + .../algol68/compile/error-supper-1.a68 | 3 + .../algol68/compile/error-supper-2.a68 | 5 + .../algol68/compile/error-supper-3.a68 | 5 + .../algol68/compile/error-supper-4.a68 | 5 + .../algol68/compile/error-supper-5.a68 | 5 + .../algol68/compile/error-supper-6.a68 | 6 + .../compile/error-underscore-in-mode-1.a68 | 7 + .../compile/error-underscore-in-tag-1.a68 | 7 + .../algol68/compile/error-upper-1.a68 | 3 + .../algol68/compile/error-vacuum-1.a68 | 2 + .../algol68/compile/error-vacuum-2.a68 | 2 + .../algol68/compile/error-vacuum-3.a68 | 3 + .../algol68/compile/error-widening-1.a68 | 6 + .../algol68/compile/error-widening-2.a68 | 6 + .../algol68/compile/error-widening-3.a68 | 10 + .../algol68/compile/error-widening-4.a68 | 10 + .../algol68/compile/error-widening-5.a68 | 6 + .../algol68/compile/error-widening-6.a68 | 6 + .../algol68/compile/error-widening-7.a68 | 6 + .../algol68/compile/error-widening-8.a68 | 6 + .../algol68/compile/error-widening-9.a68 | 10 + .../algol68/compile/hidden-operators-1.a68 | 11 + .../algol68/compile/implicit-widening-1.a68 | 10 + .../algol68/compile/include-supper.a68 | 16 + gcc/testsuite/algol68/compile/include.a68 | 19 + .../algol68/compile/labeled-unit-1.a68 | 7 + gcc/testsuite/algol68/compile/module-1.a68 | 69 ++ gcc/testsuite/algol68/compile/module-2.a68 | 16 + .../algol68/compile/module-extracts-1.a68 | 29 + .../algol68/compile/module-mode-exports-1.a68 | 21 + .../algol68/compile/module-mode-exports-2.a68 | 17 + .../algol68/compile/module-mode-exports-3.a68 | 12 + .../algol68/compile/module-mode-exports-4.a68 | 12 + .../algol68/compile/module-mode-exports-5.a68 | 21 + .../algol68/compile/module-mode-exports-6.a68 | 15 + .../algol68/compile/module-mode-exports-7.a68 | 13 + .../algol68/compile/module-mode-exports-8.a68 | 17 + .../algol68/compile/module-mode-exports-9.a68 | 12 + .../algol68/compile/module-pub-1.a68 | 16 + .../algol68/compile/module-pub-mangling-1.a68 | 15 + .../compile/module-pub-mangling-10.a68 | 10 + .../compile/module-pub-mangling-11.a68 | 10 + .../compile/module-pub-mangling-12.a68 | 10 + .../compile/module-pub-mangling-13.a68 | 10 + .../compile/module-pub-mangling-14.a68 | 10 + .../compile/module-pub-mangling-15.a68 | 10 + .../compile/module-pub-mangling-16.a68 | 10 + .../compile/module-pub-mangling-17.a68 | 10 + .../compile/module-pub-mangling-18.a68 | 10 + .../compile/module-pub-mangling-19.a68 | 10 + .../algol68/compile/module-pub-mangling-2.a68 | 15 + .../compile/module-pub-mangling-20.a68 | 10 + .../compile/module-pub-mangling-21.a68 | 10 + .../compile/module-pub-mangling-22.a68 | 10 + .../algol68/compile/module-pub-mangling-3.a68 | 15 + .../algol68/compile/module-pub-mangling-4.a68 | 17 + .../algol68/compile/module-pub-mangling-5.a68 | 17 + .../algol68/compile/module-pub-mangling-6.a68 | 21 + .../algol68/compile/module-pub-mangling-7.a68 | 19 + .../algol68/compile/module-pub-mangling-8.a68 | 18 + .../algol68/compile/module-pub-mangling-9.a68 | 14 + .../algol68/compile/module-top-down-1.a68 | 14 + .../algol68/compile/modules/compile.exp | 40 + .../algol68/compile/modules/module1.a68 | 9 + .../algol68/compile/modules/module2.a68 | 5 + .../algol68/compile/modules/module3.a68 | 6 + .../algol68/compile/modules/module4.a68 | 4 + .../algol68/compile/modules/module5.a68 | 6 + .../algol68/compile/modules/module6.a68 | 5 + .../algol68/compile/modules/module7.a68 | 5 + .../algol68/compile/modules/module8.a68 | 5 + .../algol68/compile/modules/module9.a68 | 6 + .../algol68/compile/modules/program-7.a68 | 3 + .../algol68/compile/modules/program-8.a68 | 3 + .../algol68/compile/modules/program-9.a68 | 3 + .../modules/program-error-no-prio-1.a68 | 6 + .../program-error-outside-access-1.a68 | 6 + .../program-module-accesses-module-1.a68 | 5 + .../modules/program-proc-arg-order-1.a68 | 8 + .../algol68/compile/nested-comment-1.a68 | 4 + .../algol68/compile/nested-comment-2.a68 | 6 + .../compile/operators-firmly-related.a68 | 7 + .../algol68/compile/recursive-modes-1.a68 | 33 + .../algol68/compile/recursive-modes-2.a68 | 7 + .../algol68/compile/serial-clause-jump-1.a68 | 7 + gcc/testsuite/algol68/compile/snobol.a68 | 1100 +++++++++++++++++ gcc/testsuite/algol68/compile/supper-1.a68 | 11 + gcc/testsuite/algol68/compile/supper-10.a68 | 6 + gcc/testsuite/algol68/compile/supper-11.a68 | 6 + gcc/testsuite/algol68/compile/supper-12.a68 | 6 + gcc/testsuite/algol68/compile/supper-13.a68 | 7 + gcc/testsuite/algol68/compile/supper-2.a68 | 5 + gcc/testsuite/algol68/compile/supper-3.a68 | 5 + gcc/testsuite/algol68/compile/supper-4.a68 | 5 + gcc/testsuite/algol68/compile/supper-5.a68 | 6 + gcc/testsuite/algol68/compile/supper-6.a68 | 5 + gcc/testsuite/algol68/compile/supper-7.a68 | 5 + gcc/testsuite/algol68/compile/supper-8.a68 | 6 + gcc/testsuite/algol68/compile/supper-9.a68 | 6 + gcc/testsuite/algol68/compile/uniting-1.a68 | 8 + gcc/testsuite/algol68/compile/upper-1.a68 | 11 + .../algol68/compile/warning-hidding-1.a68 | 6 + .../algol68/compile/warning-hidding-2.a68 | 6 + .../algol68/compile/warning-hidding-3.a68 | 5 + .../algol68/compile/warning-hidding-4.a68 | 6 + .../algol68/compile/warning-hidding-5.a68 | 9 + .../algol68/compile/warning-hidding-6.a68 | 9 + .../algol68/compile/warning-hidding-7.a68 | 9 + .../compile/warning-module-hidding-1.a68 | 6 + .../algol68/compile/warning-pub-loc-1.a68 | 7 + .../algol68/compile/warning-scope-1.a68 | 9 + .../algol68/compile/warning-scope-2.a68 | 8 + .../algol68/compile/warning-scope-3.a68 | 3 + .../algol68/compile/warning-scope-4.a68 | 3 + .../algol68/compile/warning-scope-5.a68 | 8 + .../algol68/compile/warning-scope-6.a68 | 6 + .../algol68/compile/warning-scope-7.a68 | 12 + .../algol68/compile/warning-voiding-1.a68 | 5 + .../algol68/compile/warning-voiding-2.a68 | 6 + 187 files changed, 2666 insertions(+) create mode 100644 gcc/testsuite/algol68/compile/a68includes/goodbye-supper.a68 create mode 100644 gcc/testsuite/algol68/compile/a68includes/goodbye.a68 create mode 100644 gcc/testsuite/algol68/compile/a68includes/hello-supper.a68 create mode 100644 gcc/testsuite/algol68/compile/a68includes/hello.a68 create mode 100644 gcc/testsuite/algol68/compile/actual-bounds-expected-1.a68 create mode 100644 gcc/testsuite/algol68/compile/actual-bounds-expected-2.a68 create mode 100644 gcc/testsuite/algol68/compile/actual-bounds-expected-3.a68 create mode 100644 gcc/testsuite/algol68/compile/balancing-1.a68 create mode 100644 gcc/testsuite/algol68/compile/bold-nestable-comment-1.a68 create mode 100644 gcc/testsuite/algol68/compile/bold-taggle-1.a68 create mode 100644 gcc/testsuite/algol68/compile/brief-nestable-comment-1.a68 create mode 100644 gcc/testsuite/algol68/compile/brief-nestable-comment-2.a68 create mode 100644 gcc/testsuite/algol68/compile/char-break-1.a68 create mode 100644 gcc/testsuite/algol68/compile/compile.exp create mode 100644 gcc/testsuite/algol68/compile/conditional-clause-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-bold-taggle-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-coercion-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-coercion-2.a68 create mode 100644 gcc/testsuite/algol68/compile/error-coercion-flex-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-compile-unknown-tag-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-conformance-clause-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-contraction-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-contraction-2.a68 create mode 100644 gcc/testsuite/algol68/compile/error-def-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-incestuous-union-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-label-after-decl-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-10.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-11.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-12.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-13.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-14.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-15.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-16.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-17.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-2.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-3.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-4.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-5.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-6.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-8.a68 create mode 100644 gcc/testsuite/algol68/compile/error-mode-stropping-9.a68 create mode 100644 gcc/testsuite/algol68/compile/error-module-coercions-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-module-not-found-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-module-ranges-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-nestable-comments-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-nested-comment-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-no-bounds-allowed-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-pragmat-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-pragmat-access-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-pragmat-access-2.a68 create mode 100644 gcc/testsuite/algol68/compile/error-pub-loc-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-pub-out-of-def-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-pub-out-of-def-2.a68 create mode 100644 gcc/testsuite/algol68/compile/error-string-break-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-string-break-2.a68 create mode 100644 gcc/testsuite/algol68/compile/error-string-break-3.a68 create mode 100644 gcc/testsuite/algol68/compile/error-string-break-4.a68 create mode 100644 gcc/testsuite/algol68/compile/error-string-break-5.a68 create mode 100644 gcc/testsuite/algol68/compile/error-string-break-6.a68 create mode 100644 gcc/testsuite/algol68/compile/error-string-break-7.a68 create mode 100644 gcc/testsuite/algol68/compile/error-string-break-8.a68 create mode 100644 gcc/testsuite/algol68/compile/error-stropping-5.a68 create mode 100644 gcc/testsuite/algol68/compile/error-stropping-6.a68 create mode 100644 gcc/testsuite/algol68/compile/error-stropping-keyword-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-stropping-keyword-2.a68 create mode 100644 gcc/testsuite/algol68/compile/error-stropping-keyword-3.a68 create mode 100644 gcc/testsuite/algol68/compile/error-stropping-keyword-4.a68 create mode 100644 gcc/testsuite/algol68/compile/error-supper-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-supper-2.a68 create mode 100644 gcc/testsuite/algol68/compile/error-supper-3.a68 create mode 100644 gcc/testsuite/algol68/compile/error-supper-4.a68 create mode 100644 gcc/testsuite/algol68/compile/error-supper-5.a68 create mode 100644 gcc/testsuite/algol68/compile/error-supper-6.a68 create mode 100644 gcc/testsuite/algol68/compile/error-underscore-in-mode-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-underscore-in-tag-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-upper-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-vacuum-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-vacuum-2.a68 create mode 100644 gcc/testsuite/algol68/compile/error-vacuum-3.a68 create mode 100644 gcc/testsuite/algol68/compile/error-widening-1.a68 create mode 100644 gcc/testsuite/algol68/compile/error-widening-2.a68 create mode 100644 gcc/testsuite/algol68/compile/error-widening-3.a68 create mode 100644 gcc/testsuite/algol68/compile/error-widening-4.a68 create mode 100644 gcc/testsuite/algol68/compile/error-widening-5.a68 create mode 100644 gcc/testsuite/algol68/compile/error-widening-6.a68 create mode 100644 gcc/testsuite/algol68/compile/error-widening-7.a68 create mode 100644 gcc/testsuite/algol68/compile/error-widening-8.a68 create mode 100644 gcc/testsuite/algol68/compile/error-widening-9.a68 create mode 100644 gcc/testsuite/algol68/compile/hidden-operators-1.a68 create mode 100644 gcc/testsuite/algol68/compile/implicit-widening-1.a68 create mode 100644 gcc/testsuite/algol68/compile/include-supper.a68 create mode 100644 gcc/testsuite/algol68/compile/include.a68 create mode 100644 gcc/testsuite/algol68/compile/labeled-unit-1.a68 create mode 100644 gcc/testsuite/algol68/compile/module-1.a68 create mode 100644 gcc/testsuite/algol68/compile/module-2.a68 create mode 100644 gcc/testsuite/algol68/compile/module-extracts-1.a68 create mode 100644 gcc/testsuite/algol68/compile/module-mode-exports-1.a68 create mode 100644 gcc/testsuite/algol68/compile/module-mode-exports-2.a68 create mode 100644 gcc/testsuite/algol68/compile/module-mode-exports-3.a68 create mode 100644 gcc/testsuite/algol68/compile/module-mode-exports-4.a68 create mode 100644 gcc/testsuite/algol68/compile/module-mode-exports-5.a68 create mode 100644 gcc/testsuite/algol68/compile/module-mode-exports-6.a68 create mode 100644 gcc/testsuite/algol68/compile/module-mode-exports-7.a68 create mode 100644 gcc/testsuite/algol68/compile/module-mode-exports-8.a68 create mode 100644 gcc/testsuite/algol68/compile/module-mode-exports-9.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-1.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-1.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-10.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-11.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-12.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-13.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-14.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-15.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-16.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-17.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-18.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-19.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-2.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-20.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-21.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-22.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-3.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-4.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-5.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-6.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-7.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-8.a68 create mode 100644 gcc/testsuite/algol68/compile/module-pub-mangling-9.a68 create mode 100644 gcc/testsuite/algol68/compile/module-top-down-1.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/compile.exp create mode 100644 gcc/testsuite/algol68/compile/modules/module1.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/module2.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/module3.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/module4.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/module5.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/module6.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/module7.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/module8.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/module9.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/program-7.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/program-8.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/program-9.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/program-error-no-prio-1.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/program-error-outside-access-1.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/program-module-accesses-module-1.a68 create mode 100644 gcc/testsuite/algol68/compile/modules/program-proc-arg-order-1.a68 create mode 100644 gcc/testsuite/algol68/compile/nested-comment-1.a68 create mode 100644 gcc/testsuite/algol68/compile/nested-comment-2.a68 create mode 100644 gcc/testsuite/algol68/compile/operators-firmly-related.a68 create mode 100644 gcc/testsuite/algol68/compile/recursive-modes-1.a68 create mode 100644 gcc/testsuite/algol68/compile/recursive-modes-2.a68 create mode 100644 gcc/testsuite/algol68/compile/serial-clause-jump-1.a68 create mode 100644 gcc/testsuite/algol68/compile/snobol.a68 create mode 100644 gcc/testsuite/algol68/compile/supper-1.a68 create mode 100644 gcc/testsuite/algol68/compile/supper-10.a68 create mode 100644 gcc/testsuite/algol68/compile/supper-11.a68 create mode 100644 gcc/testsuite/algol68/compile/supper-12.a68 create mode 100644 gcc/testsuite/algol68/compile/supper-13.a68 create mode 100644 gcc/testsuite/algol68/compile/supper-2.a68 create mode 100644 gcc/testsuite/algol68/compile/supper-3.a68 create mode 100644 gcc/testsuite/algol68/compile/supper-4.a68 create mode 100644 gcc/testsuite/algol68/compile/supper-5.a68 create mode 100644 gcc/testsuite/algol68/compile/supper-6.a68 create mode 100644 gcc/testsuite/algol68/compile/supper-7.a68 create mode 100644 gcc/testsuite/algol68/compile/supper-8.a68 create mode 100644 gcc/testsuite/algol68/compile/supper-9.a68 create mode 100644 gcc/testsuite/algol68/compile/uniting-1.a68 create mode 100644 gcc/testsuite/algol68/compile/upper-1.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-hidding-1.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-hidding-2.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-hidding-3.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-hidding-4.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-hidding-5.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-hidding-6.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-hidding-7.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-module-hidding-1.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-pub-loc-1.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-scope-1.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-scope-2.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-scope-3.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-scope-4.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-scope-5.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-scope-6.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-scope-7.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-voiding-1.a68 create mode 100644 gcc/testsuite/algol68/compile/warning-voiding-2.a68 diff --git a/gcc/testsuite/algol68/compile/a68includes/goodbye-supper.a68 b/gcc/testsuite/algol68/compile/a68includes/goodbye-supper.a68 new file mode 100644 index 000000000000..c287d6a93091 --- /dev/null +++ b/gcc/testsuite/algol68/compile/a68includes/goodbye-supper.a68 @@ -0,0 +1,4 @@ +proc goodbye = (string name) string: +begin string msg := "Goodbye " + name; + msg +end; diff --git a/gcc/testsuite/algol68/compile/a68includes/goodbye.a68 b/gcc/testsuite/algol68/compile/a68includes/goodbye.a68 new file mode 100644 index 000000000000..19c3acc57797 --- /dev/null +++ b/gcc/testsuite/algol68/compile/a68includes/goodbye.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +# PR UPPER PR # + +PROC goodbye = (STRING name) STRING: +BEGIN + STRING msg := "Goodbye " + name; + msg +END; diff --git a/gcc/testsuite/algol68/compile/a68includes/hello-supper.a68 b/gcc/testsuite/algol68/compile/a68includes/hello-supper.a68 new file mode 100644 index 000000000000..2af568bcb01c --- /dev/null +++ b/gcc/testsuite/algol68/compile/a68includes/hello-supper.a68 @@ -0,0 +1,5 @@ +proc hello = (string name) string: +begin string msg := "Hello " + name; + msg +end; + diff --git a/gcc/testsuite/algol68/compile/a68includes/hello.a68 b/gcc/testsuite/algol68/compile/a68includes/hello.a68 new file mode 100644 index 000000000000..aa72e282d2c5 --- /dev/null +++ b/gcc/testsuite/algol68/compile/a68includes/hello.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +# PR UPPER PR # + +PROC hello = (STRING name) STRING: +BEGIN + STRING msg := "Hello " + name; + msg +END; diff --git a/gcc/testsuite/algol68/compile/actual-bounds-expected-1.a68 b/gcc/testsuite/algol68/compile/actual-bounds-expected-1.a68 new file mode 100644 index 000000000000..58309db74fdd --- /dev/null +++ b/gcc/testsuite/algol68/compile/actual-bounds-expected-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []INT a := (1,2,3); # { dg-error "actual bounds expected" } # + SKIP +END diff --git a/gcc/testsuite/algol68/compile/actual-bounds-expected-2.a68 b/gcc/testsuite/algol68/compile/actual-bounds-expected-2.a68 new file mode 100644 index 000000000000..e80e8cb45c08 --- /dev/null +++ b/gcc/testsuite/algol68/compile/actual-bounds-expected-2.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN LOC[]INT a := (1,2,3); # { dg-error "actual bounds expected" } # + SKIP +END diff --git a/gcc/testsuite/algol68/compile/actual-bounds-expected-3.a68 b/gcc/testsuite/algol68/compile/actual-bounds-expected-3.a68 new file mode 100644 index 000000000000..26ddd279f056 --- /dev/null +++ b/gcc/testsuite/algol68/compile/actual-bounds-expected-3.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN LOC[]INT a := (1,2,3), # { dg-error "actual bounds expected" } # + b := (4); + SKIP +END diff --git a/gcc/testsuite/algol68/compile/balancing-1.a68 b/gcc/testsuite/algol68/compile/balancing-1.a68 new file mode 100644 index 000000000000..62d1221f675f --- /dev/null +++ b/gcc/testsuite/algol68/compile/balancing-1.a68 @@ -0,0 +1,7 @@ +mode Word = union (void,real), + Rules = union (void,string); + +op LEN = (Word w) int: skip, +LEN = (Rules r) int: skip; + +skip diff --git a/gcc/testsuite/algol68/compile/bold-nestable-comment-1.a68 b/gcc/testsuite/algol68/compile/bold-nestable-comment-1.a68 new file mode 100644 index 000000000000..0820c3d20c20 --- /dev/null +++ b/gcc/testsuite/algol68/compile/bold-nestable-comment-1.a68 @@ -0,0 +1,7 @@ +# { dg-options {-fstropping=upper} } # +# pr UPPER pr # +BEGIN NOTE This is a + NOTE nestable ETON comment in bold style. + ETON + SKIP +END diff --git a/gcc/testsuite/algol68/compile/bold-taggle-1.a68 b/gcc/testsuite/algol68/compile/bold-taggle-1.a68 new file mode 100644 index 000000000000..77ce9e7c2fa3 --- /dev/null +++ b/gcc/testsuite/algol68/compile/bold-taggle-1.a68 @@ -0,0 +1,6 @@ +# { dg-options {-std=gnu68 -fstropping=upper} } # + +BEGIN MODE FOO_BAR = INT; + FOO_BAR foo_bar = 10; + SKIP +END diff --git a/gcc/testsuite/algol68/compile/brief-nestable-comment-1.a68 b/gcc/testsuite/algol68/compile/brief-nestable-comment-1.a68 new file mode 100644 index 000000000000..045b9b56d57f --- /dev/null +++ b/gcc/testsuite/algol68/compile/brief-nestable-comment-1.a68 @@ -0,0 +1,4 @@ +begin { This is a + { nestable } comment in brief style. } + skip +end diff --git a/gcc/testsuite/algol68/compile/brief-nestable-comment-2.a68 b/gcc/testsuite/algol68/compile/brief-nestable-comment-2.a68 new file mode 100644 index 000000000000..a4e5d3ebb878 --- /dev/null +++ b/gcc/testsuite/algol68/compile/brief-nestable-comment-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +BEGIN NOTE This is a + { nestable } comment in brief style. + ETON + SKIP +END diff --git a/gcc/testsuite/algol68/compile/char-break-1.a68 b/gcc/testsuite/algol68/compile/char-break-1.a68 new file mode 100644 index 000000000000..30308b3df4b2 --- /dev/null +++ b/gcc/testsuite/algol68/compile/char-break-1.a68 @@ -0,0 +1,11 @@ +{ Make sure char denotations with string breaks work. } +begin prio % = 9; + op % = (char a) char: a; + assert (ABS %"'n" = 10); + assert (ABS %"'f" = 12); + assert (ABS %"'t" = 9); + assert (ABS %"'r" = 13); + assert (%"'( u0061)" = "a"); + assert (%"'(U00000061 )" = "a"); + assert (%"'(u1234)" = replacement_char) +end diff --git a/gcc/testsuite/algol68/compile/compile.exp b/gcc/testsuite/algol68/compile/compile.exp new file mode 100644 index 000000000000..68fa5fa2625e --- /dev/null +++ b/gcc/testsuite/algol68/compile/compile.exp @@ -0,0 +1,34 @@ +# Copyright (C) 2024 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +# Compile tests, no torture testing. +# +# These tests raise errors in the front end; torture testing doesn't apply. + +load_lib algol68-dg.exp + +# Initialize `dg'. +dg-init + +# Main loop. +set saved-dg-do-what-default ${dg-do-what-default} + +set dg-do-what-default "compile" +algol68-dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.a68]] "" "" +set dg-do-what-default ${saved-dg-do-what-default} + +# All done. +dg-finish diff --git a/gcc/testsuite/algol68/compile/conditional-clause-1.a68 b/gcc/testsuite/algol68/compile/conditional-clause-1.a68 new file mode 100644 index 000000000000..a727bc21e58a --- /dev/null +++ b/gcc/testsuite/algol68/compile/conditional-clause-1.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN INT i := 26; + IF INT ii = i * 2; ii > 50 THEN + ii + ELIF i = 10 THEN + 100 + FI +END diff --git a/gcc/testsuite/algol68/compile/error-bold-taggle-1.a68 b/gcc/testsuite/algol68/compile/error-bold-taggle-1.a68 new file mode 100644 index 000000000000..d813e55e5ba3 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-bold-taggle-1.a68 @@ -0,0 +1,6 @@ +# { dg-options {-std=algol68 -fstropping=upper} } # + +BEGIN MODE FOO_BAR = INT; # { dg-error "unworthy" } # + FOO_BAR foo_bar = 10; + SKIP +END diff --git a/gcc/testsuite/algol68/compile/error-coercion-1.a68 b/gcc/testsuite/algol68/compile/error-coercion-1.a68 new file mode 100644 index 000000000000..d0e24821f279 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-coercion-1.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN INT a; + a := "foo" # { dg-error "cannot be coerced" } # +END diff --git a/gcc/testsuite/algol68/compile/error-coercion-2.a68 b/gcc/testsuite/algol68/compile/error-coercion-2.a68 new file mode 100644 index 000000000000..bb8de3064b57 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-coercion-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # + +# This is Example 4.2.6c in McGETTRICK[78]. # +BEGIN []STRUCT([]INT a) r = (1,2,3); # { dg-error "cannot be coerced" } # + SKIP +END diff --git a/gcc/testsuite/algol68/compile/error-coercion-flex-1.a68 b/gcc/testsuite/algol68/compile/error-coercion-flex-1.a68 new file mode 100644 index 000000000000..c556d703b407 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-coercion-flex-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # + +# Coercing from REF FLEX[]REAL to REF[]REAL is not allowed, since + flexibility shall match # +BEGIN FLEX[1:0] REAL rowvar := SKIP; + REF [] REAL xlm = rowvar; # { dg-error "FLEX.*cannot be coerced" } # + SKIP +END diff --git a/gcc/testsuite/algol68/compile/error-compile-unknown-tag-1.a68 b/gcc/testsuite/algol68/compile/error-compile-unknown-tag-1.a68 new file mode 100644 index 000000000000..cd69d1a21b44 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-compile-unknown-tag-1.a68 @@ -0,0 +1,8 @@ +module Foo = def pub int idpublic = 10; + int idprivate = 20; + skip + fed, + Bar = def pub int idpublic = 30; + int idprivate = 40; + xxx { dg-error "" } + fed diff --git a/gcc/testsuite/algol68/compile/error-conformance-clause-1.a68 b/gcc/testsuite/algol68/compile/error-conformance-clause-1.a68 new file mode 100644 index 000000000000..e6cb738a2c95 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-conformance-clause-1.a68 @@ -0,0 +1,8 @@ +{ This is an invalid program. } +begin case + if true then "foo" else 10 fi { dg-error "not a united mode" } + in (string): skip, + (int): skip + esac +end + diff --git a/gcc/testsuite/algol68/compile/error-contraction-1.a68 b/gcc/testsuite/algol68/compile/error-contraction-1.a68 new file mode 100644 index 000000000000..f2bce73ff176 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-contraction-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # + +# Contracting mixed collateral variable and constant declarations is + not allowed. +# +(INT foo = 100, bar := 200) # { dg-error "mixed" } # diff --git a/gcc/testsuite/algol68/compile/error-contraction-2.a68 b/gcc/testsuite/algol68/compile/error-contraction-2.a68 new file mode 100644 index 000000000000..2115a4cbfab3 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-contraction-2.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # + +# Contracting mixed collateral variable and constant declarations is + not allowed. # +BEGIN PROC x = VOID: SKIP, + y := VOID: SKIP; # { dg-error "mixed" } # + x +END diff --git a/gcc/testsuite/algol68/compile/error-def-1.a68 b/gcc/testsuite/algol68/compile/error-def-1.a68 new file mode 100644 index 000000000000..6d7cdc87deb1 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-def-1.a68 @@ -0,0 +1,3 @@ +module Foo = +def skip; { dg-error "fed" } + skip diff --git a/gcc/testsuite/algol68/compile/error-incestuous-union-1.a68 b/gcc/testsuite/algol68/compile/error-incestuous-union-1.a68 new file mode 100644 index 000000000000..519cb8a9af1f --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-incestuous-union-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # + +# Union modes shall not contain modes which are firmly related, i.e. + it shall not be possible to coerce from one mode to another in a + firm context. # +BEGIN UNION(INT, REF INT) incestuous; # { dg-error "has firmly related components" } # + incestuous +END diff --git a/gcc/testsuite/algol68/compile/error-label-after-decl-1.a68 b/gcc/testsuite/algol68/compile/error-label-after-decl-1.a68 new file mode 100644 index 000000000000..670f8908af1c --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-label-after-decl-1.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN GOTO end; + ASSERT(FALSE); +end: 0; + INT i = 10; # { dg-error "declaration cannot follow" } # + i +END diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-1.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-1.a68 new file mode 100644 index 000000000000..7a619d8408f6 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-1.a68 @@ -0,0 +1,3 @@ +begin struct (int i, real r) j; + j := "joo" { dg-error "char.*struct \\(int i, real r\\)" } +end diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-10.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-10.a68 new file mode 100644 index 000000000000..fd70de7df0d2 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-10.a68 @@ -0,0 +1,3 @@ +begin long long int j; + j := "joo" { dg-error "char.*long long int" } +end diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-11.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-11.a68 new file mode 100644 index 000000000000..156d8d39aa64 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-11.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN LONG LONG INT j; + j := "joo" { dg-error "CHAR.*LONG LONG INT" } +END diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-12.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-12.a68 new file mode 100644 index 000000000000..0dda5beb4143 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-12.a68 @@ -0,0 +1,3 @@ +begin short int j; + j := "joo" { dg-error "char.*short int" } +end diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-13.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-13.a68 new file mode 100644 index 000000000000..84cf830e7ecb --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-13.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN SHORT INT j; + j := "joo" { dg-error "CHAR.*SHORT INT" } +END diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-14.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-14.a68 new file mode 100644 index 000000000000..24bda0a6db99 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-14.a68 @@ -0,0 +1,3 @@ +begin short short int j; + j := "joo" { dg-error "char.*short short int" } +end diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-15.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-15.a68 new file mode 100644 index 000000000000..0136fdb4f7bc --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-15.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN SHORT SHORT INT j; + j := "joo" { dg-error "CHAR.*SHORT SHORT INT" } +END diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-16.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-16.a68 new file mode 100644 index 000000000000..82359e52d954 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-16.a68 @@ -0,0 +1,3 @@ +begin flex[1:0]int j; + j := "joo" { dg-error "char.*flex.*int" } +end diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-17.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-17.a68 new file mode 100644 index 000000000000..e733c51c75f3 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-17.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN FLEX[1:0]INT j; + j := "joo" { dg-error "CHAR.*FLEX.*INT" } +END diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-2.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-2.a68 new file mode 100644 index 000000000000..f72b6dd13685 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-2.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRUCT (INT i, REAL r) j; + j := "joo" # { dg-error "CHAR.*STRUCT \\(INT i, REAL r\\)" } # +END diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-3.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-3.a68 new file mode 100644 index 000000000000..eb672c495339 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-3.a68 @@ -0,0 +1,3 @@ +begin union (int,real) j; + j := "joo" { dg-error "char.*union \\( *real *, *int *\\)" } +end diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-4.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-4.a68 new file mode 100644 index 000000000000..42c6ee29b6d7 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-4.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN UNION (INT,REAL) j; + j := "joo" { dg-error "CHAR.*UNION \\( *REAL *, *INT *\\)" } +END diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-5.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-5.a68 new file mode 100644 index 000000000000..0206d19f72f5 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-5.a68 @@ -0,0 +1,3 @@ +begin proc union (int,real) j; + j := "joo" { dg-error "char.*proc union \\( *real *, *int *\\)" } +end diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-6.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-6.a68 new file mode 100644 index 000000000000..5f8404363ddf --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-6.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN PROC UNION (INT,REAL) j; + j := "joo" { dg-error "CHAR.*PROC UNION \\( *REAL *, *INT *\\)" } +END diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-8.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-8.a68 new file mode 100644 index 000000000000..49308860381d --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-8.a68 @@ -0,0 +1,3 @@ +begin long int j; + j := "joo" { dg-error "char.*long int" } +end diff --git a/gcc/testsuite/algol68/compile/error-mode-stropping-9.a68 b/gcc/testsuite/algol68/compile/error-mode-stropping-9.a68 new file mode 100644 index 000000000000..dc20eb34a346 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-mode-stropping-9.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN LONG INT j; + j := "joo" { dg-error "CHAR.*LONG INT" } +END diff --git a/gcc/testsuite/algol68/compile/error-module-coercions-1.a68 b/gcc/testsuite/algol68/compile/error-module-coercions-1.a68 new file mode 100644 index 000000000000..460c381299e4 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-module-coercions-1.a68 @@ -0,0 +1,15 @@ +{ This test makes sure mode checks are carried + over the inside of module texts. } +module Foo = def + skip + postlude + int i = "foo"; { dg-error "coerced" } + skip + fed, + Bar = def + int i = 3.14; { dg-error "coerced" } + skip + postlude + skip + fed, + Baz = def skip fed diff --git a/gcc/testsuite/algol68/compile/error-module-not-found-1.a68 b/gcc/testsuite/algol68/compile/error-module-not-found-1.a68 new file mode 100644 index 000000000000..e990c6e22fda --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-module-not-found-1.a68 @@ -0,0 +1,4 @@ +access + Foo { dg-error "cannot find module" } +begin skip end + diff --git a/gcc/testsuite/algol68/compile/error-module-ranges-1.a68 b/gcc/testsuite/algol68/compile/error-module-ranges-1.a68 new file mode 100644 index 000000000000..b377ffba7361 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-module-ranges-1.a68 @@ -0,0 +1,13 @@ +{ Definitions in the def-part of a module text are visible in the + postlude-part, but not the other way around. } + +module Foo = def int i; + x := 20 { dg-error "" } + postlude + i := 10 { this is ok } + fed, + Bar = def int x; + skip + postlude + x := 20 { this is ok } + fed diff --git a/gcc/testsuite/algol68/compile/error-nestable-comments-1.a68 b/gcc/testsuite/algol68/compile/error-nestable-comments-1.a68 new file mode 100644 index 000000000000..df00a1a9970f --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-nestable-comments-1.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +# pr UPPER pr # +BEGIN NOTE This is a + NOTE nestable ETON comment in brief style. + ETON + { Another { comment }. } + NOTE invalid { nesting ETON of comments } # { dg-error "" } # + SKIP +END diff --git a/gcc/testsuite/algol68/compile/error-nested-comment-1.a68 b/gcc/testsuite/algol68/compile/error-nested-comment-1.a68 new file mode 100644 index 000000000000..3c78f34a51ab --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-nested-comment-1.a68 @@ -0,0 +1,6 @@ +{ The string in nested comment is in one logical line. } +begin + { puts ("{'n { dg-error {} } +"); { this prints foo }} + skip +end diff --git a/gcc/testsuite/algol68/compile/error-no-bounds-allowed-1.a68 b/gcc/testsuite/algol68/compile/error-no-bounds-allowed-1.a68 new file mode 100644 index 000000000000..75d66bc17158 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-no-bounds-allowed-1.a68 @@ -0,0 +1,15 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN [1:10]INT i, + [1:10]STRUCT(REF[]INT i, BOOL j) k, + [1:10]STRUCT([1:10]INT i, BOOL j) l, + [1:10]REF[]INT p; + # formal, so no bounds allowed: # + [1:10]PROC[1:10]INT q, # { dg-error "formal bounds expected" } # + STRUCT(REF[1:10]INT i, BOOLj) m, # { dg-error "virtual bounds expected" } # + [1:10]REF[1:10]INT mn, # { dg-error "virtual bounds expected" } # + PROC([1:10]INT)VOID pp, # { dg-error "formal bounds expected" } # + UNION([1:10] INT, BOOL) nm, # { dg-error "formal bounds expected" } # + [1:10]INT u = (1); # { dg-error "formal bounds expected" } # + SKIP +END diff --git a/gcc/testsuite/algol68/compile/error-pragmat-1.a68 b/gcc/testsuite/algol68/compile/error-pragmat-1.a68 new file mode 100644 index 000000000000..8c5f1c1d899d --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-pragmat-1.a68 @@ -0,0 +1,8 @@ +{ dg-error "unrecognized pragmat" } pr invalid Foo in "module" pr + +begin prio // = 8; + op (int,int)int // = lala; + proc lala = (int a, b) int: a + b; + proc void jeje = skip; + skip +end diff --git a/gcc/testsuite/algol68/compile/error-pragmat-access-1.a68 b/gcc/testsuite/algol68/compile/error-pragmat-access-1.a68 new file mode 100644 index 000000000000..2eb4ceb7ef51 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-pragmat-access-1.a68 @@ -0,0 +1,8 @@ +pr access Foo in pr { dg-error "expected string" } + +begin prio // = 8; + op (int,int)int // = lala; + proc lala = (int a, b) int: a + b; + proc void jeje = skip; + skip +end diff --git a/gcc/testsuite/algol68/compile/error-pragmat-access-2.a68 b/gcc/testsuite/algol68/compile/error-pragmat-access-2.a68 new file mode 100644 index 000000000000..643fcce07736 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-pragmat-access-2.a68 @@ -0,0 +1,9 @@ +pr access Foo in "lala" pr +pr access Foo in "lele" pr { dg-error "multiple" } + +begin prio // = 8; + op (int,int)int // = lala; + proc lala = (int a, b) int: a + b; + proc void jeje = skip; + skip +end diff --git a/gcc/testsuite/algol68/compile/error-pub-loc-1.a68 b/gcc/testsuite/algol68/compile/error-pub-loc-1.a68 new file mode 100644 index 000000000000..eb174806c445 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-pub-loc-1.a68 @@ -0,0 +1,10 @@ +{ Publicized varifables cannot go on the stack, for obvious reasons. } + +module Foo = +def + pub string xx; + pub heap string yy; + pub loc string zz; { dg-error "" } + loc string vv; + skip +fed diff --git a/gcc/testsuite/algol68/compile/error-pub-out-of-def-1.a68 b/gcc/testsuite/algol68/compile/error-pub-out-of-def-1.a68 new file mode 100644 index 000000000000..372bfbbcfd8c --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-pub-out-of-def-1.a68 @@ -0,0 +1,13 @@ +module Foo = +def pub mode JORL = int; + pub proc plus = (int a, b) int: a + b; + pub proc vplus := (int a, b) int: a + b; + pub loc proc lvplus := (int a, b) int: a + b; + pub heap proc hvplus := (int a, b) int: a + b; + pub prio // = 8; + pub op // = (int a, b) int: a % b; + proc invalid = void: + (pub mode JI = void; { dg-error "" } + skip); + skip +fed diff --git a/gcc/testsuite/algol68/compile/error-pub-out-of-def-2.a68 b/gcc/testsuite/algol68/compile/error-pub-out-of-def-2.a68 new file mode 100644 index 000000000000..d911e3d6d7ce --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-pub-out-of-def-2.a68 @@ -0,0 +1,9 @@ +begin pub mode Jorl = void; { dg-error "" } + pub proc lala = void: skip; { dg-error "" } + pub proc lele := void: skip; { dg-error "" } + begin pub prio + = 4; { dg-error "" } + skip + end; + pub op // = (int a, b) int: a % b; { dg-error "" } + skip +end diff --git a/gcc/testsuite/algol68/compile/error-string-break-1.a68 b/gcc/testsuite/algol68/compile/error-string-break-1.a68 new file mode 100644 index 000000000000..fd8e765ab484 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-string-break-1.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN puts ("hello '_ world") # { dg-error "invalid string break sequence" } # +END diff --git a/gcc/testsuite/algol68/compile/error-string-break-2.a68 b/gcc/testsuite/algol68/compile/error-string-break-2.a68 new file mode 100644 index 000000000000..465f8f804040 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-string-break-2.a68 @@ -0,0 +1,2 @@ +begin puts ("hello '(U0000) world") # { dg-error "eight" } # +end diff --git a/gcc/testsuite/algol68/compile/error-string-break-3.a68 b/gcc/testsuite/algol68/compile/error-string-break-3.a68 new file mode 100644 index 000000000000..e4cf8f6f1a34 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-string-break-3.a68 @@ -0,0 +1,2 @@ +begin puts ("hello '(u00) world") # { dg-error "four" } # +end diff --git a/gcc/testsuite/algol68/compile/error-string-break-4.a68 b/gcc/testsuite/algol68/compile/error-string-break-4.a68 new file mode 100644 index 000000000000..76adff9b2bc5 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-string-break-4.a68 @@ -0,0 +1,2 @@ +begin puts ("hello '(u) world") # { dg-error "four" } # +end diff --git a/gcc/testsuite/algol68/compile/error-string-break-5.a68 b/gcc/testsuite/algol68/compile/error-string-break-5.a68 new file mode 100644 index 000000000000..c42589fde7cd --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-string-break-5.a68 @@ -0,0 +1,2 @@ +begin puts ("hello '(u0010u0020) world") # { dg-error "" } # +end diff --git a/gcc/testsuite/algol68/compile/error-string-break-6.a68 b/gcc/testsuite/algol68/compile/error-string-break-6.a68 new file mode 100644 index 000000000000..fed7d84b2213 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-string-break-6.a68 @@ -0,0 +1,2 @@ +begin puts ("hello '(u0010'/) world") # { dg-error "" } # +end diff --git a/gcc/testsuite/algol68/compile/error-string-break-7.a68 b/gcc/testsuite/algol68/compile/error-string-break-7.a68 new file mode 100644 index 000000000000..58545e01ce10 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-string-break-7.a68 @@ -0,0 +1,2 @@ +begin puts ("'") # { dg-error "" } # +end diff --git a/gcc/testsuite/algol68/compile/error-string-break-8.a68 b/gcc/testsuite/algol68/compile/error-string-break-8.a68 new file mode 100644 index 000000000000..dbc96e4e57fb --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-string-break-8.a68 @@ -0,0 +1,4 @@ +begin string s = + "'(Uf09f94a5)"; { dg-error "Unicode" } + skip +end diff --git a/gcc/testsuite/algol68/compile/error-stropping-5.a68 b/gcc/testsuite/algol68/compile/error-stropping-5.a68 new file mode 100644 index 000000000000..3190472129a7 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-stropping-5.a68 @@ -0,0 +1,3 @@ +begin int j; + j := "joo" { dg-error "char.*int" } +end diff --git a/gcc/testsuite/algol68/compile/error-stropping-6.a68 b/gcc/testsuite/algol68/compile/error-stropping-6.a68 new file mode 100644 index 000000000000..af6097df7c08 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-stropping-6.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT j; + j := "joo" # { dg-error "CHAR.*INT" } # +END diff --git a/gcc/testsuite/algol68/compile/error-stropping-keyword-1.a68 b/gcc/testsuite/algol68/compile/error-stropping-keyword-1.a68 new file mode 100644 index 000000000000..4bf549f91e31 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-stropping-keyword-1.a68 @@ -0,0 +1,2 @@ +begin for i to 10 skip od { dg-error "do" } +end diff --git a/gcc/testsuite/algol68/compile/error-stropping-keyword-2.a68 b/gcc/testsuite/algol68/compile/error-stropping-keyword-2.a68 new file mode 100644 index 000000000000..a1e616deaeb9 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-stropping-keyword-2.a68 @@ -0,0 +1,3 @@ +# { dg-options "-fstropping=upper" } # +BEGIN FOR i TO 10 SKIP OD # { dg-error "DO" } # +END diff --git a/gcc/testsuite/algol68/compile/error-stropping-keyword-3.a68 b/gcc/testsuite/algol68/compile/error-stropping-keyword-3.a68 new file mode 100644 index 000000000000..d1076e935bd0 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-stropping-keyword-3.a68 @@ -0,0 +1,2 @@ +begin if then 10 else 20 fi { dg-error "if" } +end diff --git a/gcc/testsuite/algol68/compile/error-stropping-keyword-4.a68 b/gcc/testsuite/algol68/compile/error-stropping-keyword-4.a68 new file mode 100644 index 000000000000..92b0b3b58cb9 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-stropping-keyword-4.a68 @@ -0,0 +1,3 @@ +# { dg-options "-fstropping=upper" } # +BEGIN IF THEN 10 ELSE 20 FI # { dg-error "IF" } # +END diff --git a/gcc/testsuite/algol68/compile/error-supper-1.a68 b/gcc/testsuite/algol68/compile/error-supper-1.a68 new file mode 100644 index 000000000000..f2646c41b7b1 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-supper-1.a68 @@ -0,0 +1,3 @@ +# { dg-options {-fstropping=upper} } # + +begin ~ end # { dg-error "" } # diff --git a/gcc/testsuite/algol68/compile/error-supper-2.a68 b/gcc/testsuite/algol68/compile/error-supper-2.a68 new file mode 100644 index 000000000000..f8c6c284b203 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-supper-2.a68 @@ -0,0 +1,5 @@ +# { dg-options {-fstropping=supper} } # + +begin int foo__bar = 10; # { dg-error "unworthy" } # + skip +end diff --git a/gcc/testsuite/algol68/compile/error-supper-3.a68 b/gcc/testsuite/algol68/compile/error-supper-3.a68 new file mode 100644 index 000000000000..a35730ce1f77 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-supper-3.a68 @@ -0,0 +1,5 @@ +# { dg-options {-fstropping=supper} } # + +begin int _bar = 10; # { dg-error "unworthy" } # + skip +end diff --git a/gcc/testsuite/algol68/compile/error-supper-4.a68 b/gcc/testsuite/algol68/compile/error-supper-4.a68 new file mode 100644 index 000000000000..726f80638d6e --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-supper-4.a68 @@ -0,0 +1,5 @@ +{ dg-options {-fstropping=supper} } + +begin int foo bar = 10; { dg-error "" } + skip +end diff --git a/gcc/testsuite/algol68/compile/error-supper-5.a68 b/gcc/testsuite/algol68/compile/error-supper-5.a68 new file mode 100644 index 000000000000..0cf51c519de2 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-supper-5.a68 @@ -0,0 +1,5 @@ +# { dg-options {-fstropping=supper} } # + +begin int foo__ = 10; # { dg-error "unworthy" } # + skip +end diff --git a/gcc/testsuite/algol68/compile/error-supper-6.a68 b/gcc/testsuite/algol68/compile/error-supper-6.a68 new file mode 100644 index 000000000000..c013b4894b38 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-supper-6.a68 @@ -0,0 +1,6 @@ +# { dg-options {-fstropping=supper} } # + +begin mode foo_Invalid = int; # { dg-error "Invalid" } # + foo_Invalid some_int = 10; # { dg-error "Invalid" } # + skip +end diff --git a/gcc/testsuite/algol68/compile/error-underscore-in-mode-1.a68 b/gcc/testsuite/algol68/compile/error-underscore-in-mode-1.a68 new file mode 100644 index 000000000000..2aa294d1f02c --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-underscore-in-mode-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # + +# Underscores are unworthy characters if they are not trailing + either a taggle or, in UPPER stropping, a bold word. # +BEGIN INT invalid_tag__; # { dg-error "unworthy character" } # + SKIP +END diff --git a/gcc/testsuite/algol68/compile/error-underscore-in-tag-1.a68 b/gcc/testsuite/algol68/compile/error-underscore-in-tag-1.a68 new file mode 100644 index 000000000000..a5dcb86b6e11 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-underscore-in-tag-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # + +# Underscores are unworthy characters if they are not trailing a + taggle or, in UPPER stropping, a bold word.. # +BEGIN MODE INVALID_BOLD_WORD__; # { dg-error "unworthy character" } # + SKIP +END diff --git a/gcc/testsuite/algol68/compile/error-upper-1.a68 b/gcc/testsuite/algol68/compile/error-upper-1.a68 new file mode 100644 index 000000000000..053846972ace --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-upper-1.a68 @@ -0,0 +1,3 @@ +# { dg-options {-fstropping=supper} } # + +BEGIN ~ END # { dg-error "" } # diff --git a/gcc/testsuite/algol68/compile/error-vacuum-1.a68 b/gcc/testsuite/algol68/compile/error-vacuum-1.a68 new file mode 100644 index 000000000000..0e724592e255 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-vacuum-1.a68 @@ -0,0 +1,2 @@ +begin { dg-error "" } +end diff --git a/gcc/testsuite/algol68/compile/error-vacuum-2.a68 b/gcc/testsuite/algol68/compile/error-vacuum-2.a68 new file mode 100644 index 000000000000..fe9716aeef40 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-vacuum-2.a68 @@ -0,0 +1,2 @@ +( { dg-error "" } +) diff --git a/gcc/testsuite/algol68/compile/error-vacuum-3.a68 b/gcc/testsuite/algol68/compile/error-vacuum-3.a68 new file mode 100644 index 000000000000..fc0960027091 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-vacuum-3.a68 @@ -0,0 +1,3 @@ +begin struct(int i, real r) foo = (); { dg-error "" } + skip +end diff --git a/gcc/testsuite/algol68/compile/error-widening-1.a68 b/gcc/testsuite/algol68/compile/error-widening-1.a68 new file mode 100644 index 000000000000..38ea59afb28a --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-widening-1.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN INT a := 10; + LONG REAL l := a; # { dg-error "coerced" } # + l +END diff --git a/gcc/testsuite/algol68/compile/error-widening-2.a68 b/gcc/testsuite/algol68/compile/error-widening-2.a68 new file mode 100644 index 000000000000..3165d1b71134 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-widening-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN INT a := 10; + LONG INT l := a; # { dg-error "coerced" } # + l +END diff --git a/gcc/testsuite/algol68/compile/error-widening-3.a68 b/gcc/testsuite/algol68/compile/error-widening-3.a68 new file mode 100644 index 000000000000..c4ffb305a62f --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-widening-3.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN INT d := 0; + INT y := 10; + LONG REAL x; + 2 + + (d > 0 | x | # { dg-error "" } # + y + ) +END diff --git a/gcc/testsuite/algol68/compile/error-widening-4.a68 b/gcc/testsuite/algol68/compile/error-widening-4.a68 new file mode 100644 index 000000000000..fa5b2072e171 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-widening-4.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN + INT d := 0; + LONG REAL x; + 2 + + (d > 0 | x | # { dg-error "" } # + 10 + ) +END diff --git a/gcc/testsuite/algol68/compile/error-widening-5.a68 b/gcc/testsuite/algol68/compile/error-widening-5.a68 new file mode 100644 index 000000000000..a6198669c45a --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-widening-5.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN + LONG INT d := 0; # { dg-error "coerced" } # + d +END diff --git a/gcc/testsuite/algol68/compile/error-widening-6.a68 b/gcc/testsuite/algol68/compile/error-widening-6.a68 new file mode 100644 index 000000000000..09512e216781 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-widening-6.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN + LONG LONG INT d := LONG 0; # { dg-error "coerced" } # + d +END diff --git a/gcc/testsuite/algol68/compile/error-widening-7.a68 b/gcc/testsuite/algol68/compile/error-widening-7.a68 new file mode 100644 index 000000000000..093520815837 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-widening-7.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN + LONG REAL d := 3.14; # { dg-error "coerced" } # + d +END diff --git a/gcc/testsuite/algol68/compile/error-widening-8.a68 b/gcc/testsuite/algol68/compile/error-widening-8.a68 new file mode 100644 index 000000000000..098f6c3b6157 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-widening-8.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN + LONG LONG REAL d := LONG 3.14; # { dg-error "coerced" } # + d +END diff --git a/gcc/testsuite/algol68/compile/error-widening-9.a68 b/gcc/testsuite/algol68/compile/error-widening-9.a68 new file mode 100644 index 000000000000..4d092386b610 --- /dev/null +++ b/gcc/testsuite/algol68/compile/error-widening-9.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN + INT d := 0; + LONG LONG REAL x; + 2 + + (d > 0 | x | # { dg-error "" } # + 10 + ) +END diff --git a/gcc/testsuite/algol68/compile/hidden-operators-1.a68 b/gcc/testsuite/algol68/compile/hidden-operators-1.a68 new file mode 100644 index 000000000000..d66242d67a69 --- /dev/null +++ b/gcc/testsuite/algol68/compile/hidden-operators-1.a68 @@ -0,0 +1,11 @@ +{ dg-options {-Whidden-declarations} } + +begin mode Trilean = union (void,bool); + + Trilean unknown = empty; + op NOT = (Trilean a) Trilean: { dg-warning "hides" } + skip; + op AND = (Trilean a,b) Trilean: { dg-warning "hides" } + skip; + skip +end diff --git a/gcc/testsuite/algol68/compile/implicit-widening-1.a68 b/gcc/testsuite/algol68/compile/implicit-widening-1.a68 new file mode 100644 index 000000000000..2fa010c12a76 --- /dev/null +++ b/gcc/testsuite/algol68/compile/implicit-widening-1.a68 @@ -0,0 +1,10 @@ +# { dg-options "-Wextensions -fstropping=upper" } # + +# This program shall compile without warning, because + widening from INT to REAL is legal in the strict language, + since they have the same size. # + +BEGIN BOOL cond; + REAL x, y; + y + (cond | x | 10) +END diff --git a/gcc/testsuite/algol68/compile/include-supper.a68 b/gcc/testsuite/algol68/compile/include-supper.a68 new file mode 100644 index 000000000000..af0521be1019 --- /dev/null +++ b/gcc/testsuite/algol68/compile/include-supper.a68 @@ -0,0 +1,16 @@ +{ dg-options "-I$srcdir/algol68/compile/a68includes" } +{ dg-additional-files "$srcdir/algol68/compile/a68includes/hello-supper.a68 $srcdir/algol68/compile/a68includes/goodbye-supper.a68" } + +begin string name := "Algol68 with supper!"; + { Both files are in `./a68includes'. + The first one will be included because we uwed `-I. + The second one will be included because of the relative path. } + pr include "hello-supper.a68" pr + pr include "a68includes/goodbye-supper.a68" pr + + string bye := goodbye(name); + string hi := hello(name); + + puts(hi + "\n"); + puts(bye + "\n") +end diff --git a/gcc/testsuite/algol68/compile/include.a68 b/gcc/testsuite/algol68/compile/include.a68 new file mode 100644 index 000000000000..6f4855b33da9 --- /dev/null +++ b/gcc/testsuite/algol68/compile/include.a68 @@ -0,0 +1,19 @@ +# { dg-options "-I$srcdir/algol68/compile/a68includes -fstropping=upper" } # +# { dg-additional-files "$srcdir/algol68/compile/a68includes/hello.a68 $srcdir/algol68/compile/a68includes/goodbye.a68" } # + +# PR UPPER PR # + +BEGIN STRING name := "Algol68!"; + # Both files are in `./a68includes'. + The first one will be included because we used `-I'. + The second one will be included because of the relative path. + # + PR include "hello.a68" PR + PR include "a68includes/goodbye.a68" PR + + STRING bye := goodbye(name); + STRING hi := hello(name); + + puts(hi + "\n"); + puts(bye + "\n") +END diff --git a/gcc/testsuite/algol68/compile/labeled-unit-1.a68 b/gcc/testsuite/algol68/compile/labeled-unit-1.a68 new file mode 100644 index 000000000000..d3dbd8c40d7d --- /dev/null +++ b/gcc/testsuite/algol68/compile/labeled-unit-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # + +# This tests that the mode of the value yielded by a labeled unit is + the mode of the unit. # +BEGIN 10; +jorl: 20 +END diff --git a/gcc/testsuite/algol68/compile/module-1.a68 b/gcc/testsuite/algol68/compile/module-1.a68 new file mode 100644 index 000000000000..e4f3215cc356 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-1.a68 @@ -0,0 +1,69 @@ +module Argp = +def mode ArgOpt = struct (char name, string long_name, + bool arg_required, proc(string)bool handler); + + proc argp = (int p, [][]ArgOpt opts, + proc(int,string)bool no_opt_handler, + proc(string)void error_handler) void: + begin + proc getopt = (string prefix, string arg) ArgOpt: + begin ArgOpt res, bool found := false; + for i to UPB opts while NOT found + do for j to UPB opts[i] while NOT found + do if arg = long_name of opts[i][j] + OR (arg /= " " AND arg = name of opts[i][j]) + then res := opts[i][j]; found := true + fi + od + od; + (NOT found | error_handler ("unknown option " + prefix + arg)); + res + end; + + bool found_dash_dash := false, + skip_next_opt := false, + continue := true; + + for i from p to argc while continue + do string arg = argv (i); + if skip_next_opt + then skip_next_opt := false + elif arg = "--" AND NOT found_dash_dash + then found_dash_dash := true + elif found_dash_dash OR (UPB arg >= 1 andth arg[1] /= "-") + then continue := no_opt_handler (i + 1, arg) + elif UPB arg > 1 andth arg[2] = "-" + then { Long option. It may have an argument. } + int eqidx = char_in_string (arg, "="); + string optname = (eqidx > 0 | arg[3:eqidx - 1] | arg[3:]), + optarg = (eqidx > 0 AND UPB arg >= (eqidx + 1) | arg[eqidx + 1:]); + ArgOpt opt = getopt ("--", optname); + + if (arg_required of opt) AND optarg = "" + then error_handler ("option --" + arg + " requires an argument") fi; + continue := (handler of opt) (optarg) + else { This is one or more short options. } + for j to UPB arg[2:] + do ArgOpt opt = getopt ("-", arg[j + 1]); + if arg_required of opt + then if i = argc orel (ELEMS argv (i + 1) > 1 andth argv (i + 1)[1] = "-") + then error_handler ("option -" + arg[2+j] + " requires an argument") + fi; + (handler of opt) (argv (i + 1)); + skip_next_opt := true + else continue := (handler of opt) ("") + fi + od + fi + od + end; + + proc char_in_string = (string s, char c) int: + begin int res := 0, bool found := false; + for i to UPB s while NOT found + do (s[i] = c | res := i; found := true) od; + res + end; + + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-2.a68 b/gcc/testsuite/algol68/compile/module-2.a68 new file mode 100644 index 000000000000..74bd23690220 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-2.a68 @@ -0,0 +1,16 @@ +module Foo = def pub int idpublic = 10; + int idprivate = 20; + pub int varpublic := 100; + real varprivate := 3.14; + pub proc lala = (int a, b) int: a + b; + pub proc lele := (int a, b) int: a - b; + skip + fed, + Bar = def pub int idpublic = 30; + int idprivate = 40; + pub int varpublic := 100; + real varprivate := 3.14; + pub proc lala = (int a, b) int: a + b; + pub proc lele := (int a, b) int: a - b; + skip + fed diff --git a/gcc/testsuite/algol68/compile/module-extracts-1.a68 b/gcc/testsuite/algol68/compile/module-extracts-1.a68 new file mode 100644 index 000000000000..c56a1d877c1d --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-extracts-1.a68 @@ -0,0 +1,29 @@ +{ dg-options "-O0 -dA" } + +module Foo = +def pub mode JURL = union (void,int,real); + { dg-final { scan-assembler "mode extract FOO_JURL" } } + pub proc plus = (int a, b) int: a + b; + { dg-final { scan-assembler "identifier extract FOO_plus" } } + pub proc vplus := (int a, b) int: a + b; + { dg-final { scan-assembler "identifier extract FOO_vplus" } } + pub proc lvplus := (int a, b) int: a + b; + { dg-final { scan-assembler "identifier extract FOO_lvplus" } } + pub heap proc hvplus := (int a, b) int: a + b; + { dg-final { scan-assembler "identifier extract FOO_hvplus" } } + pub proc(int,int)int vplus2 = vplus; + { dg-final { scan-assembler "identifier extract FOO_vplus2" } } + pub proc(int,int)int lvplus2 := lvplus; + { dg-final { scan-assembler "identifier extract FOO_lvplus2" } } + pub heap proc(int,int)int hvplus2 := hvplus; + { dg-final { scan-assembler "identifier extract FOO_hvplus2" } } + pub int i; + { dg-final { scan-assembler "identifier extract FOO_i" } } + int k = 10; + { dg-final { scan-assembler-not "identifier extract FOO_k" } } + pub prio // = 8; + { dg-final { scan-assembler "operator extract FOO_s_s_\[0-9\]+" } } + pub op // = (int a, b) int: a % b; + { dg-final { scan-assembler "operator extract FOO_s_s_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-1.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-1.a68 new file mode 100644 index 000000000000..8a4f50ef50cb --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-mode-exports-1.a68 @@ -0,0 +1,21 @@ +{ dg-options "-dA" } + +{ Test for mode table in module definition exports. } + +module Foo = +def pub mode MyInt = int; + pub mode MyLongInt = long int; + pub mode MyLongLongInt = long long int; + pub mode MyShortInt = short int; + pub mode MyShortShortInt = short short int; + skip +fed + +{ GA68_MODE_INT = 2UB } + +{ dg-final { scan-assembler-times "2\[\t ]+\[^0-9\]+int" 5 } } +{ dg-final { scan-assembler-times "\[\t \]+0x2\[\t \]+\[^\n\]*sizety" 1 } } +{ dg-final { scan-assembler-times "\[\t \]+0x1\[\t \]+\[^\n\]*sizety" 1 } } +{ dg-final { scan-assembler-times "\[\t \]+0\[\t \]+\[^\n\]*sizety" 1 } } +{ dg-final { scan-assembler-times "\[\t \]+0xff\[\t \]+\[^\n\]*sizety" 1 } } +{ dg-final { scan-assembler-times "\[\t \]+0xfe\[\t \]+\[^\n\]*sizety" 1 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-2.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-2.a68 new file mode 100644 index 000000000000..fb67b3db6a37 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-mode-exports-2.a68 @@ -0,0 +1,17 @@ +{ dg-options "-dA" } + +{ Test for mode table in module definition exports. } + +module Foo = +def pub mode MyReal = real; + pub mode MyLongReal = long real; + pub mode MyLongLongReal = long long real; + skip +fed + +{ GA68_MODE_REAL = 3UB } + +{ dg-final { scan-assembler-times "\[\t \]+0x3\[\t \]+\[^\n\]*real" 3 } } +{ dg-final { scan-assembler-times "\[\t \]+0x2\[\t \]+\[^\n\]*sizety" 1 } } +{ dg-final { scan-assembler-times "\[\t \]+0x1\[\t \]+\[^\n\]*sizety" 1 } } +{ dg-final { scan-assembler-times "\[\t \]+0\[\t \]+\[^\n\]*sizety" 1 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-3.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-3.a68 new file mode 100644 index 000000000000..b0309032a4f1 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-mode-exports-3.a68 @@ -0,0 +1,12 @@ +{ dg-options "-dA" } + +{ Test for mode table in module definition exports. } + +module Foo = +def pub mode MyString = string; + skip +fed + +{ GA68_MODE_STRING = 14UB } + +{ dg-final { scan-assembler-times "\[\t \]+0xe\[\t \]+\[^\n\]*string" 1 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-4.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-4.a68 new file mode 100644 index 000000000000..9846f19e7df6 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-mode-exports-4.a68 @@ -0,0 +1,12 @@ +{ dg-options "-dA" } + +{ Test for mode table in module definition exports. } + +module Foo = +def pub mode MyChar = char; + skip +fed + +{ GA68_MODE_CHAR = 6UB } + +{ dg-final { scan-assembler-times "\[\t \]+0x6\[\t \]+\[^\n\]*char" 1 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-5.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-5.a68 new file mode 100644 index 000000000000..be4deef2c690 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-mode-exports-5.a68 @@ -0,0 +1,21 @@ +{ dg-options "-dA" } + +{ Test for mode table in module definition exports. } + +module Foo = +def pub mode MyBits = bits; + pub mode MyLongBits = long bits; + pub mode MyLongLongBits = long long bits; + pub mode MyShortBits = short bits; + pub mode MyShortShortBits = short short bits; + skip +fed + +{ GA68_MODE_BITS = 4UB } + +{ dg-final { scan-assembler-times "4\[\t ]+\[^0-9\]+bits" 5 } } +{ dg-final { scan-assembler-times "\[\t \]+0x2\[\t \]+\[^\n\]*sizety" 1 } } +{ dg-final { scan-assembler-times "\[\t \]+0x1\[\t \]+\[^\n\]*sizety" 1 } } +{ dg-final { scan-assembler-times "\[\t \]+0\[\t \]+\[^\n\]*sizety" 1 } } +{ dg-final { scan-assembler-times "\[\t \]+0xff\[\t \]+\[^\n\]*sizety" 1 } } +{ dg-final { scan-assembler-times "\[\t \]+0xfe\[\t \]+\[^\n\]*sizety" 1 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-6.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-6.a68 new file mode 100644 index 000000000000..18a7d4fd3edb --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-mode-exports-6.a68 @@ -0,0 +1,15 @@ +{ dg-options "-dA" } + +{ Test for mode table in module definition exports. } + +module Foo = +def pub mode MyBool = bool; + pub mode MyVoid = void; + skip +fed + +{ GA68_MODE_BOOL = 7UB + GA68_MODE_VOID = 1UB } + +{ dg-final { scan-assembler-times "7\[\t ]+\[^0-9\]+bool" 1 } } +{ dg-final { scan-assembler-times "1\[\t ]+\[^0-9\]+void" 1 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-7.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-7.a68 new file mode 100644 index 000000000000..b76085b7681a --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-mode-exports-7.a68 @@ -0,0 +1,13 @@ +{ dg-options "-dA" } + +{ Test for mode table in module definition exports. } + +module Foo = +def pub mode MyName = ref int; + skip +fed + +{ GA68_MODE_NAME = 12UB } + +{ dg-final { scan-assembler-times "0xc\[\t ]+\[^0-9\]+ref" 1 } } +{ dg-final { scan-assembler-times "0x2\[\t ]+\[^0-9\]+int" 1 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-8.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-8.a68 new file mode 100644 index 000000000000..c38502a25bb8 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-mode-exports-8.a68 @@ -0,0 +1,17 @@ +{ dg-options "-dA" } + +{ Test for mode table in module definition exports. } + +module Foo = +def pub mode MyCompl = compl; + pub mode MyLongCompl = long compl; + pub mode MyLongLongCompl = long long compl; + skip +fed + +{ GA68_MODE_CMPL = 8UB } + +{ dg-final { scan-assembler-times "0x8\[\t ]+\[^0-9\]+compl" 3 } } +{ dg-final { scan-assembler-times "\[\t \]+0x2\[\t \]+\[^\n\]*sizety" 1 } } +{ dg-final { scan-assembler-times "\[\t \]+0x1\[\t \]+\[^\n\]*sizety" 1 } } +{ dg-final { scan-assembler-times "\[\t \]+0\[\t \]+\[^\n\]*sizety" 1 } } diff --git a/gcc/testsuite/algol68/compile/module-mode-exports-9.a68 b/gcc/testsuite/algol68/compile/module-mode-exports-9.a68 new file mode 100644 index 000000000000..482aab6ea32f --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-mode-exports-9.a68 @@ -0,0 +1,12 @@ +{ dg-options "-dA" } + +{ Test for mode table in module definition exports. } + +module Foo = +def pub mode MyProc = proc void; + skip +fed + +{ GA68_MODE_CMPL = 8UB } + +{ dg-final { scan-assembler-times "0xd\[\t ]+\[^0-9\]+proc" 1 } } diff --git a/gcc/testsuite/algol68/compile/module-pub-1.a68 b/gcc/testsuite/algol68/compile/module-pub-1.a68 new file mode 100644 index 000000000000..a0cf6e9e328f --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-1.a68 @@ -0,0 +1,16 @@ +module Foo = +def pub mode JORL = int, JURL = union (void,int,real); + pub proc plus = (int a, b) int: a + b; + pub proc vplus := (int a, b) int: a + b; + pub proc lvplus := (int a, b) int: a + b; + pub heap proc hvplus := (int a, b) int: a + b; + pub proc(int,int)int vplus2 = vplus; + pub proc(int,int)int lvplus2 := lvplus; + pub heap proc(int,int)int hvplus2 := hvplus; + pub int i, x, y; + pub int k = 10; + pub int j := 20; + pub prio // = 8; + pub op // = (int a, b) int: a % b; + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-1.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-1.a68 new file mode 100644 index 000000000000..3451f46a8ffa --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-1.a68 @@ -0,0 +1,15 @@ +{ dg-options "-O0" } + +module Foo = def pub int foo; { dg-final { scan-assembler "FOO_foo" } } + int bar; { dg-final { scan-assembler "FOO_bar" } } + skip + fed, + Bar = def pub int foo; { dg-final { scan-assembler "BAR_foo" } } + int bar; { dg-final { scan-assembler "BAR_bar" } } + skip + fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } +{ dg-final { scan-assembler "BAR__prelude" } } +{ dg-final { scan-assembler "BAR__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-10.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-10.a68 new file mode 100644 index 000000000000..e427181bf533 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-10.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio + = 9; + op + = (int a, b) int: skip; { dg-final { scan-assembler "FOO_u_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-11.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-11.a68 new file mode 100644 index 000000000000..3ba8b68ade2a --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-11.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio - = 9; + op - = (int a, b) int: skip; { dg-final { scan-assembler "FOO_m_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-12.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-12.a68 new file mode 100644 index 000000000000..9efc781f6447 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-12.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio % = 9; + op % = (int a, b) int: skip; { dg-final { scan-assembler "FOO_p_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-13.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-13.a68 new file mode 100644 index 000000000000..483474776224 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-13.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio ^ = 9; + op ^ = (int a, b) int: skip; { dg-final { scan-assembler "FOO_c_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-14.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-14.a68 new file mode 100644 index 000000000000..60ffc3d90dc9 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-14.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio & = 9; + op & = (int a, b) int: skip; { dg-final { scan-assembler "FOO_a_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-15.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-15.a68 new file mode 100644 index 000000000000..9f70993099d9 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-15.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio ~ = 9; + op ~ = (int a, b) int: skip; { dg-final { scan-assembler "FOO_t_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-16.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-16.a68 new file mode 100644 index 000000000000..a5a7d261e2b2 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-16.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio ! = 9; + op ! = (int a, b) int: skip; { dg-final { scan-assembler "FOO_b_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-17.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-17.a68 new file mode 100644 index 000000000000..1f5b52a9d4a0 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-17.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio ? = 9; + op ? = (int a, b) int: skip; { dg-final { scan-assembler "FOO_q_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-18.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-18.a68 new file mode 100644 index 000000000000..a840b14bf501 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-18.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio > = 9; + op > = (int a, b) int: skip; { dg-final { scan-assembler "FOO_g_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-19.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-19.a68 new file mode 100644 index 000000000000..ffcd1cfc79be --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-19.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio < = 9; + op < = (int a, b) int: skip; { dg-final { scan-assembler "FOO_l_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-2.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-2.a68 new file mode 100644 index 000000000000..79fe3d84cd7d --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-2.a68 @@ -0,0 +1,15 @@ +{ dg-options "-O0" } + +module Foo = def pub struct (int i, real r) foo;{ dg-final { scan-assembler "FOO_foo" } } + struct (int i, real r) bar; { dg-final { scan-assembler "FOO_bar" } } + skip + fed, + Bar = def pub struct (int i, real r) foo;{ dg-final { scan-assembler "BAR_foo" } } + struct (int i, real r) bar; { dg-final { scan-assembler "BAR_bar" } } + skip + fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } +{ dg-final { scan-assembler "BAR__prelude" } } +{ dg-final { scan-assembler "BAR__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-20.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-20.a68 new file mode 100644 index 000000000000..fd435c7e50a7 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-20.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio / = 9; + op / = (int a, b) int: skip; { dg-final { scan-assembler "FOO_s_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-21.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-21.a68 new file mode 100644 index 000000000000..05b2b0a6647d --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-21.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio = = 9; + op = = (int a, b) int: skip; { dg-final { scan-assembler "FOO_e_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-22.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-22.a68 new file mode 100644 index 000000000000..d11e9a8e4c88 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-22.a68 @@ -0,0 +1,10 @@ +{ dg-options "-O0" } + +{ Mangling of monads, nomads and : + Unfortunately we cannot do all of them in a single test. } + +module Foo = +def prio +:= = 9; + op +:= = (int a, b) int: skip; { dg-final { scan-assembler "FOO_u_o_e_\[0-9\]+" } } + skip +fed diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-3.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-3.a68 new file mode 100644 index 000000000000..579cb84eac0e --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-3.a68 @@ -0,0 +1,15 @@ +{ dg-options "-O0" } + +module Foo = def pub int foo = 10; { dg-final { scan-assembler "FOO_foo" } } + int bar = 20; { dg-final { scan-assembler "FOO_bar" } } + skip + fed, + Bar = def pub int foo = 30; { dg-final { scan-assembler "BAR_foo" } } + int bar = 40; { dg-final { scan-assembler "BAR_bar" } } + skip + fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } +{ dg-final { scan-assembler "BAR__prelude" } } +{ dg-final { scan-assembler "BAR__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-4.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-4.a68 new file mode 100644 index 000000000000..4bb53949ba3e --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-4.a68 @@ -0,0 +1,17 @@ +{ dg-options "-O0" } + +{ Procedure variable declarations. } + +module Foo = def pub proc int foo; { dg-final { scan-assembler "FOO_foo" } } + proc int bar := int: skip; { dg-final { scan-assembler "FOO_bar" } } + skip + fed, + Bar = def pub proc int foo; { dg-final { scan-assembler "BAR_foo" } } + proc int bar := foo; { dg-final { scan-assembler "BAR_bar" } } + skip + fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } +{ dg-final { scan-assembler "BAR__prelude" } } +{ dg-final { scan-assembler "BAR__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-5.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-5.a68 new file mode 100644 index 000000000000..be29ee190950 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-5.a68 @@ -0,0 +1,17 @@ +{ dg-options "-O0" } + +{ Procedure identity declarations. } + +module Foo = def pub proc foo = int: skip; { dg-final { scan-assembler "FOO_foo" } } + proc bar = int: skip; { dg-final { scan-assembler "FOO_bar" } } + skip + fed, + Bar = def pub proc foo = int: skip; { dg-final { scan-assembler "BAR_foo" } } + proc bar = int: skip; { dg-final { scan-assembler "BAR_bar" } } + skip + fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } +{ dg-final { scan-assembler "BAR__prelude" } } +{ dg-final { scan-assembler "BAR__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-6.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-6.a68 new file mode 100644 index 000000000000..8ba5333ea845 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-6.a68 @@ -0,0 +1,21 @@ +{ dg-options "-O0" } + +{ Operator brief identity declarations. } + +module Foo = def pub op + = (int a, b) int: a + b; + { dg-final { scan-assembler "FOO_u_" } } + op - = (int a, b) int: a - b; + { dg-final { scan-assembler "FOO_m_" } } + skip + fed, + Bar = def pub op + = (int a, b) int: a + b; + { dg-final { scan-assembler "BAR_u_" } } + op - = (int a, b) int: a - b; + { dg-final { scan-assembler "BAR_m_" } } + skip + fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } +{ dg-final { scan-assembler "BAR__prelude" } } +{ dg-final { scan-assembler "BAR__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-7.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-7.a68 new file mode 100644 index 000000000000..5c62a7987875 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-7.a68 @@ -0,0 +1,19 @@ +{ dg-options "-O0" } + +{ Operator identity declarations. } + +module Foo = +def prio // = 8; + pub op(int,int)int // = lala; + { dg-final { scan-assembler "FOO_s_s_" } } + proc lala = (int a, b) int: a + b; + prio JORL = 8, JURL = 9; + pub op(int,int)int JORL = lala; + { dg-final { scan-assembler "FOO_JORL" } } + op(int,int)int JURL = (int a, b) int: a - b; + { dg-final { scan-assembler "FOO_JORL" } } + skip +fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-8.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-8.a68 new file mode 100644 index 000000000000..054befb7c6fa --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-8.a68 @@ -0,0 +1,18 @@ +{ dg-options "-O0" } + +{ Symbols that should _not_ include the module name. } + +module Foo = +def begin string foo = "foo'n"; { dg-final { scan-assembler-not "FOO_foo" } } + proc printfoo = void: puts (foo); { dg-final { scan-assembler-not "FOO_printfoo" } } + printfoo + end; + skip +postlude + int lala; + proc incrlala = void: lala +:= 1; { dg-final { scan-assembler-not "FOO_incrlala" } } + incrlala +fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-pub-mangling-9.a68 b/gcc/testsuite/algol68/compile/module-pub-mangling-9.a68 new file mode 100644 index 000000000000..6a6bab1211f2 --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-pub-mangling-9.a68 @@ -0,0 +1,14 @@ +{ dg-options "-O0" } + +{ Operator symbols are numbered so having overloaded symbols in the + module's public range works. } + +module Foo = +def prio // =9; + op // = (int a, b) int: a + b; { dg-final { scan-assembler "FOO_s_s_\[0-9\]+" } } + op // = (real a, b) real: a + b; { dg-final { scan-assembler "FOO_s_s_\[0-9\]+" } } + skip +fed + +{ dg-final { scan-assembler "FOO__prelude" } } +{ dg-final { scan-assembler "FOO__postlude" } } diff --git a/gcc/testsuite/algol68/compile/module-top-down-1.a68 b/gcc/testsuite/algol68/compile/module-top-down-1.a68 new file mode 100644 index 000000000000..3f130c25019c --- /dev/null +++ b/gcc/testsuite/algol68/compile/module-top-down-1.a68 @@ -0,0 +1,14 @@ +{ This test is to check that serial clauses and + enquiry clauses are properly skipped in module texts. } +module Foo = +def int i; + int j = 20; + string ss; + prio // = 8; + op // = (int a, b) int: a + b; + proc ticks = void: to i do puts ("tick'n") od; + i := 5 +postlude + if j > 5 then ticks fi; + (j < 0 | puts ("error'n") | puts ("success'n")) +fed diff --git a/gcc/testsuite/algol68/compile/modules/compile.exp b/gcc/testsuite/algol68/compile/modules/compile.exp new file mode 100644 index 000000000000..af254e8e594d --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/compile.exp @@ -0,0 +1,40 @@ +# Copyright (C) 2024 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +# Compile tests, no torture testing. +# +# These tests raise errors in the front end; torture testing doesn't apply. + +load_lib algol68-dg.exp + +# Initialize `dg'. +dg-init + +# The programs need to be able to find the built modules, which are +# left in objdir. + +global MODULES_OPTIONS +set MODULES_OPTIONS "-I $objdir" + +# Main loop. +set saved-dg-do-what-default ${dg-do-what-default} + +set dg-do-what-default "compile" +algol68-dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/program*.a68]] "" "" +set dg-do-what-default ${saved-dg-do-what-default} + +# All done. +dg-finish diff --git a/gcc/testsuite/algol68/compile/modules/module1.a68 b/gcc/testsuite/algol68/compile/modules/module1.a68 new file mode 100644 index 000000000000..f49a747033e0 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module1.a68 @@ -0,0 +1,9 @@ +module Module1 = +def + pub mode MyInt = int; + pub int beast_number := 666; + pub string who = "jemarch"; + puts ("Hello from module'n") +postlude + puts ("Bye from module'n") +fed diff --git a/gcc/testsuite/algol68/compile/modules/module2.a68 b/gcc/testsuite/algol68/compile/modules/module2.a68 new file mode 100644 index 000000000000..57c68e579b81 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module2.a68 @@ -0,0 +1,5 @@ +module Module2 = +def prio // = 9; { Note priority is not publicized. } + pub op // = (int a, b) int: a + b; + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/module3.a68 b/gcc/testsuite/algol68/compile/modules/module3.a68 new file mode 100644 index 000000000000..143a4693593a --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module3.a68 @@ -0,0 +1,6 @@ +module Module_3 = +def pub proc foo = (int i, string s) void: skip; + pub mode Jorl = struct (int i, string s); + pub mode Jurl = union (int, string, real); + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/module4.a68 b/gcc/testsuite/algol68/compile/modules/module4.a68 new file mode 100644 index 000000000000..f0ae6e689b4f --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module4.a68 @@ -0,0 +1,4 @@ +module Module_4 = +def access Module_3 (foo (10, "foo")); + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/module5.a68 b/gcc/testsuite/algol68/compile/modules/module5.a68 new file mode 100644 index 000000000000..ebb06fb329af --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module5.a68 @@ -0,0 +1,6 @@ +module Module_5 = +def + pub mode JSON_Val = union (ref JSON_Elm,int), + JSON_Elm = struct (int lala); + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/module6.a68 b/gcc/testsuite/algol68/compile/modules/module6.a68 new file mode 100644 index 000000000000..b0fefb5522f0 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module6.a68 @@ -0,0 +1,5 @@ +module Module6 = + access Module5 +def pub proc getval = JSON_VAl: skip; + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/module7.a68 b/gcc/testsuite/algol68/compile/modules/module7.a68 new file mode 100644 index 000000000000..f585171bf277 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module7.a68 @@ -0,0 +1,5 @@ +module Module7 = +access Module5, Module6 +def pub JSON_Val val = getval; + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/module8.a68 b/gcc/testsuite/algol68/compile/modules/module8.a68 new file mode 100644 index 000000000000..8704474436ce --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module8.a68 @@ -0,0 +1,5 @@ +module Module_8 = +def + pub proc lala = ([]struct (string n, v) arg) void: skip; + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/module9.a68 b/gcc/testsuite/algol68/compile/modules/module9.a68 new file mode 100644 index 000000000000..55afd6fef75f --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/module9.a68 @@ -0,0 +1,6 @@ +module Module_9 = +def + pub mode Foo = struct (flex[1:0]Event events); + pub mode Event = int; + skip +fed diff --git a/gcc/testsuite/algol68/compile/modules/program-7.a68 b/gcc/testsuite/algol68/compile/modules/program-7.a68 new file mode 100644 index 000000000000..a3cb1bf2a725 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/program-7.a68 @@ -0,0 +1,3 @@ +{ dg-modules "module5 module6 module7" } + +access Module7 (skip) diff --git a/gcc/testsuite/algol68/compile/modules/program-8.a68 b/gcc/testsuite/algol68/compile/modules/program-8.a68 new file mode 100644 index 000000000000..ba7675503987 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/program-8.a68 @@ -0,0 +1,3 @@ +{ dg-modules "module8" } + +access Module_8 ( lala ((("foo", "bar"), ("baz", "quux"))) ) diff --git a/gcc/testsuite/algol68/compile/modules/program-9.a68 b/gcc/testsuite/algol68/compile/modules/program-9.a68 new file mode 100644 index 000000000000..585607ae36b6 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/program-9.a68 @@ -0,0 +1,3 @@ +{ dg-modules "module9" } + +access Module_9 (skip) diff --git a/gcc/testsuite/algol68/compile/modules/program-error-no-prio-1.a68 b/gcc/testsuite/algol68/compile/modules/program-error-no-prio-1.a68 new file mode 100644 index 000000000000..dcca8a9baeb8 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/program-error-no-prio-1.a68 @@ -0,0 +1,6 @@ +{ dg-modules "module2" } + +access Module_2 +begin assert (2 // 3 = 5); { dg-error "no priority" } + skip +end diff --git a/gcc/testsuite/algol68/compile/modules/program-error-outside-access-1.a68 b/gcc/testsuite/algol68/compile/modules/program-error-outside-access-1.a68 new file mode 100644 index 000000000000..39f0f1896f81 --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/program-error-outside-access-1.a68 @@ -0,0 +1,6 @@ +{ dg-modules "module1" } + +begin int x = access Module1 ( beast_number ), + y = beast_number; { dg-error "declared" } + skip +end diff --git a/gcc/testsuite/algol68/compile/modules/program-module-accesses-module-1.a68 b/gcc/testsuite/algol68/compile/modules/program-module-accesses-module-1.a68 new file mode 100644 index 000000000000..7ba7804636cf --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/program-module-accesses-module-1.a68 @@ -0,0 +1,5 @@ +{ dg-modules "module3 module4" } +{ This test accesses a Module4 that itself accesses a Module3. } + +access Module_4 (skip) + diff --git a/gcc/testsuite/algol68/compile/modules/program-proc-arg-order-1.a68 b/gcc/testsuite/algol68/compile/modules/program-proc-arg-order-1.a68 new file mode 100644 index 000000000000..eecf6867ba1f --- /dev/null +++ b/gcc/testsuite/algol68/compile/modules/program-proc-arg-order-1.a68 @@ -0,0 +1,8 @@ +{ dg-modules "module3" } + +access Module_3 +begin foo (10, "foo"); + Jorl x = (10, "foo"); + Jurl y = 3.14; + skip +end diff --git a/gcc/testsuite/algol68/compile/nested-comment-1.a68 b/gcc/testsuite/algol68/compile/nested-comment-1.a68 new file mode 100644 index 000000000000..f5752435a0e8 --- /dev/null +++ b/gcc/testsuite/algol68/compile/nested-comment-1.a68 @@ -0,0 +1,4 @@ +{ Comment delimiters within strings get ignored. } +begin { puts { ("{""'n"); } } + skip +end diff --git a/gcc/testsuite/algol68/compile/nested-comment-2.a68 b/gcc/testsuite/algol68/compile/nested-comment-2.a68 new file mode 100644 index 000000000000..9fc912f26872 --- /dev/null +++ b/gcc/testsuite/algol68/compile/nested-comment-2.a68 @@ -0,0 +1,6 @@ +{ The string in nested comment is in one logical line. } +begin + { puts ("{'n\ +"); { this prints foo }} + skip +end diff --git a/gcc/testsuite/algol68/compile/operators-firmly-related.a68 b/gcc/testsuite/algol68/compile/operators-firmly-related.a68 new file mode 100644 index 000000000000..a7efe750219a --- /dev/null +++ b/gcc/testsuite/algol68/compile/operators-firmly-related.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN PRIO MIN = 6; + OP MIN = (REF REAL a, b) REF REAL: (a < b | a | b), # { dg-error "firmly related" } # + MIN = (REAL a, b) REAL: (a < b | a | b); # { dg-error "firmly related" } # + SKIP +END diff --git a/gcc/testsuite/algol68/compile/recursive-modes-1.a68 b/gcc/testsuite/algol68/compile/recursive-modes-1.a68 new file mode 100644 index 000000000000..4a77a5646bef --- /dev/null +++ b/gcc/testsuite/algol68/compile/recursive-modes-1.a68 @@ -0,0 +1,33 @@ +# { dg-options "-fstropping=upper" } # + +# This program triggered a bug related to incomplete modes. # +BEGIN MODE REC_MSET = STRUCT (REF REC_MSET_ELM head, tail, + INT num elems, + PROC(REC_MSET_DATA)BOOL gate), + REC_MSET_ELM = STRUCT (REC_MSET_DATA data, BOOL mark, REF REC_MSET_ELM next), + REC_MSET_DATA = UNION (REC_RSET,REC_RECORD,REC_FIELD,REC_CMNT), + REC_RSET = STRUCT (REC_MSET mset, + INT min size, max size, + REF REC_RECORD descriptor), + REC_RECORD = STRUCT (REC_LOC loc, REC_MSET mset, INT foo), + REC_CMNT = STRUCT (REC_LOC loc, STRING content), + REC_FIELD = STRUCT (REC_LOC loc, STRING name, value), + REC_LOC = STRUCT (STRING source, INT line, char); + + PROC rec loc unknown = REC_LOC: + ("unknown", 0, 0); + PROC rec record gate = (REC_MSET_DATA d) BOOL: + (d | (REC_FIELD): TRUE, (REC_CMNT): TRUE | FALSE); + REF REC_MSET_ELM rec no mset elm = NIL; + + PROC rec mset new = (PROC(REC_MSET_DATA)BOOL gate) REC_MSET: + (HEAP REC_MSET := (rec no mset elm, rec no mset elm, + 0, gate)); + + REF REC_RECORD rec no record = NIL; + + PROC rec record new = REF REC_RECORD: + HEAP REC_RECORD := (rec loc unknown, rec mset new (rec record gate), 0); + + SKIP +END diff --git a/gcc/testsuite/algol68/compile/recursive-modes-2.a68 b/gcc/testsuite/algol68/compile/recursive-modes-2.a68 new file mode 100644 index 000000000000..f79b214d0751 --- /dev/null +++ b/gcc/testsuite/algol68/compile/recursive-modes-2.a68 @@ -0,0 +1,7 @@ +begin mode Word = union (int, struct (ref Word w)), + Value = union (void,Word), + Stack = struct (ref Stack prev, Value val); + + struct (Word a) qs; { type_2 has no size! } + skip +end diff --git a/gcc/testsuite/algol68/compile/serial-clause-jump-1.a68 b/gcc/testsuite/algol68/compile/serial-clause-jump-1.a68 new file mode 100644 index 000000000000..f4e3773ba53a --- /dev/null +++ b/gcc/testsuite/algol68/compile/serial-clause-jump-1.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # + +# This is an infinite loop, but it should compile just fine an yield + an integer after infinite time. # + +BEGIN foo: foo +END diff --git a/gcc/testsuite/algol68/compile/snobol.a68 b/gcc/testsuite/algol68/compile/snobol.a68 new file mode 100644 index 000000000000..9b6c4fc824fa --- /dev/null +++ b/gcc/testsuite/algol68/compile/snobol.a68 @@ -0,0 +1,1100 @@ +# { dg-options "-fstropping=upper" } # + +# This is Frank Pagan's SNOBOL4 Interpreter in ALGOL 68 (1976), + fetched from Dick Grune's page https://dickgrune.com/CS/Algol68/ + + The interpreter described in "Algol 68 as an Implementation Language\ + for Portable Interpreters", ACM SIGPLAN Notices - Proceedings of the + Strathclyde ALGOL 68 conference, Volume 12 Issue 6, June 1977, + pp. 54 - 62, and "A Highly-Structured Interpreter for a SNOBOL4 + Subset", Software: Practice and Experience, Vol. 9, 4, + pp. 281-312, April 1979. + + Modifications by Jose E. Marchesi: + - Use the simple POSIX-like transput provided by GCC. + - Read programs from lines rather than from cards. + - Add command-line option -l (listing). +# + +BEGIN PROC itoa = (INT i) STRING: + BEGIN IF i = 0 + THEN "0" + ELSE INT n := ABS i; + STRING res; + WHILE n /= 0 + DO INT rem = n %* 10; + res := REPR (rem > 9 | (rem - 10) + ABS "a" | rem + ABS "0") + res; + n %:= 10 + OD; + (i < 0 | "-" + res | res) + FI + END; + + CHAR sharp = REPR 35; # Sharp character, + to avoid confusing Emacs. # + + # Input file. # + INT filein; + + # IMPLEMENTATION RESTRICTIONS # + INT spoolsize = 400, + stlim = 50, + arglim = 5, + rslim = 80, + pslim = 20, + ftlim = 10; + + # ABSTRACT MACHINE # + MODE ITEM = UNION (INT, REF STRINGITEM, PATTERN), + STRINGITEM = STRUCT (STRING val, REF ITEM ref), + PATTERN = REF[]COMPONENT, + COMPONENT = STRUCT (INT routine, subsequent, alternate, extra, + REF ITEM arg), + PSENTRY = STRUCT (INT cursor, alternate), + RSENTRY = REF ITEM, + FTENTRY = STRUCT (REF ITEM fnname, entry name, + REF[]REF ITEM params, locals); + + [1:spoolsize] REF ITEM spool; + [1:pslim] PSENTRY pattern stack; + [1:rslim] RSENTRY run stack; + [1:ftlim] FTENTRY function table; + + BOOL failed := FALSE; + INT nin, psp, rsp := 0, ftp := 0; + INT mstr = 1, mlen = 2, mbrk = 3, mspn = 4, many = 5, mnul = 6, + miv1 = 7, miv2 = 8, m1 = 9, mat = 10, mpos = 11, mtab = 12, + mrpos = 13, mrtab = 14, mnty = 15; + + # INTERNAL FORM OF PROGRAMS # + + MODE STMT = STRUCT (REF IDR label, + UNION (REF ASMT, REF MATCH, + REF REPL, REF EXPR) stmt core, + REF GOTOFIELD goto), + IDR = STRUCT (REF ITEM idr addr), + NUM = STRUCT (REF ITEM num addr), + LSTR = STRUCT (REF ITEM lstr addr), + ASMT = STRUCT (REF EXPR subject, object), + MATCH = STRUCT (REF EXPR subject, pattern), + REPL = STRUCT (REF EXPR subject, pattern, object), + EXPR = UNION (REF UNARYEXPR, REF BINARYEXPR, IDR, NUM, + LSTR, REF CALL), + GOTOFIELD = STRUCT (REF DEST upart, spart, fpart), + DEST = UNION (REF EXPR, CHAR), + UNARYEXPR = STRUCT (REF EXPR operand, CHAR operator), + BINARYEXPR = STRUCT (REF EXPR operand1, operand2, + CHAR operator), + CALL = STRUCT (IDR fnname, REF[]REF EXPR args); + + REF[]STMT t; + REF ITEM prog entry := NIL; + + PROC error = (STRING mess) VOID: + (puts ("error: " + mess + "'n"); stop); + + # TRANSLATION PHASE # + + BEGIN # DECLARATIONS FOR SCANNER # + STRING card, INT cp, # SOURCE LINE AND POINTER # + CHAR ch, # SOURCE CHARACTER # + [1:80]CHAR str, INT sp, # STRING BUFFER AND POINTER # + CHAR tok, # TOKEN CODE # + REF ITEM psn, # POSITION OF A CREATED VALUE # + INT nv, # NUMERIC VALUE OF CONSTANT # + INT stn, # SOURCE STATEMENT NUMBER # + BOOL listing, # FLAG FOR SOURCE LISTING # + CHAR c; # TEMPORARY # + + # TOKEN MNEMONICS # + CHAR doll = "$", bdoll = "D", + plus = "+", bplus = "P", + minus = "-", bminus = "M", + at = "@", bbar = "!", + bstar = "*", bslash = "/", + lpar = "(", rpar = ")", + comma = ",", colon = ":", + equal = "=", blank = " ", + eos = ";", name = "A", + lstring = "L", number = "U", + endt = "E", ret = "R", + fret = "F", stok = "Y", + ftok = "Z"; + + PROC get card = VOID: + BEGIN cp := 0; + WHILE card := fgets (filein, 80); + IF UPB card = 0 THEN exit FI; + c := card[1]; + IF c /= "." AND c /= "+" AND c /= "-" AND c /= "*" + THEN stn := stn + 1 FI; + IF listing THEN puts (itoa (stn) + " " + card + "'n") FI; + IF c = "-" + THEN IF card[2:5] = "LIST" + THEN listing := TRUE + ELIF card[2:7] = "UNLIST" + THEN listing := FALSE + FI + FI; + c = "-" OR c = "*" + DO SKIP OD; + exit: SKIP + END; + + PROC next ch = VOID: + IF cp = UPB card + THEN get card; + IF c = "." OR c = "+" + THEN ch := " "; cp := 1 + ELSE ch := sharp # END OF LINE AND STATEMENT # + FI + ELSE ch := card[cp +:= 1] + FI; + + PROC lookup = (STRING sv) REF ITEM : ( + INT i := 0, BOOL nf := TRUE; + WHILE IF (i +:= 1) <= nin + THEN nf := sv /= val OF (spool[i] | (REF STRINGITEM s) : s) + ELSE FALSE + FI + DO SKIP OD; + IF nf + THEN IF nin = spoolsize THEN error ("too many strings") FI; + spool[nin +:= 1] := HEAP ITEM := HEAP STRINGITEM := + (sv, NIL) + FI; + spool[i]); + + PROC scan = VOID: + IF ch = " " # BLANKS AND BINARY OPERATORS # + THEN WHILE next ch; ch = " " DO SKIP OD; + # IGNORE TRAILING BLANKS IN A STATEMENT # + IF ch = ";" THEN next ch; stn := stn + 1; tok := eos + ELIF ch = sharp THEN next ch; tok := eos + ELIF ch = "!" OR ch = "$" OR ch = "+" OR ch = "-" + OR ch = "*" OR ch = "/" + THEN IF card[cp+1] = " " + THEN c := ch; + WHILE next ch; ch = " " DO SKIP OD ; + tok := (c = "!" | bbar + |: c = "$" | bdoll + |: c = "-" | bminus + |: c = "+" | bplus + |: c = "*" | bstar + | bslash) + ELSE tok := blank + FI + ELSE tok := blank + FI + ELIF ch = "''" OR ch = """" # LITERAL STRINGS # + THEN c := ch; sp := 0; + WHILE next ch; + IF ch = sharp THEN error ("UNTERMINATED LITERAL") FI; + (str[sp +:= 1] := ch) /= c + DO SKIP OD ; + next ch; + tok := lstring; + IF sp = 1 + THEN psn := NIL + ELSE STRING s = str[1:sp-1] ; + psn := lookup (s) + FI + ELIF ch >= "0" AND ch <= "9" # NUMBERS # + THEN nv := 0 ; + WHILE nv := nv * 10 + ABS ch - ABS "0"; + next ch; + ch >= "0" AND ch <= "9" + DO SKIP OD ; + tok := number; + psn := HEAP ITEM := nv + ELIF ch >= "A" AND ch <= "Z" # NAMES # + THEN sp := 0; + WHILE str[sp +:= 1] := ch; + next ch; + ch = "." OR ch >= "A" AND ch <= "Z" + OR ch >= "0" AND ch <= "9" + DO SKIP OD ; + STRING s = str[1:sp]; + tok := (s = "S" | stok + |: s = "F" | ftok + |: s = "END" | endt + |: s = "RETURN" | ret + |: s = "FRETURN" | fret + | psn := lookup (s); name) + ELIF ch = ";" + THEN next ch; stn := stn + 1; tok := eos + ELIF ch = sharp + THEN next ch; tok := eos + ELSE # ( ) , : = @ $ + - # + tok := ch; next ch + FI; + + PROC init = VOID: + BEGIN stn := 0; + spool[nin := 1] := HEAP ITEM := HEAP STRINGITEM := + ("ARB", HEAP ITEM := HEAP[1:3]COMPONENT := + ((mnul, 2, 0, SKIP, NIL), + (mnul, 0, 3, SKIP, NIL), + (m1, 2, 0, SKIP, NIL))); + get card; + next ch; + scan + END; + + PROC verify = (CHAR token) VOID: + IF tok = token THEN scan + ELSE STRING s := "TOKEN "" "" DOES NOT OCCUR WHERE EXPECTED"; + s[8] := token; + error (s) + FI; + + PROC translate = VOID: + BEGIN HEAP[1:stlim]STMT ss, INT ssc := 0; + WHILE IF ssc = stlim THEN error ("TOO MANY STATEMENTS") FI; + tok /= endt + DO ss[ssc +:= 1] := trans stmt OD; + scan; + IF tok = blank + THEN scan; + IF tok = name THEN prog entry := psn FI + FI; + t := ss[1:ssc] + END; + + PROC trans stmt = STMT: + BEGIN + REF IDR lab := NIL; + REF EXPR subj, pat, obj := NIL; + REF GOTOFIELD go := NIL; + BOOL asgn; + + PROC move to obj = STMT: + BEGIN + IF tok = blank + THEN scan; + IF tok = colon + THEN go := trans gofield + ELSE obj := trans expr; + IF tok = colon + THEN go := trans gofield + ELSE verify (eos) + FI + FI + ELSE verify (eos) + FI ; + IF asgn + THEN STMT (lab, HEAP ASMT := (subj, obj), go) + ELSE STMT (lab, HEAP REPL := (subj, pat, obj), go) + FI + END; + + PROC move to subj = STMT: + BEGIN scan; + IF tok = colon + THEN STMT (lab, REF EXPR (NIL), trans gofield) + ELSE subj := trans elem; + IF tok = blank + THEN scan; + IF tok = colon + THEN STMT (lab, REF EXPR (subj), trans gofield) + ELIF tok = equal + THEN asgn := TRUE; scan; move to obj + ELSE pat := trans expr; + IF tok = colon + THEN STMT (lab, HEAP MATCH := (subj, pat), trans gofield) + ELIF tok = equal + THEN asgn := FALSE; scan; move to obj + ELSE verify (eos); + STMT (lab, HEAP MATCH := (subj, pat), NIL) + FI + FI + ELSE verify (eos); + STMT (lab, REF EXPR (subj), NIL) + FI + FI + END; + + # Body of trans stmt. # + IF tok = name + THEN lab := HEAP IDR; idr addr OF lab := psn; scan; + IF tok = blank + THEN move to subj + ELSE verify (eos); + STMT (lab, REF EXPR (NIL), NIL) + FI + ELIF tok = blank + THEN move to subj + ELSE verify (eos); + STMT (lab, REF EXPR (NIL), NIL) + FI + END; + + PROC trans gofield = REF GOTOFIELD: + BEGIN PROC where = REF DEST: + BEGIN HEAP DEST d; + verify (lpar); + IF tok = blank THEN scan FI; + d := (tok = endt | scan; "E" + |: tok = ret | scan; "R" + |: tok = fret | scan; "F" + | trans expr); + verify (rpar); + d + END; + + REF DEST uncond := NIL, succ := NIL, fail := NIL; + scan; IF tok = blank THEN scan FI; + IF tok = stok + THEN scan; succ := where; + IF tok = blank THEN scan FI; + IF tok = ftok THEN scan; fail := where FI; + verify (eos) + ELIF tok = ftok + THEN scan; fail := where; + IF tok = blank THEN scan FI; + IF tok = stok THEN scan; succ := where FI; + verify (eos) + ELSE uncond := where; verify (eos) + FI; + HEAP GOTOFIELD := (uncond, succ, fail) + END; + + PROC trans expr = REF EXPR: + BEGIN REF EXPR e := trans expr1; + WHILE tok = bbar + DO scan; + e := HEAP EXPR := HEAP BINARYEXPR := (e, trans expr1, "!") + OD; + e + END; + + PROC trans expr1 = REF EXPR: + BEGIN REF EXPR e := trans expr2; + WHILE tok = blank + DO scan; + IF tok /= colon AND tok /= rpar AND tok /= comma AND tok /= equal + THEN e := HEAP EXPR := HEAP BINARYEXPR := (e, trans expr2, "C") + FI + OD; + e + END; + + PROC trans expr2 = REF EXPR: + BEGIN REF EXPR e := trans term; + CHAR opr; + WHILE tok = bplus OR tok = bminus + DO opr := (tok = bplus | "+" | "-"); + scan; + e := HEAP EXPR := HEAP BINARYEXPR := (e, trans term, opr) + OD; + e + END; + + PROC trans term = REF EXPR: + BEGIN REF EXPR e := trans term1; + WHILE tok = bslash + DO scan; + e := HEAP EXPR := HEAP BINARYEXPR := (e, trans term1, "/") + OD; + e + END; + + PROC trans term1 = REF EXPR: + BEGIN REF EXPR e := trans term2; + WHILE tok = bstar + DO scan; + e := HEAP EXPR := HEAP BINARYEXPR := (e, trans term2, "*") + OD; + e + END; + + PROC trans term2 = REF EXPR: + BEGIN REF EXPR e := trans elem; + WHILE tok = bdoll + DO scan; + e := HEAP EXPR := HEAP BINARYEXPR := (e, trans elem, "$") + OD; + e + END; + + PROC trans elem = REF EXPR: + IF tok = doll OR tok = plus OR tok = minus OR tok = at + THEN CHAR opr = tok; + scan; + HEAP EXPR := HEAP UNARYEXPR := (trans element, opr) + ELSE trans element + FI; + + PROC trans element = REF EXPR: + IF tok = name + THEN IDR n; + idr addr OF n := psn; + scan; + IF tok /= lpar + THEN HEAP EXPR := n + ELSE HEAP[1:arglim]REF EXPR a, INT ac := 0; + WHILE scan; + IF tok = blank THEN scan FI; + IF ac = arglim + THEN error ("TOO MANY ARGUMENTS IN FUNCTION CALL") + FI; + IF NOT (ac = 0 AND tok = rpar) + THEN a[ac +:= 1] := (tok = comma OR tok = rpar | NIL | trans expr) + FI; + IF tok /= comma AND tok /= rpar + THEN error ("ERROR IN ARGUMENT LIST") + FI; + tok = comma + DO SKIP OD; + scan; + HEAP EXPR := HEAP CALL := (n, a[1:ac]) + FI + ELIF tok = lstring + THEN LSTR ls; + lstr addr OF ls := psn; + scan; + HEAP EXPR := ls + ELIF tok = number + THEN NUM nu; num addr OF nu := psn; + scan; + HEAP EXPR := nu + ELSE verify (lpar); + IF tok = blank THEN scan FI; + REF EXPR e = trans expr; + verify (rpar); + e + FI; + + PROC usage = VOID: + BEGIN puts ("Usage: snobol [-l] FILE'n"); + stop + END; + + listing := FALSE; + IF argc < 2 THEN usage FI; + FOR i FROM 2 TO argc + DO IF argv (i) = "-l" THEN listing := TRUE + ELIF filein = 0 + THEN filein := fopen (argv (i), file o rdonly); + IF (filein = -1) + THEN error ("opening " + argv (i) + ": " + strerror (errno)) FI + ELSE usage + FI + OD; + init; + translate + END; # TRANSLATION PHASE # + + BEGIN # INTERPRETATION PHASE # + + OP INTG = (REF ITEM a) INT: (a | (INT i) : i), + STR = (REF ITEM a) REF STRINGITEM: (a | (REF STRINGITEM s): s), + PAT = (REF ITEM a) PATTERN: (a | (PATTERN p) : p); + BOOL fn success; + + PROC interpret = (INT stmt no) VOID: + BEGIN INT sn := stmt no; BOOL cycling := TRUE; + + PROC jump = (REF DEST dest) VOID: + BEGIN failed := FALSE; + CASE dest + IN (REF EXPR e): sn := find label (eval softly (e)), + (CHAR c): IF c = "E" THEN sn := UPB t + 1 + ELIF c = "R" THEN fn success := TRUE; + cycling := FALSE + ELSE # c = "F" # fn success := cycling := FALSE + FI + ESAC + END; + + WHILE cycling + DO IF sn > UPB t THEN stop FI; + failed := FALSE; + + # EXECUTE STATEMENT CORE # + CASE stmt core OF t[sn] + IN (REF ASMT a): + (REF ITEM sp = eval softly (subject OF a); + assign (sp, eval strongly (object OF a))), + (REF MATCH m): + (REF ITEM svp = eval strongly (subject OF m); + match (convert to str (svp), + convert to pat (eval strongly (pattern OF m)))), + (REF REPL r): + (REF ITEM sp = eval softly (subject OF r); + REF ITEM pp = convert to pat (eval strongly (pattern OF r)); + REF ITEM svp = convert to str (ref OF (STR sp)); + INT c = match (svp, pp); + REF ITEM b = (svp IS NIL | NIL | make str ((val OF (STR svp))[c+1:])); + REF ITEM obp = eval strongly (object OF r); + assign (sp, concatenate (obp, b))), + (REF EXPR e): + eval strongly (e) + ESAC; + + # PROCESS GOTO FIELD # + REF GOTOFIELD go = goto OF t[sn]; + IF go IS NIL THEN sn := sn + 1 + ELIF REF DEST (upart OF go) ISNT NIL + THEN jump (upart OF go) + ELIF NOT failed AND (REF DEST (spart OF go) ISNT NIL) + THEN jump (spart OF go) + ELIF failed AND (REF DEST (fpart OF go) ISNT NIL) + THEN jump (fpart OF go) + ELSE sn := sn + 1 + FI + OD + END; # END OF INTERPRET # + + PROC find label = (REF ITEM label ptr) INT: + BEGIN INT stmt no := 0; + IF failed THEN error ("FAILURE IN GOTO FIELD") FI; + FOR i TO UPB t WHILE stmt no = 0 + DO IF (REF IDR (label OF t[i]) IS NIL + | FALSE + | label ptr IS idr addr OF label OF t[i]) + THEN stmt no := i + FI + OD; + IF stmt no = 0 THEN error ("UNDEFINED LABEL") FI; + stmt no + END; + + PROC match = (REF ITEM subject ptr, pattern ptr) INT: + IF failed + THEN 0 + ELSE PATTERN p = PAT pattern ptr; + STRING subj = (subject ptr IS NIL | "" | val OF (STR subject ptr)); + INT u = UPB subj; + INT iarg, # INTEGER COMPONENT ARGUMENT # + STRING sarg, # STRING COMPONENT ARGUMENT # + INT l; # LENGTH OF SARG # + INT cn := 1, # COMPONENT NUMBER # + c := 0, # CURSOR # + code; # NEW CURSOR OR -1 IF COMPONENT NO-MATCH # + BOOL matching := TRUE; + + psp := 0; # CLEAR PATTERN STACK # + WHILE matching + DO IF alternate OF p[cn] /= 0 + THEN # PUSH PATTERN STACK # + pattern stack[psp +:= 1] := (c, alternate OF p[cn]) + FI; + IF REF ITEM (arg OF p[cn]) ISNT NIL + THEN CASE arg OF p[cn] + IN (INT i) : iarg := i, + (REF STRINGITEM s): + (sarg := val OF s; l := UPB sarg) + ESAC + FI; + + # EXECUTE INDICATED MATCHING ROUTINE # + CASE routine OF p[cn] + IN # MSTR # + IF REF ITEM (arg OF p[cn]) IS NIL + THEN code := c + ELIF c + l > u THEN code := -1 + ELSE code := (sarg = subj[c+1:c+l] | c + l | -1) + FI, + # MLEN # + code := (iarg <= u - c | c + iarg | -1), + # MBRK # + IF c >= u THEN code := -1 + ELSE INT n = break scan (subj[c+1:], sarg); + code := (n < u - c | c + n | -1) + FI, + # MSPN # + IF c >= u THEN code := -1 + ELIF any (sarg, subj[c+1]) + THEN INT j := c + 1; + FOR i FROM c + 2 TO u WHILE any (sarg, subj[i]) + DO j := i OD; + code := j + ELSE code := -1 + FI, + # MANY # + IF c >= u + THEN code := -1 + ELSE code := (any (sarg, subj[c+1]) | c + 1 | -1) + FI, + # MNUL # + code := c, + # MIV1 # + code := extra OF p[cn] := c, + # MIV2 # + (INT m = extra OF p[cn - extra OF p[cn]] + 1; + assign (arg OF p[cn], make str (subj[m:c])); + code := c), + # M1 # + code := (1 <= u - c | c + 1 | -1), + # MAT # + (assign (arg OF p[cn], make int (c)); + code := c), + # MPOS # + code := (c = iarg | c | -1), + # MTAB # + code := (c <= iarg AND iarg <= u | iarg | -1), + # MRPOS # + code := (u - c = iarg | c | -1), + # MRTAB # + code := (u - c >= iarg | u - iarg | -1), + # MNTY # + IF c >= u + THEN code := -1 + ELSE code := (any (sarg, subj[c+1]) | -1 | c + 1) + FI + ESAC; + + # DECIDE WHAT TO DO NEXT # + IF code >= 0 + THEN IF subsequent OF p[cn] = 0 + THEN matching := FALSE #SUCCESSFUL TERMINATION # + ELSE cn := subsequent OF p[cn]; + c := code # CONTINUE # + FI + ELIF psp = 0 + THEN failed := TRUE; + matching := FALSE # STMT FAILURE # + ELSE # POP PATTERN STACK TO BACKTRACK # + cn := alternate OF pattern stack[psp]; + c := cursor OF pattern stack[psp]; + psp := psp - 1 + FI + OD; + (failed | 0 | code) + FI; # END OF MATCH PROCEDURE # + + PROC assign = (REF ITEM subject ptr, object ptr) VOID: + IF failed THEN SKIP + ELSE REF STRINGITEM s = STR subject ptr; + ref OF s := object ptr; + IF val OF s = "OUTPUT" + THEN IF object ptr IS NIL + THEN puts ("'n") + ELSE CASE object ptr + IN (REF STRINGITEM r): puts ((val OF r) + "'n"), + (INT i): puts (itoa (i) + "'n"), + (PATTERN): (error ("ATTEMPT TO OUTPUT PATTERN"); SKIP) + ESAC + FI + FI + FI; + + PROC eval softly = (REF EXPR expression) REF ITEM: + IF failed THEN SKIP + ELSE CASE expression # CAN NEVER BE NIL # + IN (IDR id): idr addr OF id, + (REF UNARYEXPR ue): + IF operator OF ue = "$" + THEN REF ITEM r = convert to str (eval strongly (operand OF ue)); + IF r IS NIL + THEN error ("NULL RESULT WHERE VAR REQUIRED"); + SKIP + ELSE r + FI + ELSE error ("INAPPROPRIATE UNARY EXPR WHERE VAR REQUIRED"); + SKIP + FI + OUT error ("INAPPROPRIATE EXPR WHERE VAR REQUIRED"); + SKIP + ESAC + FI; + + PROC eval strongly = (REF EXPR expression) REF ITEM: + IF failed THEN SKIP + ELIF expression IS NIL THEN NIL + ELSE CASE expression + IN (IDR id): + (REF STRINGITEM s = STR (idr addr OF id); + IF val OF s = "INPUT" + THEN STRING line; + # SNOBOL programs read data from stdin. # + line := gets (80); + IF (line = "") THEN failed := TRUE; eof FI; + assign (idr addr OF id, make str (line)); + eof: SKIP + FI; + ref OF s), + (NUM nbr): + num addr OF nbr, + (LSTR ls): + lstr addr OF ls, + (REF UNARYEXPR ue): + (REF ITEM arg ptr = (operator OF ue = "@" + | eval softly (operand OF ue) + | eval strongly (operand OF ue)); + eval unary (arg ptr, operator OF ue)), + (REF BINARYEXPR be): + (REF ITEM arg1 ptr = eval strongly (operand1 OF be); + REF ITEM arg2 ptr = (operator OF be = "$" + | eval softly (operand2 OF be) + | eval strongly (operand2 OF be)); + eval binary (arg1 ptr, arg2 ptr, operator OF be)), + (REF CALL cl): + (INT n = UPB args OF cl; + [1:n]REF ITEM arglist; + FOR i TO n + DO arglist[i] := eval strongly ((args OF cl)[i]) OD; + eval call (idr addr OF fnname OF cl, arglist)) + ESAC + FI; + + PROC eval unary = (REF ITEM arg ptr, CHAR opr) REF ITEM: + IF failed THEN SKIP + ELSE IF opr = "$" + THEN IF arg ptr IS NIL + THEN error ("INDIRECTION APPLIED TO NULL STRING"); + SKIP + ELSE ref OF (STR convert to str (arg ptr)) + FI + ELIF opr = "+" + THEN convert to int (arg ptr) + ELIF opr = "-" + THEN INT k = INTG convert to int (arg ptr); + make int (-k) + ELSE # OPR = "@" # + make pat comp (mat, arg ptr) + FI + FI; + + PROC eval binary = (REF ITEM arg1 ptr, arg2 ptr, CHAR opr) REF ITEM: + IF failed THEN SKIP + ELSE IF opr = "$" + THEN REF ITEM c = concatenate (make pat comp (miv1, NIL), + arg1 ptr); + concatenate (c, make pat comp (miv2, arg2 ptr)) + ELIF opr = "*" OR opr = "/" OR opr = "+" OR opr = "-" + THEN INT m = INTG convert to int (arg1 ptr), + n = INTG convert to int (arg2 ptr); + make int ((opr = "*" | m * n + |: opr = "/" | m OVER n + |: opr = "+" | m + n | m - n)) + ELIF opr = "C" + THEN concatenate (arg1 ptr, arg2 ptr) + ELSE # OPR = "!" # + PATTERN p1 = PAT convert to pat (arg1 ptr), + p2 = PAT convert to pat (arg2 ptr); + INT u1 = UPB p1, u2 = UPB p2; + PATTERN p = HEAP[u1 + u2]COMPONENT, + INT offset = u1 + 1, INT j := 1; + p[1:u1] := p1[1:u1]; + WHILE alternate OF p[j] /= 0 + DO j := alternate OF p[j] OD; + alternate OF p[j] := offset; + FOR i FROM offset TO u1 + u2 + DO p[i] := p2 [i - u1]; + IF subsequent OF p[i] /= 0 + THEN subsequent OF p[i] +:= u1 + FI; + IF alternate OF p[i] /= 0 + THEN alternate OF p[i] +:= u1 + FI + OD; + HEAP ITEM := p + FI + FI; + + PROC eval call = (REF ITEM name ptr, REF[]REF ITEM arglist) REF ITEM: + IF failed THEN SKIP + ELSE # SEARCH FUNCTION TABLE FOR NAME # + BOOL not found := TRUE, INT j; + FOR i TO ftp WHILE not found + DO IF name ptr IS fnname OF function table[i] + THEN j := i; not found := FALSE + FI + OD; + IF not found + THEN exec prim fn (name ptr, arglist) + ELSE #PROGRAMMER-DEFINED FUNCTION # + + PROC stack = (REF ITEM a) VOID: + (IF rsp = rslim THEN error ("RUN STACK OVERFLOW") FI; + run stack [rsp +:= 1] := a); + + PROC unstack = REF ITEM: + (IF rsp = 0 THEN error ("RETURN FROM LEVEL 0") FI; + run stack [(rsp -:= 1) + 1]); + + REF STRINGITEM name = STR name ptr; + + # ENTRY PROTOCOL # + stack (ref OF name); + assign (name ptr, NIL); + REF[]REF ITEM params = params OF function table[j], + INT n = UPB arglist; + IF UPB params /= n + THEN error ("WRONG NUMBER OF ARGUMENTS IN CALL") + FI; + FOR i TO n + DO stack (ref OF (STR params[i])); + assign (params[i], arglist[i]) + OD; + REF[]REF ITEM locals = locals OF function table[j]; + FOR i TO UPB locals + DO stack (ref OF (STR locals[i])); + assign (locals[i], NIL) + OD; + + interpret (find label (entry name OF function table[j])); + + # RETURN PROTOCOL # + FOR i FROM UPB locals BY -1 TO 1 + DO assign (locals[i], unstack) OD; + FOR i FROM n BY -1 TO 1 + DO assign (params[i], unstack) OD; + REF ITEM result = ref OF name; + assign (name ptr, unstack); + (fn success | result | failed := TRUE ; SKIP) + FI + FI; + + PROC exec prim fn = (REF ITEM name ptr, + REF[]REF ITEM arglist) REF ITEM: + BEGIN + PROC gen1 = (INT routine) REF ITEM: + BEGIN # CREATE PATTERN COMPONENT WITH STRING ARGUMENT # + REF ITEM arg = convert to str (arglist[1]); + IF arg IS NIL + THEN error ("NULL ARG FOR PATTERN-VALUED PRIMITIVE FUNCTION" ) + FI; + make pat comp (routine, arg) + END; + + PROC gen2 = (INT routine) REF ITEM: + BEGIN # CREATE PATTERN COMPONENT WITH INTEGER ARGUMENT # + REF ITEM arg = convert to int (arglist[1]); + IF INTG arg < 0 + THEN error ("NEGATIVE ARG FOR PATTERN-VALUED PRIMITIVE FUNCTION") + FI; + make pat comp (routine, arg) + END; + + STRING fn = val OF (STR name ptr), INT n = UPB arglist; + IF fn = "LE" AND n = 2 + THEN IF INTG convert to int (arglist[1]) + <= INTG convert to int (arglist[2]) + THEN NIL + ELSE failed := TRUE; + SKIP + FI + ELIF fn = "EQ" AND n = 2 + THEN IF INTG convert to int (arglist[1]) + = INTG convert to int (arglist[2]) + THEN NIL + ELSE failed := TRUE; + SKIP + FI + ELIF fn = "NE" AND n = 2 + THEN IF INTG convert to int (arglist[1]) + /= INTG convert to int (arglist[2]) + THEN NIL + ELSE failed := TRUE; + SKIP + FI + ELIF fn = "IDENT" AND n = 2 + THEN IF REF ITEM (arglist[1]) IS arglist[2] + THEN NIL + ELSE failed := TRUE; + SKIP + FI + ELIF fn = "DIFFER" AND n = 2 + THEN IF REF ITEM (arglist[1]) ISNT arglist[2] + THEN NIL + ELSE failed := TRUE; + SKIP + FI + ELIF fn = "ANY" AND n = 1 THEN gen1 (many) + ELIF fn = "LEN" AND n = 1 THEN gen2 (mlen) + ELIF fn = "POS" AND n = 1 THEN gen2 (mpos) + ELIF fn = "TAB" AND n = 1 THEN gen2 (mtab) + ELIF fn = "SPAN" AND n = 1 THEN gen1 (mspn) + ELIF fn = "RPOS" AND n = 1 THEN gen2 (mrpos) + ELIF fn = "RTAB" AND n = 1 THEN gen2 (mrtab) + ELIF fn = "BREAK" AND n = 1 THEN gen1 (mbrk) + ELIF fn = "NOTANY" AND n = 1 THEN gen1 (mnty) + ELIF fn = "SIZE" AND n = 1 + THEN make int (UPB val OF (STR convert to str (arglist[1]))) + ELIF fn = "DEFINE" AND n = 2 + THEN IF REF ITEM (arglist[1]) IS NIL + THEN error ("NULL PROTOTYPE") FI; + STRING prototype = val OF (STR convert to str (arglist[1])); + REF ITEM entry = convert to str (arglist[2]); + IF entry IS NIL THEN error ("NULL ENTRY LABEL") FI; + + PROC check and find = (STRING str) REF ITEM: + BEGIN IF UPB str = 0 THEN error ("ILLEGAL PROTOTYPE") FI; + STRING an = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789."; + IF NOT any (an[:26], str[1]) + THEN error ("ILLEGAL PROTOTYPE") FI; + FOR i FROM 2 TO UPB str + DO IF NOT any (an, str[i]) + THEN error ("ILLEGAL PROTOTYPE") + FI + OD; + make str (str) + END; + + PROC breakup = (STRING str) REF[]REF ITEM: + BEGIN #ANALYZE A LIST OF IDENTIFIERS # + [1:arglim]REF ITEM r, INT p := 0, a := 1, b; + WHILE a <= UPB str + DO b := break scan (str[a:], ","); + IF p >= arglim + THEN error ("TOO MANY PARAMETERS OR LOCALS IN PROTOTYPE") FI; + r[p +:= 1] := check and find (str[a:a+b-1]); + a := a + b + 1 + OD; + HEAP[1:p]REF ITEM := r[:p] + END; + + INT lp = UPB prototype; + INT a = break scan (prototype, "("); + IF a >= lp THEN error ("ILLEGAL PROTOTYPE") FI; + REF ITEM name ptr = check and find (prototype[:a]); + INT b = break scan (prototype[a+2:], ")"); + IF b >= lp - a - 1 THEN error ("ILLEGAL PROTOTYPE") FI; + REF[]REF ITEM params = breakup (prototype[a+2:a+1+b]); + REF[]REF ITEM locals = breakup (prototype[a+b+3:]); + + BOOL not found := TRUE; + FOR i TO ftp WHILE not found + DO IF name ptr IS fnname OF function table[i] + THEN not found := FALSE; + function table[i] := (name ptr, entry, params, locals) + FI + OD; + IF not found + THEN IF ftp = ftlim + THEN error ("FUNCTION TABLE OVERFLOW") FI; + function table [ftp +:= 1] := (name ptr, entry, params, locals) + FI; + NIL # RESULT OF DEFINE(...) # + ELSE error ("ILLEGAL FUNCTION CALL"); + SKIP + FI + END; + + PROC concatenate = (REF ITEM ptr1, ptr2) REF ITEM: + BEGIN + + PROC concat patterns = (PATTERN p1, p2) REF ITEM: + BEGIN INT u1 = UPB p1, u2 = UPB p2; + PATTERN p = HEAP[u1 + u2]COMPONENT; + INT offset = u1 + 1; + FOR i TO u1 + DO p[i] := p1[i]; + IF subsequent OF p[i] = 0 + THEN subsequent OF p[i] := offset FI + OD; + FOR i FROM offset TO u1 + u2 + DO p[i] := p2[i - u1]; + IF subsequent OF p[i] /= 0 + THEN subsequent OF p[i] +:= u1 FI; + IF alternate OF p[i] /= 0 + THEN alternate OF p[i] +:= u1 FI + OD; + IF u2 = 1 AND routine OF p[offset] = miv2 + THEN extra OF p[offset] := u1 FI; + HEAP ITEM := p + END; + + IF failed THEN SKIP + ELSE IF ptr1 IS NIL THEN ptr2 + ELIF ptr2 IS NIL THEN ptr1 + ELSE CASE ptr1 + IN (PATTERN p1): + concat patterns (p1, PAT convert to pat (ptr2)) + OUSE ptr2 + IN (PATTERN p2): + concat patterns (PAT convert to pat (ptr1), p2) + OUT STRING s1 = val OF (STR convert to str (ptr1)); + make str (s1 + val OF (STR convert to str (ptr2))) + ESAC + FI + FI + END; + + PROC convert to int = (REF ITEM ptr) REF ITEM: + IF failed THEN SKIP + ELSE IF ptr IS NIL THEN make int (0) + ELSE CASE ptr + IN (INT): ptr, + (PATTERN): (error ("PATTERN VALUE WHERE INTEGER REQUIRED"); SKIP), + (REF STRINGITEM s): + (INT n := 0, d, z := ABS "0"; + FOR i TO UPB val OF s + DO d := ABS (val OF s)[i] - z; + IF d < 0 OR d > 9 + THEN error ("STRING NOT CONVERTIBLE TO INTEGER") FI; + n := n * 10 + d + OD; + make int (n)) + ESAC + FI + FI; + + PROC convert to pat = (REF ITEM ptr) REF ITEM: + IF failed THEN SKIP + ELSE IF ptr IS NIL + THEN make pat comp (mstr, NIL) + ELSE CASE ptr + IN (PATTERN): ptr + OUT make pat comp (mstr, convert to str (ptr)) + ESAC + FI + FI; + + PROC convert to str = (REF ITEM ptr) REF ITEM: + IF failed THEN SKIP + ELSE IF ptr IS NIL THEN ptr + ELSE CASE ptr + IN (REF STRINGITEM): ptr, + (PATTERN): (error ("PATTERN VALUE WHERE STRING REQUIRED"); SKIP), + (INT i): make str (itoa (i)) + ESAC + FI + FI; + + PROC make int = (INT val) REF ITEM: + IF failed THEN SKIP + ELSE HEAP ITEM := val + FI; + + PROC make pat comp = (INT routine, REF ITEM arg) REF ITEM: + IF failed THEN SKIP + ELSE HEAP ITEM := HEAP[1:1]COMPONENT := COMPONENT (routine, 0, 0, SKIP, arg) + FI; + + PROC make str = (STRING val) REF ITEM: + IF failed THEN SKIP + ELIF UPB val = 0 THEN NIL + ELSE INT i := 0, BOOL nf := TRUE; + WHILE IF (i +:= 1) <= nin + THEN nf := val /= val OF (STR spool [i]) + ELSE FALSE + FI + DO SKIP OD; + IF nf + THEN IF nin = spoolsize THEN error ("TOO MANY STRINGS") FI; + spool[nin +:= 1] := HEAP ITEM := HEAP STRINGITEM := (val, NIL) + FI; + spool[i] + FI; + + PROC break scan = (STRING str, arg) INT: + BEGIN # RESULT = UPB STR IF NO BREAK CHAR, LESS OTHERWISE # + INT j := 0; + FOR i TO UPB str WHILE NOT any (arg, str[i]) + DO j := i OD; + j + END; + + PROC any = (STRING str, CHAR ch) BOOL: + BEGIN BOOL nf; + FOR i TO UPB str WHILE nf := ch /= str[i] DO SKIP OD; + NOT nf + END; + + interpret ((REF ITEM (prog entry) IS NIL | 1 | find label (prog entry))) + END # INTERPRETATION PHASE # +END diff --git a/gcc/testsuite/algol68/compile/supper-1.a68 b/gcc/testsuite/algol68/compile/supper-1.a68 new file mode 100644 index 000000000000..a572f1e929f0 --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-1.a68 @@ -0,0 +1,11 @@ +{ dg-options {-fstropping=supper} } + +begin mode Some_Mode = real; + Some_Mode some_real := random; + + puts ("Hello time for SUPPER!\n"); + if some_real > 0.5 + then puts ("YES\n") + else puts ("NO\n") + fi +end diff --git a/gcc/testsuite/algol68/compile/supper-10.a68 b/gcc/testsuite/algol68/compile/supper-10.a68 new file mode 100644 index 000000000000..5c661a677f4a --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-10.a68 @@ -0,0 +1,6 @@ +{ dg-options {-fstropping=supper} } + +begin mode BEGIN = int; + BEGIN some_int = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-11.a68 b/gcc/testsuite/algol68/compile/supper-11.a68 new file mode 100644 index 000000000000..5c661a677f4a --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-11.a68 @@ -0,0 +1,6 @@ +{ dg-options {-fstropping=supper} } + +begin mode BEGIN = int; + BEGIN some_int = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-12.a68 b/gcc/testsuite/algol68/compile/supper-12.a68 new file mode 100644 index 000000000000..497a88a2e66f --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-12.a68 @@ -0,0 +1,6 @@ +{ dg-options {-fstropping=supper} } + +begin for i while i < 10 + do puts ("lala\n") + od +end diff --git a/gcc/testsuite/algol68/compile/supper-13.a68 b/gcc/testsuite/algol68/compile/supper-13.a68 new file mode 100644 index 000000000000..5e17fb4832c5 --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-13.a68 @@ -0,0 +1,7 @@ +{ dg-options "-fstropping=supper" } + +{ mode_ should not be recognized as a symbol. } + +begin int mode_ = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-2.a68 b/gcc/testsuite/algol68/compile/supper-2.a68 new file mode 100644 index 000000000000..04d5f0f461f3 --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-2.a68 @@ -0,0 +1,5 @@ +{ dg-options {-fstropping=supper} } + +begin int foo_bar = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-3.a68 b/gcc/testsuite/algol68/compile/supper-3.a68 new file mode 100644 index 000000000000..4cc711b9132a --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-3.a68 @@ -0,0 +1,5 @@ +{ dg-options {-fstropping=supper} } + +begin int foo_bar_ = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-4.a68 b/gcc/testsuite/algol68/compile/supper-4.a68 new file mode 100644 index 000000000000..283be9a4735c --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-4.a68 @@ -0,0 +1,5 @@ +{ dg-options {-fstropping=supper} } + +begin int foo_ = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-5.a68 b/gcc/testsuite/algol68/compile/supper-5.a68 new file mode 100644 index 000000000000..b3ffd899e5c0 --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-5.a68 @@ -0,0 +1,6 @@ +{ dg-options {-fstropping=supper} } + +begin mode Foo_bar = int; + Foo_bar some_int = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-6.a68 b/gcc/testsuite/algol68/compile/supper-6.a68 new file mode 100644 index 000000000000..37fc5e6f3c20 --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-6.a68 @@ -0,0 +1,5 @@ +{ dg-options {-fstropping=supper} } + +begin go to done; +done: skip +end diff --git a/gcc/testsuite/algol68/compile/supper-7.a68 b/gcc/testsuite/algol68/compile/supper-7.a68 new file mode 100644 index 000000000000..a3741748b4cb --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-7.a68 @@ -0,0 +1,5 @@ +{ dg-options {-fstropping=supper} } + +begin goto done; +done: skip +end diff --git a/gcc/testsuite/algol68/compile/supper-8.a68 b/gcc/testsuite/algol68/compile/supper-8.a68 new file mode 100644 index 000000000000..363d9b483ca0 --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-8.a68 @@ -0,0 +1,6 @@ +{ dg-options {-fstropping=supper} } + +begin mode Int = int; + Int some_int = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/supper-9.a68 b/gcc/testsuite/algol68/compile/supper-9.a68 new file mode 100644 index 000000000000..5c661a677f4a --- /dev/null +++ b/gcc/testsuite/algol68/compile/supper-9.a68 @@ -0,0 +1,6 @@ +{ dg-options {-fstropping=supper} } + +begin mode BEGIN = int; + BEGIN some_int = 10; + skip +end diff --git a/gcc/testsuite/algol68/compile/uniting-1.a68 b/gcc/testsuite/algol68/compile/uniting-1.a68 new file mode 100644 index 000000000000..057c4f85838d --- /dev/null +++ b/gcc/testsuite/algol68/compile/uniting-1.a68 @@ -0,0 +1,8 @@ +{ dg-options {-fstropping=supper} } +begin mode JSON_Val = union (int,ref JSON_Obj), + JSON_Obj = struct (int je), + + proc json_new_obj = JSON_Val: + (JSON_Obj o; o); + skip +end diff --git a/gcc/testsuite/algol68/compile/upper-1.a68 b/gcc/testsuite/algol68/compile/upper-1.a68 new file mode 100644 index 000000000000..6fb7871301f2 --- /dev/null +++ b/gcc/testsuite/algol68/compile/upper-1.a68 @@ -0,0 +1,11 @@ +# { dg-options {-fstropping=upper} } # + +BEGIN MODE SOME_MODE = REAL; + SOME_MODE some_real := random; + + puts ("Hello time for SUPPER!\n"); + IF some_real > 0.5 + THEN puts ("YES\n") + ELSE puts ("NO\n") + FI +END diff --git a/gcc/testsuite/algol68/compile/warning-hidding-1.a68 b/gcc/testsuite/algol68/compile/warning-hidding-1.a68 new file mode 100644 index 000000000000..b3d568bf9a2e --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-hidding-1.a68 @@ -0,0 +1,6 @@ +{ dg-options "-Whidden-declarations" } +begin + op UPB = (union (int,string) v) int: { dg-warning "hides" } + (v | (string s): UPB s | 0); + UPB "lala" +end diff --git a/gcc/testsuite/algol68/compile/warning-hidding-2.a68 b/gcc/testsuite/algol68/compile/warning-hidding-2.a68 new file mode 100644 index 000000000000..12bfcbbc63f5 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-hidding-2.a68 @@ -0,0 +1,6 @@ +{ dg-options "-Whidden-declarations" } +begin + op UPB = (union ([]int,string) v) int: { dg-warning "hides" } + (v | (string s): UPB s | 0); + UPB "lala" +end diff --git a/gcc/testsuite/algol68/compile/warning-hidding-3.a68 b/gcc/testsuite/algol68/compile/warning-hidding-3.a68 new file mode 100644 index 000000000000..25f4809ebcf0 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-hidding-3.a68 @@ -0,0 +1,5 @@ +{ dg-options "-Whidden-declarations" } +begin op UPB = (union (int,union(string,real)) v) int: { dg-warning "hides" } + (v | (string s): UPB s | 0); + UPB "lala" +end diff --git a/gcc/testsuite/algol68/compile/warning-hidding-4.a68 b/gcc/testsuite/algol68/compile/warning-hidding-4.a68 new file mode 100644 index 000000000000..0078e6a593f9 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-hidding-4.a68 @@ -0,0 +1,6 @@ +{ dg-options "-Whidden-declarations" } +begin + op UPB = (int i, union (int,string) v) int: { dg-warning "hides" } + (v | (string s): UPB s | 0); + UPB "lala" +end diff --git a/gcc/testsuite/algol68/compile/warning-hidding-5.a68 b/gcc/testsuite/algol68/compile/warning-hidding-5.a68 new file mode 100644 index 000000000000..f9bc4a41ea4d --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-hidding-5.a68 @@ -0,0 +1,9 @@ +{ dg-options "-Whidden-declarations=none" } +begin real b; + begin int getchar = 10; + int b; + op UPB = (int i, union (int,string) v) int: + (v | (string s): UPB s | 0); + UPB "lala" + end +end diff --git a/gcc/testsuite/algol68/compile/warning-hidding-6.a68 b/gcc/testsuite/algol68/compile/warning-hidding-6.a68 new file mode 100644 index 000000000000..a865103bcdfb --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-hidding-6.a68 @@ -0,0 +1,9 @@ +{ dg-options "-Whidden-declarations=prelude" } +begin real b; + begin int getchar = 10; { dg-warning "hides" } + int b; + op UPB = (int i, union (int,string) v) int: { dg-warning "hides" } + (v | (string s): UPB s | 0); + UPB "lala" + end +end diff --git a/gcc/testsuite/algol68/compile/warning-hidding-7.a68 b/gcc/testsuite/algol68/compile/warning-hidding-7.a68 new file mode 100644 index 000000000000..e641a93934e4 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-hidding-7.a68 @@ -0,0 +1,9 @@ +{ dg-options "-Whidden-declarations=all" } +begin real b; + begin int getchar = 10; { dg-warning "hides" } + int b; { dg-warning "hides" } + op UPB = (int i, union (int,string) v) int: { dg-warning "hides" } + (v | (string s): UPB s | 0); + UPB "lala" + end +end diff --git a/gcc/testsuite/algol68/compile/warning-module-hidding-1.a68 b/gcc/testsuite/algol68/compile/warning-module-hidding-1.a68 new file mode 100644 index 000000000000..84b4b0e25b28 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-module-hidding-1.a68 @@ -0,0 +1,6 @@ +{ dg-options "-Whidden-declarations=all" } + +module Foo = def int i; i := 10 postlude puts ("bye foo'n") fed, + Bar = def int j; j := 20 + postlude int j; puts ("bye bar'n") fed, { dg-warning "hidden" } + Baz = def skip fed diff --git a/gcc/testsuite/algol68/compile/warning-pub-loc-1.a68 b/gcc/testsuite/algol68/compile/warning-pub-loc-1.a68 new file mode 100644 index 000000000000..57baef93ecaf --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-pub-loc-1.a68 @@ -0,0 +1,7 @@ +module Foo = +def pub ref int xx = loc int := 777; { dg-warning "" } + pub ref int yy; + pub ref int zz = heap int := 888; + ref int vv = loc int := 999; + skip +fed diff --git a/gcc/testsuite/algol68/compile/warning-scope-1.a68 b/gcc/testsuite/algol68/compile/warning-scope-1.a68 new file mode 100644 index 000000000000..99ae973fe90a --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-scope-1.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # + +# Potential scope violation warnings are disabled by default. # +BEGIN PROC increase = (REF INT i) REF INT: + BEGIN INT j := i; + j # Inhibited warning. # + END; + increase (LOC INT) +END diff --git a/gcc/testsuite/algol68/compile/warning-scope-2.a68 b/gcc/testsuite/algol68/compile/warning-scope-2.a68 new file mode 100644 index 000000000000..5bbc0b371263 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-scope-2.a68 @@ -0,0 +1,8 @@ +# { dg-options {-Wscope -fstropping=upper} } # +BEGIN PROC increase = (REF INT i) REF INT: + BEGIN + INT j := i; + j # { dg-warning "scope violation" } # + END; + increase (LOC INT) +END diff --git a/gcc/testsuite/algol68/compile/warning-scope-3.a68 b/gcc/testsuite/algol68/compile/warning-scope-3.a68 new file mode 100644 index 000000000000..c5dd29562c00 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-scope-3.a68 @@ -0,0 +1,3 @@ +# { dg-options {-Wscope -fstropping=upper} } # +(REF INT xx; + xx := (INT x; x := 3)) # { dg-warning "scope violation" } # diff --git a/gcc/testsuite/algol68/compile/warning-scope-4.a68 b/gcc/testsuite/algol68/compile/warning-scope-4.a68 new file mode 100644 index 000000000000..ae0592ed743f --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-scope-4.a68 @@ -0,0 +1,3 @@ +# { dg-options {-Wscope -fstropping=upper} } # +(REF INT xx; + (INT x; xx:= x; x := 3)) # { dg-warning "scope violation" } # diff --git a/gcc/testsuite/algol68/compile/warning-scope-5.a68 b/gcc/testsuite/algol68/compile/warning-scope-5.a68 new file mode 100644 index 000000000000..2bb5b4afe884 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-scope-5.a68 @@ -0,0 +1,8 @@ +# { dg-options {-Wscope -fstropping=upper} } # +# The scope violation here is due to the routine text, which is copied + to P, referring to a value whose range doesn't exist anymore: X # +BEGIN (PROC REAL p; + (REAL x; + p := REAL: x * 2); # { dg-warning "scope violation" } # + p) +END diff --git a/gcc/testsuite/algol68/compile/warning-scope-6.a68 b/gcc/testsuite/algol68/compile/warning-scope-6.a68 new file mode 100644 index 000000000000..fa3888d65289 --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-scope-6.a68 @@ -0,0 +1,6 @@ +# { dg-options {-Wscope -fstropping=upper} } # +BEGIN (PROC REAL p; REAL mypi := 3.14; + (REAL x; + p := REAL: mypi * 2); # No scope violation here. # + p) +END diff --git a/gcc/testsuite/algol68/compile/warning-scope-7.a68 b/gcc/testsuite/algol68/compile/warning-scope-7.a68 new file mode 100644 index 000000000000..b99fa85ddffa --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-scope-7.a68 @@ -0,0 +1,12 @@ +# { dg-options {-Wscope -fstropping=upper} } # +# N,M below represent pairs of insc, outsc # +BEGIN (INT x; + REF INT xx; + (REF INT yy; + INT y; + xx := yy; # 0,0 := 1,0. Dynamic check. # + yy := y; # 1,1 := 1,1. OK # + xx := y # 0,0 := 1,1. { dg-warning "scope violation" } # + ) + ) +END diff --git a/gcc/testsuite/algol68/compile/warning-voiding-1.a68 b/gcc/testsuite/algol68/compile/warning-voiding-1.a68 new file mode 100644 index 000000000000..f34787c2979f --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-voiding-1.a68 @@ -0,0 +1,5 @@ +# { dg-options {-Wvoiding -fstropping=upper} } # +BEGIN PROC sum = (INT a, INT b) INT: + ( a + b ); + sum (10, 20) # { dg-warning "will be voided" } # +END diff --git a/gcc/testsuite/algol68/compile/warning-voiding-2.a68 b/gcc/testsuite/algol68/compile/warning-voiding-2.a68 new file mode 100644 index 000000000000..e3c98792c91f --- /dev/null +++ b/gcc/testsuite/algol68/compile/warning-voiding-2.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN PROC sum = (INT a, INT b) INT: + ( a + b ); + sum (10, 20) # Voiding warning won't be emitted by default. # +END From 55e2804be05d29a6331dc820571979ef7b9aba19 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:58:04 +0200 Subject: [PATCH 181/373] a68: testsuite: revised MC Algol 68 test set We cannot distribute the MC Test Set with GCC as of now, due to not clear distribution terms of the stuff. Until this gets clarified with the CWI (then Mathematical Centrum) a README.mcts file explains how to manually fetch and install the test set. gcc/testsuite/ChangeLog * algol68/README.mcts: New file. --- gcc/testsuite/algol68/README.mcts | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) create mode 100644 gcc/testsuite/algol68/README.mcts diff --git a/gcc/testsuite/algol68/README.mcts b/gcc/testsuite/algol68/README.mcts new file mode 100644 index 000000000000..cdf95ce628b2 --- /dev/null +++ b/gcc/testsuite/algol68/README.mcts @@ -0,0 +1,18 @@ +The mcts testsuite is not distributed along with GCC due to unclear +distribution terms of its contents, which have to be clarified with +the CWI. + +In the meanwhile, you can find the testset at: + + https://git.sr.ht/~jemarch/a68-mcts + +In order to install them in the GCC sources, just copy the file and +two directories to the testsuite/algol68 directory, like: + + $ git clone https://git.sr.ht/~jemarch/a68-mcts + $ cd a68-mcts + $ cp README.mcts /path/to/gcc/gcc/testsuite/algol68/ + $ cp -r compile/* /path/to/gcc/gcc/testsuite/algol68/compile/ + $ cp -r execute/* /path/to/gcc/gcc/testsuite/algol68/execute/ + +Then make check-algol68 will include the evil MCTS as well. From 8fae61cddc1079d473cfd16d42cc570ea9a84f13 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:58:33 +0200 Subject: [PATCH 182/373] a68: testsuite: mcgt tests Signed-off-by: Jose E. Marchesi gcc/testsuite/ChangeLog * algol68/compile/mcgt-1.3b.a68: New file. * algol68/compile/mcgt-7.1.3a-bis.a68: Likewise. * algol68/compile/mcgt-7.1.3a.a68: Likewise. * algol68/execute/mcgt/execute.exp: Likewise. * algol68/execute/mcgt/mcgt-1.3a.a68: Likewise. * algol68/execute/mcgt/mcgt-1.3c.a68: Likewise. * algol68/execute/mcgt/mcgt-2.2.1a.a68: Likewise. * algol68/execute/mcgt/mcgt-2.2.2a.a68: Likewise. * algol68/execute/mcgt/mcgt-2.2.3a.a68: Likewise. * algol68/execute/mcgt/mcgt-2.3a.a68: Likewise. * algol68/execute/mcgt/mcgt-2.3b.a68: Likewise. * algol68/execute/mcgt/mcgt-2.3c.a68: Likewise. * algol68/execute/mcgt/mcgt-2.3e.a68: Likewise. * algol68/execute/mcgt/mcgt-2.4.2a.a68: Likewise. * algol68/execute/mcgt/mcgt-2.4.2b.a68: Likewise. * algol68/execute/mcgt/mcgt-2.4.2c.a68: Likewise. * algol68/execute/mcgt/mcgt-2.4.3a.a68: Likewise. * algol68/execute/mcgt/mcgt-2.6a.a68: Likewise. * algol68/execute/mcgt/mcgt-2.6b.a68: Likewise. * algol68/execute/mcgt/mcgt-2.7d.a68: Likewise. * algol68/execute/mcgt/mcgt-2.7e.a68: Likewise. * algol68/execute/mcgt/mcgt-2.8a.a68: Likewise. * algol68/execute/mcgt/mcgt-2.8b.a68: Likewise. * algol68/execute/mcgt/mcgt-2.9.1a.a68: Likewise. * algol68/execute/mcgt/mcgt-3.5.1a.a68: Likewise. * algol68/execute/mcgt/mcgt-3.5d.a68: Likewise. * algol68/execute/mcgt/mcgt-3.7.2a.a68: Likewise. * algol68/execute/mcgt/mcgt-3.8.2a.a68: Likewise. * algol68/execute/mcgt/mcgt-3.9.1b.a68: Likewise. * algol68/execute/mcgt/mcgt-4.1.2a.a68: Likewise. * algol68/execute/mcgt/mcgt-4.1.3a.a68: Likewise. * algol68/execute/mcgt/mcgt-4.1.6a.a68: Likewise. * algol68/execute/mcgt/mcgt-4.1.6b.a68: Likewise. * algol68/execute/mcgt/mcgt-4.1.6c.a68: Likewise. * algol68/execute/mcgt/mcgt-4.2.6a.a68: Likewise. * algol68/execute/mcgt/mcgt-4.2.6b.a68: Likewise. * algol68/execute/mcgt/mcgt-4.2.6d.a68: Likewise. * algol68/execute/mcgt/mcgt-4.3.1a.a68: Likewise. * algol68/execute/mcgt/mcgt-4.3.1b.a68: Likewise. * algol68/execute/mcgt/mcgt-4.3.2a.a68: Likewise. * algol68/execute/mcgt/mcgt-5.1.2a.a68: Likewise. * algol68/execute/mcgt/mcgt-5.1.3a.a68: Likewise. * algol68/execute/mcgt/mcgt-5.1.3c.a68: Likewise. * algol68/execute/mcgt/mcgt-5.1.5a.a68: Likewise. * algol68/execute/mcgt/mcgt-6.2.2a.a68: Likewise. * algol68/execute/mcgt/mcgt-6.2.2b.a68: Likewise. * algol68/execute/mcgt/mcgt-6.2.2c.a68: Likewise. * algol68/execute/mcgt/mcgt-7.1.1a.a68: Likewise. * algol68/execute/mcgt/mcgt-7.1.1b.a68: Likewise. * algol68/execute/mcgt/mcgt-7.1.3a.a68: Likewise. * algol68/execute/mcgt/mcgt-7.3.2a.a68: Likewise. * algol68/execute/mcgt/mcgt-7.3.6a.a68: Likewise. * algol68/execute/mcgt/mcgt-7.3.6b.a68: Likewise. * algol68/execute/mcgt/mcgt-7.5.3a.a68: Likewise. --- gcc/testsuite/algol68/compile/mcgt-1.3b.a68 | 5 ++++ .../algol68/compile/mcgt-7.1.3a-bis.a68 | 8 +++++ gcc/testsuite/algol68/compile/mcgt-7.1.3a.a68 | 8 +++++ .../algol68/execute/mcgt/execute.exp | 29 +++++++++++++++++++ .../algol68/execute/mcgt/mcgt-1.3a.a68 | 4 +++ .../algol68/execute/mcgt/mcgt-1.3c.a68 | 4 +++ .../algol68/execute/mcgt/mcgt-2.2.1a.a68 | 4 +++ .../algol68/execute/mcgt/mcgt-2.2.2a.a68 | 5 ++++ .../algol68/execute/mcgt/mcgt-2.2.3a.a68 | 4 +++ .../algol68/execute/mcgt/mcgt-2.3a.a68 | 5 ++++ .../algol68/execute/mcgt/mcgt-2.3b.a68 | 5 ++++ .../algol68/execute/mcgt/mcgt-2.3c.a68 | 6 ++++ .../algol68/execute/mcgt/mcgt-2.3e.a68 | 5 ++++ .../algol68/execute/mcgt/mcgt-2.4.2a.a68 | 6 ++++ .../algol68/execute/mcgt/mcgt-2.4.2b.a68 | 11 +++++++ .../algol68/execute/mcgt/mcgt-2.4.2c.a68 | 9 ++++++ .../algol68/execute/mcgt/mcgt-2.4.3a.a68 | 4 +++ .../algol68/execute/mcgt/mcgt-2.6a.a68 | 6 ++++ .../algol68/execute/mcgt/mcgt-2.6b.a68 | 5 ++++ .../algol68/execute/mcgt/mcgt-2.7d.a68 | 5 ++++ .../algol68/execute/mcgt/mcgt-2.7e.a68 | 5 ++++ .../algol68/execute/mcgt/mcgt-2.8a.a68 | 6 ++++ .../algol68/execute/mcgt/mcgt-2.8b.a68 | 5 ++++ .../algol68/execute/mcgt/mcgt-2.9.1a.a68 | 6 ++++ .../algol68/execute/mcgt/mcgt-3.5.1a.a68 | 10 +++++++ .../algol68/execute/mcgt/mcgt-3.5d.a68 | 9 ++++++ .../algol68/execute/mcgt/mcgt-3.7.2a.a68 | 5 ++++ .../algol68/execute/mcgt/mcgt-3.8.2a.a68 | 13 +++++++++ .../algol68/execute/mcgt/mcgt-3.9.1b.a68 | 16 ++++++++++ .../algol68/execute/mcgt/mcgt-4.1.2a.a68 | 7 +++++ .../algol68/execute/mcgt/mcgt-4.1.3a.a68 | 9 ++++++ .../algol68/execute/mcgt/mcgt-4.1.6a.a68 | 8 +++++ .../algol68/execute/mcgt/mcgt-4.1.6b.a68 | 7 +++++ .../algol68/execute/mcgt/mcgt-4.1.6c.a68 | 7 +++++ .../algol68/execute/mcgt/mcgt-4.2.6a.a68 | 7 +++++ .../algol68/execute/mcgt/mcgt-4.2.6b.a68 | 7 +++++ .../algol68/execute/mcgt/mcgt-4.2.6d.a68 | 11 +++++++ .../algol68/execute/mcgt/mcgt-4.3.1a.a68 | 7 +++++ .../algol68/execute/mcgt/mcgt-4.3.1b.a68 | 15 ++++++++++ .../algol68/execute/mcgt/mcgt-4.3.2a.a68 | 5 ++++ .../algol68/execute/mcgt/mcgt-5.1.2a.a68 | 15 ++++++++++ .../algol68/execute/mcgt/mcgt-5.1.3a.a68 | 12 ++++++++ .../algol68/execute/mcgt/mcgt-5.1.3c.a68 | 29 +++++++++++++++++++ .../algol68/execute/mcgt/mcgt-5.1.5a.a68 | 19 ++++++++++++ .../algol68/execute/mcgt/mcgt-6.2.2a.a68 | 5 ++++ .../algol68/execute/mcgt/mcgt-6.2.2b.a68 | 6 ++++ .../algol68/execute/mcgt/mcgt-6.2.2c.a68 | 6 ++++ .../algol68/execute/mcgt/mcgt-7.1.1a.a68 | 8 +++++ .../algol68/execute/mcgt/mcgt-7.1.1b.a68 | 11 +++++++ .../algol68/execute/mcgt/mcgt-7.1.3a.a68 | 8 +++++ .../algol68/execute/mcgt/mcgt-7.3.2a.a68 | 11 +++++++ .../algol68/execute/mcgt/mcgt-7.3.6a.a68 | 23 +++++++++++++++ .../algol68/execute/mcgt/mcgt-7.3.6b.a68 | 12 ++++++++ .../algol68/execute/mcgt/mcgt-7.5.3a.a68 | 8 +++++ 54 files changed, 476 insertions(+) create mode 100644 gcc/testsuite/algol68/compile/mcgt-1.3b.a68 create mode 100644 gcc/testsuite/algol68/compile/mcgt-7.1.3a-bis.a68 create mode 100644 gcc/testsuite/algol68/compile/mcgt-7.1.3a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/execute.exp create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-1.3a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-1.3c.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.2.1a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.2.2a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.2.3a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.3a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.3b.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.3c.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.3e.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.2a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.2b.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.2c.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.3a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.6a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.6b.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.7d.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.7e.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.8a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.8b.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-2.9.1a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-3.5.1a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-3.5d.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-3.7.2a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-3.8.2a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-3.9.1b.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.2a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.3a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.6a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.6b.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.6c.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-4.2.6a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-4.2.6b.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-4.2.6d.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-4.3.1a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-4.3.1b.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-4.3.2a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.2a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.3a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.3c.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.5a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-6.2.2a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-6.2.2b.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-6.2.2c.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-7.1.1a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-7.1.1b.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-7.1.3a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-7.3.2a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-7.3.6a.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-7.3.6b.a68 create mode 100644 gcc/testsuite/algol68/execute/mcgt/mcgt-7.5.3a.a68 diff --git a/gcc/testsuite/algol68/compile/mcgt-1.3b.a68 b/gcc/testsuite/algol68/compile/mcgt-1.3b.a68 new file mode 100644 index 000000000000..80fc4a1c976f --- /dev/null +++ b/gcc/testsuite/algol68/compile/mcgt-1.3b.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # + +BEGIN REAL r := 10.0, circum, area; + circum := 2 * pi * r; area := pi * r * r +END diff --git a/gcc/testsuite/algol68/compile/mcgt-7.1.3a-bis.a68 b/gcc/testsuite/algol68/compile/mcgt-7.1.3a-bis.a68 new file mode 100644 index 000000000000..132f0c57972e --- /dev/null +++ b/gcc/testsuite/algol68/compile/mcgt-7.1.3a-bis.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # + +# Transient references and declarations. # +BEGIN FLEX[4,6]INT p; + # Illegal, cannot remember transient name. # + REF[]INT q2 = p[3,]; # { dg-error "" } # + SKIP +END diff --git a/gcc/testsuite/algol68/compile/mcgt-7.1.3a.a68 b/gcc/testsuite/algol68/compile/mcgt-7.1.3a.a68 new file mode 100644 index 000000000000..be3f12ac7e3c --- /dev/null +++ b/gcc/testsuite/algol68/compile/mcgt-7.1.3a.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # + +# Transient references and declarations. # +BEGIN FLEX[4,6]INT p; + # Illegal. p cannot be deflexed since it is a REF FLEX. # + REF[,]INT q3 = p; # { dg-error "" } # + SKIP +END diff --git a/gcc/testsuite/algol68/execute/mcgt/execute.exp b/gcc/testsuite/algol68/execute/mcgt/execute.exp new file mode 100644 index 000000000000..f07333f483aa --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/execute.exp @@ -0,0 +1,29 @@ +# Copyright (C) 2024 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +if $tracelevel then { + strace $tracelevel +} + +load_lib algol68-torture.exp + +foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.a68]] { + # If we're only testing specific files and this isn't one of them, skip it. + if ![runtest_file_p $runtests $testcase] then { + continue + } + algol68-torture-execute $testcase +} diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-1.3a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-1.3a.a68 new file mode 100644 index 000000000000..c99c25feb888 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-1.3a.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN REAL e = 2.7182818284; REAL circum; + circum := 2 * pi * e +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-1.3c.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-1.3c.a68 new file mode 100644 index 000000000000..883d4e918ae4 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-1.3c.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT n := 10, result; + result := n * (n + 1) * (2 * n + 1) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.2.1a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.2.1a.a68 new file mode 100644 index 000000000000..4179a8221d47 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.2.1a.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +# Integer denotations. # +BEGIN 000; 43; 456; 0 +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.2.2a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.2.2a.a68 new file mode 100644 index 000000000000..3bd34667dde0 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.2.2a.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# Real denotations. # +BEGIN .5; 0.5; 2.0; .001; + 2.3e1; 2e0; 2e+0; 2e-0 +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.2.3a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.2.3a.a68 new file mode 100644 index 000000000000..a9aa44c31995 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.2.3a.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +# Character denotations. # +BEGIN "X"; "a"; "1"; "."; " " +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3a.a68 new file mode 100644 index 000000000000..e8f403b119b2 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3a.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# Identifiers. # +BEGIN INT circum, r, ibm, a1, log2, begin; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3b.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3b.a68 new file mode 100644 index 000000000000..be7368f24a9a --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3b.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# Identity declarations. # +BEGIN REAL e = 2.7182818284, log2 = 0.618, INT ten = 10, g = 32; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3c.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3c.a68 new file mode 100644 index 000000000000..676f9892bd88 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3c.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# Equivalent declarations. # +BEGIN REAL x = 2.34; + REF INT n = LOC INT, REF INT m = LOC INT; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3e.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3e.a68 new file mode 100644 index 000000000000..1a0dffe1e4be --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.3e.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# Initialisation. # +BEGIN CHAR firstchar := "A", lastchar := "Z", currentchar; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.2a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.2a.a68 new file mode 100644 index 000000000000..f304b8f21b62 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.2a.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# Ordinary division. # +BEGIN ASSERT (4/2 = 2.0); + INT a = 4, b = 7; + a/b # Yields a value of mode REAL. # +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.2b.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.2b.a68 new file mode 100644 index 000000000000..ed0b0c48676f --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.2b.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +# Integer division. The operator OVER (%) performs integer + division with truncation. # +BEGIN ASSERT (4 % 2 = 2); + ASSERT (4 OVER 2 = 2); + ASSERT (5 % 3 = 1); + ASSERT (5 OVER 3 = 1); + INT n = -5, m = -3; + ASSERT (n % 3 = -1); + ASSERT (n % m = 1) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.2c.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.2c.a68 new file mode 100644 index 000000000000..a63eb7eeb5cb --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.2c.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +# Integer modulus. The operator MOD (%*) performs integer modulus + with truncation. # +BEGIN ASSERT (0 MOD 4 = 0); + ASSERT (0 %* 4 = 0); + ASSERT (5 %* 3 = 2); + INT m = 5, n = -3; + ASSERT (m MOD n = 2) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.3a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.3a.a68 new file mode 100644 index 000000000000..d8707ee83a40 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.4.3a.a68 @@ -0,0 +1,4 @@ +# { dg-options "-fstropping=upper" } # +# Exponentiation. # +BEGIN ASSERT (2 ** 3 = 8) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.6a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.6a.a68 new file mode 100644 index 000000000000..68f8ee13ea41 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.6a.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# Comparison operators. # +BEGIN REAL x = 2.7, y = 3.6, z = 4.7; + ASSERT (x < y); + ASSERT ("B" /= "C") +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.6b.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.6b.a68 new file mode 100644 index 000000000000..c61342f3ac0b --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.6b.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# Comparison operators and boolean operators. # +BEGIN INT a = 4, b = 5, c = 9, REAL x = 4.7, y = 5.7, z = 6.7; + ASSERT (NOT (x + y < z) AND a + b = c) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.7d.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.7d.a68 new file mode 100644 index 000000000000..aa035f264e37 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.7d.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# Widening. # +BEGIN REAL x := 4, y := 7, z := 2.7; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.7e.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.7e.a68 new file mode 100644 index 000000000000..ad423a5a81ec --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.7e.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# Dereferencing and widening. # +BEGIN INT n, REAL x = n; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.8a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.8a.a68 new file mode 100644 index 000000000000..23d5e5158d4c --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.8a.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# Examples of assignations. # +BEGIN REAL pi = 3.14, e = 2.71, INT n = 10, REAL circum, INT result; + circum := 2 * pi * e; + result := n * (n + 1) * ( 2 * n + 1) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.8b.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.8b.a68 new file mode 100644 index 000000000000..1b5d642b8f85 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.8b.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# Coercions and assignations. # +BEGIN REAL y, INT n, m := 1; + y := n % m +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-2.9.1a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.9.1a.a68 new file mode 100644 index 000000000000..e5e2e781591e --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-2.9.1a.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# Arithmetical assignment operators. # +BEGIN INT m, n := 4; + n PLUSAB 1; + ASSERT (n = 5) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-3.5.1a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-3.5.1a.a68 new file mode 100644 index 000000000000..85080ea32014 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-3.5.1a.a68 @@ -0,0 +1,10 @@ +# { dg-options "-fstropping=upper" } # +# Equivalence. # +BEGIN INT m := 3; REF INT p = m; + ASSERT (m = 3 AND p = 3); + BEGIN INT m := 100; + ASSERT (m = 100 AND p = 3); + m -:= 1; p +:= 1 + END; + ASSERT (m = 4 AND p = 4) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-3.5d.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-3.5d.a68 new file mode 100644 index 000000000000..5f02498ec827 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-3.5d.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +# On the availability and accessibility of space. # +BEGIN INT m := 3, INT five = 5; + ASSERT (m = 3); + BEGIN INT m := 100; CHAR five = "5"; + m +:= 1 + END; + ASSERT (m = 3 AND five = 5) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-3.7.2a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-3.7.2a.a68 new file mode 100644 index 000000000000..b6514eb8afe8 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-3.7.2a.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT p := 10, q := 12; + FROM p TO q DO (p +:= 1, q +:= 1) OD; + ASSERT (p = 13 AND q = 15) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-3.8.2a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-3.8.2a.a68 new file mode 100644 index 000000000000..bfc67c9dbb69 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-3.8.2a.a68 @@ -0,0 +1,13 @@ +# { dg-options "-fstropping=upper" } # +# Using case clauses. # +BEGIN PROC is divisible = (INT m) BOOL: + BEGIN BOOL divisible := FALSE; + FOR i TO 4 WHILE NOT divisible + DO INT k = (i|3, 5, 7, 11); + divisible := m MOD k = 0 + OD; + divisible + END; + ASSERT (is divisible (50)); + ASSERT (is divisible (253)) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-3.9.1b.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-3.9.1b.a68 new file mode 100644 index 000000000000..01ef062fb5fc --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-3.9.1b.a68 @@ -0,0 +1,16 @@ +# { dg-options "-fstropping=upper" } # +# Using jumps. # +BEGIN INT a, INT b = 0, c = 2, d = 10, BOOL e = TRUE; + CO The following program using jumps is equivalent to: + FOR a FROM b BY c TO d WHILE e DO SKIP OD + CO + BEGIN INT j := b, INT k = c, m = d; + next: IF (k > 0 AND j <= m) OR (k < 0 AND j >= m) OR k = 0 + THEN INT i = j; + IF e + THEN SKIP; j +:= k; GOTO next + FI + FI; + ASSERT (j = 12) + END +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.2a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.2a.a68 new file mode 100644 index 000000000000..98e43c62334a --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.2a.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# Monadic lwb and upb. # +BEGIN INT n := 4; [n]INT a; + ASSERT (UPB a = 4); + n := 6; + ASSERT (UPB a = 4) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.3a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.3a.a68 new file mode 100644 index 000000000000..b2592404700f --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.3a.a68 @@ -0,0 +1,9 @@ +# { dg-options "-fstropping=upper" } # +# Dyadic lwb an upb. # +BEGIN [0:10,-4:100]REAL xx; + ASSERT (1 LWB xx = 0); + ASSERT (1 UPB xx = 10); + ASSERT (1 UPB xx = UPB xx); + ASSERT (2 LWB xx = -4); + ASSERT (2 UPB xx = 100) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.6a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.6a.a68 new file mode 100644 index 000000000000..e17a9ccc17b4 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.6a.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +BEGIN [4]REAL x2 := (6, 7, 8, 9); + ASSERT (x2[2] > 6.9); + ASSERT (x2[2] < 7.1); + x2 := (1, 1, 1, 1); + ASSERT(x2[2] > 0.9); + ASSERT(x2[2] < 1.1) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.6b.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.6b.a68 new file mode 100644 index 000000000000..09302dac5f2e --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.6b.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# Multi-dimensional row displays. # +BEGIN [2,3]INT aa := ((1,2,3),(4,5,6)); + [2,3,4]REAL bb := (((1,2,3,4), (5,6,7,8), (9,10,11,12)), + ((13,14,15,16),(17,18,19,20),(21,22,2,24))); + SKIP +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.6c.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.6c.a68 new file mode 100644 index 000000000000..241e134bf72c --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.1.6c.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# Further row displays. # +BEGIN [4]INT a, b; + [4]INT c := a, d := (1,2,3,0); + [2,4]INT ab := (a,b), cd := ((0,0,0,0), b); + SKIP +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-4.2.6a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.2.6a.a68 new file mode 100644 index 000000000000..ed1fa42771a8 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.2.6a.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN STRUCT (INT day, month, year) indep day = (4, 7, 1776); + ASSERT (day OF indep day = 4); + ASSERT (month OF indep day = 7); + ASSERT (year OF indep day = 1776); + SKIP +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-4.2.6b.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.2.6b.a68 new file mode 100644 index 000000000000..2f1ad2021d4d --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.2.6b.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +BEGIN []STRUCT(CHAR letter, INT integer) roman + = (("I",1),("V",5),("X",10),("L",50),("C",100)); + # XXX letter OF roman should be ("I","V","X","L","C") # + # XXX integer OF roman whould be (1,5,10,50,100) # + SKIP +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-4.2.6d.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.2.6d.a68 new file mode 100644 index 000000000000..8718efd7cd53 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.2.6d.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +# Multiple values and structures. + + Having strings of different lenghts would not be valid in a variable + declaration, but is acceptable in an identity declaration. +# +BEGIN []STRUCT ([]CHAR name, INT age) family = + (("JOHN", 3), ("ROBERT", 1), ("CATHERINE", 4)); + SKIP +END + diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-4.3.1a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.3.1a.a68 new file mode 100644 index 000000000000..0fae194fb227 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.3.1a.a68 @@ -0,0 +1,7 @@ +# { dg-options "-fstropping=upper" } # +# Simple mode declarations. # +BEGIN MODE INTEGER = INT; + MODE Z = INT, R = REAL, B = BOOL, V = VOID; + MODE ARRAYA = [100]INT, ARRAYB = [10,2:9]REAL; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-4.3.1b.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.3.1b.a68 new file mode 100644 index 000000000000..d98d7ec117e5 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.3.1b.a68 @@ -0,0 +1,15 @@ +# { dg-options "-fstropping=upper" } # +# Dynamic arrays revisited. # +BEGIN INT p := 2, q := 10; + MODE M = [p:q]INT; + M a; + ASSERT (LWB a = 2 AND UPB a = 10); + q := 4; + M b; + ASSERT (LWB a = 2 AND UPB a = 10); + ASSERT (LWB b = 2 AND UPB b = 4); + M c = (1,2,3,4); # M is interpreted as formal declarer. + Bounds are ignored. + # + ASSERT (LWB c = 1 AND UPB c = 4) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-4.3.2a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.3.2a.a68 new file mode 100644 index 000000000000..039a661a62f1 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-4.3.2a.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# Rows of integers. # +BEGIN [][]INT g = ((1,2,3),(4,5),(6,7,8,9)); + ASSERT (UPB g[1] = 3 AND UPB g[2] = 2 AND UPB g[3] = 4) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.2a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.2a.a68 new file mode 100644 index 000000000000..9d77795ad8d4 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.2a.a68 @@ -0,0 +1,15 @@ +# { dg-options "-fstropping=upper" } # +# Procedure declarations I. # +BEGIN INT x = 10, y = 20, i = 2; + PROC xxx = (INT arg) INT: 10; + PROC yyy = (INT arg) INT: 20; + PROC zzz = (INT arg) INT: 30; + PROC(INT)INT f = IF x > y THEN xxx ELSE zzz FI, + g = CASE i IN xxx, yyy, zzz ESAC; + PROC(INT)INT h := IF x < y THEN xxx ELSE yyy FI; + ASSERT (f (100) = 30); + ASSERT (g (200) = 20); + ASSERT (h (300) = 10); + h := yyy; + ASSERT (h (300) = 20) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.3a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.3a.a68 new file mode 100644 index 000000000000..45efc9c8834e --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.3a.a68 @@ -0,0 +1,12 @@ +# { dg-options "-fstropping=upper" } # +# Using the factorial function in a program # +BEGIN PROC f = (INT n) INT: + BEGIN INT product := 1; + FOR i TO n DO product *:= i OD; + product + END; + ASSERT (f(0) = 1); + ASSERT (f(1) = 1); + ASSERT (f(2) = 2); + ASSERT (f(3) = 6) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.3c.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.3c.a68 new file mode 100644 index 000000000000..fcd93c85c441 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.3c.a68 @@ -0,0 +1,29 @@ +# { dg-options "-fstropping=upper" } # +# Procedure declarations III # +BEGIN # From the ALGOL68 Revised Report. # + PROC my char in string = (CHAR c, REF INT i, []CHAR s) BOOL: + BEGIN BOOL found := FALSE; + FOR k FROM LWB s TO UPB s WHILE NOT found + DO (c = s[k] | i := k; found := TRUE) OD; + found + END; + ASSERT ((INT idx := 0; + my char in string ("o", idx, "foo") + ANDTH idx = 2)); + ASSERT (my char in string ("x", LOC INT, "foo") = FALSE); + # Swapping function. # + PROC swap = (REF INT a, b) VOID: + (INT r = a; a := b; b := r); + ASSERT ((INT x := 1, y := 2; + swap (x, y); + x = 2 AND y = 1)); + # Euclid's algorithm. # + PROC hcf = (INT m, n) INT: + BEGIN INT a := m, b := n; + IF a < b THEN swap (a, b) FI; + WHILE b /= 0 + DO INT c = b; b := a MOD b; a := c OD; + a + END; + ASSERT (hcf (10, 20) = 10) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.5a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.5a.a68 new file mode 100644 index 000000000000..4f61bf02a237 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-5.1.5a.a68 @@ -0,0 +1,19 @@ +# { dg-options "-fstropping=upper" } # +# Recursive procedures. # +BEGIN PROC f = (INT m, n) INT: + IF n = 0 + THEN m + ELIF m < n + THEN f (n, m) + ELSE m * f (m % n, n - 1) + n * f (m - 1, n) + FI; + f (10, 20); + PROC a = (INT m, n) INT: + IF m = 0 + THEN + 1 + ELIF n = 0 + THEN a (m - 1, 1) + ELSE a (m - 1, a (m, n - 1)) + FI; + a (10, 20) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-6.2.2a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-6.2.2a.a68 new file mode 100644 index 000000000000..b2bed32b302a --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-6.2.2a.a68 @@ -0,0 +1,5 @@ +# { dg-options "-fstropping=upper" } # +# Using AND and OR # +BEGIN ASSERT ((2r111 AND 2r101) = 2r101); + ASSERT ((16rff AND 2r111) = 16r7) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-6.2.2b.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-6.2.2b.a68 new file mode 100644 index 000000000000..b9a4730b9d05 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-6.2.2b.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# Comparing objects of mode BITS # +BEGIN ASSERT (2r1010 <= 2r1110); + ASSERT (4r331 >= 8r74); + ASSERT (NOT (2r100 >= 2r011)) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-6.2.2c.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-6.2.2c.a68 new file mode 100644 index 000000000000..79bfc97d9b45 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-6.2.2c.a68 @@ -0,0 +1,6 @@ +# { dg-options "-fstropping=upper" } # +# Using BIN # +BEGIN ASSERT (BIN 7 = 2r111); + INT i = 22; + ASSERT ((BITS b = BIN i; ABS (b SHL 3) + ABS (b SHL 1)) = 220) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-7.1.1a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-7.1.1a.a68 new file mode 100644 index 000000000000..efd948be8075 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-7.1.1a.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +# Declarations of flexible names. # +BEGIN FLEX[1:0]INT n; + ASSERT (LWB n = 1 AND UPB n = 0 AND ELEMS n = 0); + FLEX[4,6]INT p; + ASSERT (1 LWB p = 1 AND 1 UPB p = 4 AND 1 ELEMS p = 4 + AND 2 LWB p = 1 AND 2 UPB p = 6 AND 2 ELEMS p = 6) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-7.1.1b.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-7.1.1b.a68 new file mode 100644 index 000000000000..3360c5eabc23 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-7.1.1b.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +# Null row displays an string denotations. # +BEGIN FLEX[4]INT a, FLEX[4,6]INT b, FLEX[10]CHAR c; + a := (); + ASSERT (LWB a = 1 AND UPB a = 0); + b := ((),()); + ASSERT (1 LWB b = 1 AND 1 UPB b = 2 + AND 2 LWB b = 1 AND 2 UPB b = 0); + c := (); + c := "" +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-7.1.3a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-7.1.3a.a68 new file mode 100644 index 000000000000..b1bfdf737caf --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-7.1.3a.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +# Transient references and declarations. # +BEGIN FLEX[4,6]INT p; + []INT q1 = p[3,]; # Transient name is dereferenced giving []INT # + REF FLEX[,]INT q5 = p; # p and q5 are different ways of accessing + the same name. # + SKIP +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-7.3.2a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-7.3.2a.a68 new file mode 100644 index 000000000000..688bcac00ec6 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-7.3.2a.a68 @@ -0,0 +1,11 @@ +# { dg-options "-fstropping=upper" } # +# Virtual declarers. # +BEGIN REF[]INT s; + STRUCT ([10]INT a, [4]REF[]INT b) c; + UNION (REF FLEX[]INT, PROC(INT)INT) f; + FLEX[4][3]INT a; + REF FLEX[][]INT aa = LOC FLEX[4][3]INT; + [4]FLEX[3]INT b; + REF[]FLEX[]INT bb = LOC[4]FLEX[3]INT; + SKIP +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-7.3.6a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-7.3.6a.a68 new file mode 100644 index 000000000000..1fbf6a3772e5 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-7.3.6a.a68 @@ -0,0 +1,23 @@ +# { dg-options "-fstropping=upper" } # +BEGIN INT n := 3, m := 3; + REF INT w := n, z := n, REF INT y = n; + # Delivers TRUE since y and n deliver the same variable of mode REF + INT. No coercions take place. + # + ASSERT (y :=: n); + # Delivers TRUE. here w is dereferenced to yield n. The right + hand side is taken to be strong since dereferencing cannot + occur in a soft position. + # + ASSERT (n :=: w); + # Similarly delivers TRUE. Strong position is lhs. # + ASSERT (w :=: n); + # Delivers TRUE. No coercions take place. # + ASSERT (y ISNT m); + # Delivers true. w gets coerced to REF INT due to the strong + context introduced by the cast. No further coercions take place. + # + ASSERT (REF INT (w) :=: z); + # Delives true. No coercions take place. # + ASSERT (w :/=: z) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-7.3.6b.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-7.3.6b.a68 new file mode 100644 index 000000000000..479339d74855 --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-7.3.6b.a68 @@ -0,0 +1,12 @@ +# { dg-options "-fstropping=upper" } # +BEGIN + [3]INT a := (1,2,3); + + CO Comparing transient or flex names using an identity relation is + undefined. Therefore, a[2:3] :=: a[2:3] is undefined. + CO + + # But the following are defined. # + ASSERT (a[1] :=: a[1]); + ASSERT (a[1] :/=: a[2]) +END diff --git a/gcc/testsuite/algol68/execute/mcgt/mcgt-7.5.3a.a68 b/gcc/testsuite/algol68/execute/mcgt/mcgt-7.5.3a.a68 new file mode 100644 index 000000000000..dfb8cd40460b --- /dev/null +++ b/gcc/testsuite/algol68/execute/mcgt/mcgt-7.5.3a.a68 @@ -0,0 +1,8 @@ +# { dg-options "-fstropping=upper" } # +# Declarations involving global generators. # +BEGIN REF REAL xx; + BEGIN REF REAL x = HEAP REAL := 4; + xx := x + END; + ASSERT (xx = 4) +END From 8943e8a7d25a7cd3fce9581ec2ffa430dd7a178f Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:40:13 +0200 Subject: [PATCH 183/373] a68: top-level misc files This commit updates a few administrative files in the top-level directory. The MAINTAINERS file is updated with new entries for the Algol 68 front-end and the libga68 run-time library. SECURITY.txt is updated to add libga68 to the list of the other run-time libraries. Signed-off-by: Jose E. Marchesi ChangeLog * MAINTAINERS: Add Algol 68 subsystems. * SECURITY.txt: add libga68 to list of libraries. --- MAINTAINERS | 2 ++ SECURITY.txt | 1 + 2 files changed, 3 insertions(+) diff --git a/MAINTAINERS b/MAINTAINERS index ae451ae18182..22d4172c4695 100644 --- a/MAINTAINERS +++ b/MAINTAINERS @@ -173,6 +173,7 @@ objective-c/c++ Mike Stump objective-c/c++ Iain Sandoe Rust Arthur Cohen Rust Philip Herron +Algol 68 Jose E. Marchesi Various Maintainers @@ -181,6 +182,7 @@ libcpp Per Bothner libcpp All C and C++ front end maintainers libcpp David Malcolm fp-bit Ian Lance Taylor +libga68 Jose E. Marchesi libgcc Ian Lance Taylor libgo Ian Lance Taylor libgomp Jakub Jelinek diff --git a/SECURITY.txt b/SECURITY.txt index b38425ea2238..910e969a77b1 100644 --- a/SECURITY.txt +++ b/SECURITY.txt @@ -85,6 +85,7 @@ Language runtime libraries * libcpp * libdecnumber * libffi + * libga68 * libgcc * libgfortran * libgm2 From e3eafe2176dfcc8b844cbac3757d5a85cd43b048 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:41:38 +0200 Subject: [PATCH 184/373] a68: documentation This commit adds a new section to the GCC Internals Manual and also adds two new manuals. ga68.texi is The GNU Algol 68 Compiler user manual. It describes how to use the compiler and all the GNU extensions implemented on top of the Algol 68 programming language. ga68-internals.texi is The GNU algol68 Compiler Internals manual. It describes the implementation of the front-end and it is of interest primarily for developers. Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/ga68-internals.texi: New file. * algol68/ga68.texi: Likewise. --- gcc/algol68/ga68-internals.texi | 383 ++++ gcc/algol68/ga68.texi | 3169 +++++++++++++++++++++++++++++++ 2 files changed, 3552 insertions(+) create mode 100644 gcc/algol68/ga68-internals.texi create mode 100644 gcc/algol68/ga68.texi diff --git a/gcc/algol68/ga68-internals.texi b/gcc/algol68/ga68-internals.texi new file mode 100644 index 000000000000..1c0bad85f5e5 --- /dev/null +++ b/gcc/algol68/ga68-internals.texi @@ -0,0 +1,383 @@ +\input texinfo @c -*-texinfo-*- +@c %**start of header +@setfilename ga68-internals.info + +@include gcc-common.texi + +@synindex tp cp + +@settitle GNU Algol 68 Compiler Internals + +@c %**end of header + +@c %** start of document + +@copying +Copyright @copyright{} 2025 Jose E. Marchesi. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with no +Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. A +copy of the license is included in the section entitled ``GNU Free +Documentation License''. +@end copying + +@ifinfo +@dircategory Software development +@direntry +* ga68-internals: (ga68-internals). The GNU Algol 68 Compiler Internals. +@end direntry +This file documents the internals of the GNU Algol 68 +compiler, (@command{ga68}). + +@insertcopying +@end ifinfo + +@c Macro for bold-tags. In TeX and HTML they expand to proper bold words, +@c in other formats it resorts to upper stropping. +@iftex +@macro B{tag} +@strong{\tag\} +@end macro +@end iftex + +@ifhtml +@macro B{tag} +@strong{\tag\} +@end macro +@end ifhtml + +@ifnottex +@ifnothtml +@macro B{tag} +@sc{\tag\} +@end macro +@end ifnothtml +@end ifnottex + +@setchapternewpage odd +@titlepage +@title GNU Algol 68 Internals +@versionsubtitle +@author Jose E. Marchesi +@page +@vskip 0pt plus 1filll +@sp 1 +@insertcopying +@end titlepage + +@summarycontents +@contents + +@page + +@ifnottex +@node Top +@top Introduction +@cindex Introduction + +This manual documents (some of) the internals of @command{ga68}, the +GNU Algol 68 compiler. + +@menu +* Scope Checking:: Scope checking in assignation. +* Storage Management:: Management of run-time storage. +* Lowering Declarations:: Mapping external objects to internal objects. +* Lowering Assignations:: Superceding the value referred by a name. +* GNU Free Documentation License:: + How you can copy and share this manual. +* Index:: Index of this documentation. +@end menu +@end ifnottex + +@c --------------------------------------------------------------------- +@c Scope Checking +@c --------------------------------------------------------------------- + +@node Scope Checking +@chapter Scope Checking + +Static scope checking: pass. +Dynamic scope checking: run-time call. + +@c --------------------------------------------------------------------- +@c Storage Management +@c --------------------------------------------------------------------- + +@node Storage Management +@chapter Storage Management + +This chapter discusses the run-time management of internal objects in +Algol 68. + +First, a conceptual model is presented that describes the restrictions +as mandated by the Report. The storage implied by the lowered GENERIC +entities, as described in the previous chapter, shall match the +storage of the conceptual model. + +@menu +* Storage Structure of Objects:: +* Copying of Objects:: +* The Stack:: +* The Heap:: +@end menu + +@node Storage Structure of Objects +@section Storage Structure of Objects + +The internal objects which are the values in an Algol 68 program may +consist on a hierarchy of memory locations, which may not be +contiguous. This hierarchy of memory locations is the storage +structure of the object, and is not concerned by the particular +bit-patterns stored. + +Simple values. + +Names. + +Multiple values. + +Structured values. + +Values of united modes. + +@node Copying of Objects +@section Copying of Objects + +@node The Stack +@section The Stack + +XXX + +@node The Heap +@section The Heap + +@itemize @minus +@item +A value that has rows and gets returned by a procedure shall be +allocated on the stack. +@item +A copy of the right hand side is made before assigning it to the left +hand side. This copy is always allocated in the heap, because the +scope of the left hand side may be older than the scope of the right +hand side. This happens when assigning to a global variable. +@item +A trimmer of a name. This is because the trimmed multiple may be +allocated on the heap, and the trim shall have the same scope than the +trimmed multiple. +@end itemize + +@c --------------------------------------------------------------------- +@c Internal Objects +@c --------------------------------------------------------------------- + +@node Lowering Declarations +@chapter Lowering Declarations + +This chapter describes the mapping between external objects declared +in identity and variable declarations and the internal objects that +are the result of lowering the external objects in the parse tree into +GENERIC entities. + +@menu +* Identity Declarations:: @code{@B{amode} xxx = init value} +* Variable Declarations:: @code{@B{amode} xxx [:= init value]} +* Procedure Identity Declarations:: @code{@B{proc} xxx = routine text} +* Procedure Variable Declarations:: @code{@B{proc} xxx := routine text} +* Operator Brief Declarations:: @code{@B{op} @B{xxx} = routine text} +* Operator Declarations:: @code{@B{op}(...)@B{amode} @B{xxx} = routine text} +* Applied Identifiers:: +@end menu + +@node Identity Declarations +@section Identity Declarations + +An identity declaration with the form: + +@example +@B{c} part 1 @B{c} +@B{amode} defining_identifier = unit; +@B{c} part 2 @B{c} +@end example + +@noindent +Introduces the identifier @code{defining_identifier} in the current +range and ascribes a copy of the value yielded by @code{unit} to it. +Once established, the relationship between an identifier and the value +ascribed to it is constant and it cannot change during the reach of +the identifier. The ascribed unit can be any unitary clause, and its +elaboration can be arbitrarily complicated. In particular, it is not +required to be a compile-time constant. @code{@B{amode}} determines +the mode of the value yielded by the unit, and the unit is elaborated +in a strong context. + +An identity declaration like the above, where @code{@B{amode}} is not +a procedure mode (@xref{Procedure Identity Declarations}) is lowered +into: + +@itemize @bullet +@item +A @code{VAR_DECL} with name @code{defining_identifier}, type +@code{CTYPE (@B{amode})} and initial value @code{@B{amode}(@B{skip})} +that gets chained into the declarations list of the current block. +@item +A @code{DECL_EXPR} that gets prepended in the current statement's list. +@item +A @code{MODIFY_EXPR} setting the @code{VAR_DECL} to a copy of the +lowering of @code{unit}, @code{a68_low_dup (unit)}. +@end itemize + +@noindent +Schematically: + +@example + BIND_EXPR (BLOCK (DECLS: ... -> VAR_DECL (defining_identifier, INITIAL=SKIP))) + STMT_LIST + | + +-- DECL_EXPR (defining_identifier) + | + | @B{c} part 1 @B{c} + | + +-- MODIFY_EXPR (defining_identifier, unit) + | + | @B{c} part 2 @B{c} + | +@end example + +The reason why the @code{VAR_DECL} is initialized to @code{@B{skip}} +and then set to the initial @code{unit} specified in the source line +is that the Report specifies that Algol 68 identifiers can be used +before they are defined provided we are in the right range, but in +that case the value ascribed to the identifier is ``undefined''. +Accessing an ``undefined'' value in traditional Algol 68 +implementations would lead to a run-time error (these implementations +used a special value to denote undefined, such as @code{F00L}) but in +GNU Algol 68 the ``undefined'' value is always @code{@B{skip}} which, +if not terribly useful in most cases, is at least well defined in this +implementation and doesn't lead to an error. + +Identity declarations are the Algol 68 way of defining constants, and +one may wonder why we are not using @code{CONST_DECL} instead of +@code{VAR_DECL}. The reason is that @code{CONST_DECL} is really only +intended for integral values in C enums, and the @code{@B{amode}} in +the identity declaration can really be any mode, from simple integers +or characters to fairly complicated structured modes, which may +involve also rows and united modes. Whether the @code{VAR_DECL} will +lead to allocating storage on the stack depends on the nature of the +mode and the way the identifier is used in the program: whether its +address is taken, etc. + +@node Variable Declarations +@section Variable Declarations + +A variable declaration with the form: + +@example +[@B{loc}|@B{heap}] @B{amode} defining identifier [:= unit]; +@end example + +@noindent +Is in principle equivalent to the identity declaration: + +@example +@B{ref} @B{amode} defining identifier = [@B{loc}|@B{heap}] @B{amode}; +@end example + +@noindent +In both cases the object ascribed to the defining identifier is of +mode @code{@B{ref} @B{amode}}. The ascribed object is a name which is +created by a generator implied in the actual declarer in the variable +declaration case, and an explicit generator in the initialization +expression in the identity declaration case. + +However, in this compiler these two cases are handled differently in +order to reduce the amount of both indirect addressing and of storage: + +@itemize @bullet +@item +The variable declaration @code{[@B{loc}|@B{heap}] @B{amode} foo} +lowers into a @code{VAR_DECL} with type @code{CTYPE (amode)} provided +that the generator is @code{@B{loc}} and that the type contains no +rows. Accessing the variable will then involve direct addressing, and +when its address is required an @code{ADDR_EXPR} shall be used. +@item +The identity declaration @code{@B{ref} @B{amode} foo = @B{loc} +@B{amode}} lowers into a @code{VAR_DECL} with type @code{*CTYPE +(amode)}. Accessing the variable will then involve indirect +addressing: it is effectively a pointer. +@end itemize + +This optimization introduces the complication that an expression (the +@code{VAR_DECL}) whose type is TYPE can appear in a place where *TYPE +is expected, depending on the context and the r-value and l-value +interpretation of the @code{VAR_DECL}. The function +@code{a68_consolidate_ref} is used in several parts of the lowering +pass to guarantee a given name is an address regardless of how it was +initialized. + +@node Procedure Identity Declarations +@section Procedure Identity Declarations + +XXX + +@node Procedure Variable Declarations +@section Procedure Variable Declarations + +XXX + +@node Operator Brief Declarations +@section Operator Brief Declarations + +XXX + +@node Operator Declarations +@section Operator Declarations + +XXX + +@node Applied Identifiers +@section Applied Identifiers + +XXX + +@c --------------------------------------------------------------------- +@c Lowering Assignations +@c --------------------------------------------------------------------- + +@node Lowering Assignations +@chapter Lowering Assignations + +Scope checking: + +@itemize @bullet +@item +If static scope checking is relevant and OK, then just perform assignation. +@item +If static scope checking is relevant and not OK, a compile-time error +will have already being emitted. +@item +If static scope checking is not relevant, perform dynamic scope +checking: each time a name, a routine or a format of the data +structure is assigned, its dynamic scope (scope%_si) is compared with +the one of the destination (scope%_d). A run-time error message is +provided in case scope%_d < scope%_si. +@end itemize + +@c --------------------------------------------------------------------- +@c GNU Free Documentation License +@c --------------------------------------------------------------------- + +@include fdl.texi + + +@c --------------------------------------------------------------------- +@c Index +@c --------------------------------------------------------------------- + +@node Index +@unnumbered Index + +@printindex cp + +@bye diff --git a/gcc/algol68/ga68.texi b/gcc/algol68/ga68.texi new file mode 100644 index 000000000000..96ebef679653 --- /dev/null +++ b/gcc/algol68/ga68.texi @@ -0,0 +1,3169 @@ +\input texinfo @c -*-texinfo-*- +@setfilename ga68.info +@settitle The GNU Algol 68 Compiler + +@c Macro for bold-tags. In TeX and HTML they expand to proper bold words, +@c in other formats it resorts to upper stropping. +@iftex +@macro B{tag} +@strong{\tag\} +@end macro +@end iftex + +@ifhtml +@macro B{tag} +@strong{\tag\} +@end macro +@end ifhtml + +@ifnottex +@ifnothtml +@macro B{tag} +\tag\ +@end macro +@end ifnothtml +@end ifnottex + +@c Create a separate index for command line options +@defcodeindex op +@c Merge the standard indexes into a single one. +@syncodeindex fn cp +@syncodeindex vr cp +@syncodeindex ky cp +@syncodeindex pg cp +@syncodeindex tp cp + +@include gcc-common.texi + +@c Copyright years for this manual. +@set copyrights-ga68 2025 + +@copying +@c man begin COPYRIGHT +Copyright @copyright{} @value{copyrights-ga68} Free Software Foundation, Inc. + +Permission is granted to copy, distribute and/or modify this document +under the terms of the GNU Free Documentation License, Version 1.3 or +any later version published by the Free Software Foundation; with no +Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. +A copy of the license is included in the +@c man end +section entitled ``GNU Free Documentation License''. +@ignore +@c man begin COPYRIGHT +man page gfdl(7). +@c man end +@end ignore +@end copying + +@ifinfo +@format +@dircategory Software development +@direntry +* ga68: (ga68). A GCC-based compiler for Algol 68 +@end direntry +@end format + +@insertcopying +@end ifinfo + +@titlepage +@title The GNU Algol 68 Compiler +@versionsubtitle +@author Jose E. Marchesi + +@page +@vskip 0pt plus 1filll +@sp 1 +@insertcopying +@end titlepage +@summarycontents +@contents +@page + +@node Top +@top Introduction + +This manual describes how to use @command{ga68}, the GNU compiler for +Algol 68. This manual is specifically about how to invoke +@command{ga68}, as well as its features. For more information about +the Algol 68 language in general, the reader is referred to the +bibliography. + +Note that the particular way of representing Algol 68 code snippets in +this manual will depend on the media. If you are reading this manual +in a printed support or a PDF file rendered for publication then the +bold words in programs will be rendered in actual bold typography and +tags may have spaces within them. If you are reading this manual in a +terminal or other media not supporting rich typography the code +examples will follow the modern stropping regime with is the default +in ga68. + +Note also that we are making use of @dfn{pseudo-comments} in code +examples, as it is traditional in Algol 68 related documentation. +These appear surrounded by @code{@B{C}} marks and act as placeholders +of some Algol 68 code. For example, @code{@B{C} frob the input +variable @B{C}} is a pseudo-comment. + +@menu +* Invoking ga68:: How to run the compiler. +* Composing programs:: Packets, modules, holes, particular programs. +* Comments and pragmats:: Comments and pragmas. +* Hardware representation:: Representation of programs. +* Standard prelude:: Standard modes, operators, etc. +* Extended prelude:: GNU extensions to the standard prelude. +* POSIX prelude:: Simple I/O and system interaction facilities. +* Language extensions:: GNU extensions to the Algol 68 language. +* Copying:: The GNU General Public License. +* GNU Free Documentation License:: + How you can share and copy this manual. +* Option Index:: Index of command line options. +* General Index:: General index. +@end menu + +@node Invoking ga68 +@chapter Invoking ga68 + +@c man title ga68 A GCC-based compiler for Algol 68 + +@ignore +@c man begin SYNOPSIS ga68 +ga68 [@option{-c}|@option{-S}] [@option{-g}] [@option{-pg}] + [@option{-O}@var{level}] [@option{-W}@var{warn}@dots{}] + [@option{-I}@var{dir}@dots{}] [@option{-L}@var{dir}@dots{}] + [@option{-f}@var{option}@dots{}] [@option{-m}@var{machine-option}@dots{}] + [@option{-o} @var{outfile}] [@@@var{file}] @var{infile}@dots{} + +Only the most useful options are listed here; see below for the +remainder. +@c man end +@c man begin SEEALSO +gpl(7), gfdl(7), fsf-funding(7), gcc(1) +and the Info entries for @file{ga68} and @file{gcc}. +@c man end +@end ignore + +@c man begin DESCRIPTION ga68 + +The @command{ga68} command is the GNU compiler for the Algol 68 language and +supports many of the same options as @command{gcc}. @xref{Option Summary, , +Option Summary, gcc, Using the GNU Compiler Collection (GCC)}. +This manual only documents the options specific to @command{ga68}. + +@c man end + +@menu +* Dialect options:: Options controlling the accepted language. +* Directory options:: Options influencing where to find source files. +* Warnings options:: Options controlling warnings specific to ga68 +* Runtime options:: Options controlling runtime behavior +* Linking options:: Options influencing the linking step +* Developer options:: Options useful for developers of ga68 +@end menu + +@node Dialect options +@section Dialect options +@cindex options, dialect + +The following options control how the compiler handles certain dialect +variations of the language. + +@table @gcctabopt +@opindex std=@var{std} +@item -std=@var{std} +Specify the standard to which the program is expected to conform, +which may be one of @samp{algol68} or @samp{gnu68}. The default value +for @var{std} is @samp{gnu68}, which specifies a strict super language +of Algol 68 allowing GNU extensions. The @samp{algol68} value +specifies that the program strictly conform to the Revised Report. +@opindex fstropping=@var{stropping_regime} +@item -fstropping=@var{stropping_regime} +Specify the stropping regime to expect in the input programs. The +default value for @var{stropping_regime} is @samp{supper}, which +specifies the modern SUPPER stropping which is a GNU extension. The +@samp{upper} value specifies the classic UPPER stropping of Algol 68 +programs. @xref{Stropping regimes}. +@opindex fbrackets +@opindex fno-brackets +@item -fbrackets +This option controls whether @code{[ .. ]} and @code{@{ .. @}} are +considered equivalent to @code{( .. )}. This syntactic variation is +blessed by the Revised Report and is still strict Algol 68. + +This option is disabled by default. +@end table + +@node Directory options +@section Options for Directory Search +@cindex directory options +@cindex options, directory search +@cindex search path + +These options specify directories to search for files, libraries, and +other parts of the compiler: + +@table @gcctabopt + +@opindex I +@item -I@var{dir} +Add the directory @var{dir} to the list of directories to be searched +for files when processing the @ref{pragmat include}. Multiple +@option{-I} options can be used, and the directories specified are +scanned in left-to-right order, as with @command{gcc}. + +@end table + +@node Warnings options +@section Warnings options +@cindex options, warnings +@cindex options, errors +@cindex warnings, suppressing +@cindex messages, error +@cindex messages, warning +@cindex suppressing warnings + +Warnings are diagnostic messages that report constructions that +are not inherently erroneous but that are risky or suggest there +is likely to be a bug in the program. Unless @option{-Werror} is +specified, they do not prevent compilation of the program. + +@table @gcctabopt +@opindex Wvoiding +@opindex Wno-voiding +@item -Wvoiding +Warn on non-void units being voided due to a strong context. +@opindex Wscope +@opindex Wno-scope +@item -Wscope +Warn when a potential name scope violation is found. +@opindex Whidden-declarations +@opindex Wno-hidden-declarations +@item -Whidden-declarations=@var{level} +Warn when a declaration hides another declaration in a larger reach. +This includes operators that hide firmly related operators defined in +larger reach. + +@table @gcctabopt +@item -Whidden-declarations=none +At this level no warning is issued for any hidden declaration on an +outer scope. + +@item -Whidden-declarations=prelude +At this level, warnings are issued for hidden declarations defined in +the standard prelude. This is the default warning level of +@option{-Whidden-declarations}. + +@item -Whidden-declarations=all +At this level, warnings are issued for any and all hidden +declarations. +@end table + +@opindex Wextensions +@opindex Wno-extensions +@item -Wextensions +Warn when a non-portable Algol 68 construct is used, like GNU +extensions to Algol 68. +@end table + +@node Runtime options +@section Runtime options +@cindex options, runtime + +These options affect the runtime behavior of programs compiled with +@command{ga68}. + +@table @gcctabopt +@opindex fassert +@opindex fno-assert +@item -fno-assert +Turn off code generation for @code{ASSERT} contracts. + +@opindex fcheck +@item -fcheck=@var{} +Enable the generation of run-time checks; the argument shall be a +comma-delimited list of the following keywords. Prefixing a check +with @option{no-} disables it if it was activated by a previous +specification. + +@table @asis +@item @samp{all} +Enable all run-time test of @option{-fcheck}. + +@item @samp{none} +Disable all run-time test of @option{-fcheck}. + +@item @samp{nil} +Check for nil while dereferencing. + +@item @samp{bounds} +Enable generation of run-time checks when indexing and trimming +multiple values. +@end table +@end table + +@node Linking options +@section Linking options +@cindex options, linking +@cindex linking, static + +These options come into play when the compiler links object files into +an executable output file. They are meaningless if the compiler is +not doing a link step. + +@table @gcctabopt + +@opindex shared-libga68 +@item -shared-libga68 +On systems that provide @file{libga68} as a shared and a static +library, this option forces the use of the shared version. If no +shared version was built when the compiler was configured, this option +has no effect. + +@opindex static-libga68 +@item -static-libga68 +On systems that provide @file{libga68} as a shared and a static +library, this option forces the use of the static version. If no +static version was built when the compiler was configured, this option +has no effect. This is the default. +@end table + +@node Developer options +@section Developer options +@cindex developer options +@cindex debug dump options +@cindex dump options + +This section describes command-line options that are primarily of +interest to developers. + +@table @gcctabopt +@opindex fa68-dump-modes +@item -fa68-dump-modes +Output a list of all the modes parsed by the front-end. + +@opindex fa68-dump-ast +@item -fa68-dump-ast +Dump a textual representation of the parse tree. + +@opindex fa68-dump-module-interfaces +@item -fa68-dump-module-interfaces +Dump the interfaces of module definitions in the compiled packet. +@end table + +@node Composing programs +@chapter Composing programs +@cindex program +@cindex separated compilation + +This chapter documents how to compose full Algol 68 programs using the +modules and separated compilation support provided by this compiler. + +@menu +* Packets:: Compilation units. +* Modules:: Facilities for bottom-up programming. +* Holes:: Facilities for top-down programming. +* Particular programs:: The main program. +* The standard environment:: Environment conforming a full program. +@end menu + +@node Packets +@section Packets +@cindex packet +@cindex compilation unit + +Each Algol 68 source file contains a @dfn{packet}. Packets therefore +play the role of @dfn{compilation units}, and each packet can be +compiled separately to an object file. A set of compiled object files +can then be linked in the usual fashion into an executable, archive or +shared object by the system linker, without the need of any +language-specific link editor or build system. + +@noindent +This compiler supports three different kind of packets: + +@itemize @minus +@item +@dfn{Particular programs} constitute the entry point of a program. +They correspond to the @code{main} function of other languages like C. + +@xref{Particular programs}. + +@item +@dfn{Prelude packets} contain the definition of one or more modules, +which @dfn{publicize} definitions of modes, procedures, variables, +operators and even the publicized definitions of other modules. The +modules defined at the top-level of a prelude packet can be accessed +by other packets via an @code{@B{access}} construct. Prelude packets +are so-called because their contents get stuffed in the +@dfn{user-prelude} in the case of user-defined modules, or the +@dfn{library-prelude} in the case of module packets provided by the +compiler. They are usually used to compose libraries that can be used +in a bottom-up fashion. + +@xref{Modules}. + +@item +@dfn{Stuffing packets} contain the definition of an @dfn{actual hole}, +an @code{@B{egg}} construct, that can be stuffed in a matching +@dfn{formal hole} in another package via a @code{@B{nest}} construct. +Formal holes are used in order to achieve separated compilation in a +top-bottom fashion, and also to invoke procedures written in other +languages, such as C functions or Fortran subroutines. + +@xref{Holes}. +@end itemize + +A @dfn{collection of packets}, all of which must be compatible with +each other, constitutes either a @dfn{program} or a @dfn{library}. +Exactly one of the packets constituting a program shall be a +particular program. In libraries at least one packet must be a +prelude packet. + +@node Modules +@section Modules +@cindex module + +@dfn{Definition modules}, often referred as just @dfn{modules} in the +sequel, fulfill two different but related purposes. On one side, they +provide some degree of @dfn{protection} by preventing accessing +indicators defined within the module but not explicitly publicized. +On the other, they allow to define @dfn{interfaces}, allow separated +compilation based on these interfaces, and conform libraries. + +Modules are usually associated with bottom-up development strategies, +where several already written components are grouped and combined to +conform bigger components. + +@menu +* Writing modules:: Writing modules. +* Accessing modules:: Using the definitions of a module. +* Module activation:: How and when modules execute. +* Modules and libraries:: Using modules to conform libraries. +* Modules and protection:: When block structure is not enough. +@end menu + +@node Writing modules +@subsection Writing modules + +A @dfn{definition module} is a construct that provides access to a set +of publicized definitions. They can appear anywhere, but are +typically found in the outer reach and compiled separately, in which +case they conform a prelude packet (@pxref{Packets}). They are +composed of a prelude and a postlude. The publicized definitions +appear in the module's prelude. + +Consider for example the following definition module, which implements +a very simple logging facility: + +@example +@B{module} @B{Logger} = + @B{def} @B{int} fd = stderr; + @B{pub} @B{string} originator; + @B{pub} @B{proc} log = (@B{string} msg) @B{void}: + fputs (fd, (originator /= "" | ": ") + msg + "\n"); + + log ("beginning of log\n"); + @B{postlude} + log ("end of log\n"); + @B{fed} +@end example + +@noindent +The @dfn{module text} delimited by @code{@B{def}} and @code{@B{fed}} +gets ascribed to the module indicator @code{@B{Logger}}. Module +indicators are bold tags. Once defined, the module @code{@B{Logger}} +is accessible anywhere within its reach. + +The @dfn{prelude} of the module spans from @code{@B{def}} to either +@code{@B{postlude}}, or to @code{@B{fed}} in case of modules not +featuring a postlude. It consists on a restricted serial clause in a +void strong context, which can contain units and declarations, but no +labels or completers. The declarations in the prelude may be either +publicized or no publicized. As we shall see, publicized indicators +are accessible within the reach of the defining module publicizing +them. Publicized declarations are marked by preceding them with +@code{@B{pub}}. + +In our example the module prelude consists on three declarations and +one unit. The indicator @code{fd} is not publicized and is to be used +internally by the module. The indicators @code{originator} and +@code{log}, on the other hand, are publicized and conform the +interface of the module. Note how the range of the prelude also +covers the postlude: the @code{log} procedure is reachable there, as +it would be @code{fd} as well. + +The @dfn{postlude} of the module is optional and spans from +@code{@B{postlude}} to @code{@B{fed}}. It consists on a serial clause +in a @code{@B{void}} strong context, where definitions, labels and +module accesses are not allowed, just units. + +@node Accessing modules +@subsection Accessing modules + +Once a module is defined (@pxref{Writing modules}) it can be accessed, +provided it is within reach, using an @dfn{access clause}. The access +clause identifies the modules to access and then makes the publicized +definitions of these modules visible within a @dfn{control clause}. + +For example, this is how we could use the logger definition module +defined in a previous section to log the progress of some program that +reads an input file and writes some output file: + +@example +@B{access} @B{Logger} +@B{begin} # Identify ourselves with the program name # + originator := argv (1); + + # Read input file. # + @B{if} @B{NOT} parse_input (argv (2)) + @B{then} log ("error parsing input file"); stop @B{fi}; + + # Write output file. # + @B{if} @B{NOT} write_output (argv (3)) + @B{then} log ("error writing output file"); stop @B{fi}; + + log ("success") +@B{end} +@end example + +@noindent +In this case the controlled clause is the closed clause conforming the +particular program, and the definitions publicized by the logger +module, in this case @code{originator} and @code{log}, can be used +within it. + +@subsubsection Accessing several modules + +An access clause is not restricted to just provide access to a single +module: any number of module indicators can be specified in an access +clause. Suppose that our example processing program has to read and +write the data in JSON format, and that a suitable JSON library is +available in the form of a reachable module. We could then make both +logger and json modules accessible like this: + +@example +@B{access} @B{Logger}, @B{JSON} +@B{begin} # Identify ourselves with the program name # + originator := argv (1); + + @B{JSONVal} data; + + # Read input file. # + @B{if} data := json_from_file (argv (2)); + data = json no val + @B{then} log ("error parsing input file"); stop @B{fi}; + + # Write output file. # + @B{if} @B{not} json_to_file (argv (3), data) + @B{then} log ("error writing output file"); stop @B{fi}; + + log ("success") +@B{end} +@end example + +@noindent +In this version of the program the access clause includes the module +indicator @code{@B{json}}, and that makes the mode indicator +@code{@B{jsonval}} and the tags @code{@B{json no val}}, @code{json +from file} and @code{json to file} visible within the program's +closed clause. + +Note that the following two access clauses are not equivalent: + +@example +@B{access} @B{Logger}, @B{JSON} @B{C} ... @B{C}; +@B{access} @B{Logger} @B{access} @B{JSON} @B{C} ... @B{C}; +@end example + +@noindent +In the first case, a compilation time error is emitted if there is a +conflict among the publicized definitions of both modules; for +example, if both modules were to publicize a procedure called +@code{log}. In the second case, the declaration of @code{log} +publicized by @code{@B{Logger}} would hide the declaration of +@code{log} publicized by @code{@B{JSON}}. This also has implications +related to activation, that we will be discussing in a later section. + +@subsubsection The controlled clause + +The controlled clause in an access clause doesn't have to be a serial +clause, like in the examples above. It can be any enclosed clause, +like for example a loop clause: + +@example +@B{proc} frobnicate frobs = ([]@B{Frob} frobs) @B{void}: + @B{access} @B{Logger} @B{to} @B{UPB} frobs + @B{do} log ("frobnicating " + name @B{of} frob); + frobnicate (frob) + @B{od} +@end example + +@subsubsection The value yielded by an access clause + +The elaboration of an access clause yields a value, which is the value +yielded by the elaboration of the controlled clause. Since the later +is an enclosed clause, coercions get passed into them whenever +required, the usual fashion. + +We can see an example of this in the following procedure, whose body +is a controlled closed clause that yields a @code{@B{real}} value: + +@example +@B{proc} incr factor = (@B{ref}[]@B{real} factors, @B{int} idx) @B{real}: + @B{access} @B{logger} (log ("factor increased"); factors[idx] +:= 1.0) +@end example + +@noindent +Note how the access clause above is in a strong context requiring a +value of mode @code{@B{real}}. The value yielded by the access clause +is the value yielded by the controlled enclosed clause, which in this +case is a closed clause. The strong context and required mode gets +passed to the last unit of the closed clause (the assignation) which +in this case yields a value of mode @code{@B{ref} @B{real}}. The unit +is coerced to @code{@B{real}} by dereferencing, and the resulting +value becomes the value yielded by the access clause. + +@subsubsection Modules accessing other modules + +A definition module may itself access other modules. This is done by +placing the module text as a controlled clause of an access clause. +Suppose we rewrite our logger module so it uses JSON internally to log +JSON objects rather than raw strings. We could do it this way: + +@example +@B{module} @B{logger} = + @B{access} @B{json} + @B{def} @B{int} fd = stderr; + @B{pub} @B{string} originator; + @B{pub} @B{proc} log = (@B{string} msg) @B{void}: + fputs (fd, json array (json string (originator), + json string (msg))); + + log (json string ("beginning of log\n")); + @B{postlude} + log (json string ("end of log\n")); + @B{fed} +@end example + +@noindent +Note how this version of @code{@B{logger}} uses a few definitions +publicized by the @code{@B{json}} module. + +A program accessing @code{@B{logger}} will not see the definitions +publicized by the @code{@B{json}} module. If that is what we +intended, for example to allow the users of the logger to tweak their +own JSON, we would need to specify it this way: + +@example +@B{module} @B{logger} = + @B{access} @B{pub} @B{json} + @B{def} @B{c} ...as before... @B{c} @B{fed} +@end example + +@noindent +In this version the definitions publicized by @code{@B{json}} become +visible to programs accessing @code{@B{logger}}. + +@node Module activation +@subsection Module activation + +In all the examples seen so far the modules were accessed just once. +In these cases, accessing the module via an access-clause caused the +@dfn{activation} of the module. + +Activating a module involves elaborating all the declarations and +units that conform its prelude. Depending on the particular module +definition that gets activated, this may involve all sort of side +effects, such as allocating space for values and initializing them, +opening files, @i{etc}. Once the modules specified in the access +clause are successfully activated, the controlled clause gets +elaborated itself, within the reach of all the publicized definitions +by the activated modules as we saw in the last section. Finally, once +the controlled clause has been elaborated, the module gets +@dfn{revoked} by elaborating the serial clause in its postlude. + +However, nothing prevents some given definition module to be accessed +more than once in the same program. The following program, that makes +use of the @code{@B{logger}} module, exemplifies this: + +@example +@B{access} @B{logger} +@B{begin} originator := argv (1); + log ("executing program"); + @B{c} ... @B{c} + @B{access} @B{logger} (originator := argv (1) + ":subtask"; + log ("doing subtask") + @B{c} ... @B{c}) +@B{end} +@end example + +@noindent +In this program the module @code{@B{logger}} is accessed twice. The +code is obviously written assuming that the inner access clause +triggers a new activation of the @code{@B{logger}} module, allocating +new storage and executing its prelude. This would result in the +following log contents: + +@example +a.out: beginning of log +a.out: executing program +a.out:subtask: beginning of log +a.out:subtask: doing subtask +a.out:subtask: end of log +a.out: end of log +@end example + +@noindent +However, this is not what happens. The module gets only activated +once, as the result of the outer access clause. The inner access +clause just makes the publicized indicators visible in its controlled +clause. The actual resulting log output is: + +@example +a.out: beginning of log +a.out: executing program +a.out:subtask: doing subtask +a.out:subtask: end of log +@end example + +@noindent +Which is not what we intended. Modules are not classes. If we wanted +the logger to support several originators that can be nested, we would +need to add support for it in the definition module. Something like: + +@example +@B{module} @B{logger} = + @B{def} @B{int} fd = stderr, max originators = 10; + @B{int} orig := 0; + [max originators]@B{string} originators; + + @B{pub} @B{proc} push originator = (@B{string} str) @B{void}: + (@B{assert} (orig < max originators); + orig +:= 1; + originators[orig] := str); + @B{pub} @B{proc} pop originator = @B{void}: + (@B{assert} (max originators > 0); + orig -:= 1); + @B{pub} @B{proc} log = (@B{string} msg) @B{void}: + fputs (fd, (originator[orig] /= "" | ": ") + msg + "\n"); + + log ("beginning of log\n"); + @B{postlude} + log ("end of log\n"); + @B{fed} +@end example + +@noindent +Note how in this version of @code{@B{logger}} @code{originators} acts +as a stack of originator strings, and it is not publicized. The +management of the stack is done via a pair of publicized procedures +@code{push originator} and @code{pop originator}. Our program will +now look like: + +@example +@B{access} @B{logger} +@B{begin} push originator (argv (1)); + log ("executing program"); + @B{c} ... @B{c} + @B{access} @B{logger} (push originator ("subtask"); + log ("doing subtask") + @B{c} ... @B{c}; + pop originator) +@B{end} +@end example + +@noindent +And the log output is: + +@example +a.out: beginning of log +a.out: executing program +a.out:subtask: doing subtask +a.out: end of log +@end example + + +-------------------------------------------------------------- + +module-indications are used to find interface-definitions of modules: + + ACCESS FOO SKIP + +Looks for (in order): + + foo.m68 + foo.o + libfoo.so + +Should we use instead: + + ACCESS "foo" SKIP + +That would use for module indicators the same syntax than hole +indicators. + +Modules get accessed, invoked and revoked. + +Access clauses: + +: ACCESS A, B + +Where A and B are ``revelations''. + +In + +: MODULE A = ACCESS B DEF ... FED + +Doesn't reveals any contents of B. Whereas in: + +: MODULE A = ACCESS PUB B DEF .. FED + +The module A is also revealing B's public declarations. So accessing +A provides access to B. + +User-defined preludes go to the user-prelude. + +Invocation and revocation:: How modules are executed. + +It is possible for a definition module to not publicize any +definition. Such modules would be used only for the side effects +produced from executing the prelude and postlude when the module gets +invoked and revoked. XXX: provide an example? + +XXX + +@node Modules and libraries +@subsection Modules and libraries +@cindex library +@cindex prelude packet + +XXX + +@node Modules and protection +@subsection Modules and protection +@cindex protection +@cindex publicized definition + +XXX + +@node Holes +@section Holes +@cindex hole + +XXX + +@node Particular programs +@section Particular programs +@cindex particular program + +An Algol 68 @dfn{particular program} consists on an enclosed clause in +a strong context with target mode @code{@B{void}}, possibly preceded +by a set of zero or more labels. For example: + +@example +hello: +@B{begin} puts ("Hello, world!\n") +@B{end} +@end example + +@noindent +Note that the enclosed clause conforming the particular program +doesn't have to be a closed clause. Consider for example the +following program, that prints out its command line arguments: + +@example +@B{for} i @B{to} argc +@B{do} puts (argv (i) + "\n") @B{od} +@end example + +@menu +* Exit status:: How do programs communicate success or failure. +* The @code{stop} label:: How to terminate a program at any time. +@end menu + +@node Exit status +@subsection Exit status +@cindex exit status + +Some operating systems have the notion of @dfn{exit status} of a +process. In such systems, by default the execution of the particular +program results in an exit status of success. It is possible for the +program to specify an explicit exit status by using the standard +procedure @code{set exit status}, like: + +@example +@b{begin} # ... program code ... # + @B{if} error found; + @B{then} set exit status (1) @B{fi} +@b{end} +@end example + +In POSIX systems the status is an integer, and the system interprets a +value other than zero as a run-time error. In other systems the +status may be of some other type. To support this, the @code{set +error status} procedure accepts as an argument an united value that +accommodates all the supported systems. + +The following example shows a very simple program that prints ``Hello +world'' on the standard output and then returns to the operating +system with a success status: + +@example +@B{begin} puts ("Hello world\n") +@B{end} +@end example + +@node The @code{stop} label +@subsection The @code{stop} label +@cindex @code{stop} + +A predefined label named @code{stop} is defined in the standard +postlude. This label can be jumped to at any time by a program and it +will cause it to terminate and exit. For example: + +@example +@B{begin} @B{if} argc /= 2 + @B{then} puts ("Program requires exactly two arguments."); + goto stop + @B{fi} + @B{C} ... @B{C} +@B{end} +@end example + +@node The standard environment +@section The standard environment +@cindex standard environment + +The environment in which particular programs run is expressed here in +the form of pseudo code: + +@example +(@B{c} standard-prelude @B{c}; + @B{c} library-prelude @B{c}; + @B{c} system-prelude @B{c}; + @B{par} @B{begin} @B{c} system-task-1 @B{c}, + @B{c} system-task-2 @B{c}, + @B{c} system-task-n @B{c}, + @B{c} user-task-1 @B{c}, + @B{c} user-task-2 @B{c}, + @B{c} user-task-m @B{c} + @B{end}) +@end example + +@noindent +Where each user task consists on: + +@example +(@B{c} particular-prelude @B{c}; + @B{c} user-prelude @B{c}; + @B{c} particular-program @B{c}; + @B{c} particular-postlude @B{c}) +@end example + +The only standard system task described in the report is expressed in +pseudo-code as: + +@example +@B{do} @B{down} gremlins; undefined; @B{up} bfileprotect @B{od} +@end example + +@noindent +Which denotes that, once a book (file) is closed, anything may happen. +Other system tasks may exist, depending on the operating system. In +general these tasks in the parallel clause denote the fact that the +operating system is running in parallel (intercalated) with the user's +particular programs. + +@itemize @bullet +@item +The library-prelude contains, among other things, the prelude parts of +the defining modules provided by library. + +@item +The particular-prelude and particular-postlude are common to all the +particular programs. + +@item +The user-prelude is where the prelude parts of the defining modules +involved in the compilation get stuffed. If no defining module is +involved then the user-prelude is empty. +@end itemize + +Subsequent sections in this manual include a detailed description of +the contents of these preludes. + +@node Comments and pragmats +@chapter Comments and pragmats + +Comments and pragmats, also known collectively as @dfn{pragments}, can +appear almost anywhere in an Algol 68 program. Comments are usually +used for documentation purposes, and pragmats contain annotations for +the compiler. Both are handled at the lexical level. + +@menu +* Comments:: Your typical friendly comments. +* Pragmats:: In-source directives for the compiler. +@end menu + +@node Comments +@section Comments + +In the default modern stropping regime supported by GCC comments are +written between @code{@{} and @code{@}} delimiters, and can be nested +to arbitrary depth. For example: + +@example +foo +:= 1; @{ Increment foo. @} +@end example + +If UPPER stropping is selected, this compiler additionally supports +three classical Algol 68 comment styles, in which the symbols marking +the beginning of comments are the same than the symbols marking the +end of comments and therefore can't be nested: @code{@B{comment} +... @B{comment}}, @code{@B{co} ... @B{co}} and @code{# .. #}. For +example: + +@example +@B{comment} + This is a comment. +@B{comment} + +foo := 10; @B{co} this is also a comment @B{co} +foo +:= 1; # and so is this. # +@end example + +Unless @option{-std=algol68} is specified in the command line, two +styles of nestable comments can be also used with UPPER stropping: the +already explained @code{@{ ... @}} and a ``bold'' style that uses +@code{@B{code} ... @B{edoc}}. For example: + +@example +foo := 10; @{ this is a nestable comment in brief style. @} +foo +:= 1; @B{note} this is a nestable comment in bold style. @B{eton}. +@end example + +@example +@B{note} + "Bold" nestable comments. +@B{eton} + +@{ "Brief" nestable comments. @} +@end example + +In UPPER stropping all comment styles are available, both classic and +nestable. In modern SUPPER stropping, which is based on reserved +words, only @code{@{ ... @}} is available. + +@node Pragmats +@section Pragmats + +@cindex pragmat +@dfn{Pragmats} (also known as @dfn{pragmas} in other programming +languages) are directives and annotations for the compiler, and their +usage impacts the compilation process in several ways. A pragmat +starts with either @code{@B{pragmat}} or @code{@B{pr}} and finished +with either @code{@B{pragmat}} or @code{@B{pr}} respectively. +Pragmats cannot be nested. For example: + +@example +@B{pr} include "foo.a68" @B{pr} +@end example + +The interpretation of pragmats is compiler-specific. This chapter +documents the pragmats supported by GCC. + +@menu +* pragmat include:: Include another source file. +@end menu + +@node pragmat include +@subsection pragmat include +@cindex include + +An @dfn{include pragmat} has the form: + +@example +@B{pr} include "PATH" @B{pr} +@end example + +@noindent +Where @code{PATH} is the path of the file whose contents are to be +included at the location of the pragmat. If the provided path is +relative then it is interpreted as relative to the directory +containing the source file that contains the pragmat. + +The @option{-I} command line option can be used in order to add +additional search paths for @code{include}. + +@node Hardware representation +@chapter Hardware representation + +The @dfn{reference language} specified by the Revised Report describes +Algol 68 particular programs as composed by @dfn{symbols}. However, +the Report leaves the matter of the concrete representation of these +symbols, the @dfn{representation language}, open to the several +implementations. This was motivated by the very heterogeneous +computer systems in existence at the time the Report was written, +which made flexibility in terms of representation a crucial matter. + +This flexibility was indeed exploited by the early implementations, +and there was a price to pay for it. A few years after the +publication of the Revised Report the different implementations had +already given rise to a plethora of many related languages that, +albeit being strict Algol 68, differed considerably in appearance. +This, and the fact that people were already engrossed in writing +programs other than compilers that needed to process Algol 68 +programs, such as code formatters and macro processors, prompted the +WG 2.1 to develop and publish a @dfn{Report on the Standard Hardware +Representation for ALGOL 68}, which came out in 1975. + +This compiler generally follows the Standard Hardware Representation, +but deviates from it in a few aspects. This chapter provides an +overview of the hardware representation and documents any deviation. + +@menu +* Representation languages:: From symbols to syntactic marks. +* Worthy characters:: Marks that can appear in a program. +* Base characters:: Mapping of worthy characters to code points. +* Stropping regimes:: Representation of bold words. +* Monads and Nomads:: Characters that can appear in operator names. +* String breaks:: String literals and escape sequences. +@end menu + +@node Representation languages +@section Representation languages + +A program in the strict Algol 68 language is composed by a series of +symbols. These symbols have names such as @code{letter-a-symbol} and +@code{assigns-to-symbol} which are, well, purely symbolic. In fact, +these are notions in the two-level grammar that defines the strict +language. + +A @dfn{representation language} provides a mapping between symbols in +the strict language and the representation of these symbols. Each +representation is a sequence of syntactic marks. For example, the +@code{completion symbol} may be represented by @strong{exit}, where +the marks are the bold letters. The @code{tilde symbol} may be +represented by @code{~}, which is a single mark. The representation of +@code{assigns to symbol} is @code{:=}, which is composed by the two +marks @code{:} and @code{=}. The representation of @code{letter-a} +is, not surprising, the single mark @code{a}. + +The section 9.4 of the Report describes the recommended representation +for all the symbols of the language. The set of all recommendations +constitutes the so-called @dfn{reference language}. Algol 68 +implementations are strongly encouraged to use representation +languages which are similar enough to the reference language, +recognizable ``without further elucidation'', but this is not +strictly required. + +A representation language may specify more than one representation for +a given symbol. For example, in the reference language the @code{is +not symbol} is represented by @strong{isnt}, @code{:/=:} and a variant +of the later where the slash sign is superimposed on the equal sign. +In this case, an implementation can choose to implement any number of +the representations. + +Spaces, tabs and newlines are @dfn{typographical display features} +that, when they appear between symbols, are of no significance and do +not alter the meaning of the program. However, when a space or a tab +appear in string or character denotations, they represent the +@code{space symbol} and the @code{tab symbol} +respectively@footnote{The @code{tab symbol} is a GNU extension}. + +@node Worthy characters +@section Worthy characters +@cindex worthy characters + +The syntactic marks of a representation language, both symbols and +typographical display features, are realized as a set of @dfn{worthy +characters} and the newline. Effectively, an Algol 68 program is a +sequence of @dfn{worthy characters} and newlines. The worthy +characters are: + +@example +a b c d e f g h i j k l m n o p q r s t u v w x y z +A B C D E F G H I J K L M N O P Q R S T U V W X Y Z +0 1 2 3 4 5 6 7 8 9 +space tab " # $ % & ' ( ) * + , - . / : ; < = > @ [ \ ] +^ _ | @ ! ? ~ @{ @} +@end example + +Some of the characters above were considered unworthy by the original +Standard Hardware Representation: + +@table @code +@item ! +It was considered unworthy because many installations didn't have a +vertical bar base character, and @code{!} was used as a base character +for @code{|}. Today every computer system features a vertical bar +character, so @code{!} can qualify as a worthy character. +@item & +The Revised Report specifies that @code{&} is a monad, used as a +symbol for the dyadic @code{@B{and}} operator. The Standard Hardware +representation decided to turn it into an unworthy character, +motivated by the fact that no nomads existed for the other logical +operators @code{@B{not}} and @code{@B{or}}, and also with the goal of +maintaining the set of worthy characters as small as possible to +improve portability. Recognizing that the first motivation still +holds, but not the second, this compiler re-instates @code{&} as a +monad but doesn't use it as an alternative representation of the +@code{@B{and}} operator. +@item ~ +The Standard Hardware Representation vaguely cites some ``severe +difficulties'' with the hardware representation of the tilde +character. Whatever these difficulties were at the time, they surely +don't exist anymore. This compiler therefore recognizes @code{~} as a +worthy character, and is used as a monad. +@item ? +The question mark character was omitted as a worthy character to limit +the size of the worthy set. This compiler recognizes @code{?} as a +worthy character, and is used as a monad. +@item \ +Back-slash wasn't included as a worthy character because back in 1975 +it wasn't supported in EBCDIC (it is now). This compiler recognizes +@code{\} as a worthy character. +@item tab +This compiler recognizes the tabulator character as a worthy +character, and it is used as a typographical display feature. +@end table + +@node Base characters +@section Base characters +@cindex base characters + +The worthy characters described in the previous section are to be +interpreted symbolically rather than visually. The worthy character +@code{|}, for example, is the vertical line character and generally +looks the same in every system. The worthy character @code{space} is +obviously referred by a symbolic name. + +The actual visually distinguishable characters available in an +installation are known as @dfn{base characters}. The Standard +Hardware Representation allows implementations the possibility of +using two or more base characters to represent a single worthy +character. This was the case of the @code{|} character, which was +represented in many implementations by either @code{|} or @code{!}. + +This compiler uses the set of base characters corresponding to the +subset of the Unicode character set that maps one to one to the set of +worthy characters described in the previous section: + +@example +A-Z 65-90 +a-z 97-122 +space 32 +tab 9 +! 33 +" 34 +# 35 +$ 36 +% 37 +& 38 +' 39 +( 40 +) 41 +* 42 ++ 43 +, 44 +- 45 +. 46 +/ 47 +: 58 +; 59 +< 60 += 61 +> 62 +? 63 +@@ 64 +[ 91 +\ 92 +] 93 +^ 94 +_ 95 +| 124 +~ 126 +@end example + +@node Stropping regimes +@section Stropping regimes + +The Algol 68 reference language establishes that certain source +constructs, namely mode indications and operator indications, consist +in a sequence of @dfn{bold letters} and @dfn{bold digits}, known as a +@dfn{bold word}. In contrast, other constructs like identifiers, +field selectors and labels, collectively known as @dfn{tags}, are +composed of regular, non-bold letters and digits. + +What is precisely a bold letter or digit, and how they differ from +non-bold letters and digits, is not specified by the Report. This is +no negligence, but a conscious effort at abstracting the definition of +the so-called @dfn{strict language} from its representation. This +allows different representations of the same language. + +Some representations of Algol 68 are intended to be published in +books, be it paper or electronic devices, and be consumed by persons. +These are called @dfn{publication languages}. In publication +languages bold letters and digits are typically represented by actual +bold alphanumeric typographic marks. An Algol 68 program hand written +on a napkin or a sheet of paper would typically represent bold letters +and digits underlined, or stroked using a different color ink. + +Other representations of Algol 68 are intended to be automatically +processed by a computer. These representations are called +@dfn{hardware languages}. Sometimes the hardware languages are also +intended to be written and read by programmers; these are called +@dfn{programming languages}. + +Unfortunately, computer systems today usually do not yet provide +readily usable and ergonomic bold or underline alphanumeric marks, +despite the existence of Unicode and modern and sophisticated editing +environments. The lack of appropriate input methods surely plays a +role to explain this. Thus, the programming representation languages +of Algol 68 should resort to a technique known as @dfn{stropping} in +order to differentiate bold letters and digits from non-bold letters +and digits. The set of rules specifying the representation of these +characters is called a @dfn{stropping regime}. + +There are three classical stropping regimes for Algol 68, which are +standardized and specified in the Standard Hardware Representation +normative document. These are @dfn{POINT stropping}, @dfn{RES +stropping} and @dfn{UPPER stropping}. The following sections do a +cursory tour over them; for more details the reader is referred to the +Standard Hardware Representation. + +This compiler implements UPPER stropping and SUPPER stropping. + +@menu +* POINT stropping:: +* RES stropping:: +* UPPER stropping:: +* SUPPER stropping:: +@end menu + +@node POINT stropping +@subsection POINT stropping + +POINT stropping is in a way the most fundamental of the three standard +regimes. It was designed to work in installations with limited +character sets that provide only one alphabet, one set of digits, and +a very restricted set of other symbols. + +In POINT stropping a bold word is represented by its constituent +letters and digits preceded by a point character. For example, the +symbol @code{bold begin symbol} in the strict language, which is +represented as @strong{begin} in bold face in the reference language, +would be represented as @code{.BEGIN} in POINT stropping. + +More examples are summarized in the following table. + +@multitable @columnfractions .33 .33 .33 +@headitem Strict language @tab Reference language @tab POINT stropping +@item @code{true symbol} @tab @strong{true} @tab @code{.TRUE} +@item @code{false symbol} @tab @strong{false} @tab @code{.FALSE} +@item @code{integral symbol} @tab @strong{int} @tab @code{.INT} +@item @code{completion symbol} @tab @strong{exit} @tab @code{.EXIT} +@item @code{bold-letter-c-...} @tab @strong{crc32} @tab @code{.CRC32} +@end multitable + +In POINT stropping a tag is represented by writing its constituent +non-bold letters and digits in order. But they are organized in +several @dfn{taggles}. + +Each taggle is a sequence of one or more letters and digits, +optionally followed by an underscore character. For example, the tag +@code{PRINT} is composed of a single taggle, but the tag +@code{PRINT_TABLE} is composed of a first taggle @code{PRINT_} +followed by a second taggle @code{TABLE}. + +To improve readability it is possible to insert zero or more white +space characters between the taggles in a tag. Therefore, the tag +@code{PRINT_TABLE} could have been written @code{PRINT TABLE}, or even +@code{PRINT_ TABLE}. This is the reason why Algol 68 identifiers, +labels and field selectors can and do usually feature white spaces in +them. + +It is important to note that both the trailing underscore characters +in taggles and the white spaces in a tag do not contribute anything to +the denoted tag: these are just stropping artifacts aimed to improve +readability. Therefore @code{FOOBAR} @code{FOO BAR}, @code{FOO_BAR} +and @code{FOO_BAR_} are all representations of the same tag, that +represents the +@code{letter-f-letter-o-letter-o-letter-b-letter-a-letter-r} language +construct. + +Below is the text of an example Algol 68 procedure encoded in POINT +stropping. + +@example +.PROC RECSEL OUTPUT RECORDS = .VOID: +.BEGIN .BITS FLAGS + := (INCLUDE DESCRIPTORS | REC F DESCRIPTOR | REC F NONE); + .RECRSET RES = REC DB QUERY (DB, RECUTL TYPE, + RECUTL QUICK, FLAGS); + .RECWRITER WRITER := REC WRITER FILE NEW (STDOUT); + + SKIP COMMENTS .OF WRITER := .TRUE; + .IF RECUTL PRINT SEXPS + .THEN MODE .OF WRITER := REC WRITER SEXP .FI; + REC WRITE (WRITER, RES) +.END +@end example + +@node RES stropping +@subsection RES stropping + +The early installations where Algol 68 ran not only featured a very +restricted character set, but also suffered from limited storage and +complex to use and time consuming input methods such as card punchers +and readers. It was important for the representation of programs to +be as compact as possible. + +It is likely that is what motivated the introduction of the RES +stropping regime. As its name implies, it removes the need of +stropping many bold words by introducing @dfn{reserved words}. + +A @dfn{reserved word} is one of the bold words specified in the +section 9.4.1 of the Report as a representation of some symbol. +Examples are @strong{at}, @strong{begin}, @strong{if}, @strong{int} +and @strong{real}. + +RES stropping encodes bold words and tags like POINT stropping, but if +a bold word is a reserved word then it can then be written without a +preceding point, achieving this way a more compact, and easier to +read, representation for programs. + +Introducing reserved words has the obvious disadvantage that some tags +cannot be written the obvious way due to the possibility of conflicts. +For example, to represent a tag @code{if} it is not possible to just +write @code{IF}, because it conflicts with a reserved word, but this +can be overcome easily (if not elegantly) by writing @code{IF_} +instead. + +Below is the @code{recsel output records} procedure again, this time +encoded in RES stropping. + +@example +PROC RECSEL OUTPUT RECORDS = VOID: +BEGIN BITS FLAGS + := (INCLUDE DESCRIPTORS | REC F DESCRIPTOR | REC F NONE); + .RECRSET RES = REC DB QUERY (DB, RECUTL TYPE, + RECUTL QUICK, FLAGS); + .RECWRITER WRITER := REC WRITER FILE NEW (STDOUT); + + SKIP COMMENTS OF WRITER := TRUE; + IF RECUTL PRINT SEXPS + THEN MODE .OF WRITER := REC WRITER SEXP FI; + REC WRITE (WRITER, RES) +END +@end example + +Note how user-defined mode an operator indications still require +explicit stropping. + +@node UPPER stropping +@subsection UPPER stropping + +In time computers added support for more than one alphabet by +introducing character sets with both upper and lower case letters, +along with convenient ways to both input and display these. + +In UPPER stropping the bold letters in bold word are represented by +upper-case letters, whereas the letters in tags are represented by +lower-case letters. + +The notions of upper- and lower-case are not applicable to digits, but +since the language syntax assures that it is not possible to have a +bold word that starts with a digit, digits are considered to be bold +if they follow a bold letter or another bold digit. + +Below is the @code{recsel output records} procedure again, this time +encoded in UPPER stropping. + +@example +PROC recsel output records = VOID: +BEGIN BITS flags + := (include descriptors | rec f descriptor | rec f none); + RECRSET res = rec db query (db, recutl type, + recutl quick, flags); + RECWRITER writer := rec writer file new (stdout); + + skip comments of writer := TRUE; + IF recutl print sexps + THEN mode OF writer := rec writer sexp FI; + rec write (writer, res) +END +@end example + +Note how in this regime it is almost never necessary to introduce bold +tags with points. All in all, it looks much more natural to +contemporary readers. UPPER stropping is in fact the stropping regime +of choice today. It is difficult to think of any reason why anyone +would resort to use POINT or RES stropping. + +@node SUPPER stropping +@subsection SUPPER stropping + +In the SUPPER stropping regime bold words are written by writing a +sequence of one or more @dfn{taggles}. Each taggle is written by +writing a letter followed by zero or more other letters and digits and +is optionally followed by a trailing underscore character. The first +letter in a bold word shall be an upper-case letter. The rest of the +letters in the bold word may be either upper- or lower-case. + +For example, @code{RecRset}, @code{Rec_Rset} and @code{RECRset} are +all different ways to represent the same mode indication. This allows +to recreate popular naming conventions such as @code{CamelCase}. + +As in the other stropping regimes, the casing of the letters and the +underscore characters are not really part of the mode or operator +indication. + +Operator indications are also bold words and are written in exactly +the same way than mode indications, but it is usually better to always +use upper-case letters in operator indications. On one side, it looks +better, especially in the case of dyadic operators where the asymmetry +of, for example @code{Equal} would look odd, consider @code{m1 Equal +m2} as opposed to @code{m1 EQUAL m2}. On the other side, tools like +editors can make use of this convention in order to highlight operator +indications differently than mode indications. + +In the SUPPER stropping regime tags are written by writing a sequence +of one or more @dfn{taggles}. Each taggle is written by writing a +letter followed by zero or more other letters and digits and is +optionally followed by a trailing underscore character. All letters +in a tag shall be lower-case letters. + +For example, the identifier @code{list} is represented by a single +taggle, and it is composed by the letters @code{l}, @code{i}, @code{s} +and @code{t}, in order. In the jargon of the strict language we would +spell the tag as @code{letter-l-letter-i-letter-s-letter-t}. + +The label @code{found_zero} is represented by two taggles, +@code{found_} and @code{zero}, and it is composed by the letters +@code{f}, @code{o}, @code{u}, @code{n}, @code{d}, @code{z}, @code{e}, +@code{r} and @code{o}, in order. In the jargon of the strict language +we would spell the tag as @code{letter-f-letter-o-letter-u-letter-n +-letter-d-letter-z-letter-e-letter-r-letter-o}. + +The identifier @code{crc_32} is likewise represented by two taggles, +@code{crc_} and @code{32}. Note how the second taggle contains only +digits. In the jargon of the strict language we would spell the tag +as @code{letter-c-letter-r-letter-c-digit-three-digit-two}. + +The underscore characters are not really part of the tag, but part of +the stropping. For example, both @code{goto found_zero} and +@code{goto foundzero} jump to the same label. + +The @code{recsel output records} procedure, encoded in SUPPER +stropping, looks like below. + +@example +proc recsel_output_records = void: +begin bits flags + := (include_descriptors | rec_f_descriptor | rec_f_none); + RecRset res = rec_db_query (db, recutl_type, + recutl_uick, flags); + RecWriter writer := rec_writer_file_new (stdout); + + skip_comments of writer := true; + if recutl_print_sexps + then mode_ of writer := rec_writer_sexp fi; + rec_write (writer, res) +end +@end example + +@node Monads and Nomads +@section Monads and Nomads +@cindex monads +@cindex nomads + +Algol68 operators, be them predefined or defined by the programmer, +can be referred via either bold tags or sequences of certain +non-alphabetic symbols. For example, the dyadic operator @code{+} is +defined for many modes to perform addition, the monadic operator +@code{@B{entier}} gets a real value and rounds it to an integral +value, and the operator @code{:=:} is the identity relation. Many +operators provide both bold tag names and symbols names, like in the +case of @code{:/=:} that can also be written as @code{@B{isnt}}. + +Bold tags are lexically well delimited, and if the same tag is used to +refer to a monadic operator and to a dyadic operator, no ambiguity can +arise. For example, in the following program it is clear that the +second instance of @code{@B{plus}} refers to the monadic operator, and +the first instance refers to the dyadic operator@footnote{If one would +write @code{@B{plusplus}}, it would be a third different bold tag.}. + +@example +@B{op} @B{PLUS} = (@B{int} a, b) @B{int}: a + b, + @B{PLUS} = (@B{int} a): a; +@B{int} val = 2 @B{PLUS} @B{PLUS} 3; +@end example + +On the other hand, symbols are not lexically delimited as words, and +one symbol can appear immediately following another symbol. This can +lead to ambiguities. For example, if we were to define a C-like +monadic operator @code{++} like: + +@example +@B{op} ++ = (@B{ref} @B{int} a) @B{int}: (@B{int} t = a; a +:=1; t); +@end example + +@noindent +Then the expression @code{++a} would be ambiguous: is it @code{++a} or +@code{+(+a)}?. In a similar way, if we would use @code{++} as the +name of a dyadic operator, an expression like @code{a++b} could be +also interpreted as both @code{a++b} and @code{a+(+b)}. + +To avoid these problems Algol 68 divides the symbols which are +suitable to appear in the name of an operator into two classes: monads +and nomads. @dfn{Monads} are symbols that can be used as monadic +operators. @dfn{Nomads} are symbols which can be used as both monadic +or dyadic operators. Given these two sets, the rules to conform a +valid operator are: + +@itemize @minus +@item A bold tag. +@item Any monad. +@item A monad followed by a nomad. +@item A monad optionally followed by a nomad followed by either @code{:=} or @code{=:}, but not by both. +@end itemize + +@noindent +In the GNU Algol 68 compiler: + +@itemize @minus +@item The set of monads is @code{%^&+-~!?}. +@item The set of nomads is @code{> 1} and +@code{1 - small real < 1}. +@end deftypevr + +@deftypevr Constant @B{int} {bits lengths} +1 plus the number of extra widths of bits which are meaningful. +@end deftypevr + +@deftypevr Constant @B{int} {bits shorths} +1 plus the number of extra shorths of bits which are meaningful. +@end deftypevr + +@deftypevr Constant @B{int} {bits width} +@deftypevrx Constant @B{int} {long bits width} +@deftypevrx Constant @B{int} {long long bits width} +The number of bits in a @code{@B{bits}} value. +@end deftypevr + +@deftypevr Constant @B{int} {bytes lengths} +1 plus the number of extra widths of bytes which are meaningful. +@end deftypevr + +@deftypevr Constant @B{int} {bytes shorths} +1 plus the number of extra shorths of bytes which are meaningful. +@end deftypevr + +@deftypevr Constant @B{int} {bytes width} +@deftypevrx Constant @B{int} {long bytes width} +@deftypevrx Constant @B{int} {long long bytes width} +The number of chars in a @code{@B{bytes}} value. +@end deftypevr + +@deftypevr Constant @B{int} {max abs char} +The largest value which @code{@B{abs}} of a @code{@B{char}} can yield. +@end deftypevr + +@deftypevr Constant @B{char} {null character} +Some character. +@end deftypevr + +@deftypevr Constant @B{char} flip +@deftypevrx Constant @B{char} flop +Characters used to represent @code{@B{true}} and @code{@B{false}} +boolean values in textual transput. +@end deftypevr + +@deftypevr Constant @B{char} {error char} +Character used to represent the digit of a value resulting from a +conversion error in textual transput. +@end deftypevr + +@deftypevr Constant @B{char} blank +The space character. +@end deftypevr + +@deftypevr Constant {@B{l} @B{real}} {L pi} +The number pi. +@end deftypevr + +@node Standard modes +@section Standard modes + +@deftp Mode @B{void} +The only value of this mode is @code{@B{empty}}. +@end deftp + +@deftp Mode @B{bool} +Mode for the boolean truth values @code{@B{true}} and @code{@B{false}}. +@end deftp + +@deftp Mode {@B{l} @B{int}} +Modes for signed integral values. Each @code{@B{long}} or +@code{@B{short}} may increase or decrease the range of the domain, +depending on the characteristics of the current target. Further +@code{@B{long}}s and @code{@B{short}}s may be specified with no +effect. +@end deftp + +@deftp Mode {@B{l} @B{real}} +Modes for signed real values. Each @code{@B{long}} may increase the +upper range of the domain, depending on the characteristics of the +current target. Further @code{@B{long}}s may be specified but with no +effect. +@end deftp + +@deftp Mode @B{char} +Mode for character values. The character values are mapped one-to-one +to code points in the 21-bit space of Unicode. +@end deftp + +@deftp Mode @B{string} {= @B{flex}[1:0]@B{char}} +Mode for sequences of characters. This is implemented as a flexible +row of @code{@B{char}} values. +@end deftp + +@deftp Mode {@B{l} @B{compl}} {= @B{struct} (@B{real} re,im)} +Modes for complex values. Each @code{@B{long}} may increase the +precision of both the real and imaginary parts of the numbers, +depending on the characteristics of the current target. Further +@code{@B{long}}s may be specified with no effect. +@end deftp + +@deftp Mode {@B{l} @B{bits}} +Compact and efficient representation of a row of boolean values. Each +@code{@B{long}} may increase the number of booleans that can be packed +in a bits, depending on the characteristics of the current target. +@end deftp + +@deftp Mode {@B{l} @B{bytes}} +Compact and efficient representation of a row of character values. +Each @code{@B{long}} may increase the number of characters that can be +packed in a bytes, depending on the characteristics of the current +target. +@end deftp + +@node Standard priorities +@section Standard priorities + +@table @code +@item 1 +@itemize @bullet +@item @code{plusab}, @code{+:=} +@item @code{minusab}, @code{-:=} +@item @code{timesab}, @code{*:=} +@item @code{divab}, @code{/:=} +@item @code{overab}, @code{%:=} +@item @code{modab}, @code{%*:=} +@item @code{plusto}, @code{+=:} +@end itemize + +@item 2 +@itemize @bullet +@item @code{or} +@end itemize + +@item 3 +@itemize @bullet +@item @code{and} +@item @code{xor} +@end itemize + +@item 4 +@itemize @bullet +@item @code{@B{eq}}, @code{=} +@item @code{@B{ne}}, @code{/=} +@end itemize + +@item 5 +@itemize @bullet +@item @code{@B{lt}}, @code{<}, +@item @code{@B{le}}, @code{<=} +@item @code{@B{gt}}, @code{>} +@item @code{@B{ge}}, @code{>=} +@end itemize + +@item 6 +@itemize @bullet +@item @code{+} +@item @code{-} +@end itemize + +@item 7 +@itemize @bullet +@item @code{*} +@item @code{/} +@item @code{@B{over}}, @code{%} +@item @code{@B{mod}}, @code{%*} +@item @code{@B{elem}} +@end itemize + +@item 8 +@itemize @bullet +@item @code{**} +@item @code{@B{shl}}, @code{@B{up}} +@item @code{@B{shr}}, @code{@B{down}} +@item @code{@B{up}}, @code{@B{down}} +@item @code{^} +@item @code{@B{lwb}} +@item @code{@B{upb}} +@end itemize + +@item 9 +@itemize @bullet +@item @code{@B{i}} +@item @code{+*} +@end itemize +@end table + +@node Rows operators +@section Rows operators + +The following operators work on any row mode, denoted below using the +pseudo-mode @code{@B{rows}}. + +@deftypefn Operator {} {@B{lwb}} {= (@B{rows} a) @B{int}} +Monadic operator that yields the lower bound of the first bound pair +of the descriptor of the value of @code{a}. +@end deftypefn + +@deftypefn Operator {} {@B{upb}} {= (@B{rows} a) @B{int}} +Monadic operator that yields the upper bound of the first bound pair +of the descriptor of the value of @code{a}. +@end deftypefn + +@deftypefn Operator {} {@B{lwb}} {= (@B{int} n, @B{rows} a) @B{int}} +Dyadic operator that yields the lower bound in the n-th bound pair of +the descriptor of the value of @code{a}, if that bound pair exists. +Attempting to access a non-existing bound pair results in a run-time +error. +@end deftypefn + +@deftypefn Operator {} {@B{upb}} {= (@B{int} n, @B{rows} a) @B{int}} +Dyadic operator that yields the upper bound in the n-th bound pair of +the descriptor of the value of @code{a}, if that bound pair exists. +Attempting to access a non-existing bound pair results in a run-time +error. +@end deftypefn + +@node Boolean operators +@section Boolean operators + +@deftypefn Operator {} {@B{not}} {= (@B{bool} a) @B{bool}} +@deftypefnx Operator {} {~} {= (@B{bool} a) @B{bool}} +Monadic operator that yields the logical negation of its operand. +@end deftypefn + +@deftypefn Operator {} {@B{or}} {= (@B{bool} a, b) @B{bool}} +Dyadic operator that yields the logical ``or'' of its operands. +@end deftypefn + +@deftypefn Operator {} {@B{and}} {= (@B{bool} a, b) @B{bool}} +@deftypefnx Operator {} {@B{&}} {= (@B{bool} a, b) @B{bool}} +Dyadic operator that yields the logical ``and'' of its operands. +@end deftypefn + +@deftypefn Operator {} {@B{eq}} {= (@B{bool} a, b) @B{bool}} +@deftypefnx Operator {} {=} {= (@B{bool} a, b) @B{bool}} +Dyadic operator that yields @code{@B{true}} if its operands are the +same truth value, @code{@B{false}} otherwise. +@end deftypefn + +@deftypefn Operator {} {@B{ne}} {= (@B{bool} a, b) @B{bool}} +@deftypefnx Operator {} {/=} {= (@B{bool} a, b) @B{bool}} +Dyadic operator that yields @code{@B{false}} if its operands are the +same truth value, @code{@B{true}} otherwise. +@end deftypefn + +@deftypefn Operator {} {@B{abs}} {= (@B{bool} a) @B{int}} +Monadic operator that yields 1 if its operand is @code{@B{true}}, and +0 if its operand is @code{@B{false}}. +@end deftypefn + +@node Integral operators +@section Integral operators + +@subsection Arithmetic + +@deftypefn Operator {} {+} {= (@B{l} @B{int} a) @B{l} @B{int}} +Monadic operator that yields the affirmation of its operand. +@end deftypefn + +@deftypefn Operator {} {-} {= (@B{l} @B{int} a) @B{l} @B{int}} +Monadic operator that yields the negative of its operand. +@end deftypefn + +@deftypefn Operator {} {@B{abs}} {= (@B{l} @B{int} a) @B{l} @B{int}} +Monadic operator that yields the absolute value of its operand. +@end deftypefn + +@deftypefn Operator {} {@B{sign}} {= (@B{l} @B{int} a) @B{int}} +Monadic operator that yields -1 if @code{a} if negative, 0 if @code{a} +is zero and 1 if @code{a} is positive. +@end deftypefn + +@deftypefn Operator {} {@B{odd}} {= (@B{l} @B{int} a) @B{bool}} +Monadic operator that yields @code{@B{true}} if its operand is odd, +@code{@B{false}} otherwise. +@end deftypefn + +@deftypefn Operator {} {+} {= (@B{l} @B{int} a, b) @B{l} @B{int}} +Dyadic operator that yields the addition of its operands. +@end deftypefn + +@deftypefn Operator {} {-} {= (@B{l} @B{int} a, b) @B{l} @B{int}} +Dyadic operator that yields @code{b} subtracted from @code{a}. +@end deftypefn + +@deftypefn Operator {} {*} {= (@B{l} @B{int} a, b) @B{l} @B{int}} +Dyadic operator that yields the multiplication of its operands. +@end deftypefn + +@deftypefn Operator {} {@B{over}} {= (@B{l} @B{int} a, b) @B{l} @B{int}} +@deftypefnx Operator {} {%} {= (@B{l} @B{int} a, b) @B{l} @B{int}} +Dyadic operator that yields the integer division of @code{a} by +@code{b}, rounding the quotient toward zero. +@end deftypefn + +@deftypefn Operator {} {@B{mod}} {= (@B{l} @B{int} a, b) @B{l} @B{int}} +@deftypefnx Operator {} {%*} {= (@B{l} @B{int} a, b) @B{l} @B{int}} +Dyadic operator that yields the remainder of the division of @code{a} +by @code{b}. +@end deftypefn + +@deftypefn Operator {} {/} {= (@B{l} @B{int} a, b) @B{l} @B{real}} +Dyadic operator that yields the integer division with real result of +@code{a} by @code{b}. +@end deftypefn + +@deftypefn Operator {} {**} {= (@B{l} @B{int} a, b) @B{l} @B{int}} +@deftypefnx Operator {} {^} {= (@B{l} @B{int} a, b) @B{l} @B{int}} +Dyadic operator that yields @code{a} raised to the exponent @code{b}. +@end deftypefn + +@subsection Arithmetic combined with assignation + +@deftypefn Operator {} {@B{plusab}} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}} +@deftypefnx Operator {} {+:=} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}} +@dfn{Plus and become}. Dyadic operator that calculates @code{a + b}, +assigns the result of the operation to the name @code{a} and then +yields @code{a}. +@end deftypefn + +@deftypefn Operator {} {@B{minusab}} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}} +@deftypefnx Operator {} {-:=} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}} +Dyadic operator that calculates @code{a - b}, assigns the result of +the operation to the name @code{a} and then yields @code{a}. +@end deftypefn + +@deftypefn Operator {} {@B{timesab}} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}} +@deftypefnx Operator {} {*:=} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}} +Dyadic operator that calculates @code{a * b}, assigns the result of +the operation to the name @code{a} and then yields @code{a}. +@end deftypefn + +@deftypefn Operator {} {@B{overab}} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}} +@deftypefnx Operator {} {%:=} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}} +Dyadic operator that calculates @code{a % b}, assigns the result of +the operation to the name @code{a} and then yields @code{a}. +@end deftypefn + +@deftypefn Operator {} {@B{modab}} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}} +@deftypefnx Operator {} {%*:=} {= (@B{ref} @B{l} @B{int} a, @B{l} @B{int} b) @B{ref} @B{l} @B{int}} +Dyadic operator that calculates @code{a %* b}, assigns the result of +the operation to the name @code{a} and then yields @code{a}. +@end deftypefn + +@subsection Relational + +@deftypefn Operator {} {@B{eq}} {= (@B{l} @B{int} a, b) @B{bool}} +@deftypefnx Operator {} {=} {= (@B{l} @B{int} a, b) @B{bool}} +Dyadic operator that yields whether its operands are equal. +@end deftypefn + +@deftypefn Operator {} {@B{ne}} {= (@B{l} @B{int} a, b) @B{bool}} +@deftypefnx Operator {} {/=} {= (@B{l} @B{int} a, b) @B{bool}} +Dyadic operator that yields whether its operands are not equal. +@end deftypefn + +@deftypefn Operator {} {@B{lt}} {= (@B{l} @B{int} a, b) @B{bool}} +@deftypefnx Operator {} {<} {= (@B{l} @B{int} a, b) @B{bool}} +Dyadic operator that yields whether @code{a} is less than @code{b}. +@end deftypefn + +@deftypefn Operator {} {@B{le}} {= (@B{l} @B{int} a, b) @B{bool}} +@deftypefnx Operator {} {<=} {= (@B{l} @B{int} a, b) @B{bool}} +Dyadic operator that yields whether @code{a} is less than, or equal to +@code{b}. +@end deftypefn + +@deftypefn Operator {} {@B{gt}} {= (@B{l} @B{int} a, b) @B{bool}} +@deftypefnx Operator {} {>} {= (@B{l} @B{int} a, b) @B{bool}} +Dyadic operator that yields whether @code{a} is greater than +@code{b}. +@end deftypefn + +@deftypefn Operator {} {@B{ge}} {= (@B{l} @B{int} a, b) @B{bool}} +@deftypefnx Operator {} {>=} {= (@B{l} @B{int} a, b) @B{bool}} +Dyadic operator that yields whether @code{a} is greater than, or equal +to @code{b}. +@end deftypefn + +@subsection Conversion + +@deftypefn Operator {} {@B{shorten}} {= (@B{short} @B{int} a) @B{short} @B{short} @B{int}} +@deftypefnx Operator {} {@B{shorten}} {= (@B{int} a) @B{short} @B{int}} +@deftypefnx Operator {} {@B{shorten}} {= (@B{long} @B{int} a) @B{int}} +@deftypefnx Operator {} {@B{shorten}} {= (@B{long} @B{long} @B{int} a) @B{long} @B{int}} +Monadic operator that yields, if it exists, the integral value that +can be lengthened to the value of @code{a}. If the value doesn't +exist then the operator yields either the most positive integral value +in the destination mode, if @code{a} is bigger than that value, or the +most negative integral value in the destination mode, if @code{a} is +smaller than that value. +@end deftypefn + +@deftypefn Operator {} {@B{leng}} {= (@B{short} @B{short} @B{int} a) @B{short} @B{int}} +@deftypefnx Operator {} {@B{leng}} {= (@B{short} @B{int} a) @B{int}} +@deftypefnx Operator {} {@B{leng}} {= (@B{int} a) @B{long} @B{int}} +@deftypefnx Operator {} {@B{leng}} {= (@B{long} @B{int} a) @B{long} @B{long} @B{int}} +Monadic operator that yields the integral value lengthened from the +value of @code{a}. +@end deftypefn + +@node Real operators +@section Real operators + +@subsection Arithmetic + +@deftypefn Operator {} {+} {= (@B{l} @B{real} a) @B{l} @B{real}} +Monadic operator that yields the affirmation of its operand. +@end deftypefn + +@deftypefn Operator {} {-} {= (@B{l} @B{real} a) @B{l} @B{real}} +Monadic operator that yields the negative of its operand. +@end deftypefn + +@deftypefn Operator {} {@B{abs}} {= (@B{l} @B{real} a) @B{l} @B{real}} +Monadic operator that yields the absolute value of its operand. +@end deftypefn + +@deftypefn Operator {} {@B{sign}} {= (@B{l} @B{real} a) @B{int}} +Monadic operator that yields -1 if @code{a} if negative, 0 if @code{a} +is zero and 1 if @code{a} is positive. +@end deftypefn + +@deftypefn Operator {} {+} {= (@B{l} @B{real} a, b) @B{l} @B{real}} +Dyadic operator that yields the addition of its operands. +@end deftypefn + +@deftypefn Operator {} {-} {= (@B{l} @B{real} a, b) @B{l} @B{real}} +Dyadic operator that yields @code{b} subtracted from @code{a}. +@end deftypefn + +@deftypefn Operator {} {*} {= (@B{l} @B{real} a, b) @B{l} @B{real}} +Dyadic operator that yields the multiplication of its operands. +@end deftypefn + +@deftypefn Operator {} {/} {= (@B{l} @B{real} a, b) @B{l} @B{real}} +Dyadic operator that yields the realeger division with real result of +@code{a} by @code{b}. +@end deftypefn + +@deftypefn Operator {} {**} {= (@B{l} @B{real} a, b) @B{l} @B{real}} +@deftypefnx Operator {} {^} {= (@B{l} @B{real} a, b) @B{l} @B{real}} +Dyadic operator that yields @code{a} raised to the real exponent @code{b}. +@end deftypefn + +@deftypefn Operator {} {**} {= (@B{l} @B{real} a, @B{int} b) @B{l} @B{real}} +@deftypefnx Operator {} {^} {= (@B{l} @B{real} a, @B{int} b) @B{l} @B{real}} +Dyadic operator that yields @code{a} raised to the integral exponent +@code{b}. +@end deftypefn + +@subsection Arithmetic combined with assignation + +@deftypefn Operator {} {@B{plusab}} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}} +@deftypefnx Operator {} {+:=} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}} +@dfn{Plus and become}. Dyadic operator that calculates @code{a + b}, +assigns the result of the operation to the name @code{a} and then +yields @code{a}. +@end deftypefn + +@deftypefn Operator {} {@B{minusab}} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}} +@deftypefnx Operator {} {-:=} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}} +Dyadic operator that calculates @code{a - b}, assigns the result of +the operation to the name @code{a} and then yields @code{a}. +@end deftypefn + +@deftypefn Operator {} {@B{timesab}} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}} +@deftypefnx Operator {} {*:=} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}} +Dyadic operator that calculates @code{a * b}, assigns the result of +the operation to the name @code{a} and then yields @code{a}. +@end deftypefn + +@deftypefn Operator {} {@B{divab}} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}} +@deftypefnx Operator {} {/:=} {= (@B{ref} @B{l} @B{real} a, @B{l} @B{real} b) @B{ref} @B{l} @B{real}} +Dyadic operator that calculates @code{a / b}, assigns the result of +the operation to the name @code{a} and then yields @code{a}. +@end deftypefn + +@subsection Relational + +@deftypefn Operator {} {@B{eq}} {= (@B{l} @B{real} a, b) @B{bool}} +@deftypefnx Operator {} {=} {= (@B{l} @B{real} a, b) @B{bool}} +Dyadic operator that yields whether its operands are equal. +@end deftypefn + +@deftypefn Operator {} {@B{ne}} {= (@B{l} @B{real} a, b) @B{bool}} +@deftypefnx Operator {} {/=} {= (@B{l} @B{real} a, b) @B{bool}} +Dyadic operator that yields whether its operands are not equal. +@end deftypefn + +@deftypefn Operator {} {@B{lt}} {= (@B{l} @B{real} a, b) @B{bool}} +@deftypefnx Operator {} {<} {= (@B{l} @B{real} a, b) @B{bool}} +Dyadic operator that yields whether @code{a} is less than @code{b}. +@end deftypefn + +@deftypefn Operator {} {@B{le}} {= (@B{l} @B{real} a, b) @B{bool}} +@deftypefnx Operator {} {<=} {= (@B{l} @B{real} a, b) @B{bool}} +Dyadic operator that yields whether @code{a} is less than, or equal to +@code{b}. +@end deftypefn + +@deftypefn Operator {} {@B{gt}} {= (@B{l} @B{real} a, b) @B{bool}} +@deftypefnx Operator {} {>} {= (@B{l} @B{real} a, b) @B{bool}} +Dyadic operator that yields whether @code{a} is greater than +@code{b}. +@end deftypefn + +@deftypefn Operator {} {@B{ge}} {= (@B{l} @B{real} a, b) @B{bool}} +@deftypefnx Operator {} {>=} {= (@B{l} @B{real} a, b) @B{bool}} +Dyadic operator that yields whether @code{a} is greater than, or equal +to @code{b}. +@end deftypefn + +@subsection Conversions + +@deftypefn Operator {} {@B{round}} {= (@B{l} @B{real} a) @B{int}} +Monadic operator that yields the nearest integer to its operand. +@end deftypefn + +@deftypefn Operator {} {@B{entier}} {= (@B{l} @B{real} a) @B{int}} +Monadic operator that yields the integer equal to @code{a}, or the +next integer below (more negative than) @code{a}. +@end deftypefn + +@deftypefn Operator {} {@B{shorten}} {= (@B{long} @B{real} a) @B{real}} +@deftypefnx Operator {} {@B{shorten}} {= (@B{long} @B{long} @B{real} a) @B{long} @B{real}} +Monadic operator that yields, if it exists, the real value that +can be lengthened to the value of @code{a}. If the value doesn't +exist then the operator yields either the most positive real value +in the destination mode, if @code{a} is bigger than that value, or the +most negative real value in the destination mode, if @code{a} is +smaller than that value. +@end deftypefn + +@deftypefn Operator {} {@B{leng}} {= (@B{real} a) @B{long} @B{real}} +@deftypefnx Operator {} {@B{leng}} {= (@B{long} @B{real} a) @B{long} @B{long} @B{real}} +Monadic operator that yields the real value lengthened from the +value of @code{a}. +@end deftypefn + +@node Character operators +@section Character operators + +@subsection Relational + +@deftypefn Operator {} {@B{eq}} {= (@B{char} a, b) @B{bool}} +@deftypefnx Operator {} {=} {= (@B{char} a, b) @B{bool}} +Dyadic operator that yields whether its operands are equal. +@end deftypefn + +@deftypefn Operator {} {@B{ne}} {= (@B{char} a, b) @B{bool}} +@deftypefnx Operator {} {/=} {= (@B{char} a, b) @B{bool}} +Dyadic operator that yields whether its operands are not equal. +@end deftypefn + +@deftypefn Operator {} {@B{lt}} {= (@B{char} a, b) @B{bool}} +@deftypefnx Operator {} {<} {= (@B{char} a, b) @B{bool}} +Dyadic operator that yields whether @code{a} is less than @code{b}. +@end deftypefn + +@deftypefn Operator {} {@B{le}} {= (@B{char} a, b) @B{bool}} +@deftypefnx Operator {} {<=} {= (@B{char} a, b) @B{bool}} +Dyadic operator that yields whether @code{a} is less than, or equal to +@code{b}. +@end deftypefn + +@deftypefn Operator {} {@B{gt}} {= (@B{char} a, b) @B{bool}} +@deftypefnx Operator {} {>} {= (@B{char} a, b) @B{bool}} +Dyadic operator that yields whether @code{a} is greater than @code{b}. +@end deftypefn + +@deftypefn Operator {} {@B{ge}} {= (@B{char} a, b) @B{bool}} +@deftypefnx Operator {} {>=} {= (@B{char} a, b) @B{bool}} +Dyadic operator that yields whether @code{a} is greater than, or equal +to @code{b}. +@end deftypefn + +@subsection Conversions + +@deftypefn Operator {} {@B{ABS}} {= (@B{char} a) @B{int}} +Monadic operator that yields an unique integer for each permissable +value of @code{@B{char}}. +@end deftypefn + +@deftypefn Operator {} {@B{REPR}} {= (@B{int} a) @B{char}} +The opposite of @code{@B{abs}} of a character. +@end deftypefn + +@node String operators +@section String operators + +@subsection Relational + +@deftypefn Operator {} {@B{eq}} {= (@B{string} a, b) @B{bool}} +@deftypefnx Operator {} {=} {= (@B{string} a, b) @B{bool}} +Dyadic operator that yields whether its operands are equal. Two +strings are equal if they contain the same sequence of characters. +@end deftypefn + +@deftypefn Operator {} {@B{ne}} {= (@B{string} a, b) @B{bool}} +@deftypefnx Operator {} {/=} {= (@B{string} a, b) @B{bool}} +Dyadic operator that yields whether its operands are not equal. +@end deftypefn + +@deftypefn Operator {} {@B{lt}} {= (@B{string} a, b) @B{bool}} +@deftypefnx Operator {} {<} {= (@B{string} a, b) @B{bool}} +Dyadic operator that yields whether the string @code{a} is less than +the string @code{b}. +@end deftypefn + +@deftypefn Operator {} {@B{le}} {= (@B{string} a, b) @B{bool}} +@deftypefnx Operator {} {<=} {= (@B{string} a, b) @B{bool}} +Dyadic operator that yields whether the string @code{a} is less than, +or equal to string @code{b}. +@end deftypefn + +@deftypefn Operator {} {@B{gt}} {= (@B{string} a, b) @B{bool}} +@deftypefnx Operator {} {>} {= (@B{string} a, b) @B{bool}} +Dyadic operator that yields whether the string @code{a} is greater +than the string @code{b}. +@end deftypefn + +@deftypefn Operator {} {@B{ge}} {= (@B{string} a, b) @B{bool}} +@deftypefnx Operator {} {>=} {= (@B{string} a, b) @B{bool}} +Dyadic operator that yields whether the string @code{a} is greater +than, or equal to the string @code{b}. +@end deftypefn + +@subsection Composition + +@deftypefn Operator {} {+} {= (@B{string} a, b) @B{string}} +Dyadic operator that yields the concatenation of the two given +strings as a new string. +@end deftypefn + +@deftypefn Operator {} {+} {= (@B{string} a, @B{char} b) @B{string}} +Dyadic operator that yields the concatenation of the given string +@code{a} and a string whose contents are the character @code{b}. +@end deftypefn + +@deftypefn Operator {} {*} (= (@B{int} a, @B{string} b) @B{string}) +@deftypefnx Operator {} {*} (= (@B{string} b, @B{int} a) @B{string}) +Dyadic operator that yields the string @code{a} concatenated @code{a} +times to itself. If @code{a} is less than zero then it is interpreted +to be zero. +@end deftypefn + +@subsection Composition combined with assignation + +@deftypefn Operator {} {@B{plusab}} {= (@B{ref} @B{string} a, @B{string} b) @B{ref} @B{string}} +@deftypefnx Operator {} {+:=} {= (@B{ref} @B{string} a, @B{string} b) @B{ref} @B{string}} +@dfn{Plus and become}. Dyadic operator that calculates @code{a + b}, +assigns the result of the operation to the name @code{a} and then +yields @code{a}. +@end deftypefn + +@deftypefn Operator {} {@B{plusto}} {= (@B{string} b, @B{ref} @B{string} a) @B{ref} @B{string}} +@deftypefnx Operator {} {+=:} {= (@B{string} b, @B{ref} @B{string} b) @B{ref} @B{string}} +Dyadic operator that calculates @code{a + b}, assigns the result of +the operation to the name @code{a} and then yields @code{a}. +@end deftypefn + +@deftypefn Operator {} {@B{timesab}} {= (@B{ref} @B{string} a, @B{string} b) @B{ref} @B{string}} +@deftypefnx Operator {} {*:=} {= (@B{ref} @B{string} a, @B{string} b) @B{ref} @B{stringl}} +@dfn{Plus and become}. Dyadic operator that calculates @code{a * b}, +assigns the result of the operation to the name @code{a} and then +yields @code{a}. +@end deftypefn + +@node Complex operators +@section Complex operators + +@node Bits operators +@section Bits operators + +@subsection Logical + +@deftypefn Operator {} {@B{NOT}} {= (@B{l} @B{bits} a, b) @B{l} @B{bits}} +@deftypefnx Operator {} {~} {= (@B{l} @B{bits} a, b) @B{l} @B{bits}} +Monadic operator that yields the element-wise not logical operation in +the elements of the given bits operand. +@end deftypefn + +@deftypefn Operator {} {@B{AND}} {= (@B{l} @B{bits} a, b) @B{l} @B{bits}} +@deftypefnx Operator {} {&} {= (@B{l} @B{bits} a, b) @B{l} @B{bits}} +Dyadic operator that yields the element-wise and logical operation in +the elements of the given bits operands. +@end deftypefn + +@deftypefn Operator {} {@B{OR}} {= (@B{l} @B{bits} a, b) @B{l} @B{bits}} +Dyadic operator that yields the element-wise ``or'' logical operation +in the elements of the given bits operands. +@end deftypefn + +@subsection Shifting + +@deftypefn Operator {} {@B{SHL}} {= (@B{l} @B{bits} a, @B{int} n) @B{l} @B{bits}} +@deftypefnx Operator {} {@B{UP}} {= (@B{l} @B{bits} a, @B{int} n) @B{l} @B{bits}} +Dyadic operator that yields the given bits operand shifted @code{n} +positions to the left. Extra elements introduced on the right are +initialized to @code{@B{false}}. +@end deftypefn + +@deftypefn Operator {} {@B{SHR}} {= (@B{l} @B{bits} a, @B{int} n) @B{l} @B{bits}} +@deftypefnx Operator {} {@B{DOWN}} {= (@B{l} @B{bits} a, @B{int} n) @B{l} @B{bits}} +Dyadic operator that yields the given bits operand shifted @code{n} +positions to the right. Extra elements introduced on the left are +initialized to @code{@B{false}}. +@end deftypefn + +@subsection Relational + +@deftypefn Operator {} {@B{eq}} {= (@B{l} @B{bits} a, b) @B{bool}} +@deftypefnx Operator {} {=} {= (@B{l} @B{bits} a, b) @B{bool}} +Dyadic operator that yields whether its operands are equal. Two +bits are equal if they contain the same sequence of booleans. +@end deftypefn + +@deftypefn Operator {} {@B{ne}} {= (@B{l} @B{bits} a, b) @B{bool}} +@deftypefnx Operator {} {/=} {= (@B{l} @B{bits} a, b) @B{bool}} +Dyadic operator that yields whether its operands are not equal. +@end deftypefn + +@deftypefn Operator {} {@B{lt}} {= (@B{l} @B{bits} a, b) @B{bool}} +@deftypefnx Operator {} {<} {= (@B{l} @B{bits} a, b) @B{bool}} +Dyadic operator that yields whether the bits @code{a} is less than +the bits @code{b}. +@end deftypefn + +@deftypefn Operator {} {@B{le}} {= (@B{l} @B{bits} a, b) @B{bool}} +@deftypefnx Operator {} {<=} {= (@B{l} @B{bits} a, b) @B{bool}} +Dyadic operator that yields whether the bits @code{a} is less than, +or equal to bits @code{b}. +@end deftypefn + +@deftypefn Operator {} {@B{gt}} {= (@B{l} @B{bits} a, b) @B{bool}} +@deftypefnx Operator {} {>} {= (@B{l} @B{bits} a, b) @B{bool}} +Dyadic operator that yields whether the bits @code{a} is greater than +the bits @code{b}. +@end deftypefn + +@deftypefn Operator {} {@B{ge}} {= (@B{l} @B{bits} a, b) @B{bool}} +@deftypefnx Operator {} {>=} {= (@B{l} @B{bits} a, b) @B{bool}} +Dyadic operator that yields whether the bits @code{a} is greater +than, or equal to the bits @code{b}. +@end deftypefn + +@subsection Conversions + +@deftypefn Operator {} {@B{abs}} {= (@B{l} @B{bits} a) @B{l} @B{int}} +Monadic operator that yields the integral value whose constituent bits +correspond to the booleans stored in @code{a}. @xref{@code{@B{bin}} +and @code{@B{abs}} of negative integral values}. +@end deftypefn + +@deftypefn Operator {} {@B{bin}} {= (@B{l} @B{int} a) @B{l} @B{bits}} +Monadic operator that yields the bits value whose boolean elements map +the bits in the given integral operand. @xref{@code{@B{bin}} and +@code{@B{abs}} of negative integral values}. +@end deftypefn + +@deftypefn Operator {} {@B{shorten}} {= (@B{long} @B{bits} a) @B{bits}} +@deftypefnx Operator {} {@B{shorten}} {= (@B{long} @B{long} @B{bits} a) @B{long} @B{bits}} +Monadic operator that yields the bits value that can be lengthened to +the value of @code{a}. +@end deftypefn + +@deftypefn Operator {} {@B{leng}} {= (@B{bits} a) @B{long} @B{bits}} +@deftypefnx Operator {} {@B{leng}} {= (@B{long} @B{bits} a) @B{long} @B{long} @B{bits}} +Monadic operator that yields the bits value lengthened from the value +of @code{a}. The lengthened value features @code{@B{false}} in the +extra left positions added to match the lengthened size. +@end deftypefn + +@node Bytes operators +@section Bytes operators + +@node Semaphore operators +@section Semaphore operators + +@node Math procedures +@section Math procedures + +@subsection Arithmetic + +@deftypefn Procedure {} {@B{sqrt}} {= (@B{l} @B{real} a) @B{l} @B{real}} +Procedure that yields the square root of the given real argument. +@end deftypefn + +@subsection Logarithms + +@deftypefn Procedure {} {@B{ln}} {= (@B{l} @B{real} a) @B{l} @B{real}} +Procedure that yields the base @code{e} logarithm of the given real +argument. +@end deftypefn + +@deftypefn Procedure {} {@B{exp}} {= (@B{l} @B{real} a) @B{l} @B{real}} +Procedure that yields the exponential function of the given real +argument. This is the inverse of @code{@B{ln}}. +@end deftypefn + +@subsection Trigonometric + +@deftypefn Procedure {} {@B{sin}} {= (@B{l} @B{real} a) @B{l} @B{real}} +Procedure that yields the sin trigonometric function of the given real +argument. +@end deftypefn + +@deftypefn Procedure {} {@B{arcsin}} {= (@B{l} @B{real} a) @B{l} @B{real}} +Procedure that yields the arc-sin trigonometric function of the given real +argument. +@end deftypefn + +@deftypefn Procedure {} {@B{cos}} {= (@B{l} @B{real} a) @B{l} @B{real}} +Procedure that yields the cos trigonometric function of the given real +argument. +@end deftypefn + +@deftypefn Procedure {} {@B{arccos}} {= (@B{l} @B{real} a) @B{l} @B{real}} +Procedure that yields the arc-cos trigonometric function of the given real +argument. +@end deftypefn + +@deftypefn Procedure {} {@B{tan}} {= (@B{l} @B{real} a) @B{l} @B{real}} +Procedure that yields the tan trigonometric function of the given real +argument. +@end deftypefn + +@deftypefn Procedure {} {@B{arctan}} {= (@B{l} @B{real} a) @B{l} @B{real}} +Procedure that yields the arc-tan trigonometric function of the given +real argument. +@end deftypefn + +@node Extended prelude +@chapter Extended prelude +@cindex prelude, extended + +This chapter documents the GNU extensions to the standard prelude. +The facilities documented below are available to Algol 68 programs +only if the @option{gnu68} language dialect is selected, which is the +default. + +The extended prelude is available to Algol 68 programs without needing +to import any module, provided they are compiled as @code{gnu68} code, +which is the default. + +@menu +* Extended priorities:: Priorities of extended operators. +* Extended environment enquiries:: Information about the implementation. +* Extended rows operators:: Rows and associated operations. +* Extended boolean operators:: Operations on boolean operands. +* Extended bits operators:: Bits and associated operations. +* Extended math procedures:: Mathematical constants and functions. +@end menu + +@node Extended priorities +@section Extended priorities + +@table @code +@item 3 +@itemize @bullet +@item @code{@B{xor}} +@end itemize + +@item 8 +@itemize @bullet +@item @code{@B{elems}} +@end itemize +@end table + +@node Extended environment enquiries +@section Extended environment enquiries + +An @dfn{environment enquiry} is a constant, whose value may be useful +to the programmer, that reflects some characteristic of the particular +implementation. The values of these enquiries are also determined by +the architecture and operating system targeted by the compiler. + +@deftypevr Constant {@B{l} @B{int}} {L min int} +The most negative integral value. +@end deftypevr + +@deftypevr Constant {@B{l} @B{real}} {L min real} +The most negative real value. +@end deftypevr + +@deftypevr Constant {@B{l} @B{real}} {L infinity} +Positive infinity expressed in a real value. +@end deftypevr + +@deftypevr Constant {@B{l} @B{real}} {L minus infinity} +Negative infinity expressed in a real value. +@end deftypevr + +@deftypevr Constant @B{char} {replacement char} +A character that is unknown, unrecognizable or unrepresentable in +Unicode. +@end deftypevr + +@deftypevr Constant @B{char} {eof char} +@B{char} value that doesn't denote an actual char, but an end-of-file +situation. +@end deftypevr + +@node Extended rows operators +@section Extended rows operators + +The following operators work on any row mode, denoted below using the +pseudo-mode @code{@B{rows}}. + +@deftypefn Operator {} {@B{elems}} {= (@B{rows} a) @B{int}} +Monadic operator that yields the number of elements implied by the +first bound pair of the descriptor of the value of @code{a}. +@end deftypefn + +@deftypefn Operator {} {@B{elems}} {= (@B{int} n, @B{rows} a) @B{int}} +Dyadic operator that yields the number of elements implied by the n-th +bound pair of the descriptor of the value of @code{a}. +@end deftypefn + +@node Extended boolean operators +@section Extended boolean operators + +@deftypefn Operator {} {@B{xor}} {= (@B{bool} a, b) @B{bool}} +Dyadic operator that yields the exclusive-or operation of the given +boolean arguments. +@end deftypefn + +@node Extended bits operators +@section Extended bits operators + +@deftypefn Operator {} {@B{xor}} {= (@B{l} @B{bits} a, b) @B{l} @B{bits}} +Dyadic operator that yields the bit exclusive-or operation of the +given bits arguments. +@end deftypefn + +@node Extended math procedures +@section Extended math procedures + +@subsection Logarithms + +@deftypefn Procedure {} {@B{log}} {= (@B{l} @B{real} a, b) @B{l} @B{real}} +Procedure that calculates the base ten logarithm of the given arguments. +@end deftypefn + +@node POSIX prelude +@chapter POSIX prelude + +The POSIX prelude provides facilities to perform simple transput (I/O) +based on POSIX file descriptors, accessing the file system, +command-line arguments, environment variables, etc. + +This prelude is available to Algol 68 programs without needing to +import any module, provided they are compiled as @code{gnu68} code, +which is the default. + +@menu +* POSIX process:: Process exit status. +* POSIX command line:: Parsing command-line arguments. +* POSIX environment:: Environment variables. +* POSIX errors:: Error handling and error descriptions. +* POSIX files:: Creating, opening and closing files. +* POSIX sockets:: Communication endpoints. +* POSIX string transput:: Reading and writing characters and strings. +@end menu + +@node POSIX process +@section POSIX process + +The Algol 68 program can report an exit status to the operating system +once they stop running. The exit status reported by default is zero, +which corresponds to success. + +@deftypefn Procedure {} {set exit status} {= (@B{int} status)} +Procedure that sets the exit status to report to the operating system +once the program stop executing. The default exit status is 0 which, +by convention, is interpreted by POSIX systems as success. A value +different to zero is interpreted as an error status. This procedure +can be invoked more than one, the previous exit status being +overwritten. +@end deftypefn + +@node POSIX command line +@section POSIX command line + +Algol 68 programs can access the command-line arguments passed to them +by using the following procedures. + +@deftypefn Procedure {} {argc} {= @B{int}} +Procedure that yields the number of arguments passed in the command +line, including the name of the program. +@end deftypefn + +@deftypefn Procedure {} {argv} {= (@B{int} n) @B{string}} +Procedure that yields the @code{n}th argument passed in the command +line. The first argument is always the name used to invoke the +program. If @code{n} is out of range then this procedure returns the +empty string. +@end deftypefn + +@node POSIX environment +@section POSIX environment + +@deftypefn Procedure {} {getenv} {= (@B{string} varname) @B{string}} +Procedure that yields the value of the environment variable +@code{varname} as a string. If the specified environmental variable +is not defined the this procedure returns an empty string. +@end deftypefn + +@node POSIX errors +@section POSIX errors + +When a call to a procedure in this prelude results in an error, the +called procedure signals the error in some particular way and also +sets a global @code{errno} to a code describing the error. For +example, trying to opening a file that doesn't exist will result in +@code{fopen} returning -1, which signals an error. The caller can +then inspect the global @code{errno} to see what particular error +prevented the operation to be completed: in this case, @code{errno} +will contain the error code corresponding to ``file doesn't exist''. + +@deftypefn Procedure {} {errno} {= @B{int}} +This procedure yields the current value of the global @code{errno}. +The yielded value reflects the error status of the last executed POSIX +prelude operation. +@end deftypefn + +@deftypefn Procedure {} {strerror} {= (@B{int} ecode) @B{string}} +This procedure gets an error code and yields a string containing an +explanatory short description of the error. It is typical to pass the +output of @code{errno} to this procedure. +@end deftypefn + +@deftypefn Procedure {} {perror} {= (@B{string} msg) @B{void}} +This procedure prints the given string @code{msg} in the standard +error output, followed by a colon character, a space character and +finally the string error of the current value of @code{errno}. +@end deftypefn + +@node POSIX files +@section POSIX files + +File descriptors are @code{@B{int}} values that identify open files +that can be accessed by the program. The @code{fopen} procedure +allocates file descriptors as it opens files, and the descriptor is +used in subsequent transput calls to perform operations on the files. + +@subsection Standard file descriptors + +There are three descriptors, however, which are automatically opened +when the program starts executing and automatically closed when the +program finishes. These are: + +@deftypevr Constant {@B{int}} {stdin} +File descriptor associated with the standard input. Its value is @code{0}. +@end deftypevr + +@deftypevr Constant {@B{int}} {stdout} +File descriptor associated with the standard output. Its value is @code{1}. +@end deftypevr + +@deftypevr Constant {@B{int}} {stderr} +File descriptor associated with the standard error. Its value is @code{2}. +@end deftypevr + +@subsection Opening and closing files + +@deftypefn Procedure {} {fopen} {= (@B{string} pathname, @B{bits} flags) @B{int}} +Open the file specified by @code{pathname}. The argument @code{flags} +is a combination of @code{file o} flags as defined below. If the +specified file is successfully opened while satisfying the constraints +implied by @code{flags} then this procedure yields a file descriptor +that is used in subsequent I/O calls to refer to the open +file. Otherwise, this procedure yields -1. The particular error can +be inspected by calling the @code{errno} procedure. +@end deftypefn + +@deftypefn Procedure {} {fclose} {= (@B{int} fd) @B{int}} +Close the given file descriptor, which no longer refers to any file. +This procedure yields zero on success, and -1 on error. In the later +case, the program can look at the particular error by calling the +@code{errno} procedure. +@end deftypefn + +@subsection Creating files + +@deftypefn Procedure {} {fcreate} {= (@B{string} pathname, @B{bits} mode) @B{int}} +Create a file with name @code{pathname}. The argument @code{mode} is +a @code{@B{bits}} value containing a bit pattern that determines the +permissions on the created file. The bit pattern has the form +@code{8rUGO}, where @code{U} reflects the permissions of the user who +owns the file, @code{U} reflects the permissions of the users +pertaining to the file's group, and @code{O} reflects the permissions +of all other users. The permission bits are 1 for execute, 2 for +write and 4 for read. If the file is successfully created then this +procedure yields a file descriptor that is used in subsequent I/O +calls to refer to the newly created file. Otherwise, this procedure +yields -1. The particular error can be inspected by calling the +@code{errno} procedure. +@end deftypefn + +@subsection Flags for @code{fopen} + +The following flags can be combined using bit-wise operators. Note +that in POSIX systems the effective mode of the created file is the +mode specified by the programmer masked with the process's +@dfn{umask}. + +@deftypevr Constant {@B{bits}} {file o default} +Flag for @code{fopen} indicating that the file shall be opened with +whatever capabilities allowed by its permissions. +@end deftypevr + +@deftypevr Constant {@B{bits}} {file o rdwr} +Flag for @code{fopen} indicating that the file shall be opened for +both reading and writing. +@end deftypevr + +@deftypevr Constant {@B{bits}} {file o rdonly} +Flag for @code{fopen} indicating that the file shall be opened for +reading only. This flag is not compatible with @code{file o rdwr} nor +with @code{file o wronly}. +@end deftypevr + +@deftypevr Constant {@B{bits}} {file o wronly} +Flag for @code{fopen} indicating that the file shall be opened for +write only. This flag is not compatible with @code{file o rdwr} nor +with @code{file o rdonly}. +@end deftypevr + +@deftypevr Constant {@B{bits}} {file o trunc} +Flag for @code{fopen} indicating that the opened file shall be +truncated upon opening it. The file must allow writing for this flag +to take effect. The effect of combining @code{file o trunc} and +@code{file o rdonly} is undefined and varies among implementations. +@end deftypevr + +@subsection Getting file properties + +@deftypefn Procedure {} {fsize} {= (@B{int} fd) @B{long} @B{long} @B{int}} +Return the size in bytes of the file characterized by the file +descriptor @code{fd}. If the system entity characterized by the given +file descriptor doesn't have a size, if the size of the file cannot be +stored in a @code{@B{long} @B{long} @B{int}}, or if there is any other +error condition, this procedure yields -1 and @code{errno} is set +appropriately. +@end deftypefn + +@deftypefn Procedure {} {lseek} {= (@B{int} fd, @B{long int} offset, @B{int} whence) @B{long long int}} +Set the file offset of the file characterized by the file descriptor @code{fd} +depending on the values of @code{offset} and @code{whence}. On success, the +resulting offset, as measured in bytes from the beginning of the file, is +returned. Otherwise, -1 is returned, @code{errno} is set to indicate the error, +and the file offset remains unchanged. The effects of @code{offset} and +@code{whence} are: +@itemize +@item +If @code{whence} is @code{seek set}, the file offset is set to @code{offset} +bytes. +@item +If @code{whence} is @code{seek cur}, the file offset is set to its current +location plus @code{offset}. +@item +If @code{whence} is @code{seek end}, the file offset is set to the size of the +file plus @code{offset}. +@end itemize +@end deftypefn + +@node POSIX sockets +@section POSIX sockets + +A program can communicate with other computers, or with other +processes running in the same computer, via sockets. The sockets are +identified by file descriptors. + +@deftypefn Procedure {} {fconnect} {= (@B{string} host, @B{int} port) @B{int}} +This procedure creates a stream socket and connects it to the given +@code{host} using port @code{port}. The established communication is +full-duplex, and allows sending and receiving data using transput +until it gets closed. On success this procedure yields a file +descriptor. On error this procedure yields -1 and @code{errno} is set +appropriately. +@end deftypefn + +@node POSIX string transput +@section POSIX string transput + +The following procedures read or write characters and strings from and +to open files. The external encoding of the files is assumed to be +UTF-8. Since Algol 68 @code{@B{char}}s are UCS-4, this means that +reading or writing a character may involve reading or writing more +than one byte, depending on the particular Unicode code points +involved. + +@subsection Output of strings and chars + +@deftypefn Procedure {} {putchar} {= (@B{char} c) @B{char}} +Write the given character to the standard output. This procedure +yields @code{c} in case the character got successfully written, or +@code{eof char} otherwise. +@end deftypefn + +@deftypefn Procedure {} {puts} {= (@B{string} str) @B{void}} +Write the given string to the standard output. +@end deftypefn + +@deftypefn Procedure {} {fputc} {= (@B{int} fd, @B{char} c) @B{int}} +Write given character @code{c} to the file with descriptor @code{fd}. +This procedure yields @code{c} on success, or @code{eof char} on +error. +@end deftypefn + +@deftypefn Procedure {} {fputs} {= (@B{int} fd, @B{string} str) @B{int}} +Write the given string @code{str} to the file with descriptor +@code{fd}. This procedure yields the number of bytes written on +success, or 0 on error. +@end deftypefn + +@subsection Input of strings and chars + +@deftypefn Procedure {} {getchar} {= @B{char}} +Read a character from the standard input. This procedure yields the +read character in case the character got successfully read, or +@code{eof char} otherwise. +@end deftypefn + +@deftypefn Procedure {} {gets} {= (@B{int} n) @B{ref} @B{string}} +Read a string composed of @code{n} characters from the standard input +and yield a reference to it. If @code{n} is bigger than zero then +characters get read until either @code{n} characters have been read or +the end of line is reached. If @code{n} is zero or negative then +characters get read until either a new line character is read or the +end of line is reached. +@end deftypefn + +@deftypefn Procedure {} {fgetc} {= (@B{int} fd) @B{int}} +Read a character from the file with descriptor @code{fd}. This +procedure yields the read character in case a valid Unicode character +got successfully read. If an unrecognizable or unknown character is +found then this procedure yields @code{replacement char}. In case of +end of file this procedure yields @code{eof char}. +@end deftypefn + +@deftypefn Procedure {} {fgets} {= (@B{int} fd, @B{int} n) @B{ref} @B{string}} +Read a string from the file with descriptor @code{fd} and yield a +reference to it. If @code{n} is bigger than zero then characters get +read until either @code{n} characters have been read or the end of +line is reached. If @code{n} is zero or negative then characters get +read until either a new line character is read or the end of line is +reached. +@end deftypefn + +@node Language extensions +@chapter Language extensions + +This chapter documents the GNU extensions implemented by this compiler +on top of the Algol 68 programming language. These extensions +collectively conform a strict @dfn{superlanguage} of Algol 68, and are +enabled by default. To disable them the user can select the strict +Algol 68 standard by passing the option @option{-std=algol68} when +invoking the compiler. + +@menu +* @code{@B{bin}} and @code{@B{abs}} of negative integral values:: +* Bold taggles:: Using underscores in mode and operator indications. +@end menu + +@node @code{@B{bin}} and @code{@B{abs}} of negative integral values +@section @code{@B{bin}} and @code{@B{abs}} of negative integral values + +The @code{@B{bin}} operator gets an integral value and yields a +@code{@B{bits}} value that reflects the internal bits of the integral +value. The semantics of this operator, as defined in the Algol 68 +standard prelude, are: + +@example +@B{op} @B{bin} = (L @B{int} a) L @B{bits}: + @B{if} a >= L 0 + @B{then} L @B{int} b := a; L @B{bits}; + @B{for} i @B{from} L bits width @B{by} -1 @B{to} 1 + @B{do} (L F @B{of} c)[i] := @B{odd} b; b := b % L 2 @B{od}; + c + @B{fi}; +@end example + +The @code{@B{abs}} operator performs the inverse operation of +@code{@B{bits}}. Given a @code{L @B{bits}} value, it yields the +@code{L @B{int}} value whose bits representation is the bits value. +The semantics of this operator, as defined in the Algol 68 prelude, +are: + +@example +@B{op} @B{abs} = (L @B{bits} a) L @B{int}: +@B{begin} L @B{int} c := L 0; + @B{for} i @B{to} L bits width + @B{do} c := L 2 * c + K @B{abs} (L F @B{of} a)[i] @B{od}; + c +@B{end} +@end example + +@noindent +Note how the @code{@B{bin}} of a negative integral value is not +defined: the implicit else-part of the conditional yields +@code{@B{skip}}, which is defined as any bits value in that context. +Note also how @code{@B{abs}} doesn't make any provision to check +whether the resulting value is positive: it assumes it is so. + +The GNU Algol 68 compiler, when working in strict Algol 68 mode +(@option{-std=algol68}), makes @code{@B{bin}} to always yield @code{L +@B{bits} (@B{skip})} when given a negative value, as mandated by the +report. But the skip value is always the bits representation of zero, +@i{i.e.} 2r0. Strict Algol 68 programs, however, must not rely on +this. + +When GNU extensions are enabled (@option{-std=gnu68}) the +@code{@B{bin}} of a negative value yields the two's complement bit +pattern of the value rather than zero. Therefore, @code{@B{bin} - +@B{short} @B{short} 2} yields @code{2r11111110}. And @code{@B{abs} +@B{short} @B{short} 2r11111110} yields -2. + +@node Bold taggles +@section Bold taggles + +This compiler supports the stropping regimes known as UPPER and +SUPPER. In both regimes bold words are written by writing their +constituent bold letters and digits, in order. In UPPER regime all +the letters of a bold word are to be written using upper-case. In +SUPPER regime, only the first bold letter is required to be written +using upper-case, and this only when the bold word is not a reserved +word. + +When a bold word comprises several natural words, it may be a little +difficult to distinguish them at first sight. Consider for example +the following code, written fist in UPPER stropping: + +@example +MODE TREENODE = STRUCT (TREENODEPAYLOAD data, REF TREENODE next), + TREENODEPAYLOAD = STRUCT (INT code, REAL average, mean); +@end example + +@noindent +Then written in SUPPER stropping: + +@example +mode TreeNode = struct (TreeNodePayload data, REF TreeNode next), + TreeNodePayload = struct (int code, real average, mean); +@end example + +Particularly in UPPER stropping, it may be difficult to distinguish +the constituent natural words at first sight. + +In order to improve this, this compiler implements a GNU extension +called @dfn{bold taggles} that allows to use underscore characters +(@code{_}) within mode and operator indications as a visual aid to +improve readability. When this extension is enabled, mode indications +and operator indications consist in a sequence of the so-called +@dfn{bold taggles}, which are themselves sequences of one or more bold +letters or digits optionally terminated by an underscore character. + +With bold taggles enabled the program above could have been written +using UPPER stropping as: + +@example +MODE TREE_NODE = STRUCT (TREE_NODE_PAYLOAD data, REF TREE_NODE next), + TREE_NODE_PAYLOAD = STRUCT (INT code, REAL average, mean); +@end example + +@noindent +And using SUPPER stropping as: + +@example +mode Tree_Node = struct (Tree_Node_Payload data, ref Tree_Node next), + Tree_Node_Payload = struct (int code, real average, mean); +@end example + +@noindent +Which is perhaps more readable for most people. Note that the +underscore characters are not really part of the mode or operator +indication. Both @code{TREE_NODE} and @code{TREENODE} denote the same +mode indication. Note also that, following the definition, constructs +like @code{Foo__bar} and @code{_Baz} are not valid indications. + +Bold taggles are available when the gnu68 dialect of the language is +selected. @xref{Dialect options}. + +@include gpl_v3.texi +@include fdl.texi + +@node Option Index +@unnumbered Option Index + +@command{ga68}'s command line options are indexed here without any initial +@samp{-} or @samp{--}. Where an option has both positive and negative forms +(such as @option{-f@var{option}} and @option{-fno-@var{option}}), relevant +entries in the manual are indexed under the most appropriate form; it may +sometimes be useful to look up both forms. + +@printindex op + +@node General Index +@unnumbered Index + +@printindex cp + +@bye From 41729a7475084af00fa359b47cc7daee2c373977 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:42:08 +0200 Subject: [PATCH 185/373] a68: command-line options This commit adds a new common command-line option to the compiler driver (-static-libga68) as well as several other front-end specific options. Signed-off-by: Jose E. Marchesi gcc/ChangeLog * algol68/lang.opt: New file. * algol68/lang.opt.urls: Generate. * common.opt: New option -static-libga68. * common.opt.urls: Generate. * gcc.cc: Handle OPT_static_libga68. * regenerate-opt-urls.py (PER_LANGUAGE_OPTION_INDEXES): Add Algol68. --- gcc/algol68/lang.opt | 122 +++++++++++++++++++++++++++++++++++++ gcc/algol68/lang.opt.urls | 41 +++++++++++++ gcc/common.opt | 3 + gcc/common.opt.urls | 3 + gcc/gcc.cc | 2 + gcc/regenerate-opt-urls.py | 3 +- 6 files changed, 173 insertions(+), 1 deletion(-) create mode 100644 gcc/algol68/lang.opt create mode 100644 gcc/algol68/lang.opt.urls diff --git a/gcc/algol68/lang.opt b/gcc/algol68/lang.opt new file mode 100644 index 000000000000..5fcbfadcdb36 --- /dev/null +++ b/gcc/algol68/lang.opt @@ -0,0 +1,122 @@ +; Options for the Algol 68 front end. +; Copyright (C) 2025 Free Software Foundation, Inc. +; +; GCC is free software; you can redistribute it and/or modify it under +; the terms of the GNU General Public License as published by the Free +; Software Foundation; either version 3, or (at your option) any later +; version. +; +; GCC is distributed in the hope that it will be useful, but WITHOUT ANY +; WARRANTY; without even the implied warranty of MERCHANTABILITY or +; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +; for more details. +; +; You should have received a copy of the GNU General Public License +; along with GCC; see the file COPYING3. If not see +; . + +; See the GCC internals manual for a description of this file's format. + +; Please try to keep this file in ASCII collating order. + +; Describes command-line options used by this frontend + +Language +Algol68 + +I +Algol68 Joined Separate +; Documented in c-family/c.opt + +Wextensions +Algol68 Warning Var(warn_algol68_extensions) LangEnabledBy(Algol68, Wextra) +Warn for usage of non-portable extensions of Algol 68. + +Wvoiding +Algol68 Warning Var(warn_algol68_voiding) LangEnabledBy(Algol68, Wextra) +Warn when voiding occurs. + +Wextra +Algol68 Warning +; Documented in common.opt + +Wscope +Algol68 Warning Var(warn_algol68_scope) +Warn for potential name scope violations. + +Enum +Name(warn_hidden_declarations_level) Type(int) UnknownError(argument %qs to %<-Whidden-declaration%> not recognized) + +EnumValue +Enum(warn_hidden_declarations_level) String(none) Value(0) + +EnumValue +Enum(warn_hidden_declarations_level) String(prelude) Value(1) + +EnumValue +Enum(warn_hidden_declarations_level) String(all) Value(2) + +Whidden-declarations +Algol68 Alias(Whidden-declarations=,prelude,none) +Warn about hidden declarations in inner scopes. + +Whidden-declarations= +Algol68 Warning Var(warn_algol68_hidden_declarations) Enum(warn_hidden_declarations_level) Joined RejectNegative LangEnabledBy(Algol68,Wall) +-Whidden-declarations=[none|prelude|all] Warn about declarations hidden in inner scopes. + +fbrackets +Algol68 Var(flag_brackets) +-fbrackets Consider [ .. ] and { .. } as being equivalent to ( .. ). + +fassert +Algol68 Var(flag_assert) +Generate code for assert contracts. + +fcheck= +Algol68 RejectNegative JoinedOrMissing +-fcheck=[...] Specify which runtime checks are to be performed. + +fa68-dump-modes +Algol68 Var(flag_a68_dump_modes) +Dump Algol 68 modes after parsing. + +fa68-dump-ast +Algol68 Var(flag_a68_dump_ast) +Dump Algol 68 parse tree after parsing. + +fa68-dump-module-interfaces +Algol68 Var(flag_a68_dump_moif) +Dump the interfaces of module definitions in the compiled packet. + +static-libga68 +Driver +Link the GNU Algol run-time library statically in the compilation. + +shared-libga68 +Driver +Link the GNU Algol 68 run-time library dynamically in the compilation. + +std=algol68 +Algol68 +Compile strict Algol 68 as defined by the Revised Report + +std=gnu68 +Algol68 +Accept GNU extensions to Algol 68 + +; Stropping regimes. + +fstropping= +Algol68 Joined RejectNegative Enum(stropping_regime) Var(flag_stropping_regime) +-fstropping=[upper|supper] Stropping regime to expect in Algol 68 programs. + +Enum +Name(stropping_regime) Type(int) UnknownError(unknown stropping_regime setting %qs) + +EnumValue +Enum(stropping_regime) String(upper) Value(0) + +EnumValue +Enum(stropping_regime) String(supper) Value(1) + +; This comment is to ensure we retain the blank line above. diff --git a/gcc/algol68/lang.opt.urls b/gcc/algol68/lang.opt.urls new file mode 100644 index 000000000000..df303b98f6a2 --- /dev/null +++ b/gcc/algol68/lang.opt.urls @@ -0,0 +1,41 @@ +; Autogenerated by regenerate-opt-urls.py from gcc/algol68/lang.opt and generated HTML + +I +UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) LangUrlSuffix_Algol68(ga68/Directory-options.html#index-I) + +Wextensions +LangUrlSuffix_Algol68(ga68/Warnings-options.html#index-Wextensions) + +Wvoiding +LangUrlSuffix_Algol68(ga68/Warnings-options.html#index-Wno-voiding) + +Wextra +UrlSuffix(gcc/Warning-Options.html#index-Wextra) LangUrlSuffix_D(gdc/Warnings.html#index-Wextra) LangUrlSuffix_Fortran(gfortran/Error-and-Warning-Options.html#index-Wextra) + +Wscope +LangUrlSuffix_Algol68(ga68/Warnings-options.html#index-Wno-scope) + +Whidden-declarations +LangUrlSuffix_Algol68(ga68/Warnings-options.html#index-Whidden-declarations) + +fbrackets +LangUrlSuffix_Algol68(ga68/Dialect-options.html#index-fbrackets) + +fassert +LangUrlSuffix_D(gdc/Runtime-Options.html#index-fassert) LangUrlSuffix_Algol68(ga68/Runtime-options.html#index-fassert) + +fcheck= +LangUrlSuffix_Fortran(gfortran/Code-Gen-Options.html#index-fcheck) LangUrlSuffix_Algol68(ga68/Runtime-options.html#index-fcheck) + +fa68-dump-modes +LangUrlSuffix_Algol68(ga68/Developer-options.html#index-fa68-dump-modes) + +fa68-dump-ast +LangUrlSuffix_Algol68(ga68/Developer-options.html#index-fa68-dump-ast) + +static-libga68 +LangUrlSuffix_Algol68(ga68/Linking-options.html#index-static-libga68) + +shared-libga68 +LangUrlSuffix_Algol68(ga68/Linking-options.html#index-shared-libga68) + diff --git a/gcc/common.opt b/gcc/common.opt index d44f713ae34f..0a3d65d4d4a8 100644 --- a/gcc/common.opt +++ b/gcc/common.opt @@ -3985,6 +3985,9 @@ Driver Joined static Driver +static-libga68 +Driver + static-libgcc Driver diff --git a/gcc/common.opt.urls b/gcc/common.opt.urls index c42fba3157d7..cade6079f578 100644 --- a/gcc/common.opt.urls +++ b/gcc/common.opt.urls @@ -1999,6 +1999,9 @@ UrlSuffix(gcc/Overall-Options.html#index-specs) static UrlSuffix(gcc/Link-Options.html#index-static) +static-libga68 +LangUrlSuffix_Algol68(ga68/Linking-options.html#index-static-libga68) + static-libgcc UrlSuffix(gcc/Link-Options.html#index-static-libgcc) diff --git a/gcc/gcc.cc b/gcc/gcc.cc index fa46387e59a6..b5d0f759f144 100644 --- a/gcc/gcc.cc +++ b/gcc/gcc.cc @@ -4651,11 +4651,13 @@ driver_handle_option (struct gcc_options *opts, case OPT_static_libgfortran: case OPT_static_libquadmath: case OPT_static_libphobos: + case OPT_static_libga68: case OPT_static_libgm2: case OPT_static_libstdc__: /* These are always valid; gcc.cc itself understands the first two gfortranspec.cc understands -static-libgfortran, libgfortran.spec handles -static-libquadmath, + a68spec.cc understands -static-libga68, d-spec.cc understands -static-libphobos, gm2spec.cc understands -static-libgm2, and g++spec.cc understands -static-libstdc++. */ diff --git a/gcc/regenerate-opt-urls.py b/gcc/regenerate-opt-urls.py index 2daa1d603f06..bda91905aceb 100755 --- a/gcc/regenerate-opt-urls.py +++ b/gcc/regenerate-opt-urls.py @@ -361,7 +361,8 @@ def write_url_file(index, optfile, dstfile): PER_LANGUAGE_OPTION_INDEXES = [ ('gcc/Option-Index.html', None), ('gdc/Option-Index.html', 'D'), - ('gfortran/Option-Index.html', 'Fortran') + ('gfortran/Option-Index.html', 'Fortran'), + ('ga68/Option-Index.html', 'Algol68'), ] def main(args): From 0d787df6f2926e357f4c7791281c157804f91ed3 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:42:30 +0200 Subject: [PATCH 186/373] a68: DWARF language codes This commit makes GCC aware of the DWARF numbers recently allocated for Algol 68. For DWARF 5, DW_LANG_Algol68 = 0x44. For DWARF 6, DW_LNAME_Algol68 = 0x2e with versioning schema YYYY, starting with 1973 for the original Revised language. The language extensions we are working on will be encoded in subsequent versions, 2025 etc. See https://dwarfstd.org/issues/250304.1.html for more information. Signed-off-by: Jose E. Marchesi gcc/ChangeLog * dwarf2out.cc: Set DW_LANG_Algol68 an DW_LNAME_Algol68. include/ChangeLog * dwarf2.h (DW_LANG_Algol68): Define. (DW_LNAME_Algol68): Likewise. --- gcc/dwarf2out.cc | 8 ++++++++ include/dwarf2.h | 2 ++ 2 files changed, 10 insertions(+) diff --git a/gcc/dwarf2out.cc b/gcc/dwarf2out.cc index 9251bcf6cbb9..16f9b855a993 100644 --- a/gcc/dwarf2out.cc +++ b/gcc/dwarf2out.cc @@ -25821,6 +25821,14 @@ gen_compile_unit_die (const char *filename) else if (strcmp (language_string, "GNU Rust") == 0) language = DW_LANG_Rust; } + else if (!dwarf_strict) + { + if (strcmp (language_string, "GNU Algol 68") == 0) + { + language = DW_LANG_Algol68; + lname = DW_LNAME_Algol68; + } + } } /* Use a degraded Fortran setting in strict DWARF2 so is_fortran works. */ else if (startswith (language_string, "GNU Fortran")) diff --git a/include/dwarf2.h b/include/dwarf2.h index 344447fbc368..638e131437ed 100644 --- a/include/dwarf2.h +++ b/include/dwarf2.h @@ -409,6 +409,7 @@ enum dwarf_source_language DW_LANG_Ruby = 0x0040, DW_LANG_Move = 0x0041, DW_LANG_Hylo = 0x0042, + DW_LANG_Algol68 = 0x0044, DW_LANG_lo_user = 0x8000, /* Implementation-defined range start. */ DW_LANG_hi_user = 0xffff, /* Implementation-defined range end. */ @@ -476,6 +477,7 @@ enum dwarf_source_language_name DW_LNAME_Odin = 0x002a, DW_LNAME_P4 = 0x002b, DW_LNAME_Metal = 0x002c, + DW_LNAME_Algol68 = 0x002e, DW_LNAME_lo_user = 0x8000, /* Implementation-defined range start. */ DW_LNAME_hi_user = 0xffff /* Implementation-defined range end. */ From 0fdf9b30c6f9dd8da349bd4dc754313d6e6834da Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:43:02 +0200 Subject: [PATCH 187/373] a68: darwin specific support This commit: - Adapts specs in config/darwin.h for libga68.a. - Amends section processing for non-LTO use in libibery on Darwin. The initial implementation of the Mach-O simple object code was mainly targeting LTO cases. The implementation was not suitable for cases where we are just looking for a regular named section. Signed-off-by: Iain Sandoe gcc/ChangeLog * config/darwin.h: Adapt specs for libga68.a. libiberty/ChangeLog: * simple-object-mach-o.c (simple_object_mach_o_segment): Handle non-LTO sections. --- gcc/config/darwin.h | 5 +++++ libiberty/simple-object-mach-o.c | 25 +++++++------------------ 2 files changed, 12 insertions(+), 18 deletions(-) diff --git a/gcc/config/darwin.h b/gcc/config/darwin.h index e23414c00b6d..ef356ad1419f 100644 --- a/gcc/config/darwin.h +++ b/gcc/config/darwin.h @@ -523,6 +523,7 @@ extern GTY(()) int darwin_ms_struct; %{static|static-libgcc|static-libgcobol:%:replace-outfile(-lgcobol libgcobol.a%s)}\ %{static|static-libgcc|static-libstdc++|static-libgfortran:%:replace-outfile(-lgomp libgomp.a%s)}\ %{static|static-libgcc|static-libstdc++:%:replace-outfile(-lstdc++ libstdc++.a%s)}\ + %{static|static-libga68:%:replace-outfile(-lga68 libga68.a%s)}\ %{static|static-libgm2:%:replace-outfile(-lm2pim libm2pim.a%s)}\ %{static|static-libgm2:%:replace-outfile(-lm2iso libm2iso.a%s)}\ %{static|static-libgm2:%:replace-outfile(-lm2min libm2min.a%s)}\ @@ -1301,4 +1302,8 @@ extern void darwin_driver_init (unsigned int *,struct cl_decoded_option **); #undef BTF_INFO_SECTION_NAME #define BTF_INFO_SECTION_NAME "__CTF_BTF,__btf,regular,debug" +/* Algol68 */ +#undef A68_EXPORT_SECTION_NAME +#define A68_EXPORT_SECTION_NAME "__a68_exports" + #endif /* CONFIG_DARWIN_H */ diff --git a/libiberty/simple-object-mach-o.c b/libiberty/simple-object-mach-o.c index e70e98ee3065..5c992355b31f 100644 --- a/libiberty/simple-object-mach-o.c +++ b/libiberty/simple-object-mach-o.c @@ -617,7 +617,6 @@ simple_object_mach_o_segment (simple_object_read *sobj, off_t offset, char *name; off_t secoffset; size_t secsize; - int l; sechdr = secdata + i * sechdrsize; @@ -669,12 +668,15 @@ simple_object_mach_o_segment (simple_object_read *sobj, off_t offset, } } + memset (namebuf, 0, sizeof (namebuf)); + /* Copy the section name so we can append a null to make it into a + c-string (Mach-o section names are not terminated). */ + memcpy (namebuf, sechdr + sectname_offset, MACH_O_NAME_LEN); + namebuf[MACH_O_NAME_LEN] = '\0'; + name = &namebuf[0]; + /* Maybe override this if we have long section name extension. */ if ((gnu_sections_found & SOMO_LONGN_PRESENT) != 0) { - memcpy (namebuf, sechdr + sectname_offset, MACH_O_NAME_LEN); - namebuf[MACH_O_NAME_LEN] = '\0'; - - name = &namebuf[0]; if (strtab != NULL && name[0] == '_' && name[1] == '_') { unsigned long stringoffset; @@ -696,19 +698,6 @@ simple_object_mach_o_segment (simple_object_read *sobj, off_t offset, } } } - else - { - /* Otherwise, make a name like __segment,__section as per the - convention in mach-o asm. */ - name = &namebuf[0]; - memcpy (namebuf, (char *) sechdr + segname_offset, MACH_O_NAME_LEN); - namebuf[MACH_O_NAME_LEN] = '\0'; - l = strlen (namebuf); - namebuf[l] = ','; - memcpy (namebuf + l + 1, (char *) sechdr + sectname_offset, - MACH_O_NAME_LEN); - namebuf[l + 1 + MACH_O_NAME_LEN] = '\0'; - } simple_object_mach_o_section_info (omr->is_big_endian, is_32, sechdr, &secoffset, &secsize); From f90f1c1a0166375144978ed16817d34065175d44 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 11 Oct 2025 19:43:16 +0200 Subject: [PATCH 188/373] a68: powerpc specific support Some code in the rs6000 port relies on parsing the language name. This commit makes that code to recognize "GNU Algol 68". Signed-off-by: Jose E. Marchesi gcc/ChangeLog * config/rs6000/rs6000-logue.cc (rs6000_output_function_epilogue): Handle "GNU Algol 68" in language_string. --- gcc/config/rs6000/rs6000-logue.cc | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/gcc/config/rs6000/rs6000-logue.cc b/gcc/config/rs6000/rs6000-logue.cc index 5377ad6cee62..0005039733bd 100644 --- a/gcc/config/rs6000/rs6000-logue.cc +++ b/gcc/config/rs6000/rs6000-logue.cc @@ -5332,18 +5332,18 @@ rs6000_output_function_epilogue (FILE *file) /* Tbtab format type. Use format type 0. */ fputs ("\t.byte 0,", file); - /* Language type. Unfortunately, there does not seem to be any - official way to discover the language being compiled, so we - use language_string. - C is 0. Fortran is 1. Ada is 3. Modula-2 is 8. C++ is 9. - Java is 13. Objective-C is 14. Objective-C++ isn't assigned - a number, so for now use 9. LTO, Go, D, and JIT aren't assigned - numbers either, so for now use 0. */ + /* Language type. Unfortunately, there does not seem to be any official + way to discover the language being compiled, so we use + language_string. C is 0. Fortran is 1. Ada is 3. Modula-2 is 8. + C++ is 9. Java is 13. Objective-C is 14. Objective-C++ isn't + assigned a number, so for now use 9. LTO, Go, D, Algol 68 and JIT + aren't assigned numbers either, so for now use 0. */ if (lang_GNU_C () || ! strcmp (language_string, "GNU GIMPLE") || ! strcmp (language_string, "GNU Go") || ! strcmp (language_string, "GNU D") || ! strcmp (language_string, "GNU Rust") + || ! strcmp (language_string, "GNU Algol 68") || ! strcmp (language_string, "libgccjit")) i = 0; else if (! strcmp (language_string, "GNU F77") From 7cdfa289c5f8ce5c5d0e95ead715b6d63f131e64 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 29 Nov 2025 16:54:32 +0100 Subject: [PATCH 189/373] a68: updates to common documentation Signed-off-by: Jose E. Marchesi gcc/ChangeLog * doc/install.texi (Configuration): Mention algol68 option for --enable-languages. (Algol 68-Specific Options): New section. * doc/sourcebuild.texi (Top Level): Add entry for libga68. --- gcc/doc/install.texi | 39 +++++++++++++++++++++++++++++++++++++-- gcc/doc/sourcebuild.texi | 3 +++ 2 files changed, 40 insertions(+), 2 deletions(-) diff --git a/gcc/doc/install.texi b/gcc/doc/install.texi index 1ca0119fe76e..df0711874b83 100644 --- a/gcc/doc/install.texi +++ b/gcc/doc/install.texi @@ -2103,13 +2103,13 @@ their runtime libraries should be built. For a list of valid values for grep ^language= */config-lang.in @end smallexample Currently, you can use any of the following: -@code{all}, @code{default}, @code{ada}, @code{c}, @code{c++}, +@code{all}, @code{default}, @code{ada}, @code{algol68}, @code{c}, @code{c++}, @code{cobol}, @code{d}, @code{fortran}, @code{go}, @code{jit}, @code{lto}, @code{m2}, @code{objc}, @code{obj-c++}. Building the Ada compiler has special requirements, see below. If you do not pass this flag, or specify the option @code{default}, then the default languages available in the @file{gcc} sub-tree will be configured. -Ada, COBOL, D, Go, Jit, Objective-C++ and Modula-2 are not default languages. +Algol 68, Ada, COBOL, D, Go, Jit, Objective-C++ and Modula-2 are not default languages. LTO is not a default language, but is built by default because @option{--enable-lto} is enabled by default. The other languages are default languages. If @@ -2913,6 +2913,41 @@ In order to avoid shell and @command{make} quoting issues for complex overrides, you can pass a setting for @env{CONFIG_SITE} and set variables in the site file. +@subheading Algol 68-Specific Options + +The following options apply to the build of the Algol 68 runtime library. + +@table @code +@item --enable-algol68-gc +Specify that an additional variant of the GNU Algol 68 runtime library +is built, using an external build of the Boehm-Demers-Weiser garbage +collector (@uref{https://www.hboehm.info/gc/}). + +This library needs to be available for each multilib variant, unless +configured with @option{--enable-objc-gc=@samp{auto}} in which case +the build of the additional runtime library is skipped when not +available and the build continues. + +@item --with-target-bdw-gc=@var{list} +@itemx --with-target-bdw-gc-include=@var{list} +@itemx --with-target-bdw-gc-lib=@var{list} +Specify search directories for the garbage collector header files and +libraries. @var{list} is a comma separated list of key value pairs of the +form @samp{@var{multilibdir}=@var{path}}, where the default multilib key +is named as @samp{.} (dot), or is omitted (e.g.@: +@samp{--with-target-bdw-gc=/opt/bdw-gc,32=/opt-bdw-gc32}). + +The options @option{--with-target-bdw-gc-include} and +@option{--with-target-bdw-gc-lib} must always be specified together +for each multilib variant and they take precedence over +@option{--with-target-bdw-gc}. If @option{--with-target-bdw-gc-include} +is missing values for a multilib, then the value for the default +multilib is used (e.g.@: @samp{--with-target-bdw-gc-include=/opt/bdw-gc/include} +@samp{--with-target-bdw-gc-lib=/opt/bdw-gc/lib64,32=/opt-bdw-gc/lib32}). +If none of these options are specified, the library is assumed in +default locations. +@end table + @subheading Objective-C-Specific Options The following options apply to the build of the Objective-C runtime library. diff --git a/gcc/doc/sourcebuild.texi b/gcc/doc/sourcebuild.texi index ef3736125b04..49460649f973 100644 --- a/gcc/doc/sourcebuild.texi +++ b/gcc/doc/sourcebuild.texi @@ -91,6 +91,9 @@ The Decimal Float support library. @item libffi The @code{libffi} library, used as part of the Go runtime library. +@item libga68 +The Algol 68 runtime library. + @item libgcc The GCC runtime library. From 9f1ae12f0ee0d3cebb7a5249b7f741c51c5934a0 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sat, 29 Nov 2025 16:57:51 +0100 Subject: [PATCH 190/373] a68: build system changes This commit adds support for building the Algol 68 front-end to the build system. Signed-off-by: Jose E. Marchesi ChangeLog * Makefile.def (libga68): New module. (configure-target-libga68): Likewise. * Makefile.tpl (GA68): Define. (GA68_FOR_BUILD): Likewise. (GA68FLAGS): Likewise. * configure.ac (--enable-libga68): New option. (--enable-algol68-gc): Likewise. (GA68): Subst. (GA68FLAGS): Likewise. Invoke ACX_PROG_GA68. * configure: Regenerate. * Makefile.in: Likewise. config/ChangeLog * acx.m4 (ACX_PROG_GA68): New defun. gcc/ChangeLog * Makefile.in (OPT_URLS_HTML_DEPS): Add ga68/Option-Index.html. * algol68/Make-lang.in: New file. * algol68/config-lang.in: Likewise. --- Makefile.def | 8 + Makefile.in | 550 ++++++++++++++++++++++++++++++++++++- Makefile.tpl | 18 ++ config/acx.m4 | 6 + configure | 355 +++++++++++++++++++++++- configure.ac | 47 +++- gcc/Makefile.in | 3 +- gcc/algol68/Make-lang.in | 287 +++++++++++++++++++ gcc/algol68/config-lang.in | 32 +++ 9 files changed, 1280 insertions(+), 26 deletions(-) create mode 100644 gcc/algol68/Make-lang.in create mode 100644 gcc/algol68/config-lang.in diff --git a/Makefile.def b/Makefile.def index e7f33345aa82..627121e87bc8 100644 --- a/Makefile.def +++ b/Makefile.def @@ -205,6 +205,7 @@ target_modules = { module= zlib; bootstrap=true; }; target_modules = { module= rda; }; target_modules = { module= libada; }; target_modules = { module= libgm2; lib_path=.libs; }; +target_modules = { module= libga68; lib_path=.libs; }; target_modules = { module= libgomp; bootstrap= true; lib_path=.libs; }; target_modules = { module= libitm; lib_path=.libs; }; target_modules = { module= libatomic; bootstrap=true; lib_path=.libs; }; @@ -313,6 +314,8 @@ flags_to_pass = { flag= GNATBIND ; }; flags_to_pass = { flag= GNATMAKE ; }; flags_to_pass = { flag= GDC ; }; flags_to_pass = { flag= GDCFLAGS ; }; +flags_to_pass = { flag= GA68 ; }; +flags_to_pass = { flag= GA68FLAGS ; }; // Target tools flags_to_pass = { flag= AR_FOR_TARGET ; }; @@ -329,6 +332,8 @@ flags_to_pass = { flag= GOC_FOR_TARGET ; }; flags_to_pass = { flag= GOCFLAGS_FOR_TARGET ; }; flags_to_pass = { flag= GDC_FOR_TARGET ; }; flags_to_pass = { flag= GDCFLAGS_FOR_TARGET ; }; +flags_to_pass = { flag= GA68_FOR_TARGET ; }; +flags_to_pass = { flag= GA68FLAGS_FOR_TARGET ; }; flags_to_pass = { flag= GM2_FOR_TARGET ; }; flags_to_pass = { flag= GM2FLAGS_FOR_TARGET ; }; flags_to_pass = { flag= LD_FOR_TARGET ; }; @@ -678,6 +683,7 @@ dependencies = { module=configure-target-libstdc++-v3; on=configure-target-libgo dependencies = { module=configure-target-libsanitizer; on=all-target-libstdc++-v3; }; dependencies = { module=configure-target-libvtv; on=all-target-libstdc++-v3; }; dependencies = { module=configure-target-libgrust; on=all-target-libstdc++-v3; }; +dependencies = { module=configure-target-libga68; on=all-target-libstdc++-v3; }; // parallel_list.o and parallel_settings.o depend on omp.h, which is // generated by the libgomp configure. Unfortunately, due to the use of // recursive make, we can't be that specific. @@ -736,6 +742,8 @@ languages = { language=jit; gcc-check-target=check-jit; }; languages = { language=rust; gcc-check-target=check-rust; }; languages = { language=cobol; gcc-check-target=check-cobol; lib-check-target=check-target-libgcobol; }; +languages = { language=algol68; gcc-check-target=check-algol68; + lib-check-target=check-target-libga68; }; // Toplevel bootstrap bootstrap_stage = { id=1 ; }; diff --git a/Makefile.in b/Makefile.in index 15f7413e9973..ef49d3a4c032 100644 --- a/Makefile.in +++ b/Makefile.in @@ -160,6 +160,8 @@ BUILD_EXPORTS = \ CXX="$(CXX_FOR_BUILD)"; export CXX; \ CXXFLAGS="$(CXXFLAGS_FOR_BUILD)"; export CXXFLAGS; \ GFORTRAN="$(GFORTRAN_FOR_BUILD)"; export GFORTRAN; \ + GA68="$(GA68_FOR_BUILD)"; export GA68; \ + GA68FLAGS="$(GA68FLAGS_FOR_BUILD)"; export GA68FLAGS; \ GOC="$(GOC_FOR_BUILD)"; export GOC; \ GOCFLAGS="$(GOCFLAGS_FOR_BUILD)"; export GOCFLAGS; \ GDC="$(GDC_FOR_BUILD)"; export GDC; \ @@ -203,6 +205,7 @@ HOST_EXPORTS = \ CXX="$(CXX)"; export CXX; \ CXXFLAGS="$(CXXFLAGS)"; export CXXFLAGS; \ GFORTRAN="$(GFORTRAN)"; export GFORTRAN; \ + GA68="$(GA68)"; export GA68; \ GOC="$(GOC)"; export GOC; \ GDC="$(GDC)"; export GDC; \ GM2="$(GM2)"; export GM2; \ @@ -278,6 +281,11 @@ POSTSTAGE1_HOST_EXPORTS = \ CC_FOR_BUILD="$$CC"; export CC_FOR_BUILD; \ $(POSTSTAGE1_CXX_EXPORT) \ $(LTO_EXPORTS) \ + GA68="$$r/$(HOST_SUBDIR)/prev-gcc/ga68$(exeext) -B$$r/$(HOST_SUBDIR)/prev-gcc/ \ + -B$(build_tooldir)/bin/ $(GA68FLAGS_FOR_TARGET) \ + -B$$r/prev-$(TARGET_SUBDIR)/libga68/.libs"; \ + export GA68; \ + GA68_FOR_BUILD="$$GA68"; export GA68_FOR_BUILD; \ GDC="$$r/$(HOST_SUBDIR)/prev-gcc/gdc$(exeext) -B$$r/$(HOST_SUBDIR)/prev-gcc/ \ -B$(build_tooldir)/bin/ $(GDCFLAGS_FOR_TARGET) \ -B$$r/prev-$(TARGET_SUBDIR)/libphobos/libdruntime/gcc \ @@ -310,6 +318,7 @@ BASE_TARGET_EXPORTS = \ CPPFLAGS="$(CPPFLAGS_FOR_TARGET)"; export CPPFLAGS; \ CXXFLAGS="$(CXXFLAGS_FOR_TARGET)"; export CXXFLAGS; \ GFORTRAN="$(GFORTRAN_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GFORTRAN; \ + GA68="$(GA68_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GA68; \ GOC="$(GOC_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GOC; \ GDC="$(GDC_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GDC; \ GM2="$(GM2_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GM2; \ @@ -380,6 +389,7 @@ CXX_FOR_BUILD = @CXX_FOR_BUILD@ DLLTOOL_FOR_BUILD = @DLLTOOL_FOR_BUILD@ DSYMUTIL_FOR_BUILD = @DSYMUTIL_FOR_BUILD@ GFORTRAN_FOR_BUILD = @GFORTRAN_FOR_BUILD@ +GA68_FOR_BUILD = @GA68_FOR_BUILD@ GOC_FOR_BUILD = @GOC_FOR_BUILD@ GDC_FOR_BUILD = @GDC_FOR_BUILD@ GM2_FOR_BUILD = @GM2_FOR_BUILD@ @@ -443,6 +453,7 @@ STRIP = @STRIP@ WINDRES = @WINDRES@ WINDMC = @WINDMC@ +GA68 = @GA68@ GDC = @GDC@ GNATBIND = @GNATBIND@ GNATMAKE = @GNATMAKE@ @@ -453,6 +464,7 @@ LIBCFLAGS = $(CFLAGS) CXXFLAGS = @CXXFLAGS@ LIBCXXFLAGS = $(CXXFLAGS) -fno-implicit-templates GOCFLAGS = $(CFLAGS) +GA68FLAGS = @GA68FLAGS@ GDCFLAGS = @GDCFLAGS@ GM2FLAGS = $(CFLAGS) @@ -678,6 +690,7 @@ CXX_FOR_TARGET=$(STAGE_CC_WRAPPER) @CXX_FOR_TARGET@ RAW_CXX_FOR_TARGET=$(STAGE_CC_WRAPPER) @RAW_CXX_FOR_TARGET@ GFORTRAN_FOR_TARGET=$(STAGE_CC_WRAPPER) @GFORTRAN_FOR_TARGET@ GOC_FOR_TARGET=$(STAGE_CC_WRAPPER) @GOC_FOR_TARGET@ +GA68_FOR_TARGET=$(STAGE_CC_WRAPPER) @GA68_FOR_TARGET@ GDC_FOR_TARGET=$(STAGE_CC_WRAPPER) @GDC_FOR_TARGET@ GM2_FOR_TARGET=$(STAGE_CC_WRAPPER) @GM2_FOR_TARGET@ DLLTOOL_FOR_TARGET=@DLLTOOL_FOR_TARGET@ @@ -707,6 +720,7 @@ LIBCXXFLAGS_FOR_TARGET = $(CXXFLAGS_FOR_TARGET) -fno-implicit-templates LDFLAGS_FOR_TARGET = @LDFLAGS_FOR_TARGET@ GM2FLAGS_FOR_TARGET = -O2 -g GOCFLAGS_FOR_TARGET = -O2 -g +GA68FLAGS_FOR_TARGET = -O2 -g GDCFLAGS_FOR_TARGET = -O2 -g FLAGS_FOR_TARGET = @FLAGS_FOR_TARGET@ @@ -732,7 +746,7 @@ all: # This is the list of directories that may be needed in RPATH_ENVVAR # so that programs built for the target machine work. -TARGET_LIB_PATH = $(TARGET_LIB_PATH_libstdc++-v3)$(TARGET_LIB_PATH_libsanitizer)$(TARGET_LIB_PATH_libvtv)$(TARGET_LIB_PATH_libssp)$(TARGET_LIB_PATH_libphobos)$(TARGET_LIB_PATH_libgm2)$(TARGET_LIB_PATH_libgomp)$(TARGET_LIB_PATH_libitm)$(TARGET_LIB_PATH_libatomic)$(HOST_LIB_PATH_gcc) +TARGET_LIB_PATH = $(TARGET_LIB_PATH_libstdc++-v3)$(TARGET_LIB_PATH_libsanitizer)$(TARGET_LIB_PATH_libvtv)$(TARGET_LIB_PATH_libssp)$(TARGET_LIB_PATH_libphobos)$(TARGET_LIB_PATH_libgm2)$(TARGET_LIB_PATH_libga68)$(TARGET_LIB_PATH_libgomp)$(TARGET_LIB_PATH_libitm)$(TARGET_LIB_PATH_libatomic)$(HOST_LIB_PATH_gcc) @if target-libstdc++-v3 TARGET_LIB_PATH_libstdc++-v3 = $$r/$(TARGET_SUBDIR)/libstdc++-v3/src/.libs: @@ -758,6 +772,10 @@ TARGET_LIB_PATH_libphobos = $$r/$(TARGET_SUBDIR)/libphobos/src/.libs: TARGET_LIB_PATH_libgm2 = $$r/$(TARGET_SUBDIR)/libgm2/.libs: @endif target-libgm2 +@if target-libga68 +TARGET_LIB_PATH_libga68 = $$r/$(TARGET_SUBDIR)/libga68/.libs: +@endif target-libga68 + @if target-libgomp TARGET_LIB_PATH_libgomp = $$r/$(TARGET_SUBDIR)/libgomp/.libs: @endif target-libgomp @@ -889,6 +907,8 @@ BASE_FLAGS_TO_PASS = \ "GNATMAKE=$(GNATMAKE)" \ "GDC=$(GDC)" \ "GDCFLAGS=$(GDCFLAGS)" \ + "GA68=$(GA68)" \ + "GA68FLAGS=$(GA68FLAGS)" \ "AR_FOR_TARGET=$(AR_FOR_TARGET)" \ "AS_FOR_TARGET=$(AS_FOR_TARGET)" \ "CC_FOR_TARGET=$(CC_FOR_TARGET)" \ @@ -903,6 +923,8 @@ BASE_FLAGS_TO_PASS = \ "GOCFLAGS_FOR_TARGET=$(GOCFLAGS_FOR_TARGET)" \ "GDC_FOR_TARGET=$(GDC_FOR_TARGET)" \ "GDCFLAGS_FOR_TARGET=$(GDCFLAGS_FOR_TARGET)" \ + "GA68_FOR_TARGET=$(GA68_FOR_TARGET)" \ + "GA68FLAGS_FOR_TARGET=$(GA68FLAGS_FOR_TARGET)" \ "GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \ "GM2FLAGS_FOR_TARGET=$(GM2FLAGS_FOR_TARGET)" \ "LD_FOR_TARGET=$(LD_FOR_TARGET)" \ @@ -977,6 +999,7 @@ EXTRA_HOST_FLAGS = \ 'DSYMUTIL=$(DSYMUTIL)' \ 'GFORTRAN=$(GFORTRAN)' \ 'GOC=$(GOC)' \ + 'GA68=$(GA68)' \ 'GDC=$(GDC)' \ 'GM2=$(GM2)' \ 'LD=$(LD)' \ @@ -1005,6 +1028,7 @@ STAGE1_FLAGS_TO_PASS = \ POSTSTAGE1_FLAGS_TO_PASS = \ CC="$${CC}" CC_FOR_BUILD="$${CC_FOR_BUILD}" \ CXX="$${CXX}" CXX_FOR_BUILD="$${CXX_FOR_BUILD}" \ + GA68="$${GA68}" GA68_FOR_BUILD="$${GA68_FOR_BUILD}" \ GDC="$${GDC}" GDC_FOR_BUILD="$${GDC_FOR_BUILD}" \ GM2="$${GM2}" GM2_FOR_BUILD="$${GM2_FOR_BUILD}" \ GNATBIND="$${GNATBIND}" \ @@ -1040,6 +1064,8 @@ EXTRA_TARGET_FLAGS = \ 'GFORTRAN=$$(GFORTRAN_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \ 'GOC=$$(GOC_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \ 'GOCFLAGS=$$(GOCFLAGS_FOR_TARGET)' \ + 'GA68=$$(GA68_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \ + 'GA68FLAGS=$$(GA68FLAGS_FOR_TARGET)' \ 'GDC=$$(GDC_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \ 'GDCFLAGS=$$(GDCFLAGS_FOR_TARGET)' \ 'GM2=$$(GM2_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \ @@ -1161,6 +1187,7 @@ configure-target: \ maybe-configure-target-rda \ maybe-configure-target-libada \ maybe-configure-target-libgm2 \ + maybe-configure-target-libga68 \ maybe-configure-target-libgomp \ maybe-configure-target-libitm \ maybe-configure-target-libatomic \ @@ -1361,6 +1388,7 @@ all-target: maybe-all-target-zlib all-target: maybe-all-target-rda all-target: maybe-all-target-libada all-target: maybe-all-target-libgm2 +all-target: maybe-all-target-libga68 @if target-libgomp-no-bootstrap all-target: maybe-all-target-libgomp @endif target-libgomp-no-bootstrap @@ -1464,6 +1492,7 @@ info-target: maybe-info-target-zlib info-target: maybe-info-target-rda info-target: maybe-info-target-libada info-target: maybe-info-target-libgm2 +info-target: maybe-info-target-libga68 info-target: maybe-info-target-libgomp info-target: maybe-info-target-libitm info-target: maybe-info-target-libatomic @@ -1558,6 +1587,7 @@ dvi-target: maybe-dvi-target-zlib dvi-target: maybe-dvi-target-rda dvi-target: maybe-dvi-target-libada dvi-target: maybe-dvi-target-libgm2 +dvi-target: maybe-dvi-target-libga68 dvi-target: maybe-dvi-target-libgomp dvi-target: maybe-dvi-target-libitm dvi-target: maybe-dvi-target-libatomic @@ -1652,6 +1682,7 @@ pdf-target: maybe-pdf-target-zlib pdf-target: maybe-pdf-target-rda pdf-target: maybe-pdf-target-libada pdf-target: maybe-pdf-target-libgm2 +pdf-target: maybe-pdf-target-libga68 pdf-target: maybe-pdf-target-libgomp pdf-target: maybe-pdf-target-libitm pdf-target: maybe-pdf-target-libatomic @@ -1746,6 +1777,7 @@ html-target: maybe-html-target-zlib html-target: maybe-html-target-rda html-target: maybe-html-target-libada html-target: maybe-html-target-libgm2 +html-target: maybe-html-target-libga68 html-target: maybe-html-target-libgomp html-target: maybe-html-target-libitm html-target: maybe-html-target-libatomic @@ -1840,6 +1872,7 @@ TAGS-target: maybe-TAGS-target-zlib TAGS-target: maybe-TAGS-target-rda TAGS-target: maybe-TAGS-target-libada TAGS-target: maybe-TAGS-target-libgm2 +TAGS-target: maybe-TAGS-target-libga68 TAGS-target: maybe-TAGS-target-libgomp TAGS-target: maybe-TAGS-target-libitm TAGS-target: maybe-TAGS-target-libatomic @@ -1934,6 +1967,7 @@ install-info-target: maybe-install-info-target-zlib install-info-target: maybe-install-info-target-rda install-info-target: maybe-install-info-target-libada install-info-target: maybe-install-info-target-libgm2 +install-info-target: maybe-install-info-target-libga68 install-info-target: maybe-install-info-target-libgomp install-info-target: maybe-install-info-target-libitm install-info-target: maybe-install-info-target-libatomic @@ -2028,6 +2062,7 @@ install-dvi-target: maybe-install-dvi-target-zlib install-dvi-target: maybe-install-dvi-target-rda install-dvi-target: maybe-install-dvi-target-libada install-dvi-target: maybe-install-dvi-target-libgm2 +install-dvi-target: maybe-install-dvi-target-libga68 install-dvi-target: maybe-install-dvi-target-libgomp install-dvi-target: maybe-install-dvi-target-libitm install-dvi-target: maybe-install-dvi-target-libatomic @@ -2122,6 +2157,7 @@ install-pdf-target: maybe-install-pdf-target-zlib install-pdf-target: maybe-install-pdf-target-rda install-pdf-target: maybe-install-pdf-target-libada install-pdf-target: maybe-install-pdf-target-libgm2 +install-pdf-target: maybe-install-pdf-target-libga68 install-pdf-target: maybe-install-pdf-target-libgomp install-pdf-target: maybe-install-pdf-target-libitm install-pdf-target: maybe-install-pdf-target-libatomic @@ -2216,6 +2252,7 @@ install-html-target: maybe-install-html-target-zlib install-html-target: maybe-install-html-target-rda install-html-target: maybe-install-html-target-libada install-html-target: maybe-install-html-target-libgm2 +install-html-target: maybe-install-html-target-libga68 install-html-target: maybe-install-html-target-libgomp install-html-target: maybe-install-html-target-libitm install-html-target: maybe-install-html-target-libatomic @@ -2310,6 +2347,7 @@ installcheck-target: maybe-installcheck-target-zlib installcheck-target: maybe-installcheck-target-rda installcheck-target: maybe-installcheck-target-libada installcheck-target: maybe-installcheck-target-libgm2 +installcheck-target: maybe-installcheck-target-libga68 installcheck-target: maybe-installcheck-target-libgomp installcheck-target: maybe-installcheck-target-libitm installcheck-target: maybe-installcheck-target-libatomic @@ -2404,6 +2442,7 @@ mostlyclean-target: maybe-mostlyclean-target-zlib mostlyclean-target: maybe-mostlyclean-target-rda mostlyclean-target: maybe-mostlyclean-target-libada mostlyclean-target: maybe-mostlyclean-target-libgm2 +mostlyclean-target: maybe-mostlyclean-target-libga68 mostlyclean-target: maybe-mostlyclean-target-libgomp mostlyclean-target: maybe-mostlyclean-target-libitm mostlyclean-target: maybe-mostlyclean-target-libatomic @@ -2498,6 +2537,7 @@ clean-target: maybe-clean-target-zlib clean-target: maybe-clean-target-rda clean-target: maybe-clean-target-libada clean-target: maybe-clean-target-libgm2 +clean-target: maybe-clean-target-libga68 clean-target: maybe-clean-target-libgomp clean-target: maybe-clean-target-libitm clean-target: maybe-clean-target-libatomic @@ -2592,6 +2632,7 @@ distclean-target: maybe-distclean-target-zlib distclean-target: maybe-distclean-target-rda distclean-target: maybe-distclean-target-libada distclean-target: maybe-distclean-target-libgm2 +distclean-target: maybe-distclean-target-libga68 distclean-target: maybe-distclean-target-libgomp distclean-target: maybe-distclean-target-libitm distclean-target: maybe-distclean-target-libatomic @@ -2686,6 +2727,7 @@ maintainer-clean-target: maybe-maintainer-clean-target-zlib maintainer-clean-target: maybe-maintainer-clean-target-rda maintainer-clean-target: maybe-maintainer-clean-target-libada maintainer-clean-target: maybe-maintainer-clean-target-libgm2 +maintainer-clean-target: maybe-maintainer-clean-target-libga68 maintainer-clean-target: maybe-maintainer-clean-target-libgomp maintainer-clean-target: maybe-maintainer-clean-target-libitm maintainer-clean-target: maybe-maintainer-clean-target-libatomic @@ -2838,6 +2880,7 @@ check-target: \ maybe-check-target-rda \ maybe-check-target-libada \ maybe-check-target-libgm2 \ + maybe-check-target-libga68 \ maybe-check-target-libgomp \ maybe-check-target-libitm \ maybe-check-target-libatomic \ @@ -3036,6 +3079,7 @@ install-target: \ maybe-install-target-rda \ maybe-install-target-libada \ maybe-install-target-libgm2 \ + maybe-install-target-libga68 \ maybe-install-target-libgomp \ maybe-install-target-libitm \ maybe-install-target-libatomic \ @@ -3150,6 +3194,7 @@ install-strip-target: \ maybe-install-strip-target-rda \ maybe-install-strip-target-libada \ maybe-install-strip-target-libgm2 \ + maybe-install-strip-target-libga68 \ maybe-install-strip-target-libgomp \ maybe-install-strip-target-libitm \ maybe-install-strip-target-libatomic \ @@ -60201,6 +60246,491 @@ maintainer-clean-target-libgm2: +.PHONY: configure-target-libga68 maybe-configure-target-libga68 +maybe-configure-target-libga68: +@if gcc-bootstrap +configure-target-libga68: stage_current +@endif gcc-bootstrap +@if target-libga68 +maybe-configure-target-libga68: configure-target-libga68 +configure-target-libga68: + @: $(MAKE); $(unstage) + @r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + echo "Checking multilib configuration for libga68..."; \ + $(SHELL) $(srcdir)/mkinstalldirs $(TARGET_SUBDIR)/libga68; \ + $(CC_FOR_TARGET) --print-multi-lib > $(TARGET_SUBDIR)/libga68/multilib.tmp 2> /dev/null; \ + if test -r $(TARGET_SUBDIR)/libga68/multilib.out; then \ + if cmp -s $(TARGET_SUBDIR)/libga68/multilib.tmp $(TARGET_SUBDIR)/libga68/multilib.out; then \ + rm -f $(TARGET_SUBDIR)/libga68/multilib.tmp; \ + else \ + rm -f $(TARGET_SUBDIR)/libga68/Makefile; \ + mv $(TARGET_SUBDIR)/libga68/multilib.tmp $(TARGET_SUBDIR)/libga68/multilib.out; \ + fi; \ + else \ + mv $(TARGET_SUBDIR)/libga68/multilib.tmp $(TARGET_SUBDIR)/libga68/multilib.out; \ + fi; \ + test ! -f $(TARGET_SUBDIR)/libga68/Makefile || exit 0; \ + $(SHELL) $(srcdir)/mkinstalldirs $(TARGET_SUBDIR)/libga68; \ + $(NORMAL_TARGET_EXPORTS) \ + echo Configuring in $(TARGET_SUBDIR)/libga68; \ + cd "$(TARGET_SUBDIR)/libga68" || exit 1; \ + case $(srcdir) in \ + /* | [A-Za-z]:[\\/]*) topdir=$(srcdir) ;; \ + *) topdir=`echo $(TARGET_SUBDIR)/libga68/ | \ + sed -e 's,\./,,g' -e 's,[^/]*/,../,g' `$(srcdir) ;; \ + esac; \ + module_srcdir=libga68; \ + rm -f no-such-file || : ; \ + CONFIG_SITE=no-such-file $(SHELL) \ + $$s/$$module_srcdir/configure \ + --srcdir=$${topdir}/$$module_srcdir \ + $(TARGET_CONFIGARGS) --build=${build_alias} --host=${target_alias} \ + --target=${target_alias} \ + || exit 1 +@endif target-libga68 + + + + + +.PHONY: all-target-libga68 maybe-all-target-libga68 +maybe-all-target-libga68: +@if gcc-bootstrap +all-target-libga68: stage_current +@endif gcc-bootstrap +@if target-libga68 +TARGET-target-libga68=all +maybe-all-target-libga68: all-target-libga68 +all-target-libga68: configure-target-libga68 + @: $(MAKE); $(unstage) + @r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) $(EXTRA_TARGET_FLAGS) \ + $(TARGET-target-libga68)) +@endif target-libga68 + + + + + +.PHONY: check-target-libga68 maybe-check-target-libga68 +maybe-check-target-libga68: +@if target-libga68 +maybe-check-target-libga68: check-target-libga68 + +check-target-libga68: + @: $(MAKE); $(unstage) + @r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(TARGET_FLAGS_TO_PASS) check) + +@endif target-libga68 + +.PHONY: install-target-libga68 maybe-install-target-libga68 +maybe-install-target-libga68: +@if target-libga68 +maybe-install-target-libga68: install-target-libga68 + +install-target-libga68: installdirs + @: $(MAKE); $(unstage) + @r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(TARGET_FLAGS_TO_PASS) install) + +@endif target-libga68 + +.PHONY: install-strip-target-libga68 maybe-install-strip-target-libga68 +maybe-install-strip-target-libga68: +@if target-libga68 +maybe-install-strip-target-libga68: install-strip-target-libga68 + +install-strip-target-libga68: installdirs + @: $(MAKE); $(unstage) + @r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(TARGET_FLAGS_TO_PASS) install-strip) + +@endif target-libga68 + +# Other targets (info, dvi, pdf, etc.) + +.PHONY: maybe-info-target-libga68 info-target-libga68 +maybe-info-target-libga68: +@if target-libga68 +maybe-info-target-libga68: info-target-libga68 + +info-target-libga68: \ + configure-target-libga68 + @: $(MAKE); $(unstage) + @[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + echo "Doing info in $(TARGET_SUBDIR)/libga68"; \ + for flag in $(EXTRA_TARGET_FLAGS); do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + info) \ + || exit 1 + +@endif target-libga68 + +.PHONY: maybe-dvi-target-libga68 dvi-target-libga68 +maybe-dvi-target-libga68: +@if target-libga68 +maybe-dvi-target-libga68: dvi-target-libga68 + +dvi-target-libga68: \ + configure-target-libga68 + @: $(MAKE); $(unstage) + @[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + echo "Doing dvi in $(TARGET_SUBDIR)/libga68"; \ + for flag in $(EXTRA_TARGET_FLAGS); do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + dvi) \ + || exit 1 + +@endif target-libga68 + +.PHONY: maybe-pdf-target-libga68 pdf-target-libga68 +maybe-pdf-target-libga68: +@if target-libga68 +maybe-pdf-target-libga68: pdf-target-libga68 + +pdf-target-libga68: \ + configure-target-libga68 + @: $(MAKE); $(unstage) + @[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + echo "Doing pdf in $(TARGET_SUBDIR)/libga68"; \ + for flag in $(EXTRA_TARGET_FLAGS); do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + pdf) \ + || exit 1 + +@endif target-libga68 + +.PHONY: maybe-html-target-libga68 html-target-libga68 +maybe-html-target-libga68: +@if target-libga68 +maybe-html-target-libga68: html-target-libga68 + +html-target-libga68: \ + configure-target-libga68 + @: $(MAKE); $(unstage) + @[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + echo "Doing html in $(TARGET_SUBDIR)/libga68"; \ + for flag in $(EXTRA_TARGET_FLAGS); do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + html) \ + || exit 1 + +@endif target-libga68 + +.PHONY: maybe-TAGS-target-libga68 TAGS-target-libga68 +maybe-TAGS-target-libga68: +@if target-libga68 +maybe-TAGS-target-libga68: TAGS-target-libga68 + +TAGS-target-libga68: \ + configure-target-libga68 + @: $(MAKE); $(unstage) + @[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + echo "Doing TAGS in $(TARGET_SUBDIR)/libga68"; \ + for flag in $(EXTRA_TARGET_FLAGS); do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + TAGS) \ + || exit 1 + +@endif target-libga68 + +.PHONY: maybe-install-info-target-libga68 install-info-target-libga68 +maybe-install-info-target-libga68: +@if target-libga68 +maybe-install-info-target-libga68: install-info-target-libga68 + +install-info-target-libga68: \ + configure-target-libga68 \ + info-target-libga68 + @: $(MAKE); $(unstage) + @[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + echo "Doing install-info in $(TARGET_SUBDIR)/libga68"; \ + for flag in $(EXTRA_TARGET_FLAGS); do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + install-info) \ + || exit 1 + +@endif target-libga68 + +.PHONY: maybe-install-dvi-target-libga68 install-dvi-target-libga68 +maybe-install-dvi-target-libga68: +@if target-libga68 +maybe-install-dvi-target-libga68: install-dvi-target-libga68 + +install-dvi-target-libga68: \ + configure-target-libga68 \ + dvi-target-libga68 + @: $(MAKE); $(unstage) + @[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + echo "Doing install-dvi in $(TARGET_SUBDIR)/libga68"; \ + for flag in $(EXTRA_TARGET_FLAGS); do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + install-dvi) \ + || exit 1 + +@endif target-libga68 + +.PHONY: maybe-install-pdf-target-libga68 install-pdf-target-libga68 +maybe-install-pdf-target-libga68: +@if target-libga68 +maybe-install-pdf-target-libga68: install-pdf-target-libga68 + +install-pdf-target-libga68: \ + configure-target-libga68 \ + pdf-target-libga68 + @: $(MAKE); $(unstage) + @[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + echo "Doing install-pdf in $(TARGET_SUBDIR)/libga68"; \ + for flag in $(EXTRA_TARGET_FLAGS); do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + install-pdf) \ + || exit 1 + +@endif target-libga68 + +.PHONY: maybe-install-html-target-libga68 install-html-target-libga68 +maybe-install-html-target-libga68: +@if target-libga68 +maybe-install-html-target-libga68: install-html-target-libga68 + +install-html-target-libga68: \ + configure-target-libga68 \ + html-target-libga68 + @: $(MAKE); $(unstage) + @[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + echo "Doing install-html in $(TARGET_SUBDIR)/libga68"; \ + for flag in $(EXTRA_TARGET_FLAGS); do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + install-html) \ + || exit 1 + +@endif target-libga68 + +.PHONY: maybe-installcheck-target-libga68 installcheck-target-libga68 +maybe-installcheck-target-libga68: +@if target-libga68 +maybe-installcheck-target-libga68: installcheck-target-libga68 + +installcheck-target-libga68: \ + configure-target-libga68 + @: $(MAKE); $(unstage) + @[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + echo "Doing installcheck in $(TARGET_SUBDIR)/libga68"; \ + for flag in $(EXTRA_TARGET_FLAGS); do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + installcheck) \ + || exit 1 + +@endif target-libga68 + +.PHONY: maybe-mostlyclean-target-libga68 mostlyclean-target-libga68 +maybe-mostlyclean-target-libga68: +@if target-libga68 +maybe-mostlyclean-target-libga68: mostlyclean-target-libga68 + +mostlyclean-target-libga68: + @: $(MAKE); $(unstage) + @[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + echo "Doing mostlyclean in $(TARGET_SUBDIR)/libga68"; \ + for flag in $(EXTRA_TARGET_FLAGS); do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + mostlyclean) \ + || exit 1 + +@endif target-libga68 + +.PHONY: maybe-clean-target-libga68 clean-target-libga68 +maybe-clean-target-libga68: +@if target-libga68 +maybe-clean-target-libga68: clean-target-libga68 + +clean-target-libga68: + @: $(MAKE); $(unstage) + @[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + echo "Doing clean in $(TARGET_SUBDIR)/libga68"; \ + for flag in $(EXTRA_TARGET_FLAGS); do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + clean) \ + || exit 1 + +@endif target-libga68 + +.PHONY: maybe-distclean-target-libga68 distclean-target-libga68 +maybe-distclean-target-libga68: +@if target-libga68 +maybe-distclean-target-libga68: distclean-target-libga68 + +distclean-target-libga68: + @: $(MAKE); $(unstage) + @[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + echo "Doing distclean in $(TARGET_SUBDIR)/libga68"; \ + for flag in $(EXTRA_TARGET_FLAGS); do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + distclean) \ + || exit 1 + +@endif target-libga68 + +.PHONY: maybe-maintainer-clean-target-libga68 maintainer-clean-target-libga68 +maybe-maintainer-clean-target-libga68: +@if target-libga68 +maybe-maintainer-clean-target-libga68: maintainer-clean-target-libga68 + +maintainer-clean-target-libga68: + @: $(MAKE); $(unstage) + @[ -f $(TARGET_SUBDIR)/libga68/Makefile ] || exit 0; \ + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(NORMAL_TARGET_EXPORTS) \ + echo "Doing maintainer-clean in $(TARGET_SUBDIR)/libga68"; \ + for flag in $(EXTRA_TARGET_FLAGS); do \ + eval `echo "$$flag" | sed -e "s|^\([^=]*\)=\(.*\)|\1='\2'; export \1|"`; \ + done; \ + (cd $(TARGET_SUBDIR)/libga68 && \ + $(MAKE) $(BASE_FLAGS_TO_PASS) "AR=$${AR}" "AS=$${AS}" \ + "CC=$${CC}" "CXX=$${CXX}" "LD=$${LD}" "NM=$${NM}" \ + "RANLIB=$${RANLIB}" \ + "DLLTOOL=$${DLLTOOL}" "WINDRES=$${WINDRES}" "WINDMC=$${WINDMC}" \ + maintainer-clean) \ + || exit 1 + +@endif target-libga68 + + + + + .PHONY: configure-target-libgomp maybe-configure-target-libgomp maybe-configure-target-libgomp: @if gcc-bootstrap @@ -64336,6 +64866,14 @@ check-gcc-cobol: gcc-site.exp (cd gcc && $(MAKE) $(GCC_FLAGS_TO_PASS) check-cobol); check-cobol: check-gcc-cobol check-target-libgcobol +.PHONY: check-gcc-algol68 check-algol68 +check-gcc-algol68: gcc-site.exp + r=`${PWD_COMMAND}`; export r; \ + s=`cd $(srcdir); ${PWD_COMMAND}`; export s; \ + $(HOST_EXPORTS) \ + (cd gcc && $(MAKE) $(GCC_FLAGS_TO_PASS) check-algol68); +check-algol68: check-gcc-algol68 check-target-libga68 + # The gcc part of install-no-fixedincludes, which relies on an intimate # knowledge of how a number of gcc internal targets (inter)operate. Delegate. @@ -67877,6 +68415,7 @@ configure-stageautofeedback-target-zlib: maybe-all-stageautofeedback-gcc configure-target-rda: stage_last configure-target-libada: stage_last configure-target-libgm2: stage_last +configure-target-libga68: stage_last configure-stage1-target-libgomp: maybe-all-stage1-gcc configure-stage2-target-libgomp: maybe-all-stage2-gcc configure-stage3-target-libgomp: maybe-all-stage3-gcc @@ -67921,6 +68460,7 @@ configure-target-zlib: maybe-all-gcc configure-target-rda: maybe-all-gcc configure-target-libada: maybe-all-gcc configure-target-libgm2: maybe-all-gcc +configure-target-libga68: maybe-all-gcc configure-target-libgomp: maybe-all-gcc configure-target-libitm: maybe-all-gcc configure-target-libatomic: maybe-all-gcc @@ -69221,6 +69761,9 @@ all-target-libgm2: maybe-all-target-libatomic @unless target-libstdc++-v3-bootstrap configure-target-libgrust: maybe-all-target-libstdc++-v3 @endunless target-libstdc++-v3-bootstrap +@unless target-libstdc++-v3-bootstrap +configure-target-libga68: maybe-all-target-libstdc++-v3 +@endunless target-libstdc++-v3-bootstrap @unless target-libbacktrace-bootstrap configure-target-libgfortran: maybe-all-target-libbacktrace @endunless target-libbacktrace-bootstrap @@ -69284,6 +69827,7 @@ all-target-libgo: maybe-all-target-libatomic configure-target-libgm2: maybe-all-target-libstdc++-v3 all-target-libgm2: maybe-all-target-libatomic configure-target-libgrust: maybe-all-target-libstdc++-v3 +configure-target-libga68: maybe-all-target-libstdc++-v3 configure-target-newlib: maybe-all-binutils configure-target-newlib: maybe-all-ld configure-target-libgfortran: maybe-all-target-libbacktrace @@ -69390,6 +69934,7 @@ configure-target-zlib: maybe-all-target-libgcc configure-target-rda: maybe-all-target-libgcc configure-target-libada: maybe-all-target-libgcc configure-target-libgm2: maybe-all-target-libgcc +configure-target-libga68: maybe-all-target-libgcc configure-target-libgomp: maybe-all-target-libgcc configure-target-libitm: maybe-all-target-libgcc configure-target-libatomic: maybe-all-target-libgcc @@ -69436,6 +69981,8 @@ configure-target-libada: maybe-all-target-newlib maybe-all-target-libgloss configure-target-libgm2: maybe-all-target-newlib maybe-all-target-libgloss +configure-target-libga68: maybe-all-target-newlib maybe-all-target-libgloss + configure-target-libgomp: maybe-all-target-newlib maybe-all-target-libgloss configure-target-libitm: maybe-all-target-newlib maybe-all-target-libgloss @@ -69533,6 +70080,7 @@ configure-target-zlib: maybe-all-target-libatomic configure-target-rda: maybe-all-target-libatomic configure-target-libada: maybe-all-target-libatomic configure-target-libgm2: maybe-all-target-libatomic +configure-target-libga68: maybe-all-target-libatomic configure-target-libgomp: maybe-all-target-libatomic configure-target-libitm: maybe-all-target-libatomic configure-target-libgrust: maybe-all-target-libatomic diff --git a/Makefile.tpl b/Makefile.tpl index f4f0fc58df4f..362a21b2aff1 100644 --- a/Makefile.tpl +++ b/Makefile.tpl @@ -163,6 +163,8 @@ BUILD_EXPORTS = \ CXX="$(CXX_FOR_BUILD)"; export CXX; \ CXXFLAGS="$(CXXFLAGS_FOR_BUILD)"; export CXXFLAGS; \ GFORTRAN="$(GFORTRAN_FOR_BUILD)"; export GFORTRAN; \ + GA68="$(GA68_FOR_BUILD)"; export GA68; \ + GA68FLAGS="$(GA68FLAGS_FOR_BUILD)"; export GA68FLAGS; \ GOC="$(GOC_FOR_BUILD)"; export GOC; \ GOCFLAGS="$(GOCFLAGS_FOR_BUILD)"; export GOCFLAGS; \ GDC="$(GDC_FOR_BUILD)"; export GDC; \ @@ -206,6 +208,7 @@ HOST_EXPORTS = \ CXX="$(CXX)"; export CXX; \ CXXFLAGS="$(CXXFLAGS)"; export CXXFLAGS; \ GFORTRAN="$(GFORTRAN)"; export GFORTRAN; \ + GA68="$(GA68)"; export GA68; \ GOC="$(GOC)"; export GOC; \ GDC="$(GDC)"; export GDC; \ GM2="$(GM2)"; export GM2; \ @@ -281,6 +284,11 @@ POSTSTAGE1_HOST_EXPORTS = \ CC_FOR_BUILD="$$CC"; export CC_FOR_BUILD; \ $(POSTSTAGE1_CXX_EXPORT) \ $(LTO_EXPORTS) \ + GA68="$$r/$(HOST_SUBDIR)/prev-gcc/ga68$(exeext) -B$$r/$(HOST_SUBDIR)/prev-gcc/ \ + -B$(build_tooldir)/bin/ $(GA68FLAGS_FOR_TARGET) \ + -B$$r/prev-$(TARGET_SUBDIR)/libga68/.libs"; \ + export GA68; \ + GA68_FOR_BUILD="$$GA68"; export GA68_FOR_BUILD; \ GDC="$$r/$(HOST_SUBDIR)/prev-gcc/gdc$(exeext) -B$$r/$(HOST_SUBDIR)/prev-gcc/ \ -B$(build_tooldir)/bin/ $(GDCFLAGS_FOR_TARGET) \ -B$$r/prev-$(TARGET_SUBDIR)/libphobos/libdruntime/gcc \ @@ -313,6 +321,7 @@ BASE_TARGET_EXPORTS = \ CPPFLAGS="$(CPPFLAGS_FOR_TARGET)"; export CPPFLAGS; \ CXXFLAGS="$(CXXFLAGS_FOR_TARGET)"; export CXXFLAGS; \ GFORTRAN="$(GFORTRAN_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GFORTRAN; \ + GA68="$(GA68_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GA68; \ GOC="$(GOC_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GOC; \ GDC="$(GDC_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GDC; \ GM2="$(GM2_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GM2; \ @@ -383,6 +392,7 @@ CXX_FOR_BUILD = @CXX_FOR_BUILD@ DLLTOOL_FOR_BUILD = @DLLTOOL_FOR_BUILD@ DSYMUTIL_FOR_BUILD = @DSYMUTIL_FOR_BUILD@ GFORTRAN_FOR_BUILD = @GFORTRAN_FOR_BUILD@ +GA68_FOR_BUILD = @GA68_FOR_BUILD@ GOC_FOR_BUILD = @GOC_FOR_BUILD@ GDC_FOR_BUILD = @GDC_FOR_BUILD@ GM2_FOR_BUILD = @GM2_FOR_BUILD@ @@ -446,6 +456,7 @@ STRIP = @STRIP@ WINDRES = @WINDRES@ WINDMC = @WINDMC@ +GA68 = @GA68@ GDC = @GDC@ GNATBIND = @GNATBIND@ GNATMAKE = @GNATMAKE@ @@ -456,6 +467,7 @@ LIBCFLAGS = $(CFLAGS) CXXFLAGS = @CXXFLAGS@ LIBCXXFLAGS = $(CXXFLAGS) -fno-implicit-templates GOCFLAGS = $(CFLAGS) +GA68FLAGS = @GA68FLAGS@ GDCFLAGS = @GDCFLAGS@ GM2FLAGS = $(CFLAGS) @@ -601,6 +613,7 @@ CXX_FOR_TARGET=$(STAGE_CC_WRAPPER) @CXX_FOR_TARGET@ RAW_CXX_FOR_TARGET=$(STAGE_CC_WRAPPER) @RAW_CXX_FOR_TARGET@ GFORTRAN_FOR_TARGET=$(STAGE_CC_WRAPPER) @GFORTRAN_FOR_TARGET@ GOC_FOR_TARGET=$(STAGE_CC_WRAPPER) @GOC_FOR_TARGET@ +GA68_FOR_TARGET=$(STAGE_CC_WRAPPER) @GA68_FOR_TARGET@ GDC_FOR_TARGET=$(STAGE_CC_WRAPPER) @GDC_FOR_TARGET@ GM2_FOR_TARGET=$(STAGE_CC_WRAPPER) @GM2_FOR_TARGET@ DLLTOOL_FOR_TARGET=@DLLTOOL_FOR_TARGET@ @@ -630,6 +643,7 @@ LIBCXXFLAGS_FOR_TARGET = $(CXXFLAGS_FOR_TARGET) -fno-implicit-templates LDFLAGS_FOR_TARGET = @LDFLAGS_FOR_TARGET@ GM2FLAGS_FOR_TARGET = -O2 -g GOCFLAGS_FOR_TARGET = -O2 -g +GA68FLAGS_FOR_TARGET = -O2 -g GDCFLAGS_FOR_TARGET = -O2 -g FLAGS_FOR_TARGET = @FLAGS_FOR_TARGET@ @@ -734,6 +748,7 @@ EXTRA_HOST_FLAGS = \ 'DSYMUTIL=$(DSYMUTIL)' \ 'GFORTRAN=$(GFORTRAN)' \ 'GOC=$(GOC)' \ + 'GA68=$(GA68)' \ 'GDC=$(GDC)' \ 'GM2=$(GM2)' \ 'LD=$(LD)' \ @@ -762,6 +777,7 @@ STAGE1_FLAGS_TO_PASS = \ POSTSTAGE1_FLAGS_TO_PASS = \ CC="$${CC}" CC_FOR_BUILD="$${CC_FOR_BUILD}" \ CXX="$${CXX}" CXX_FOR_BUILD="$${CXX_FOR_BUILD}" \ + GA68="$${GA68}" GA68_FOR_BUILD="$${GA68_FOR_BUILD}" \ GDC="$${GDC}" GDC_FOR_BUILD="$${GDC_FOR_BUILD}" \ GM2="$${GM2}" GM2_FOR_BUILD="$${GM2_FOR_BUILD}" \ GNATBIND="$${GNATBIND}" \ @@ -797,6 +813,8 @@ EXTRA_TARGET_FLAGS = \ 'GFORTRAN=$$(GFORTRAN_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \ 'GOC=$$(GOC_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \ 'GOCFLAGS=$$(GOCFLAGS_FOR_TARGET)' \ + 'GA68=$$(GA68_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \ + 'GA68FLAGS=$$(GA68FLAGS_FOR_TARGET)' \ 'GDC=$$(GDC_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \ 'GDCFLAGS=$$(GDCFLAGS_FOR_TARGET)' \ 'GM2=$$(GM2_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \ diff --git a/config/acx.m4 b/config/acx.m4 index db54ccf1c7c1..4e0c64172e6c 100644 --- a/config/acx.m4 +++ b/config/acx.m4 @@ -434,6 +434,12 @@ else have_cargo=no fi]) +# Test for Algol 68 +AC_DEFUN([ACX_PROG_GA68], +[AC_REQUIRE([AC_CHECK_TOOL_PREFIX]) +AC_REQUIRE([AC_PROG_CC]) +AC_CHECK_TOOL(GA68, ga68, no)]) + # Test for D. AC_DEFUN([ACX_PROG_GDC], [AC_REQUIRE([AC_CHECK_TOOL_PREFIX]) diff --git a/configure b/configure index d4da79e76690..e59746f3d000 100755 --- a/configure +++ b/configure @@ -620,6 +620,7 @@ AR_FOR_TARGET GM2_FOR_TARGET GDC_FOR_TARGET GOC_FOR_TARGET +GA68_FOR_TARGET GFORTRAN_FOR_TARGET GCC_FOR_TARGET CXX_FOR_TARGET @@ -633,6 +634,7 @@ GREP CPP PKG_CONFIG_PATH GDCFLAGS +GA68FLAGS READELF OTOOL OBJDUMP @@ -665,6 +667,7 @@ LDFLAGS_FOR_BUILD GNATMAKE_FOR_BUILD GDC_FOR_BUILD GOC_FOR_BUILD +GA68_FOR_BUILD GFORTRAN_FOR_BUILD DSYMUTIL_FOR_BUILD DLLTOOL_FOR_BUILD @@ -728,6 +731,7 @@ HAVE_CXX14 do_compare CARGO GDC +GA68 GNATMAKE GNATBIND ac_ct_CXX @@ -829,6 +833,7 @@ enable_libquadmath enable_libquadmath_support enable_libada enable_libgm2 +enable_libga68 enable_libssp enable_libstdcxx enable_bootstrap @@ -859,6 +864,7 @@ enable_host_shared enable_libgdiagnostics enable_stage1_languages enable_objc_gc +enable_algol68_gc with_target_bdw_gc with_target_bdw_gc_include with_target_bdw_gc_lib @@ -907,6 +913,7 @@ CC_FOR_TARGET CXX_FOR_TARGET GCC_FOR_TARGET GFORTRAN_FOR_TARGET +GA68_FOR_TARGET GOC_FOR_TARGET GDC_FOR_TARGET GM2_FOR_TARGET @@ -1576,6 +1583,7 @@ Optional Features: disable libquadmath support for Fortran --enable-libada build libada directory --enable-libgm2 build libgm2 directory + --enable-libga68 build libga68 directory --enable-libssp build libssp directory --disable-libstdcxx do not build libstdc++-v3 directory --enable-bootstrap enable bootstrapping [yes if native build] @@ -1599,6 +1607,8 @@ Optional Features: Mostly useful for compiler development --enable-objc-gc enable use of Boehm's garbage collector with the GNU Objective-C runtime + --enable-algol68-gc enable use of Boehm's garbage collector with the GNU + Algol runtime --enable-vtable-verify Enable vtable verification feature --enable-serial-[{host,target,build}-]configure force sequential configuration of sub-packages for @@ -1712,6 +1722,8 @@ Some influential environment variables: GCC for the target GFORTRAN_FOR_TARGET GFORTRAN for the target + GA68_FOR_TARGET + GA68 for the target GOC_FOR_TARGET GOC for the target GDC_FOR_TARGET @@ -2916,6 +2928,7 @@ target_libraries="target-libgcc \ target-libgcobol \ target-libada \ target-libgm2 \ + target-libga68 \ target-libgo \ target-libgrust \ target-libphobos \ @@ -3319,6 +3332,14 @@ if test "${ENABLE_LIBGM2}" != "yes" ; then noconfigdirs="$noconfigdirs gm2tools" fi +# Check whether --enable-libga68 was given. +if test "${enable_libga68+set}" = set; then : + enableval=$enable_libga68; ENABLE_LIBGA68=$enableval +else + ENABLE_LIBGA68=yes +fi + + # Check whether --enable-libssp was given. if test "${enable_libssp+set}" = set; then : enableval=$enable_libssp; ENABLE_LIBSSP=$enableval @@ -4301,6 +4322,7 @@ if test "${build}" != "${host}" ; then DLLTOOL_FOR_BUILD=${DLLTOOL_FOR_BUILD-dlltool} DSYMUTIL_FOR_BUILD=${DSYMUTIL_FOR_BUILD-dsymutil} GFORTRAN_FOR_BUILD=${GFORTRAN_FOR_BUILD-gfortran} + GA68_FOR_BUILD=${GA68_FOR_BUILD-ga68} GOC_FOR_BUILD=${GOC_FOR_BUILD-gccgo} GDC_FOR_BUILD=${GDC_FOR_BUILD-gdc} GNATMAKE_FOR_BUILD=${GNATMAKE_FOR_BUILD-gnatmake} @@ -4317,6 +4339,7 @@ else DLLTOOL_FOR_BUILD="\$(DLLTOOL)" DSYMUTIL_FOR_BUILD="\$(DSYMUTIL)" GFORTRAN_FOR_BUILD="\$(GFORTRAN)" + GA68_FOR_BUILD="\$(GA68)" GOC_FOR_BUILD="\$(GOC)" GDC_FOR_BUILD="\$(GDC)" GNATMAKE_FOR_BUILD="\$(GNATMAKE)" @@ -5837,6 +5860,100 @@ fi +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ga68", so it can be a program name with args. +set dummy ${ac_tool_prefix}ga68; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_GA68+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$GA68"; then + ac_cv_prog_GA68="$GA68" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_GA68="${ac_tool_prefix}ga68" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +GA68=$ac_cv_prog_GA68 +if test -n "$GA68"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GA68" >&5 +$as_echo "$GA68" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_GA68"; then + ac_ct_GA68=$GA68 + # Extract the first word of "ga68", so it can be a program name with args. +set dummy ga68; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_GA68+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_GA68"; then + ac_cv_prog_ac_ct_GA68="$ac_ct_GA68" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_GA68="ga68" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_GA68=$ac_cv_prog_ac_ct_GA68 +if test -n "$ac_ct_GA68"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_GA68" >&5 +$as_echo "$ac_ct_GA68" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_GA68" = x; then + GA68="no" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + GA68=$ac_ct_GA68 + fi +else + GA68="$ac_cv_prog_GA68" +fi + + + if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gdc", so it can be a program name with args. set dummy ${ac_tool_prefix}gdc; ac_word=$2 @@ -10383,6 +10500,11 @@ if test "${enable_objc_gc+set}" = set; then : enableval=$enable_objc_gc; fi +# Check whether --enable-algol68-gc was given. +if test "${enable_algol68_gc+set}" = set; then : + enableval=$enable_algol68_gc; +fi + # Check whether --with-target-bdw-gc was given. if test "${with_target_bdw_gc+set}" = set; then : @@ -10402,22 +10524,23 @@ if test "${with_target_bdw_gc_lib+set}" = set; then : fi -case ,${enable_languages},:${enable_objc_gc} in *,objc,*:yes|*,objc,*:auto) - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bdw garbage collector" >&5 +case ,${enable_languages},:${enable_objc_gc}:${enable_algol68_gc} in + *,objc,*:yes:*|*,objc,*:auto:*|*,algol68,*:*:yes|*,algol68,*:*:auto) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bdw garbage collector" >&5 $as_echo_n "checking for bdw garbage collector... " >&6; } - if test "x$with_target_bdw_gc$with_target_bdw_gc_include$with_target_bdw_gc_lib" = x; then - { $as_echo "$as_me:${as_lineno-$LINENO}: result: using bdw-gc in default locations" >&5 + if test "x$with_target_bdw_gc$with_target_bdw_gc_include$with_target_bdw_gc_lib" = x; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: using bdw-gc in default locations" >&5 $as_echo "using bdw-gc in default locations" >&6; } - else - if test "x$with_target_bdw_gc_include" = x && test "x$with_target_bdw_gc_lib" != x; then - as_fn_error $? "found --with-target-bdw-gc-lib but --with-target-bdw-gc-include missing" "$LINENO" 5 - elif test "x$with_target_bdw_gc_include" != x && test "x$with_target_bdw_gc_lib" = x; then - as_fn_error $? "found --with-target-bdw-gc-include but --with-target-bdw-gc-lib missing" "$LINENO" 5 else - { $as_echo "$as_me:${as_lineno-$LINENO}: result: using paths configured with --with-target-bdw-gc options" >&5 + if test "x$with_target_bdw_gc_include" = x && test "x$with_target_bdw_gc_lib" != x; then + as_fn_error $? "found --with-target-bdw-gc-lib but --with-target-bdw-gc-include missing" "$LINENO" 5 + elif test "x$with_target_bdw_gc_include" != x && test "x$with_target_bdw_gc_lib" = x; then + as_fn_error $? "found --with-target-bdw-gc-include but --with-target-bdw-gc-lib missing" "$LINENO" 5 + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: using paths configured with --with-target-bdw-gc options" >&5 $as_echo "using paths configured with --with-target-bdw-gc options" >&6; } + fi fi - fi esac # Disable libitm, libsanitizer, libvtv if we're not building C++ @@ -11746,6 +11869,7 @@ done + # Generate default definitions for YACC, M4, LEX and other programs that run @@ -14266,6 +14390,9 @@ fi +GA68FLAGS=${GA68FLAGS-${CFLAGS}} + + GDCFLAGS=${GDCFLAGS-${CFLAGS}} @@ -15594,6 +15721,167 @@ fi +if test -n "$GA68_FOR_TARGET"; then + ac_cv_prog_GA68_FOR_TARGET=$GA68_FOR_TARGET +elif test -n "$ac_cv_prog_GA68_FOR_TARGET"; then + GA68_FOR_TARGET=$ac_cv_prog_GA68_FOR_TARGET +fi + +if test -n "$ac_cv_prog_GA68_FOR_TARGET"; then + for ncn_progname in ga68; do + # Extract the first word of "${ncn_progname}", so it can be a program name with args. +set dummy ${ncn_progname}; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_GA68_FOR_TARGET+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$GA68_FOR_TARGET"; then + ac_cv_prog_GA68_FOR_TARGET="$GA68_FOR_TARGET" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_GA68_FOR_TARGET="${ncn_progname}" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +GA68_FOR_TARGET=$ac_cv_prog_GA68_FOR_TARGET +if test -n "$GA68_FOR_TARGET"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GA68_FOR_TARGET" >&5 +$as_echo "$GA68_FOR_TARGET" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + done +fi + +if test -z "$ac_cv_prog_GA68_FOR_TARGET" && test -n "$with_build_time_tools"; then + for ncn_progname in ga68; do + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ${ncn_progname} in $with_build_time_tools" >&5 +$as_echo_n "checking for ${ncn_progname} in $with_build_time_tools... " >&6; } + if test -x $with_build_time_tools/${ncn_progname}; then + ac_cv_prog_GA68_FOR_TARGET=$with_build_time_tools/${ncn_progname} + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + break + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + fi + done +fi + +if test -z "$ac_cv_prog_GA68_FOR_TARGET"; then + for ncn_progname in ga68; do + if test -n "$ncn_target_tool_prefix"; then + # Extract the first word of "${ncn_target_tool_prefix}${ncn_progname}", so it can be a program name with args. +set dummy ${ncn_target_tool_prefix}${ncn_progname}; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_GA68_FOR_TARGET+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$GA68_FOR_TARGET"; then + ac_cv_prog_GA68_FOR_TARGET="$GA68_FOR_TARGET" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_GA68_FOR_TARGET="${ncn_target_tool_prefix}${ncn_progname}" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +GA68_FOR_TARGET=$ac_cv_prog_GA68_FOR_TARGET +if test -n "$GA68_FOR_TARGET"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GA68_FOR_TARGET" >&5 +$as_echo "$GA68_FOR_TARGET" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi + if test -z "$ac_cv_prog_GA68_FOR_TARGET" && test $build = $target ; then + # Extract the first word of "${ncn_progname}", so it can be a program name with args. +set dummy ${ncn_progname}; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_GA68_FOR_TARGET+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$GA68_FOR_TARGET"; then + ac_cv_prog_GA68_FOR_TARGET="$GA68_FOR_TARGET" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_GA68_FOR_TARGET="${ncn_progname}" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +GA68_FOR_TARGET=$ac_cv_prog_GA68_FOR_TARGET +if test -n "$GA68_FOR_TARGET"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GA68_FOR_TARGET" >&5 +$as_echo "$GA68_FOR_TARGET" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi + test -n "$ac_cv_prog_GA68_FOR_TARGET" && break + done +fi + +if test -z "$ac_cv_prog_GA68_FOR_TARGET" ; then + set dummy ga68 + if test $build = $target ; then + GA68_FOR_TARGET="$2" + else + GA68_FOR_TARGET="${ncn_target_tool_prefix}$2" + fi +else + GA68_FOR_TARGET="$ac_cv_prog_GA68_FOR_TARGET" +fi + + + if test -n "$GOC_FOR_TARGET"; then ac_cv_prog_GOC_FOR_TARGET=$GOC_FOR_TARGET elif test -n "$ac_cv_prog_GOC_FOR_TARGET"; then @@ -20060,6 +20348,51 @@ $as_echo "pre-installed" >&6; } fi fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking where to find the target ga68" >&5 +$as_echo_n "checking where to find the target ga68... " >&6; } +if test "x${build}" != "x${host}" ; then + if expr "x$GA68_FOR_TARGET" : "x/" > /dev/null; then + # We already found the complete path + ac_dir=`dirname $GA68_FOR_TARGET` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: pre-installed in $ac_dir" >&5 +$as_echo "pre-installed in $ac_dir" >&6; } + else + # Canadian cross, just use what we found + { $as_echo "$as_me:${as_lineno-$LINENO}: result: pre-installed" >&5 +$as_echo "pre-installed" >&6; } + fi +else + ok=yes + case " ${configdirs} " in + *" gcc "*) ;; + *) ok=no ;; + esac + case ,${enable_languages}, in + *,algol68,*) ;; + *) ok=no ;; + esac + if test $ok = yes; then + # An in-tree tool is available and we can use it + GA68_FOR_TARGET='$$r/$(HOST_SUBDIR)/gcc/ga68 -B$$r/$(HOST_SUBDIR)/gcc/' + { $as_echo "$as_me:${as_lineno-$LINENO}: result: just compiled" >&5 +$as_echo "just compiled" >&6; } + elif expr "x$GA68_FOR_TARGET" : "x/" > /dev/null; then + # We already found the complete path + ac_dir=`dirname $GA68_FOR_TARGET` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: pre-installed in $ac_dir" >&5 +$as_echo "pre-installed in $ac_dir" >&6; } + elif test "x$target" = "x$host"; then + # We can use an host tool + GA68_FOR_TARGET='$(GA68)' + { $as_echo "$as_me:${as_lineno-$LINENO}: result: host tool" >&5 +$as_echo "host tool" >&6; } + else + # We need a cross tool + { $as_echo "$as_me:${as_lineno-$LINENO}: result: pre-installed" >&5 +$as_echo "pre-installed" >&6; } + fi +fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking where to find the target gdc" >&5 $as_echo_n "checking where to find the target gdc... " >&6; } if test "x${build}" != "x${host}" ; then diff --git a/configure.ac b/configure.ac index 456a673b9bbe..2fb385961df6 100644 --- a/configure.ac +++ b/configure.ac @@ -166,6 +166,7 @@ target_libraries="target-libgcc \ target-libgcobol \ target-libada \ target-libgm2 \ + target-libga68 \ target-libgo \ target-libgrust \ target-libphobos \ @@ -514,6 +515,11 @@ if test "${ENABLE_LIBGM2}" != "yes" ; then noconfigdirs="$noconfigdirs gm2tools" fi +AC_ARG_ENABLE(libga68, +[AS_HELP_STRING([--enable-libga68], [build libga68 directory])], +ENABLE_LIBGA68=$enableval, +ENABLE_LIBGA68=yes) + AC_ARG_ENABLE(libssp, [AS_HELP_STRING([--enable-libssp], [build libssp directory])], ENABLE_LIBSSP=$enableval, @@ -1451,6 +1457,7 @@ if test "${build}" != "${host}" ; then DLLTOOL_FOR_BUILD=${DLLTOOL_FOR_BUILD-dlltool} DSYMUTIL_FOR_BUILD=${DSYMUTIL_FOR_BUILD-dsymutil} GFORTRAN_FOR_BUILD=${GFORTRAN_FOR_BUILD-gfortran} + GA68_FOR_BUILD=${GA68_FOR_BUILD-ga68} GOC_FOR_BUILD=${GOC_FOR_BUILD-gccgo} GDC_FOR_BUILD=${GDC_FOR_BUILD-gdc} GNATMAKE_FOR_BUILD=${GNATMAKE_FOR_BUILD-gnatmake} @@ -1467,6 +1474,7 @@ else DLLTOOL_FOR_BUILD="\$(DLLTOOL)" DSYMUTIL_FOR_BUILD="\$(DSYMUTIL)" GFORTRAN_FOR_BUILD="\$(GFORTRAN)" + GA68_FOR_BUILD="\$(GA68)" GOC_FOR_BUILD="\$(GOC)" GDC_FOR_BUILD="\$(GDC)" GNATMAKE_FOR_BUILD="\$(GNATMAKE)" @@ -1520,6 +1528,7 @@ int main() {}])], fi ACX_PROG_GNAT +ACX_PROG_GA68 ACX_PROG_GDC ACX_PROG_CARGO ACX_PROG_CMP_IGNORE_INITIAL @@ -2644,6 +2653,10 @@ AC_ARG_ENABLE(objc-gc, [AS_HELP_STRING([--enable-objc-gc], [enable use of Boehm's garbage collector with the GNU Objective-C runtime])]) +AC_ARG_ENABLE(algol68-gc, +[AS_HELP_STRING([--enable-algol68-gc], + [enable use of Boehm's garbage collector with the + GNU Algol runtime])]) AC_ARG_WITH([target-bdw-gc], [AS_HELP_STRING([--with-target-bdw-gc=PATHLIST], [specify prefix directory for installed bdw-gc package. @@ -2656,21 +2669,22 @@ AC_ARG_WITH([target-bdw-gc-lib], [AS_HELP_STRING([--with-target-bdw-gc-lib=PATHLIST], [specify directories for installed bdw-gc library])]) -case ,${enable_languages},:${enable_objc_gc} in *,objc,*:yes|*,objc,*:auto) - AC_MSG_CHECKING([for bdw garbage collector]) - if test "x$with_target_bdw_gc$with_target_bdw_gc_include$with_target_bdw_gc_lib" = x; then - dnl no bdw-gw options, assume default locations - AC_MSG_RESULT([using bdw-gc in default locations]) - else - dnl bdw-gw options, first error checking, complete checking in libobjc - if test "x$with_target_bdw_gc_include" = x && test "x$with_target_bdw_gc_lib" != x; then - AC_MSG_ERROR([found --with-target-bdw-gc-lib but --with-target-bdw-gc-include missing]) - elif test "x$with_target_bdw_gc_include" != x && test "x$with_target_bdw_gc_lib" = x; then - AC_MSG_ERROR([found --with-target-bdw-gc-include but --with-target-bdw-gc-lib missing]) +case ,${enable_languages},:${enable_objc_gc}:${enable_algol68_gc} in + *,objc,*:yes:*|*,objc,*:auto:*|*,algol68,*:*:yes|*,algol68,*:*:auto) + AC_MSG_CHECKING([for bdw garbage collector]) + if test "x$with_target_bdw_gc$with_target_bdw_gc_include$with_target_bdw_gc_lib" = x; then + dnl no bdw-gw options, assume default locations + AC_MSG_RESULT([using bdw-gc in default locations]) else - AC_MSG_RESULT([using paths configured with --with-target-bdw-gc options]) + dnl bdw-gw options, first error checking, complete checking in libobjc and libga68 + if test "x$with_target_bdw_gc_include" = x && test "x$with_target_bdw_gc_lib" != x; then + AC_MSG_ERROR([found --with-target-bdw-gc-lib but --with-target-bdw-gc-include missing]) + elif test "x$with_target_bdw_gc_include" != x && test "x$with_target_bdw_gc_lib" = x; then + AC_MSG_ERROR([found --with-target-bdw-gc-include but --with-target-bdw-gc-lib missing]) + else + AC_MSG_RESULT([using paths configured with --with-target-bdw-gc options]) + fi fi - fi esac # Disable libitm, libsanitizer, libvtv if we're not building C++ @@ -3917,6 +3931,7 @@ AC_SUBST(CXX_FOR_BUILD) AC_SUBST(DLLTOOL_FOR_BUILD) AC_SUBST(DSYMUTIL_FOR_BUILD) AC_SUBST(GFORTRAN_FOR_BUILD) +AC_SUBST(GA68_FOR_BUILD) AC_SUBST(GOC_FOR_BUILD) AC_SUBST(GDC_FOR_BUILD) AC_SUBST(GNATMAKE_FOR_BUILD) @@ -4012,6 +4027,9 @@ AC_SUBST(CC) AC_SUBST(CXX) AC_SUBST(CFLAGS) AC_SUBST(CXXFLAGS) +AC_SUBST(GA68) +AC_SUBST(GA68FLAGS) +GA68FLAGS=${GA68FLAGS-${CFLAGS}} AC_SUBST(GDC) AC_SUBST(GDCFLAGS) GDCFLAGS=${GDCFLAGS-${CFLAGS}} @@ -4060,6 +4078,7 @@ NCN_STRICT_CHECK_TARGET_TOOLS(CC_FOR_TARGET, cc gcc) NCN_STRICT_CHECK_TARGET_TOOLS(CXX_FOR_TARGET, c++ g++ cxx gxx) NCN_STRICT_CHECK_TARGET_TOOLS(GCC_FOR_TARGET, gcc, ${CC_FOR_TARGET}) NCN_STRICT_CHECK_TARGET_TOOLS(GFORTRAN_FOR_TARGET, gfortran) +NCN_STRICT_CHECK_TARGET_TOOLS(GA68_FOR_TARGET, ga68) NCN_STRICT_CHECK_TARGET_TOOLS(GOC_FOR_TARGET, gccgo) NCN_STRICT_CHECK_TARGET_TOOLS(GDC_FOR_TARGET, gdc) NCN_STRICT_CHECK_TARGET_TOOLS(GM2_FOR_TARGET, gm2) @@ -4111,6 +4130,8 @@ GCC_TARGET_TOOL(gfortran, GFORTRAN_FOR_TARGET, GFORTRAN, [gcc/gfortran -B$$r/$(HOST_SUBDIR)/gcc/], fortran) GCC_TARGET_TOOL(gccgo, GOC_FOR_TARGET, GOC, [gcc/gccgo -B$$r/$(HOST_SUBDIR)/gcc/], go) +GCC_TARGET_TOOL(ga68, GA68_FOR_TARGET, GA68, + [gcc/ga68 -B$$r/$(HOST_SUBDIR)/gcc/], algol68) GCC_TARGET_TOOL(gdc, GDC_FOR_TARGET, GDC, [gcc/gdc -B$$r/$(HOST_SUBDIR)/gcc/], d) GCC_TARGET_TOOL(gm2, GM2_FOR_TARGET, GM2, diff --git a/gcc/Makefile.in b/gcc/Makefile.in index 02cc38ce57e0..2c3194e7d1e3 100644 --- a/gcc/Makefile.in +++ b/gcc/Makefile.in @@ -3902,7 +3902,8 @@ $(build_htmldir)/gccinstall/index.html: $(TEXI_GCCINSTALL_FILES) .PHONY: regenerate-opt-urls OPT_URLS_HTML_DEPS = $(build_htmldir)/gcc/Option-Index.html \ $(build_htmldir)/gdc/Option-Index.html \ - $(build_htmldir)/gfortran/Option-Index.html + $(build_htmldir)/gfortran/Option-Index.html \ + $(build_htmldir)/ga68/Option-Index.html $(OPT_URLS_HTML_DEPS): %/Option-Index.html: %/index.html regenerate-opt-urls: $(srcdir)/regenerate-opt-urls.py $(OPT_URLS_HTML_DEPS) diff --git a/gcc/algol68/Make-lang.in b/gcc/algol68/Make-lang.in new file mode 100644 index 000000000000..11756f772627 --- /dev/null +++ b/gcc/algol68/Make-lang.in @@ -0,0 +1,287 @@ +# Make-lang.in -- Top level -*- makefile -*- fragment for GCC Algol 68 +# frontend. + +# Copyright (C) 2025 Free Software Foundation, Inc. + +# This file is NOT part of GCC. + +# GCC is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3, or (at your option) +# any later version. + +# GCC is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +# This file provides the language dependent support in the main Makefile. + +.PHONY: algol68 + +# Installation name. + +A68_INSTALL_NAME = $(shell echo ga68|sed '$(program_transform_name)') +A68_TARGET_INSTALL_NAME = $(target_noncanonical)-$(shell echo ga68|sed '$(program_transform_name)') + +# General hooks + +algol68: a681$(exeext) +algol68.serial = a681$(exeext) + +.PHONY: algol68 + +# Use maximal warnings for this front end. +algol68-warn = $(STRICT_WARN) + +# First the driver, ga68. + +GA68_OBJS = \ + $(GCC_OBJS) \ + algol68/a68spec.o \ + $(END) + +a68spec.o: $(srcdir)/algol68/a68spec.cc $(SYSTEM_H) coretypes.h $(TM_H) $(GCC_H) \ + $(CONFIG_H) opts.h + $(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(DRIVER_DEFINES) \ + $(INCLUDES) $(srcdir)/algol68/a68spec.cc + +ga68$(exeext): $(GA68_OBJS) $(EXTRA_GCC_OBJS) libcommon-target.a $(LIBDEPS) + +$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ \ + $(GA68_OBJS) $(EXTRA_GCC_OBJS) libcommon-target.a \ + $(EXTRA_GCC_LIBS) $(LIBS) + +# Now the compiler proper, a681. + +ALGOL68_OBJS = algol68/a68-lang.o \ + algol68/a68-unistr.o \ + algol68/a68-moids-diagnostics.o \ + algol68/a68-moids-misc.o \ + algol68/a68-moids-to-string.o \ + algol68/a68-postulates.o \ + algol68/a68-diagnostics.o \ + algol68/a68-exports.o \ + algol68/a68-imports.o \ + algol68/a68-parser.o \ + algol68/a68-parser-keywords.o \ + algol68/a68-parser-bottom-up.o \ + algol68/a68-parser-brackets.o \ + algol68/a68-parser-debug.o \ + algol68/a68-parser-extract.o \ + algol68/a68-parser-modes.o \ + algol68/a68-parser-moids-check.o \ + algol68/a68-parser-moids-coerce.o \ + algol68/a68-parser-moids-equivalence.o \ + algol68/a68-parser-pragmat.o \ + algol68/a68-parser-scanner.o \ + algol68/a68-parser-scope.o \ + algol68/a68-parser-serial-dsa.o \ + algol68/a68-parser-taxes.o \ + algol68/a68-parser-top-down.o \ + algol68/a68-parser-victal.o \ + algol68/a68-parser-prelude.o \ + algol68/a68-low.o \ + algol68/a68-low-builtins.o \ + algol68/a68-low-clauses.o \ + algol68/a68-low-coercions.o \ + algol68/a68-low-decls.o \ + algol68/a68-low-generator.o \ + algol68/a68-low-misc.o \ + algol68/a68-low-moids.o \ + algol68/a68-low-multiples.o \ + algol68/a68-low-refs.o \ + algol68/a68-low-procs.o \ + algol68/a68-low-structs.o \ + algol68/a68-low-chars.o \ + algol68/a68-low-strings.o \ + algol68/a68-low-ints.o \ + algol68/a68-low-bools.o \ + algol68/a68-low-reals.o \ + algol68/a68-low-complex.o \ + algol68/a68-low-bits.o \ + algol68/a68-low-posix.o \ + algol68/a68-low-prelude.o \ + algol68/a68-low-ranges.o \ + algol68/a68-low-runtime.o \ + algol68/a68-low-unions.o \ + algol68/a68-low-units.o \ + $(END) + +ALGOL68_ALL_OBJS = $(ALGOL68_OBJS) + +algol68_OBJS = $(ALGOL68_ALL_OBJS) algol68/a68spec.o + +a681$(exeext): $(ALGOL68_ALL_OBJS) attribs.o $(BACKEND) $(LIBDEPS) $(algol68.prev) + @$(call LINK_PROGRESS,$(INDEX.algol68),start) + +$(LLINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ \ + $(ALGOL68_OBJS) attribs.o $(BACKEND) $(LIBS) $(A681_LIBS) $(BACKENDLIBS) + @$(call LINK_PROGRESS,$(INDEX.algol68),end) + +algol68/tfspec.o: $(srcdir)/algol68/tfspec.c \ + $(SYSTEM_H) coretypes.h $(TM_H) $(GCC_H) $(CONFIG_H) $(TREE_H) + +# Documentation. + +A68_MANUAL_FILES = + +A68_MANUAL_FILES = \ + algol68/ga68.texi \ + $(gcc_docdir)/include/fdl.texi \ + $(gcc_docdir)/include/gpl_v3.texi \ + $(gcc_docdir)/include/gcc-common.texi \ + gcc-vers.texi + +A68_INT_MANUAL_FILES = \ + algol68/ga68-internals.texi \ + $(gcc_docdir)/include/fdl.texi \ + $(gcc_docdir)/include/gcc-common.texi \ + gcc-vers.texi + +A68_TEXI_FILES = $(A68_MANUAL_FILES) $(A68_INT_MANUAL_FILES) + +doc/ga68.info: $(A68_MANUAL_FILES) + if test "x$(BUILD_INFO)" = xinfo; then \ + rm -f doc/ga68.info*; \ + $(MAKEINFO) $(MAKEINFOFLAGS) -I $(gcc_docdir) \ + -I $(gcc_docdir)/include -o $@ $<; \ + else true; fi + +doc/ga68-internals.info: $(A68_INT_MANUAL_FILES) + if test "x$(BUILD_INFO)" = xinfo; then \ + rm -f doc/ga68-internals.info*; \ + $(MAKEINFO) $(MAKEINFOFLAGS) -I $(gcc_docdir) \ + -I $(gcc_docdir)/include -o $@ $<; \ + else true; fi + +doc/ga68.dvi: $(A68_MANUAL_FILES) + $(TEXI2DVI) -I $(abs_docdir)/include -o $@ $< + +doc/ga68-internals.dvi: $(A68_INT_MANUAL_FILES) + $(TEXI2DVI) -I $(abs_docdir)/include -o $@ $< + +doc/ga68.pdf: $(A68_MANUAL_FILES) + $(TEXI2PDF) -I $(abs_docdir)/include -o $@ $< + +doc/ga68-internals.pdf: $(A68_INT_MANUAL_FILES) + $(TEXI2PDF) -I $(abs_docdir)/include -o $@ $< + +$(build_htmldir)/ga68/index.html: $(A68_MANUAL_FILES) + $(mkinstalldirs) $(@D) + rm -f $(@D)/* + $(TEXI2HTML) $(MAKEINFO_TOC_INLINE_FLAG) \ + -I $(gcc_docdir)/include -I $(srcdir)/d -o $(@D) $< + +$(build_htmldir)/ga68-internals/index.html: $(A68_INT_MANUAL_FILES) + $(mkinstalldirs) $(@D) + rm -f $(@D)/* + $(TEXI2HTML) $(MAKEINFO_TOC_INLINE_FLAG) \ + -I $(gcc_docdir)/include -I $(srcdir)/d -o $(@D) $< + +.INTERMEDIATE: ga68.pod + +ga68.pod: algol68/ga68.texi + -$(TEXI2POD) -D ga68 < $< > $@ + +# Build hooks. + +algol68.srcextra: + +algol68.all.cross: ga68$(exeext) +algol68.start.encap: ga68$(exeect) +algol68.rest.encap: +algol68.info: doc/ga68.info doc/ga68-internals.info +algol68.dvi: doc/ga68.dvi doc/ga68-internals.dvi +algol68.pdf: doc/ga68.pdf doc/ga68-internals.pdf +algol68.install-pdf: +algol68.html: $(build_htmldir)/ga68/index.html $(build_htmldir)/ga68-internals/index.html +algol68.man: doc/ga68.1 +algol68.srcinfo: doc/ga68.info doc/ga68-internals.info + -cp -p $^ $(srcdir)/doc +algol68.srcinfo: +algol68.srcman: +algol68.srcman: doc/ga68.1 + -cp -p $^ $(srcdir)/doc +algol68.install-plugin: + +algol68.tags: force + cd $(srcdir)/algol68; etags -o TAGS.sub *.c *.h; \ + etags --include TAGS.sub --include ../TAGS.sub + +lang_checks += check-algol68 +lang_checks_parallelized += check-algol68 +check_algol68_parallelize = 10 + +selftest-algol68: + +# +# Install hooks: + +algol68.install-common: installdirs + -rm -f $(DESTDIR)$(bindir)/$(A68_INSTALL_NAME)$(exeext) + $(INSTALL_PROGRAM) ga68$(exeext) $(DESTDIR)$(bindir)/$(A68_INSTALL_NAME)$(exeext) + +algol68.install-man: $(DESTDIR)$(man1dir)/$(A68_INSTALL_NAME)$(man1ext) + +$(DESTDIR)$(man1dir)/$(A68_INSTALL_NAME)$(man1ext): doc/ga68.1 installdirs + -rm -f $@ + -$(INSTALL_DATA) $< $@ + -chmod a-x $@ + +$(DESTDIR)$(man7dir)/%.7algol: doc/%.7algol installdirs + -rm -f $@ + -$(INSTALL_DATA) $< $@ + -chmod a-x $@ + +algol68.install-info: $(DESTDIR)$(infodir)/ga68.info $(DESTDIR)$(infodir)/ga68-internals.info + +algol68.install-html: $(build_htmldir)/ga68 $(build_htmldir)/ga68-internals + @$(NORMAL_INSTALL) + test -z "$(htmldir)" || $(mkinstalldirs) "$(DESTDIR)$(htmldir)" + @for p in $(build_htmldir)/ga68; do \ + if test -f "$$p" || test -d "$$p"; then d=""; else d="$(srcdir)/"; fi; \ + f=$(html__strip_dir) \ + if test -d "$$d$$p"; then \ + echo " $(mkinstalldirs) '$(DESTDIR)$(htmldir)/$$f'"; \ + $(mkinstalldirs) "$(DESTDIR)$(htmldir)/$$f" || exit 1; \ + echo " $(INSTALL_DATA) '$$d$$p'/* '$(DESTDIR)$(htmldir)/$$f'"; \ + $(INSTALL_DATA) "$$d$$p"/* "$(DESTDIR)$(htmldir)/$$f"; \ + else \ + echo " $(INSTALL_DATA) '$$d$$p' '$(DESTDIR)$(htmldir)/$$f'"; \ + $(INSTALL_DATA) "$$d$$p" "$(DESTDIR)$(htmldir)/$$f"; \ + fi; \ + done + +algol68.uninstall: +# +# Clean hooks: +# A lot of the ancillary files are deleted by the main makefile. +# We just have to delete files specific to us. +algol68.mostlyclean: + -rm -f algol68/*$(objext) algol68/xforward algol68/fflags + -rm -f algol68/*$(coverageexts) +algol68.clean: algol68.mostlyclean +algol68.distclean: + -rm -f algol68/Makefile algol68/Make-host algol68/Make-target + -rm -f algol68/config.status algol68/config.cache +algol68.maintainer-clean: + -rm -f $(gcc_docdir)/*.7algol + +# +# Stage hooks: + +algol68.stage1: stage1-start + -mv algol68/*$(objext) stage1/algol68 +algol68.stage2: stage2-start + -mv algol68/*$(objext) stage2/algol68 +algol68.stage3: stage3-start + -mv algol68/*$(objext) stage3/algol68 +algol68.stage4: stage4-start + -mv algol68/*$(objext) stage4/algol68 +algol68.stageprofile: stageprofile-start + -mv algol68/*$(objext) stageprofile/algol68 +algol68.stagefeedback: stagefeedback-start + -mv algol68/*$(objext) stagefeedback/algol68 diff --git a/gcc/algol68/config-lang.in b/gcc/algol68/config-lang.in new file mode 100644 index 000000000000..e3de063715de --- /dev/null +++ b/gcc/algol68/config-lang.in @@ -0,0 +1,32 @@ +# config-lang.in -- Top level configure fragment for gcc Algol 68 frontend. + +# Copyright (C) 2025 Free Software Foundation, Inc. + +# GCC is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3, or (at your option) +# any later version. + +# GCC is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +# Configure looks for the existence of this file to auto-config each language. +# We define several parameters used by configure: +# +# language - name of language as it would appear in $(LANGUAGES) +# compilers - value to add to $(COMPILERS) + +language="algol68" +compilers="a681\$(exeext)" +gtfiles="\$(srcdir)/algol68/a68-types.h \$(srcdir)/algol68/a68.h \$(srcdir)/algol68/a68-lang.cc \$(srcdir)/algol68/a68-low-ranges.cc" + +target_libs="target-libga68" + +# Do not build by default. +build_by_default="no" From c6af130047a96a923351a174d9f2b51fcc9e8e55 Mon Sep 17 00:00:00 2001 From: Andrew Pinski Date: Sat, 29 Nov 2025 19:50:53 -0800 Subject: [PATCH 191/373] Regenerate .opt.urls Looks like Jose forgot to one last regenerate of the opt.urls file. Pushed as obvious after quickly looking to make sure they look decent. gcc/ada/ChangeLog: * gcc-interface/lang.opt.urls: Regenerate. gcc/ChangeLog: * algol68/lang.opt.urls: Regenerate. gcc/c-family/ChangeLog: * c.opt.urls: Regenerate. gcc/cobol/ChangeLog: * lang.opt.urls: Regenerate. gcc/d/ChangeLog: * lang.opt.urls: Regenerate. gcc/fortran/ChangeLog: * lang.opt.urls: Regenerate. gcc/go/ChangeLog: * lang.opt.urls: Regenerate. gcc/m2/ChangeLog: * lang.opt.urls: Regenerate. gcc/rust/ChangeLog: * lang.opt.urls: Regenerate. Signed-off-by: Andrew Pinski --- gcc/ada/gcc-interface/lang.opt.urls | 2 +- gcc/algol68/lang.opt.urls | 6 ++++++ gcc/c-family/c.opt.urls | 2 +- gcc/cobol/lang.opt.urls | 2 +- gcc/d/lang.opt.urls | 4 ++-- gcc/fortran/lang.opt.urls | 4 ++-- gcc/go/lang.opt.urls | 2 +- gcc/m2/lang.opt.urls | 2 +- gcc/rust/lang.opt.urls | 2 +- 9 files changed, 16 insertions(+), 10 deletions(-) diff --git a/gcc/ada/gcc-interface/lang.opt.urls b/gcc/ada/gcc-interface/lang.opt.urls index 3174c223a169..f2e837248f3a 100644 --- a/gcc/ada/gcc-interface/lang.opt.urls +++ b/gcc/ada/gcc-interface/lang.opt.urls @@ -1,7 +1,7 @@ ; Autogenerated by regenerate-opt-urls.py from gcc/ada/gcc-interface/lang.opt and generated HTML I -UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) +UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) LangUrlSuffix_Algol68(ga68/Directory-options.html#index-I) ; skipping UrlSuffix for 'Wall' due to multiple URLs: ; duplicate: 'gcc/Standard-Libraries.html#index-Wall-1' diff --git a/gcc/algol68/lang.opt.urls b/gcc/algol68/lang.opt.urls index df303b98f6a2..3fea50a3fded 100644 --- a/gcc/algol68/lang.opt.urls +++ b/gcc/algol68/lang.opt.urls @@ -18,6 +18,9 @@ LangUrlSuffix_Algol68(ga68/Warnings-options.html#index-Wno-scope) Whidden-declarations LangUrlSuffix_Algol68(ga68/Warnings-options.html#index-Whidden-declarations) +Whidden-declarations= +LangUrlSuffix_Algol68(ga68/Warnings-options.html#index-Whidden-declarations) + fbrackets LangUrlSuffix_Algol68(ga68/Dialect-options.html#index-fbrackets) @@ -33,6 +36,9 @@ LangUrlSuffix_Algol68(ga68/Developer-options.html#index-fa68-dump-modes) fa68-dump-ast LangUrlSuffix_Algol68(ga68/Developer-options.html#index-fa68-dump-ast) +fa68-dump-module-interfaces +LangUrlSuffix_Algol68(ga68/Developer-options.html#index-fa68-dump-module-interfaces) + static-libga68 LangUrlSuffix_Algol68(ga68/Linking-options.html#index-static-libga68) diff --git a/gcc/c-family/c.opt.urls b/gcc/c-family/c.opt.urls index 1f9e6ba95d9f..9430f4bc2f9c 100644 --- a/gcc/c-family/c.opt.urls +++ b/gcc/c-family/c.opt.urls @@ -23,7 +23,7 @@ H UrlSuffix(gcc/Preprocessor-Options.html#index-H) LangUrlSuffix_D(gdc/Code-Generation.html#index-H) LangUrlSuffix_Fortran(gfortran/Preprocessing-Options.html#index-H) I -UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) +UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) LangUrlSuffix_Algol68(ga68/Directory-options.html#index-I) M UrlSuffix(gcc/Preprocessor-Options.html#index-M) LangUrlSuffix_D(gdc/Code-Generation.html#index-M) diff --git a/gcc/cobol/lang.opt.urls b/gcc/cobol/lang.opt.urls index 9ceb6cff39a2..e628ae52505c 100644 --- a/gcc/cobol/lang.opt.urls +++ b/gcc/cobol/lang.opt.urls @@ -8,7 +8,7 @@ UrlSuffix(gcc/Preprocessor-Options.html#index-D-1) ; duplicate: 'gcc/Overall-Options.html#index-E' I -UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) +UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) LangUrlSuffix_Algol68(ga68/Directory-options.html#index-I) M UrlSuffix(gcc/Preprocessor-Options.html#index-M) LangUrlSuffix_D(gdc/Code-Generation.html#index-M) diff --git a/gcc/d/lang.opt.urls b/gcc/d/lang.opt.urls index b4886bf18ad4..d0d9bc8fd3d2 100644 --- a/gcc/d/lang.opt.urls +++ b/gcc/d/lang.opt.urls @@ -10,7 +10,7 @@ Hf LangUrlSuffix_D(gdc/Code-Generation.html#index-Hf) I -UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) +UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) LangUrlSuffix_Algol68(ga68/Directory-options.html#index-I) J LangUrlSuffix_D(gdc/Directory-Options.html#index-J) @@ -103,7 +103,7 @@ fall-instantiations LangUrlSuffix_D(gdc/Runtime-Options.html#index-fall-instantiations) fassert -LangUrlSuffix_D(gdc/Runtime-Options.html#index-fassert) +LangUrlSuffix_D(gdc/Runtime-Options.html#index-fassert) LangUrlSuffix_Algol68(ga68/Runtime-options.html#index-fassert) fbounds-check LangUrlSuffix_D(gdc/Runtime-Options.html#index-fbounds-check) LangUrlSuffix_Fortran(gfortran/Code-Gen-Options.html#index-fbounds-check) diff --git a/gcc/fortran/lang.opt.urls b/gcc/fortran/lang.opt.urls index 742b9b9c07ca..cdb0ba8195d8 100644 --- a/gcc/fortran/lang.opt.urls +++ b/gcc/fortran/lang.opt.urls @@ -17,7 +17,7 @@ H UrlSuffix(gcc/Preprocessor-Options.html#index-H) LangUrlSuffix_D(gdc/Code-Generation.html#index-H) LangUrlSuffix_Fortran(gfortran/Preprocessing-Options.html#index-H) I -UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) +UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) LangUrlSuffix_Algol68(ga68/Directory-options.html#index-I) J LangUrlSuffix_D(gdc/Directory-Options.html#index-J) @@ -425,7 +425,7 @@ fcoarray= LangUrlSuffix_Fortran(gfortran/Code-Gen-Options.html#index-fcoarray) fcheck= -LangUrlSuffix_Fortran(gfortran/Code-Gen-Options.html#index-fcheck) +LangUrlSuffix_Fortran(gfortran/Code-Gen-Options.html#index-fcheck) LangUrlSuffix_Algol68(ga68/Runtime-options.html#index-fcheck) fsecond-underscore LangUrlSuffix_Fortran(gfortran/Code-Gen-Options.html#index-fsecond-underscore) diff --git a/gcc/go/lang.opt.urls b/gcc/go/lang.opt.urls index 051f7060d870..4b93c4919acc 100644 --- a/gcc/go/lang.opt.urls +++ b/gcc/go/lang.opt.urls @@ -1,7 +1,7 @@ ; Autogenerated by regenerate-opt-urls.py from gcc/go/lang.opt and generated HTML I -UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) +UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) LangUrlSuffix_Algol68(ga68/Directory-options.html#index-I) L UrlSuffix(gcc/Directory-Options.html#index-L) LangUrlSuffix_D(gdc/Directory-Options.html#index-L) diff --git a/gcc/m2/lang.opt.urls b/gcc/m2/lang.opt.urls index 1abc1685ea32..f7751fe4a3c8 100644 --- a/gcc/m2/lang.opt.urls +++ b/gcc/m2/lang.opt.urls @@ -38,7 +38,7 @@ UrlSuffix(gcc/Preprocessor-Options.html#index-D-1) ; duplicate: 'gcc/Overall-Options.html#index-E' I -UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) +UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) LangUrlSuffix_Algol68(ga68/Directory-options.html#index-I) L UrlSuffix(gcc/Directory-Options.html#index-L) LangUrlSuffix_D(gdc/Directory-Options.html#index-L) diff --git a/gcc/rust/lang.opt.urls b/gcc/rust/lang.opt.urls index 33a54b4dea79..09cfede81436 100644 --- a/gcc/rust/lang.opt.urls +++ b/gcc/rust/lang.opt.urls @@ -1,7 +1,7 @@ ; Autogenerated by regenerate-opt-urls.py from gcc/rust/lang.opt and generated HTML I -UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) +UrlSuffix(gcc/Directory-Options.html#index-I) LangUrlSuffix_D(gdc/Directory-Options.html#index-I) LangUrlSuffix_Algol68(ga68/Directory-options.html#index-I) L UrlSuffix(gcc/Directory-Options.html#index-L) LangUrlSuffix_D(gdc/Directory-Options.html#index-L) From 65a3849eb46df2fbac6b41ff78dae13c85387f9e Mon Sep 17 00:00:00 2001 From: Tamar Christina Date: Sun, 30 Nov 2025 07:29:50 +0000 Subject: [PATCH 192/373] vect: support vectorization of early break forced live IVs as scalar Consider this simple loop long long arr[1024]; long long *f() { int i; for (i = 0; i < 1024; i++) if (arr[i] == 42) break; return arr + i; } where today we generate this at -O3: .L2: add v29.4s, v29.4s, v25.4s add v28.4s, v28.4s, v26.4s cmp x2, x1 beq .L9 .L6: ldp q30, q31, [x1], 32 cmeq v30.2d, v30.2d, v27.2d cmeq v31.2d, v31.2d, v27.2d addhn v31.2s, v31.2d, v30.2d fmov x3, d31 cbz x3, .L2 but which is highly inefficient. This loops has 3 IVs (PR119577), one normal scalar one, two vector ones, one counting up and one counting down (PR115120) and has a forced unrolling due to an increase in VF because of the mismatch in modes between the IVs and the loop body (PR119860). This patch fixed all three of these issues and we now generate: .L2: add w2, w2, 2 cmp w2, 1024 beq .L13 .L5: ldr q31, [x1] add x1, x1, 16 cmeq v31.2d, v31.2d, v30.2d umaxp v31.4s, v31.4s, v31.4s fmov x0, d31 cbz x0, .L2 or with sve .L3: add x1, x1, x3 whilelo p7.d, w1, w2 b.none .L11 .L4: ld1d z30.d, p7/z, [x0, x1, lsl 3] cmpeq p7.d, p7/z, z30.d, z31.d b.none .L3 which shows that the new scalar IV is efficiently merged with the loop control one based on IVopts. To accomplish this the patch reworks how we handle "forced lived inductions" with regard to vectorization. Prior to this change when we vectorize a loop with early break any induction variables would be forced live. Forcing live means that even though the values aren't used inside the loop we must preserve the values such that when we start the scalar loop we can pass the correct initial values. However this had several side-effects: 1. We must be able to vectorize the induction. 2. The induction variable participates in VF determination. This would often times lead to a higher VF than would have normally been needed. As such the vector loops become less profitable. 3. IVcannon on constant loop iterations inserts a downward counting IV in addition to the upwards one in order to support things like doloops. Normally this duplicate IV is removed by IV opts, but IV doesn't understand vector inductions. As such we end up with 3 IVs. This patch fixes all three of these by choosing instead to create a new scalar IV that's adjusted within the loop and to update all the IV statements outside the loop by using this new IV. We re-use vect_update_ivs_after_vectorizer for all exits now and put in a dummy value representing the IV that is to be generated later. To do this we delay when we call vect_update_ivs_after_vectorizer until after the skip_epilogue edge is created and vect_update_ivs_after_vectorizer now updates all out of loop usages of IVs and not just that in the merge edge to the scalar loop. This not only generates better code, but negates the need to fixup the "forced live" scalar IVs later on. This new scalar IV is then materialized in vect_update_ivs_after_vectorizer_for_early_breaks. When PFA using masks by skipping iterations we now roll up the pfa IV into the new scalar IV by adjusting the first iteration back from start - niters_peel and then take the MAX to correctly handle the first iteration. Because we are now re-using vect_update_ivs_after_vectorizer we have an issue with UB clamping on non-linear inductions. At the moment when doing early exit updating I just ignore the possibility of UB since if the main exit is OK, the early exit is one iteration behind the main one and so should be ok. Things however get complicated with PEELED loops. gcc/ChangeLog: PR tree-optimization/115120 PR tree-optimization/119577 PR tree-optimization/119860 * tree-vect-loop-manip.cc (vect_can_advance_ivs_p): Check for nonlinear mult induction and early break. (vect_update_ivs_after_vectorizer): Support early break exits. (vect_do_peeling): Support scalar IVs. * tree-vect-loop.cc (vect_peel_nonlinear_iv_init): Support early break. (vect_update_nonlinear_iv): use `unsigned_type_for` such that function works for both vector and scalar types. (vectorizable_induction, vectorizable_live_operation): Remove vector early break IV code. (vect_update_ivs_after_vectorizer_for_early_breaks): New. (vect_transform_loop): Support new scalar IV for early break. * tree-vect-slp.cc (vect_analyze_slp): Remove SLP build for early break IVs. * tree-vect-stmts.cc (vect_stmt_relevant_p): No longer mark early break IVs as completely unused rather than used_only_live. They no longer contribute to the vector loop and so should not be analyzed. (can_vectorize_live_stmts): Remove vector early vreak IV code. * tree-vectorizer.h (LOOP_VINFO_EARLY_BRK_NITERS_VAR): New. (class loop_vec_info): Add early_break_niters_var. gcc/testsuite/ChangeLog: PR tree-optimization/115120 PR tree-optimization/119577 PR tree-optimization/119860 * gcc.dg/vect/vect-early-break_39.c: Update. * gcc.dg/vect/vect-early-break_139.c: New testcase. * gcc.target/aarch64/sve/peel_ind_10.c: Update. * gcc.target/aarch64/sve/peel_ind_11.c: Update. * gcc.target/aarch64/sve/peel_ind_12.c: Update. * gcc.target/aarch64/sve/peel_ind_5.c: Update. * gcc.target/aarch64/sve/peel_ind_6.c: Update. * gcc.target/aarch64/sve/peel_ind_7.c: Update. * gcc.target/aarch64/sve/peel_ind_9.c: Update. * gcc.target/aarch64/sve/pr119351.c --- .../gcc.dg/vect/vect-early-break_139.c | 37 +++ .../gcc.dg/vect/vect-early-break_39.c | 5 +- .../gcc.target/aarch64/sve/peel_ind_10.c | 1 - .../gcc.target/aarch64/sve/peel_ind_11.c | 1 - .../gcc.target/aarch64/sve/peel_ind_12.c | 1 - .../gcc.target/aarch64/sve/peel_ind_5.c | 1 - .../gcc.target/aarch64/sve/peel_ind_6.c | 1 - .../gcc.target/aarch64/sve/peel_ind_7.c | 1 - .../gcc.target/aarch64/sve/peel_ind_9.c | 4 +- .../gcc.target/aarch64/sve/pr119351.c | 1 - gcc/tree-vect-loop-manip.cc | 77 ++++-- gcc/tree-vect-loop.cc | 238 ++++++++++-------- gcc/tree-vect-slp.cc | 42 ---- gcc/tree-vect-stmts.cc | 28 +-- gcc/tree-vectorizer.h | 8 +- 15 files changed, 246 insertions(+), 200 deletions(-) create mode 100644 gcc/testsuite/gcc.dg/vect/vect-early-break_139.c diff --git a/gcc/testsuite/gcc.dg/vect/vect-early-break_139.c b/gcc/testsuite/gcc.dg/vect/vect-early-break_139.c new file mode 100644 index 000000000000..95994936c432 --- /dev/null +++ b/gcc/testsuite/gcc.dg/vect/vect-early-break_139.c @@ -0,0 +1,37 @@ +/* { dg-add-options vect_early_break } */ +/* { dg-require-effective-target vect_early_break_hw } */ +/* { dg-require-effective-target vect_int } */ + +/* { dg-final { scan-tree-dump "LOOP VECTORIZED" "vect" } } */ + +#include "tree-vect.h" + +__attribute__((noipa)) +unsigned loop9(unsigned char *a, unsigned n, unsigned c) +{ + for (unsigned j = 0;;) + { + if (c <= j) + __builtin_abort(); + + unsigned char *slot = (unsigned char *)a + j; + + *slot = (char)j; + + unsigned d = j + 1; + if (d < n) + j = d; + else + return d; + } +} + +int main () +{ + check_vect (); + + unsigned char buff[16] = {0}; + unsigned res = loop9 (buff, 16, 20); + if (res != 16) + __builtin_abort (); +} diff --git a/gcc/testsuite/gcc.dg/vect/vect-early-break_39.c b/gcc/testsuite/gcc.dg/vect/vect-early-break_39.c index b3f40b8c9ba4..bc862ad20e68 100644 --- a/gcc/testsuite/gcc.dg/vect/vect-early-break_39.c +++ b/gcc/testsuite/gcc.dg/vect/vect-early-break_39.c @@ -23,5 +23,6 @@ unsigned test4(unsigned x, unsigned n) return ret; } -/* cannot safely vectorize this due due to the group misalignment. */ -/* { dg-final { scan-tree-dump-times "vectorized 1 loops in function" 0 "vect" } } */ +/* AArch64 will scalarize the load and is able to vectorize it. */ +/* { dg-final { scan-tree-dump-times "vectorized 1 loops in function" 1 "vect" { target aarch64*-*-* } } } */ +/* { dg-final { scan-tree-dump-times "vectorized 1 loops in function" 0 "vect" { target { ! aarch64*-*-* } } } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_10.c b/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_10.c index b7a7bc5cb0cf..43abd01c078d 100644 --- a/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_10.c +++ b/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_10.c @@ -20,5 +20,4 @@ foo (int start) } /* { dg-final { scan-tree-dump "LOOP VECTORIZED" "vect" } } */ -/* { dg-final { scan-tree-dump "pfa_iv_offset" "vect" } } */ /* { dg-final { scan-tree-dump "Alignment of access forced using peeling" "vect" } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_11.c b/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_11.c index feb7ee7d61c9..37806adea7b9 100644 --- a/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_11.c +++ b/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_11.c @@ -15,6 +15,5 @@ foo (int *a) { } /* { dg-final { scan-tree-dump "LOOP VECTORIZED" "vect" } } */ -/* { dg-final { scan-tree-dump "pfa_iv_offset" "vect" } } */ /* { dg-final { scan-tree-dump "Alignment of access forced using peeling" "vect" } } */ /* { dg-final { scan-assembler {\tnot\tp[0-7]\.b, p[0-7]/z, p.*\n} } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_12.c b/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_12.c index 260482a94df7..e3ed63afb05c 100644 --- a/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_12.c +++ b/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_12.c @@ -15,7 +15,6 @@ foo (int *restrict a, int * restrict b) { } /* { dg-final { scan-tree-dump "LOOP VECTORIZED" "vect" } } */ -/* { dg-final { scan-tree-dump "pfa_iv_offset" "vect" } } */ /* { dg-final { scan-tree-dump "Both peeling and versioning will be applied" "vect" } } */ /* { dg-final { scan-assembler {\tnot\tp[0-7]\.b, p[0-7]/z, p.*\n} } } */ /* { dg-final { scan-assembler {\teor\t.*\n} } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_5.c b/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_5.c index a03bb1dec21e..1977bf3af2db 100644 --- a/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_5.c +++ b/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_5.c @@ -20,5 +20,4 @@ foo (void) } /* { dg-final { scan-tree-dump "LOOP VECTORIZED" "vect" } } */ -/* { dg-final { scan-tree-dump "pfa_iv_offset" "vect" } } */ /* { dg-final { scan-tree-dump "Alignment of access forced using peeling" "vect" } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_6.c b/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_6.c index 9bfd1a65c4fe..0b40d26ae2a3 100644 --- a/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_6.c +++ b/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_6.c @@ -20,5 +20,4 @@ foo (int start) } /* { dg-final { scan-tree-dump "LOOP VECTORIZED" "vect" } } */ -/* { dg-final { scan-tree-dump "pfa_iv_offset" "vect" } } */ /* { dg-final { scan-tree-dump "Alignment of access forced using peeling" "vect" } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_7.c b/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_7.c index 0182e131a173..7a24d689e95a 100644 --- a/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_7.c +++ b/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_7.c @@ -20,5 +20,4 @@ foo (void) } /* { dg-final { scan-tree-dump "LOOP VECTORIZED" "vect" } } */ -/* { dg-final { scan-tree-dump "pfa_iv_offset" "vect" } } */ /* { dg-final { scan-tree-dump "Alignment of access forced using peeling" "vect" } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_9.c b/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_9.c index cc904e88170f..136d18c2ea89 100644 --- a/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_9.c +++ b/gcc/testsuite/gcc.target/aarch64/sve/peel_ind_9.c @@ -20,6 +20,6 @@ foo (void) } /* { dg-final { scan-tree-dump "LOOP VECTORIZED" "vect" } } */ -/* Peels using a scalar loop. */ -/* { dg-final { scan-tree-dump-not "pfa_iv_offset" "vect" } } */ +/* Peels using fully masked loop. */ +/* { dg-final { scan-tree-dump "misalignment for fully-masked loop" "vect" } } */ /* { dg-final { scan-tree-dump "Alignment of access forced using peeling" "vect" } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/sve/pr119351.c b/gcc/testsuite/gcc.target/aarch64/sve/pr119351.c index 1ebc735a82f4..1aca6c7de1d4 100644 --- a/gcc/testsuite/gcc.target/aarch64/sve/pr119351.c +++ b/gcc/testsuite/gcc.target/aarch64/sve/pr119351.c @@ -33,6 +33,5 @@ foo (void) } /* { dg-final { scan-tree-dump "LOOP VECTORIZED" "vect" } } */ -/* { dg-final { scan-tree-dump "pfa_iv_offset" "vect" } } */ /* { dg-final { scan-tree-dump "Alignment of access forced using peeling" "vect" } } */ diff --git a/gcc/tree-vect-loop-manip.cc b/gcc/tree-vect-loop-manip.cc index 9ddf9acf2f19..43847c4c3fbd 100644 --- a/gcc/tree-vect-loop-manip.cc +++ b/gcc/tree-vect-loop-manip.cc @@ -2161,6 +2161,16 @@ vect_can_peel_nonlinear_iv_p (loop_vec_info loop_vinfo, return false; } + if (LOOP_VINFO_EARLY_BREAKS (loop_vinfo) + && induction_type == vect_step_op_mul) + { + if (dump_enabled_p ()) + dump_printf_loc (MSG_MISSED_OPTIMIZATION, vect_location, + "Peeling for is not supported for nonlinear mult" + " induction using partial vectorization.\n"); + return false; + } + /* Avoid compile time hog on vect_peel_nonlinear_iv_init. */ if (induction_type == vect_step_op_mul) { @@ -2315,6 +2325,9 @@ vect_can_advance_ivs_p (loop_vec_info loop_vinfo) The phi args associated with the edge UPDATE_E in the bb UPDATE_E->dest are updated accordingly. + - EARLY_EXIT_P - Indicates whether the exit is an early exit rather than + the main latch exit. + Assumption 1: Like the rest of the vectorizer, this function assumes a single loop exit that has a single predecessor. @@ -2333,7 +2346,8 @@ vect_can_advance_ivs_p (loop_vec_info loop_vinfo) static void vect_update_ivs_after_vectorizer (loop_vec_info loop_vinfo, - tree niters, edge update_e) + tree niters, edge update_e, + bool early_exit_p) { gphi_iterator gsi, gsi1; class loop *loop = LOOP_VINFO_LOOP (loop_vinfo); @@ -2400,15 +2414,16 @@ vect_update_ivs_after_vectorizer (loop_vec_info loop_vinfo, else ni = vect_peel_nonlinear_iv_init (&stmts, init_expr, niters, step_expr, - induction_type); + induction_type, early_exit_p); var = create_tmp_var (type, "tmp"); gimple_seq new_stmts = NULL; ni_name = force_gimple_operand (ni, &new_stmts, false, var); - /* Exit_bb shouldn't be empty. */ - if (!gsi_end_p (last_gsi)) + /* Exit_bb shouldn't be empty, but we also can't insert after a ctrl + statements. */ + if (!gsi_end_p (last_gsi) && !is_ctrl_stmt (gsi_stmt (last_gsi))) { gsi_insert_seq_after (&last_gsi, stmts, GSI_SAME_STMT); gsi_insert_seq_after (&last_gsi, new_stmts, GSI_SAME_STMT); @@ -2419,8 +2434,15 @@ vect_update_ivs_after_vectorizer (loop_vec_info loop_vinfo, gsi_insert_seq_before (&last_gsi, new_stmts, GSI_SAME_STMT); } - /* Fix phi expressions in the successor bb. */ - adjust_phi_and_debug_stmts (phi1, update_e, ni_name); + /* Fix phi expressions in all out of loop bb. */ + imm_use_iterator imm_iter; + gimple *use_stmt; + use_operand_p use_p; + tree ic_var = PHI_ARG_DEF_FROM_EDGE (phi1, update_e); + FOR_EACH_IMM_USE_STMT (use_stmt, imm_iter, ic_var) + if (!flow_bb_inside_loop_p (loop, gimple_bb (use_stmt))) + FOR_EACH_IMM_USE_ON_STMT (use_p, imm_iter) + SET_USE (use_p, ni_name); } } @@ -3562,14 +3584,6 @@ vect_do_peeling (loop_vec_info loop_vinfo, tree niters, tree nitersm1, if (LOOP_VINFO_EARLY_BREAKS (loop_vinfo)) update_e = single_succ_edge (LOOP_VINFO_IV_EXIT (loop_vinfo)->dest); - /* If we have a peeled vector iteration, all exits are the same, leave it - and so the main exit needs to be treated the same as the alternative - exits in that we leave their updates to vectorizable_live_operations. - */ - if (!LOOP_VINFO_EARLY_BREAKS_VECT_PEELED (loop_vinfo)) - vect_update_ivs_after_vectorizer (loop_vinfo, niters_vector_mult_vf, - update_e); - /* If we have a peeled vector iteration we will never skip the epilog loop and we can simplify the cfg a lot by not doing the edge split. */ if (skip_epilog @@ -3625,6 +3639,41 @@ vect_do_peeling (loop_vec_info loop_vinfo, tree niters, tree nitersm1, scale_loop_profile (epilog, prob_epilog, -1); } + /* If we have a peeled vector iteration, all exits are the same, leave it + and so the main exit needs to be treated the same as the alternative + exits in that we leave their updates to vectorizable_live_operations. + */ + tree vector_iters_vf = niters_vector_mult_vf; + if (LOOP_VINFO_EARLY_BREAKS (loop_vinfo)) + { + tree scal_iv_ty = signed_type_for (TREE_TYPE (vector_iters_vf)); + tree tmp_niters_vf = make_ssa_name (scal_iv_ty); + basic_block exit_bb = NULL; + edge update_e = NULL; + + /* Identify the early exit merge block. I wish we had stored this. */ + for (auto e : get_loop_exit_edges (loop)) + if (e != LOOP_VINFO_IV_EXIT (loop_vinfo)) + { + exit_bb = e->dest; + update_e = single_succ_edge (exit_bb); + break; + } + vect_update_ivs_after_vectorizer (loop_vinfo, tmp_niters_vf, + update_e, true); + + if (LOOP_VINFO_EARLY_BREAKS_VECT_PEELED (loop_vinfo)) + vector_iters_vf = tmp_niters_vf; + + LOOP_VINFO_EARLY_BRK_NITERS_VAR (loop_vinfo) = tmp_niters_vf; + } + + bool recalculate_peel_niters_init + = LOOP_VINFO_EARLY_BREAKS_VECT_PEELED (loop_vinfo); + vect_update_ivs_after_vectorizer (loop_vinfo, vector_iters_vf, + update_e, + recalculate_peel_niters_init); + /* Recalculate the dominators after adding the guard edge. */ if (LOOP_VINFO_EARLY_BREAKS (loop_vinfo)) iterate_fix_dominators (CDI_DOMINATORS, doms, false); diff --git a/gcc/tree-vect-loop.cc b/gcc/tree-vect-loop.cc index ab6c0f084703..3ac264f0ce32 100644 --- a/gcc/tree-vect-loop.cc +++ b/gcc/tree-vect-loop.cc @@ -8951,14 +8951,25 @@ vect_create_nonlinear_iv_init (gimple_seq* stmts, tree init_expr, tree vect_peel_nonlinear_iv_init (gimple_seq* stmts, tree init_expr, tree skip_niters, tree step_expr, - enum vect_induction_op_type induction_type) + enum vect_induction_op_type induction_type, + bool early_exit_p) { - gcc_assert (TREE_CODE (skip_niters) == INTEGER_CST); + gcc_assert (TREE_CODE (skip_niters) == INTEGER_CST || early_exit_p); tree type = TREE_TYPE (init_expr); unsigned prec = TYPE_PRECISION (type); switch (induction_type) { + /* neg inductions are typically not used for loop termination conditions but + are typically implemented as b = -b. That is every scalar iteration b is + negated. That means that for the initial value of b we will have to + determine whether the number of skipped iteration is a multiple of 2 + because every 2 scalar iterations we are back at "b". */ case vect_step_op_neg: + /* For early exits the neg induction will always be the same value at the + start of the iteration. */ + if (early_exit_p) + break; + if (TREE_INT_CST_LOW (skip_niters) % 2) init_expr = gimple_build (stmts, NEGATE_EXPR, type, init_expr); /* else no change. */ @@ -8966,13 +8977,15 @@ vect_peel_nonlinear_iv_init (gimple_seq* stmts, tree init_expr, case vect_step_op_shr: case vect_step_op_shl: - skip_niters = gimple_convert (stmts, type, skip_niters); - step_expr = gimple_build (stmts, MULT_EXPR, type, step_expr, skip_niters); + skip_niters = fold_build1 (NOP_EXPR, type, skip_niters); + step_expr = fold_build1 (NOP_EXPR, type, step_expr); + step_expr = fold_build2 (MULT_EXPR, type, step_expr, skip_niters); /* When shift mount >= precision, need to avoid UD. In the original loop, there's no UD, and according to semantic, init_expr should be 0 for lshr, ashl, and >>= (prec - 1) for ashr. */ - if (!tree_fits_uhwi_p (step_expr) + if ((!tree_fits_uhwi_p (step_expr) || tree_to_uhwi (step_expr) >= prec) + && !early_exit_p) { if (induction_type == vect_step_op_shl || TYPE_UNSIGNED (type)) @@ -8983,13 +8996,19 @@ vect_peel_nonlinear_iv_init (gimple_seq* stmts, tree init_expr, wide_int_to_tree (type, prec - 1)); } else - init_expr = gimple_build (stmts, (induction_type == vect_step_op_shr + { + init_expr = fold_build2 ((induction_type == vect_step_op_shr ? RSHIFT_EXPR : LSHIFT_EXPR), - type, init_expr, step_expr); + type, init_expr, step_expr); + init_expr = force_gimple_operand (init_expr, stmts, false, NULL); + } break; case vect_step_op_mul: { + /* Due to UB we can't support vect_step_op_mul with early break for now. + so assert and block. */ + gcc_assert (TREE_CODE (skip_niters) == INTEGER_CST); tree utype = unsigned_type_for (type); init_expr = gimple_convert (stmts, utype, init_expr); wide_int skipn = wi::to_wide (skip_niters); @@ -9073,9 +9092,7 @@ vect_update_nonlinear_iv (gimple_seq* stmts, tree vectype, case vect_step_op_mul: { /* Use unsigned mult to avoid UD integer overflow. */ - tree uvectype - = build_vector_type (unsigned_type_for (TREE_TYPE (vectype)), - TYPE_VECTOR_SUBPARTS (vectype)); + tree uvectype = unsigned_type_for (vectype); vec_def = gimple_convert (stmts, uvectype, vec_def); vec_step = gimple_convert (stmts, uvectype, vec_step); vec_def = gimple_build (stmts, MULT_EXPR, uvectype, @@ -9322,7 +9339,7 @@ vectorizable_nonlinear_induction (loop_vec_info loop_vinfo, to adjust the start value here. */ if (niters_skip != NULL_TREE) init_expr = vect_peel_nonlinear_iv_init (&stmts, init_expr, niters_skip, - step_expr, induction_type); + step_expr, induction_type, false); vec_init = vect_create_nonlinear_iv_init (&stmts, init_expr, step_expr, nunits, vectype, @@ -9703,53 +9720,6 @@ vectorizable_induction (loop_vec_info loop_vinfo, LOOP_VINFO_MASK_SKIP_NITERS (loop_vinfo)); peel_mul = gimple_build_vector_from_val (&init_stmts, step_vectype, peel_mul); - - /* If early break then we have to create a new PHI which we can use as - an offset to adjust the induction reduction in early exits. - - This is because when peeling for alignment using masking, the first - few elements of the vector can be inactive. As such if we find the - entry in the first iteration we have adjust the starting point of - the scalar code. - - We do this by creating a new scalar PHI that keeps track of whether - we are the first iteration of the loop (with the additional masking) - or whether we have taken a loop iteration already. - - The generated sequence: - - pre-header: - bb1: - i_1 = - - header: - bb2: - i_2 = PHI - … - - early-exit: - bb3: - i_3 = iv_step * i_2 + PHI - - The first part of the adjustment to create i_1 and i_2 are done here - and the last part creating i_3 is done in - vectorizable_live_operations when the induction extraction is - materialized. */ - if (LOOP_VINFO_EARLY_BREAKS (loop_vinfo) - && !LOOP_VINFO_MASK_NITERS_PFA_OFFSET (loop_vinfo)) - { - auto skip_niters = LOOP_VINFO_MASK_SKIP_NITERS (loop_vinfo); - tree ty_skip_niters = TREE_TYPE (skip_niters); - tree break_lhs_phi = vect_get_new_vect_var (ty_skip_niters, - vect_scalar_var, - "pfa_iv_offset"); - gphi *nphi = create_phi_node (break_lhs_phi, bb); - add_phi_arg (nphi, skip_niters, pe, UNKNOWN_LOCATION); - add_phi_arg (nphi, build_zero_cst (ty_skip_niters), - loop_latch_edge (iv_loop), UNKNOWN_LOCATION); - - LOOP_VINFO_MASK_NITERS_PFA_OFFSET (loop_vinfo) = PHI_RESULT (nphi); - } } tree step_mul = NULL_TREE; unsigned ivn; @@ -10325,8 +10295,7 @@ vectorizable_live_operation (vec_info *vinfo, stmt_vec_info stmt_info, to the latch then we're restarting the iteration in the scalar loop. So get the first live value. */ bool early_break_first_element_p - = (all_exits_as_early_p || !main_exit_edge) - && STMT_VINFO_DEF_TYPE (stmt_info) == vect_induction_def; + = all_exits_as_early_p || !main_exit_edge; if (early_break_first_element_p) { tmp_vec_lhs = vec_lhs0; @@ -10335,52 +10304,13 @@ vectorizable_live_operation (vec_info *vinfo, stmt_vec_info stmt_info, gimple_stmt_iterator exit_gsi; tree new_tree - = vectorizable_live_operation_1 (loop_vinfo, - e->dest, vectype, - slp_node, bitsize, - tmp_bitstart, tmp_vec_lhs, - lhs_type, &exit_gsi); + = vectorizable_live_operation_1 (loop_vinfo, + e->dest, vectype, + slp_node, bitsize, + tmp_bitstart, tmp_vec_lhs, + lhs_type, &exit_gsi); auto gsi = gsi_for_stmt (use_stmt); - if (early_break_first_element_p - && LOOP_VINFO_MASK_NITERS_PFA_OFFSET (loop_vinfo)) - { - tree step_expr - = STMT_VINFO_LOOP_PHI_EVOLUTION_PART (stmt_info); - tree break_lhs_phi - = LOOP_VINFO_MASK_NITERS_PFA_OFFSET (loop_vinfo); - tree ty_skip_niters = TREE_TYPE (break_lhs_phi); - gimple_seq iv_stmts = NULL; - - /* Now create the PHI for the outside loop usage to - retrieve the value for the offset counter. */ - tree rphi_step - = gimple_convert (&iv_stmts, ty_skip_niters, step_expr); - tree tmp2 - = gimple_build (&iv_stmts, MULT_EXPR, - ty_skip_niters, rphi_step, - break_lhs_phi); - - if (POINTER_TYPE_P (TREE_TYPE (new_tree))) - { - tmp2 = gimple_convert (&iv_stmts, sizetype, tmp2); - tmp2 = gimple_build (&iv_stmts, POINTER_PLUS_EXPR, - TREE_TYPE (new_tree), new_tree, - tmp2); - } - else - { - tmp2 = gimple_convert (&iv_stmts, TREE_TYPE (new_tree), - tmp2); - tmp2 = gimple_build (&iv_stmts, PLUS_EXPR, - TREE_TYPE (new_tree), new_tree, - tmp2); - } - - new_tree = tmp2; - gsi_insert_seq_before (&exit_gsi, iv_stmts, GSI_SAME_STMT); - } - tree lhs_phi = gimple_phi_result (use_stmt); remove_phi_node (&gsi, false); gimple *copy = gimple_build_assign (lhs_phi, new_tree); @@ -11021,6 +10951,101 @@ move_early_exit_stmts (loop_vec_info loop_vinfo) SET_PHI_ARG_DEF_ON_EDGE (phi, e, last_seen_vuse); } +/* Generate adjustment code for early break scalar IVs filling in the value + we created earlier on for LOOP_VINFO_EARLY_BRK_NITERS_VAR. */ + +static void +vect_update_ivs_after_vectorizer_for_early_breaks (loop_vec_info loop_vinfo) +{ + DUMP_VECT_SCOPE ("vect_update_ivs_after_vectorizer_for_early_breaks"); + + if (!LOOP_VINFO_EARLY_BREAKS (loop_vinfo)) + return; + + gcc_assert (LOOP_VINFO_EARLY_BRK_NITERS_VAR (loop_vinfo)); + + tree phi_var = LOOP_VINFO_EARLY_BRK_NITERS_VAR (loop_vinfo); + tree niters_skip = LOOP_VINFO_MASK_SKIP_NITERS (loop_vinfo); + poly_uint64 vf = LOOP_VINFO_VECT_FACTOR (loop_vinfo); + tree ty_var = TREE_TYPE (phi_var); + auto loop = LOOP_VINFO_LOOP (loop_vinfo); + tree induc_var = niters_skip ? copy_ssa_name (phi_var) : phi_var; + + auto induction_phi = create_phi_node (induc_var, loop->header); + tree induc_def = PHI_RESULT (induction_phi); + + /* Create the iv update inside the loop. */ + gimple_seq init_stmts = NULL; + gimple_seq stmts = NULL; + gimple_seq iv_stmts = NULL; + tree tree_vf = build_int_cst (ty_var, vf); + + /* For loop len targets we have to use .SELECT_VL (ivtmp_33, VF); instead of + just += VF as the VF can change in between two loop iterations. */ + if (LOOP_VINFO_USING_SELECT_VL_P (loop_vinfo)) + { + vec_loop_lens *lens = &LOOP_VINFO_LENS (loop_vinfo); + tree_vf = vect_get_loop_len (loop_vinfo, NULL, lens, 1, + NULL_TREE, 0, 0); + } + + tree iter_var; + if (POINTER_TYPE_P (ty_var)) + { + tree offset = gimple_convert (&stmts, sizetype, tree_vf); + iter_var = gimple_build (&stmts, POINTER_PLUS_EXPR, ty_var, induc_def, + gimple_convert (&stmts, sizetype, offset)); + } + else + { + tree offset = gimple_convert (&stmts, ty_var, tree_vf); + iter_var = gimple_build (&stmts, PLUS_EXPR, ty_var, induc_def, offset); + } + + tree init_var = build_zero_cst (ty_var); + if (niters_skip) + init_var = gimple_build (&init_stmts, MINUS_EXPR, ty_var, init_var, + gimple_convert (&init_stmts, ty_var, niters_skip)); + + add_phi_arg (induction_phi, iter_var, + loop_latch_edge (loop), UNKNOWN_LOCATION); + add_phi_arg (induction_phi, init_var, + loop_preheader_edge (loop), UNKNOWN_LOCATION); + + /* Find the first insertion point in the BB. */ + auto pe = loop_preheader_edge (loop); + + /* If we've done any peeling, calculate the peeling adjustment needed to the + final IV. */ + if (niters_skip) + { + induc_def = gimple_build (&iv_stmts, MAX_EXPR, TREE_TYPE (induc_def), + induc_def, + build_zero_cst (TREE_TYPE (induc_def))); + auto stmt = gimple_build_assign (phi_var, induc_def); + gimple_seq_add_stmt_without_update (&iv_stmts, stmt); + basic_block exit_bb = NULL; + /* Identify the early exit merge block. I wish we had stored this. */ + for (auto e : get_loop_exit_edges (loop)) + if (e != LOOP_VINFO_IV_EXIT (loop_vinfo)) + { + exit_bb = e->dest; + break; + } + + gcc_assert (exit_bb); + auto exit_gsi = gsi_after_labels (exit_bb); + gsi_insert_seq_before (&exit_gsi, iv_stmts, GSI_SAME_STMT); + } + /* Write the init_stmts in the loop-preheader block. */ + auto psi = gsi_last_nondebug_bb (pe->src); + gsi_insert_seq_after (&psi, init_stmts, GSI_LAST_NEW_STMT); + /* Wite the adjustments in the header block. */ + basic_block bb = loop->header; + auto si = gsi_after_labels (bb); + gsi_insert_seq_before (&si, stmts, GSI_SAME_STMT); +} + /* Function vect_transform_loop. The analysis phase has determined that the loop is vectorizable. @@ -11165,7 +11190,10 @@ vect_transform_loop (loop_vec_info loop_vinfo, gimple *loop_vectorized_call) /* Handle any code motion that we need to for early-break vectorization after we've done peeling but just before we start vectorizing. */ if (LOOP_VINFO_EARLY_BREAKS (loop_vinfo)) - move_early_exit_stmts (loop_vinfo); + { + vect_update_ivs_after_vectorizer_for_early_breaks (loop_vinfo); + move_early_exit_stmts (loop_vinfo); + } /* Remove existing clobber stmts and prefetches. */ for (i = 0; i < nbbs; i++) diff --git a/gcc/tree-vect-slp.cc b/gcc/tree-vect-slp.cc index 5b0de9291cb0..658ad6dc2579 100644 --- a/gcc/tree-vect-slp.cc +++ b/gcc/tree-vect-slp.cc @@ -5885,48 +5885,6 @@ vect_analyze_slp (vec_info *vinfo, unsigned max_tree_size, "SLP build failed.\n"); } } - - /* Find and create slp instances for inductions that have been forced - live due to early break. */ - edge latch_e = loop_latch_edge (LOOP_VINFO_LOOP (loop_vinfo)); - for (auto stmt_info : LOOP_VINFO_EARLY_BREAKS_LIVE_IVS (loop_vinfo)) - { - vec stmts; - vec roots = vNULL; - vec remain = vNULL; - gphi *phi = as_a (STMT_VINFO_STMT (stmt_info)); - tree def = gimple_phi_arg_def_from_edge (phi, latch_e); - stmt_vec_info lc_info = loop_vinfo->lookup_def (def); - if (lc_info) - { - stmts.create (1); - stmts.quick_push (vect_stmt_to_vectorize (lc_info)); - if (! vect_build_slp_instance (vinfo, slp_inst_kind_reduc_group, - stmts, roots, remain, - max_tree_size, &limit, - bst_map, force_single_lane)) - return opt_result::failure_at (vect_location, - "SLP build failed.\n"); - } - /* When the latch def is from a different cycle this can only - be a induction. Build a simple instance for this. - ??? We should be able to start discovery from the PHI - for all inductions, but then there will be stray - non-SLP stmts we choke on as needing non-SLP handling. */ - auto_vec tem; - tem.quick_push (stmt_info); - if (!bst_map->get (tem)) - { - stmts.create (1); - stmts.quick_push (stmt_info); - if (! vect_build_slp_instance (vinfo, slp_inst_kind_reduc_group, - stmts, roots, remain, - max_tree_size, &limit, - bst_map, force_single_lane)) - return opt_result::failure_at (vect_location, - "SLP build failed.\n"); - } - } } hash_set visited_patterns; diff --git a/gcc/tree-vect-stmts.cc b/gcc/tree-vect-stmts.cc index de28316ddc66..1d7e50afcde1 100644 --- a/gcc/tree-vect-stmts.cc +++ b/gcc/tree-vect-stmts.cc @@ -356,7 +356,6 @@ is_simple_and_all_uses_invariant (stmt_vec_info stmt_info, - it has uses outside the loop. - it has vdefs (it alters memory). - control stmts in the loop (except for the exit condition). - - it is an induction and we have multiple exits. CHECKME: what other side effects would the vectorizer allow? */ @@ -418,26 +417,6 @@ vect_stmt_relevant_p (stmt_vec_info stmt_info, loop_vec_info loop_vinfo, } } - /* Check if it's a not live PHI and multiple exits. In this case - there will be a usage later on after peeling which is needed for the - alternate exit. - ??? Unless the PHI was marked live because of early - break, which also needs the latch def live and vectorized. */ - if (LOOP_VINFO_EARLY_BREAKS (loop_vinfo) - && is_a (stmt) - && gimple_bb (stmt) == LOOP_VINFO_LOOP (loop_vinfo)->header - && ((! VECTORIZABLE_CYCLE_DEF (STMT_VINFO_DEF_TYPE (stmt_info)) - && ! *live_p) - || STMT_VINFO_DEF_TYPE (stmt_info) == vect_induction_def)) - { - if (dump_enabled_p ()) - dump_printf_loc (MSG_NOTE, vect_location, - "vec_stmt_relevant_p: PHI forced live for " - "early break.\n"); - LOOP_VINFO_EARLY_BREAKS_LIVE_IVS (loop_vinfo).safe_push (stmt_info); - *live_p = true; - } - if (*live_p && *relevant == vect_unused_in_scope && !is_simple_and_all_uses_invariant (stmt_info, loop_vinfo)) { @@ -12985,17 +12964,12 @@ can_vectorize_live_stmts (vec_info *vinfo, bool vec_stmt_p, stmt_vector_for_cost *cost_vec) { - loop_vec_info loop_vinfo = dyn_cast (vinfo); stmt_vec_info slp_stmt_info; unsigned int i; FOR_EACH_VEC_ELT (SLP_TREE_SCALAR_STMTS (slp_node), i, slp_stmt_info) { if (slp_stmt_info - && (STMT_VINFO_LIVE_P (slp_stmt_info) - || (loop_vinfo - && LOOP_VINFO_EARLY_BREAKS (loop_vinfo) - && STMT_VINFO_DEF_TYPE (slp_stmt_info) - == vect_induction_def)) + && STMT_VINFO_LIVE_P (slp_stmt_info) && !vectorizable_live_operation (vinfo, slp_stmt_info, slp_node, slp_node_instance, i, vec_stmt_p, cost_vec)) diff --git a/gcc/tree-vectorizer.h b/gcc/tree-vectorizer.h index 5d125afa6bc5..0356b129e36f 100644 --- a/gcc/tree-vectorizer.h +++ b/gcc/tree-vectorizer.h @@ -1241,6 +1241,10 @@ typedef class _loop_vec_info : public vec_info { happen. */ auto_vec early_break_vuses; + /* The IV adjustment value for inductions that needs to be materialized + inside the relavent exit blocks in order to adjust for early break. */ + tree early_break_niters_var; + /* Record statements that are needed to be live for early break vectorization but may not have an LC PHI node materialized yet in the exits. */ auto_vec early_break_live_ivs; @@ -1308,6 +1312,7 @@ typedef class _loop_vec_info : public vec_info { (L)->early_break_live_ivs #define LOOP_VINFO_EARLY_BRK_DEST_BB(L) (L)->early_break_dest_bb #define LOOP_VINFO_EARLY_BRK_VUSES(L) (L)->early_break_vuses +#define LOOP_VINFO_EARLY_BRK_NITERS_VAR(L) (L)->early_break_niters_var #define LOOP_VINFO_LOOP_CONDS(L) (L)->conds #define LOOP_VINFO_LOOP_IV_COND(L) (L)->loop_iv_cond #define LOOP_VINFO_NO_DATA_DEPENDENCIES(L) (L)->no_data_dependencies @@ -2716,7 +2721,8 @@ extern tree cse_and_gimplify_to_preheader (loop_vec_info, tree); /* Nonlinear induction. */ extern tree vect_peel_nonlinear_iv_init (gimple_seq*, tree, tree, - tree, enum vect_induction_op_type); + tree, enum vect_induction_op_type, + bool); /* In tree-vect-slp.cc. */ extern void vect_slp_init (void); From d3f638f4dfe67f50ba298890258ef6466705f0fa Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Sun, 30 Nov 2025 15:52:27 +0100 Subject: [PATCH 193/373] c++: Fix error recovery in cp_hide_range_decl [PR122465] The following testcase shows that range_decl in cp_hide_range_decl is sometimes also NULL_TREE and not just error_mark_node, and the function IMHO should treat both the same, not try to hide anything in that case because it doesn't know what should be hidden. This ICEs during error recovery since something like cp_hide_range_decl has been introduced (earlier it wasn't called that way). The fix tweaks cp_parser_simple_declaration, such that it stores error_mark_node instead of NULL_TREE into *maybe_range_for_decl in the erroneous cases. 2025-11-30 Jakub Jelinek PR c++/122465 * parser.cc (cp_parser_simple_declaration): Adjust function comment. Set *maybe_range_for_decl to error_mark_node instead of keeping it NULL_TREE in error cases or when followed by CPP_COLON. * g++.dg/cpp0x/pr122465.C: New test. --- gcc/cp/parser.cc | 20 ++++++++++---------- gcc/testsuite/g++.dg/cpp0x/pr122465.C | 10 ++++++++++ 2 files changed, 20 insertions(+), 10 deletions(-) create mode 100644 gcc/testsuite/g++.dg/cpp0x/pr122465.C diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc index 786212713dbc..4289f47e1b23 100644 --- a/gcc/cp/parser.cc +++ b/gcc/cp/parser.cc @@ -17086,8 +17086,9 @@ cp_parser_block_declaration (cp_parser *parser, If MAYBE_RANGE_FOR_DECL is not NULL, the pointed tree will be set to the parsed declaration if it is an uninitialized single declarator not followed - by a `;', or to error_mark_node otherwise. Either way, the trailing `;', - if present, will not be consumed. */ + by a `;', or to NULL_TREE when not followed by `:' or to error_mark_node + otherwise. Either way, the trailing `;', if present, will not be + consumed. */ static void cp_parser_simple_declaration (cp_parser* parser, @@ -17139,7 +17140,7 @@ cp_parser_simple_declaration (cp_parser* parser, && !decl_specifiers.any_specifiers_p) { cp_parser_error (parser, "expected declaration"); - goto done; + goto error_out; } /* If the next two tokens are both identifiers, the code is @@ -17155,7 +17156,7 @@ cp_parser_simple_declaration (cp_parser* parser, looking at a declaration. */ cp_parser_commit_to_tentative_parse (parser); /* Give up. */ - goto done; + goto error_out; } cp_parser_maybe_commit_to_declaration (parser, &decl_specifiers); @@ -17180,11 +17181,7 @@ cp_parser_simple_declaration (cp_parser* parser, if (token->type == CPP_SEMICOLON) goto finish; else if (maybe_range_for_decl) - { - if (*maybe_range_for_decl == NULL_TREE) - *maybe_range_for_decl = error_mark_node; - goto finish; - } + goto finish; /* Anything else is an error. */ else { @@ -17263,7 +17260,7 @@ cp_parser_simple_declaration (cp_parser* parser, statement is treated as a declaration-statement until proven otherwise.) */ if (cp_parser_error_occurred (parser)) - goto done; + goto error_out; if (auto_specifier_p && cxx_dialect >= cxx14) { @@ -17401,6 +17398,9 @@ cp_parser_simple_declaration (cp_parser* parser, if (comma_loc != UNKNOWN_LOCATION) error_at (comma_loc, "multiple declarations in range-based % loop"); + error_out: + if (maybe_range_for_decl && *maybe_range_for_decl == NULL_TREE) + *maybe_range_for_decl = error_mark_node; } done: diff --git a/gcc/testsuite/g++.dg/cpp0x/pr122465.C b/gcc/testsuite/g++.dg/cpp0x/pr122465.C new file mode 100644 index 000000000000..b8de3d417b40 --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp0x/pr122465.C @@ -0,0 +1,10 @@ +// PR c++/122465 +// { dg-do compile { target c++11 } } + +void +foo () +{ + int x = 0; + for (const T i = { i } : x) // { dg-error "'T' does not name a type" } + ; +} From c85bf98ad29840d9829e1f5a2d9859a2fbad2037 Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sun, 30 Nov 2025 13:48:00 +0100 Subject: [PATCH 194/373] fortran: testsuite: fix matching of language lists in diagnostics MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A few Fortran tests that pass both Fortran and C programs in the same compilation check for warnings like: { dg-warning "command-line option '-fcheck=all' is valid for Fortran but not for C" "" { target *-*-* } 0 } The problem is that the warning may actually indicate the option is valid for other languages other than Fortran. Like in: warning: command-line option ‘-fcheck=all’ is valid for Algol68/Fortran but not for C This patch modifies the regexps used in the tests in order to match the language list strings generated by opts-global.cc:write_langs. Tested in x86_64-linux-gnu with make check-gfortran. gcc/testsuite/ChangeLog PR fortran/122923 * gfortran.dg/ISO_Fortran_binding_17.f90: Recognize language list in warning regexp. * gfortran.dg/c-interop/allocate-errors.f90: Likewise. * gfortran.dg/c-interop/establish-errors.f90: Likewise. * gfortran.dg/c-interop/pr113338.f90: Likewise. * gfortran.dg/c-interop/section-errors.f90: Likewise. * gfortran.dg/c-interop/select-errors.f90: Likewise. * gfortran.dg/c-interop/setpointer-errors.f90: Likewise. --- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_17.f90 | 2 +- gcc/testsuite/gfortran.dg/c-interop/allocate-errors.f90 | 2 +- gcc/testsuite/gfortran.dg/c-interop/establish-errors.f90 | 2 +- gcc/testsuite/gfortran.dg/c-interop/pr113338.f90 | 2 +- gcc/testsuite/gfortran.dg/c-interop/section-errors.f90 | 2 +- gcc/testsuite/gfortran.dg/c-interop/select-errors.f90 | 2 +- gcc/testsuite/gfortran.dg/c-interop/setpointer-errors.f90 | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_17.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_17.f90 index c399e710ce97..43a011526ce3 100644 --- a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_17.f90 +++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_17.f90 @@ -1,7 +1,7 @@ ! { dg-do run } ! { dg-additional-sources ISO_Fortran_binding_17.c } ! { dg-options "-fcheck=all" } -! { dg-warning "command-line option '-fcheck=all' is valid for Fortran but not for C" "" { target *-*-* } 0 } +! { dg-warning "command-line option '-fcheck=all' is valid for (\[a-zA-Z0-9]+/)*Fortran(/\[a-zA-Z0-9]+)* but not for C" "" { target *-*-* } 0 } ! ! PR fortran/92470 ! diff --git a/gcc/testsuite/gfortran.dg/c-interop/allocate-errors.f90 b/gcc/testsuite/gfortran.dg/c-interop/allocate-errors.f90 index a58d05a33681..57bc709bc160 100644 --- a/gcc/testsuite/gfortran.dg/c-interop/allocate-errors.f90 +++ b/gcc/testsuite/gfortran.dg/c-interop/allocate-errors.f90 @@ -1,7 +1,7 @@ ! { dg-do run } ! { dg-additional-sources "allocate-errors-c.c dump-descriptors.c" } ! { dg-additional-options "-Wno-error -fcheck=all" } -! { dg-warning "command-line option '-fcheck=all' is valid for Fortran but not for C" "" { target *-*-* } 0 } +! { dg-warning "command-line option '-fcheck=all' is valid for (\[a-zA-Z0-9]+/)*Fortran(/\[a-zA-Z0-9]+)* but not for C" "" { target *-*-* } 0 } ! ! This program tests that the CFI_allocate and CFI_deallocate functions ! properly detect invalid arguments. All the interesting things happen diff --git a/gcc/testsuite/gfortran.dg/c-interop/establish-errors.f90 b/gcc/testsuite/gfortran.dg/c-interop/establish-errors.f90 index 307a2664b743..9dc88895bac9 100644 --- a/gcc/testsuite/gfortran.dg/c-interop/establish-errors.f90 +++ b/gcc/testsuite/gfortran.dg/c-interop/establish-errors.f90 @@ -2,7 +2,7 @@ ! { dg-do run } ! { dg-additional-sources "establish-errors-c.c dump-descriptors.c" } ! { dg-additional-options "-Wno-error -fcheck=all" } -! { dg-warning "command-line option '-fcheck=all' is valid for Fortran but not for C" "" { target *-*-* } 0 } +! { dg-warning "command-line option '-fcheck=all' is valid for (\[a-zA-Z0-9]+/)*Fortran(/\[a-zA-Z0-9]+)* but not for C" "" { target *-*-* } 0 } ! ! This program tests that the CFI_establish function properly detects ! invalid arguments. All the interesting things happen in the diff --git a/gcc/testsuite/gfortran.dg/c-interop/pr113338.f90 b/gcc/testsuite/gfortran.dg/c-interop/pr113338.f90 index a83c3ca93faa..6da3378bb93c 100644 --- a/gcc/testsuite/gfortran.dg/c-interop/pr113338.f90 +++ b/gcc/testsuite/gfortran.dg/c-interop/pr113338.f90 @@ -1,7 +1,7 @@ ! { dg-do run } ! { dg-additional-sources pr113338-c.c } ! { dg-additional-options "-Wno-error -O2 -std=f2018" } -! { dg-warning "command-line option '-std=f2018' is valid for Fortran but not for C" "" { target *-*-* } 0 } +! { dg-warning "command-line option '-std=f2018' is valid for (\[a-zA-Z0-9]+/)*Fortran(/\[a-zA-Z0-9]+)* but not for C" "" { target *-*-* } 0 } ! ! PR fortran/113338 - F2018 extensions to interoperability of procedures diff --git a/gcc/testsuite/gfortran.dg/c-interop/section-errors.f90 b/gcc/testsuite/gfortran.dg/c-interop/section-errors.f90 index 28328b799b30..bc52917a79fa 100644 --- a/gcc/testsuite/gfortran.dg/c-interop/section-errors.f90 +++ b/gcc/testsuite/gfortran.dg/c-interop/section-errors.f90 @@ -1,7 +1,7 @@ ! { dg-do run } ! { dg-additional-sources "section-errors-c.c dump-descriptors.c" } ! { dg-additional-options "-Wno-error -fcheck=all" } -! { dg-warning "command-line option '-fcheck=all' is valid for Fortran but not for C" "" { target *-*-* } 0 } +! { dg-warning "command-line option '-fcheck=all' is valid for (\[a-zA-Z0-9]+/)*Fortran(/\[a-zA-Z0-9]+)* but not for C" "" { target *-*-* } 0 } ! ! This program tests that the CFI_section function properly detects ! invalid arguments. All the interesting things happen in the diff --git a/gcc/testsuite/gfortran.dg/c-interop/select-errors.f90 b/gcc/testsuite/gfortran.dg/c-interop/select-errors.f90 index b719c9e68679..584a302fc34a 100644 --- a/gcc/testsuite/gfortran.dg/c-interop/select-errors.f90 +++ b/gcc/testsuite/gfortran.dg/c-interop/select-errors.f90 @@ -1,7 +1,7 @@ ! { dg-do run } ! { dg-additional-sources "select-errors-c.c dump-descriptors.c" } ! { dg-additional-options "-Wno-error -fcheck=all" } -! { dg-warning "command-line option '-fcheck=all' is valid for Fortran but not for C" "" { target *-*-* } 0 } +! { dg-warning "command-line option '-fcheck=all' is valid for (\[a-zA-Z0-9]+/)*Fortran(/\[a-zA-Z0-9]+)* but not for C" "" { target *-*-* } 0 } ! ! This program tests that the CFI_select_part function properly detects ! invalid arguments. All the interesting things happen in the diff --git a/gcc/testsuite/gfortran.dg/c-interop/setpointer-errors.f90 b/gcc/testsuite/gfortran.dg/c-interop/setpointer-errors.f90 index 84a01ce16b12..15ea7baffaaa 100644 --- a/gcc/testsuite/gfortran.dg/c-interop/setpointer-errors.f90 +++ b/gcc/testsuite/gfortran.dg/c-interop/setpointer-errors.f90 @@ -2,7 +2,7 @@ ! { dg-do run } ! { dg-additional-sources "setpointer-errors-c.c dump-descriptors.c" } ! { dg-additional-options "-Wno-error -fcheck=all" } -! { dg-warning "command-line option '-fcheck=all' is valid for Fortran but not for C" "" { target *-*-* } 0 } +! { dg-warning "command-line option '-fcheck=all' is valid for (\[a-zA-Z0-9]+/)*Fortran(/\[a-zA-Z0-9]+)* but not for C" "" { target *-*-* } 0 } ! ! This program tests that the CFI_setpointer function properly detects ! invalid arguments. All the interesting things happen in the From 16cf0b49fbb22087e7ae4145da03e73a3dc3626a Mon Sep 17 00:00:00 2001 From: "Jose E. Marchesi" Date: Sun, 30 Nov 2025 20:42:43 +0100 Subject: [PATCH 195/373] a68: some small a68-diagnostics.cc improvements This commit fixes a few problems in algol68/a68-diagnostics.cc, reported by David Malcolm in-list. gcc/ChangeLog * algol68/a68-diagnostics.cc (diagnostic): Copypasto "a meek" should be "a firm". Support printing line number for programs longer than 9 lines. Use obstack_append_str rather than obstack_grow. (obstack_append_str): New function. --- gcc/algol68/a68-diagnostics.cc | 72 +++++++++++++++++++--------------- 1 file changed, 40 insertions(+), 32 deletions(-) diff --git a/gcc/algol68/a68-diagnostics.cc b/gcc/algol68/a68-diagnostics.cc index 0c25da2a21f3..254be5f49b2e 100644 --- a/gcc/algol68/a68-diagnostics.cc +++ b/gcc/algol68/a68-diagnostics.cc @@ -41,6 +41,15 @@ #define A68_SCAN_ERROR 3 #define A68_INFORM 4 +/* Auxiliary function used to grow an obstack by the contents of some given + string. */ + +static void +obstack_append_str (obstack *b, const char *str) +{ + obstack_grow (b, str, strlen (str)); +} + /* Give a diagnostic message. */ #if __GNUC__ >= 10 @@ -80,7 +89,7 @@ diagnostic (int sev, int opt, gcc_obstack_init (&b); if (t[0] == '*') - obstack_grow (&b, t + 1, strlen (t + 1)); + obstack_append_str (&b, t + 1); else while (t[0] != '\0') { @@ -88,18 +97,18 @@ diagnostic (int sev, int opt, { const char *nt = a68_attribute_name (ATTRIBUTE (p)); if (t != NO_TEXT) - obstack_grow (&b, nt, strlen (nt)); + obstack_append_str (&b, nt); else - obstack_grow (&b, "construct", strlen ("construct")); + obstack_append_str (&b, "construct"); } else if (t[0] == 'A') { enum a68_attribute att = (enum a68_attribute) va_arg (args, int); const char *nt = a68_attribute_name (att); if (nt != NO_TEXT) - obstack_grow (&b, nt, strlen (nt)); + obstack_append_str (&b, nt); else - obstack_grow (&b, "construct", strlen ("construct")); + obstack_append_str (&b, "construct"); } else if (t[0] == 'B') { @@ -109,12 +118,12 @@ diagnostic (int sev, int opt, { const char *strop_keyword = a68_strop_keyword (TEXT (nt)); - obstack_grow (&b, "%<", 2); - obstack_grow (&b, strop_keyword, strlen (strop_keyword)); - obstack_grow (&b, "%>", 2); + obstack_append_str (&b, "%<"); + obstack_append_str (&b, strop_keyword); + obstack_append_str (&b, "%>"); } else - obstack_grow (&b, "keyword", strlen ("keyword")); + obstack_append_str (&b, "keyword"); } else if (t[0] == 'C') { @@ -127,29 +136,28 @@ diagnostic (int sev, int opt, case SOFT: sort = "a soft"; break; case WEAK: sort = "a weak"; break; case MEEK: sort = "a meek"; break; - case FIRM: sort = "a meek"; break; + case FIRM: sort = "a firm"; break; case STRONG: sort = "a strong"; break; default: gcc_unreachable (); } - obstack_grow (&b, sort, strlen (sort)); + obstack_append_str (&b, sort); } else if (t[0] == 'L') { LINE_T *a = va_arg (args, LINE_T *); gcc_assert (a != NO_LINE); if (NUMBER (a) == 0) - obstack_grow (&b, "in standard environment", - strlen ("in standard environment")); + obstack_append_str (&b, "in standard environment"); else if (p != NO_NODE && NUMBER (a) == LINE_NUMBER (p)) - obstack_grow (&b, "in this line", strlen ("in this line")); + obstack_append_str (&b, "in this line"); else { - char d[10]; - if (snprintf (d, 10, "in line %d", NUMBER (a)) < 0) + char d[18]; + if (snprintf (d, 18, "in line %d", NUMBER (a)) < 0) gcc_unreachable (); - obstack_grow (&b, d, strlen (d)); + obstack_append_str (&b, d); } } else if (t[0] == 'M') @@ -171,9 +179,9 @@ diagnostic (int sev, int opt, else moidstr = a68_moid_to_string (moid, MOID_ERROR_WIDTH, p); - obstack_grow (&b, "%<", 2); - obstack_grow (&b, moidstr, strlen (moidstr)); - obstack_grow (&b, "%>", 2); + obstack_append_str (&b, "%<"); + obstack_append_str (&b, moidstr); + obstack_append_str (&b, "%>"); } else if (t[0] == 'O') { @@ -181,7 +189,7 @@ diagnostic (int sev, int opt, if (moid == NO_MOID || moid == M_ERROR) moid = M_UNDEFINED; if (moid == M_VOID) - obstack_grow (&b, "UNION (VOID, ..)", strlen ("UNION (VOID, ..)")); + obstack_append_str (&b, "UNION (VOID, ..)"); else if (IS (moid, SERIES_MODE)) { const char *moidstr = NULL; @@ -190,12 +198,12 @@ diagnostic (int sev, int opt, moidstr = a68_moid_to_string (MOID (PACK (moid)), MOID_ERROR_WIDTH, p); else moidstr = a68_moid_to_string (moid, MOID_ERROR_WIDTH, p); - obstack_grow (&b, moidstr, strlen (moidstr)); + obstack_append_str (&b, moidstr); } else { const char *moidstr = a68_moid_to_string (moid, MOID_ERROR_WIDTH, p); - obstack_grow (&b, moidstr, strlen (moidstr)); + obstack_append_str (&b, moidstr); } } else if (t[0] == 'S') @@ -206,9 +214,9 @@ diagnostic (int sev, int opt, char *sym = NCHAR_IN_LINE (p); int n = 0, size = (int) strlen (txt); - obstack_grow (&b, "%<", 2); + obstack_append_str (&b, "%<"); if (txt[0] != sym[0] || (int) strlen (sym) < size) - obstack_grow (&b, txt, strlen (txt)); + obstack_append_str (&b, txt); else { while (n < size) @@ -223,28 +231,28 @@ diagnostic (int sev, int opt, sym++; } } - obstack_grow (&b, "%>", 2); + obstack_append_str (&b, "%>"); } else - obstack_grow (&b, "symbol", strlen ("symbol")); + obstack_append_str (&b, "symbol"); } else if (t[0] == 'X') { enum a68_attribute att = (enum a68_attribute) (va_arg (args, int)); const char *att_name = a68_attribute_name (att); - obstack_grow (&b, att_name, strlen (att_name)); + obstack_append_str (&b, att_name); } else if (t[0] == 'Y') { char *loc_string = va_arg (args, char *); - obstack_grow (&b, loc_string, strlen (loc_string)); + obstack_append_str (&b, loc_string); } else if (t[0] == 'Z') { char *str = va_arg (args, char *); - obstack_grow (&b, "%<", 2); - obstack_grow (&b, str, strlen (str)); - obstack_grow (&b, "%>", 2); + obstack_append_str (&b, "%<"); + obstack_append_str (&b, str); + obstack_append_str (&b, "%>"); } else obstack_1grow (&b, t[0]); From e1f33d3890ddccca3a2c6c5bce08d68e313b1f3a Mon Sep 17 00:00:00 2001 From: Kugan Vivekanandarajah Date: Mon, 1 Dec 2025 09:29:16 +1100 Subject: [PATCH 196/373] [PATCH] [Testsuite] Fix testcases after LICM of self-write Adjust the testcase as above. gcc/testsuite/ChangeLog: 2025-11-26 Kugan Vivekanandarajah * gcc.dg/vect/tsvc/vect-tsvc-s293.c: Remove xfail. * gcc.target/aarch64/vect-ld1r-compile.c: Add -fno-tree-loop-distribute-patterns to prevent memset detection. Signed-off-by: Kugan Vivekanandarajah --- gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s293.c | 2 +- gcc/testsuite/gcc.target/aarch64/vect-ld1r-compile.c | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s293.c b/gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s293.c index 321394811c8a..34f6af00b4c0 100644 --- a/gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s293.c +++ b/gcc/testsuite/gcc.dg/vect/tsvc/vect-tsvc-s293.c @@ -36,4 +36,4 @@ int main (int argc, char **argv) return 0; } -/* { dg-final { scan-tree-dump "vectorized 1 loops" "vect" { xfail *-*-* } } } */ +/* { dg-final { scan-tree-dump "vectorized 1 loops" "vect"} } */ diff --git a/gcc/testsuite/gcc.target/aarch64/vect-ld1r-compile.c b/gcc/testsuite/gcc.target/aarch64/vect-ld1r-compile.c index 30219e62d79d..26fef5bcc0bd 100644 --- a/gcc/testsuite/gcc.target/aarch64/vect-ld1r-compile.c +++ b/gcc/testsuite/gcc.target/aarch64/vect-ld1r-compile.c @@ -1,5 +1,6 @@ /* { dg-do compile } */ -/* { dg-options "-O3 -fno-vect-cost-model" } */ +/* Adding -fno-tree-loop-distribute-patterns to present memset dtection. */ +/* { dg-options "-O3 -fno-tree-loop-distribute-patterns -fno-vect-cost-model" } */ #pragma GCC target "+nosve" From 3b30d09ac7bbf8983363b9e12004742360b7b036 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Mon, 1 Dec 2025 00:16:36 +0000 Subject: [PATCH 197/373] Daily bump. --- ChangeLog | 46 +++ config/ChangeLog | 4 + gcc/ChangeLog | 251 ++++++++++++++ gcc/DATESTAMP | 2 +- gcc/ada/ChangeLog | 4 + gcc/c-family/ChangeLog | 4 + gcc/cobol/ChangeLog | 4 + gcc/cp/ChangeLog | 7 + gcc/d/ChangeLog | 4 + gcc/fortran/ChangeLog | 4 + gcc/go/ChangeLog | 4 + gcc/m2/ChangeLog | 4 + gcc/rust/ChangeLog | 4 + gcc/testsuite/ChangeLog | 742 ++++++++++++++++++++++++++++++++++++++++ include/ChangeLog | 5 + libiberty/ChangeLog | 5 + 16 files changed, 1093 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 6279013362d1..c605ba9cfe5a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,49 @@ +2025-11-30 Jose E. Marchesi + + * Makefile.def (libga68): New module. + (configure-target-libga68): Likewise. + * Makefile.tpl (GA68): Define. + (GA68_FOR_BUILD): Likewise. + (GA68FLAGS): Likewise. + * configure.ac (--enable-libga68): New option. + (--enable-algol68-gc): Likewise. + (GA68): Subst. + (GA68FLAGS): Likewise. + Invoke ACX_PROG_GA68. + * configure: Regenerate. + * Makefile.in: Likewise. + +2025-11-30 Jose E. Marchesi + + * MAINTAINERS: Add Algol 68 subsystems. + * SECURITY.txt: add libga68 to list of libraries. + +2025-11-30 Jose E. Marchesi + + * libga68/config.h.in: Regenerate. + * libga68/configure: Likewise. + * libga68/Makefile.in: Likewise. + * libga68/aclocal.m4: Likewise. + +2025-11-30 Jose E. Marchesi + + * libga68/Makefile.am: New file. + * libga68/configure.ac: Likewise. + * libga68/Makefile.in: Generate. + * libga68/aclocal.m4: Likewise. + +2025-11-30 Jose E. Marchesi + + * libga68/README: New file. + * libga68/ga68-alloc.c: Likewise. + * libga68/ga68-error.c: Likewise. + * libga68/ga68-posix.c: Likewise. + * libga68/ga68-standenv.c: Likewise. + * libga68/ga68-unistr.c: Likewise. + * libga68/ga68.h: Likewise. + * libga68/libga68.c: Likewise. + * libga68/libga68.spec.in: Likewise. + 2025-11-20 Claudio Bantaloukas * MAINTAINERS: Add myself in forge integration maintainers diff --git a/config/ChangeLog b/config/ChangeLog index 0a70422182b7..59cc1f4dea44 100644 --- a/config/ChangeLog +++ b/config/ChangeLog @@ -1,3 +1,7 @@ +2025-11-30 Jose E. Marchesi + + * acx.m4 (ACX_PROG_GA68): New defun. + 2025-11-03 Sam James * clang-plugin.m4: Sync with binutils. diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 9e78a81bef6f..17a68a5a8f3a 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,254 @@ +2025-11-30 Jose E. Marchesi + + * algol68/a68-diagnostics.cc (diagnostic): Copypasto "a meek" + should be "a firm". Support printing line number for programs + longer than 9 lines. Use obstack_append_str rather than + obstack_grow. + (obstack_append_str): New function. + +2025-11-30 Tamar Christina + + PR tree-optimization/115120 + PR tree-optimization/119577 + PR tree-optimization/119860 + * tree-vect-loop-manip.cc (vect_can_advance_ivs_p): Check for nonlinear + mult induction and early break. + (vect_update_ivs_after_vectorizer): Support early break exits. + (vect_do_peeling): Support scalar IVs. + * tree-vect-loop.cc (vect_peel_nonlinear_iv_init): Support early break. + (vect_update_nonlinear_iv): use `unsigned_type_for` such that function + works for both vector and scalar types. + (vectorizable_induction, vectorizable_live_operation): Remove vector + early break IV code. + (vect_update_ivs_after_vectorizer_for_early_breaks): New. + (vect_transform_loop): Support new scalar IV for early break. + * tree-vect-slp.cc (vect_analyze_slp): Remove SLP build for early break + IVs. + * tree-vect-stmts.cc (vect_stmt_relevant_p): No longer mark early break + IVs as completely unused rather than used_only_live. They no longer + contribute to the vector loop and so should not be analyzed. + (can_vectorize_live_stmts): Remove vector early vreak IV code. + * tree-vectorizer.h (LOOP_VINFO_EARLY_BRK_NITERS_VAR): New. + (class loop_vec_info): Add early_break_niters_var. + +2025-11-30 Andrew Pinski + + * algol68/lang.opt.urls: Regenerate. + +2025-11-30 Jose E. Marchesi + + * Makefile.in (OPT_URLS_HTML_DEPS): Add ga68/Option-Index.html. + * algol68/Make-lang.in: New file. + * algol68/config-lang.in: Likewise. + +2025-11-30 Jose E. Marchesi + + * doc/install.texi (Configuration): Mention algol68 option for + --enable-languages. + (Algol 68-Specific Options): New section. + * doc/sourcebuild.texi (Top Level): Add entry for libga68. + +2025-11-30 Jose E. Marchesi + + * config/rs6000/rs6000-logue.cc (rs6000_output_function_epilogue): + Handle "GNU Algol 68" in language_string. + +2025-11-30 Jose E. Marchesi + + * config/darwin.h: Adapt specs for libga68.a. + +2025-11-30 Jose E. Marchesi + + * dwarf2out.cc: Set DW_LANG_Algol68 an DW_LNAME_Algol68. + +2025-11-30 Jose E. Marchesi + + * algol68/lang.opt: New file. + * algol68/lang.opt.urls: Generate. + * common.opt: New option -static-libga68. + * common.opt.urls: Generate. + * gcc.cc: Handle OPT_static_libga68. + * regenerate-opt-urls.py (PER_LANGUAGE_OPTION_INDEXES): Add Algol68. + +2025-11-30 Jose E. Marchesi + + * algol68/ga68-internals.texi: New file. + * algol68/ga68.texi: Likewise. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-low-moids.cc: New file. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-low-coercions.cc: New file. + * algol68/a68-low-generator.cc: Likewise. + * algol68/a68-low-units.cc: Likewise. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-low-ranges.cc: New file. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-low-builtins.cc: New file. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-low-runtime.cc: New file. + * algol68/a68-low-runtime.def: Likewise. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-low-clauses.cc: New file. + * algol68/a68-low-decls.cc: Likewise. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-low-posix.cc: New file. + * algol68/a68-low-prelude.cc: Likewise. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-low-multiples.cc: New file. + * algol68/a68-low-structs.cc: Likewise. + * algol68/a68-low-unions.cc: Likewise. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-low-bits.cc: New file. + * algol68/a68-low-bools.cc: Likewise. + * algol68/a68-low-chars.cc: Likewise. + * algol68/a68-low-complex.cc: Likewise. + * algol68/a68-low-ints.cc: Likewise. + * algol68/a68-low-procs.cc: Likewise. + * algol68/a68-low-reals.cc: Likewise. + * algol68/a68-low-refs.cc: Likewise. + * algol68/a68-low-strings.cc: Likewise. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-low.cc: New file. + * algol68/a68-low-misc.cc: Likewise. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-parser-pragmat.cc: New file. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-parser-serial-dsa.cc: New file. + +2025-11-30 Jose E. Marchesi + Marcel van der Veer + + * algol68/a68-parser-extract.cc: New file. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-parser-debug.cc: New file. + +2025-11-30 Jose E. Marchesi + Marcel van der Veer + + * algol68/a68-parser-scope.cc: New file. + +2025-11-30 Jose E. Marchesi + Marcel van der Veer + + * algol68/a68-parser-taxes.cc: New file. + +2025-11-30 Jose E. Marchesi + Marcel van der Veer + + * algol68/a68-moids-diagnostics.cc: New file. + * algol68/a68-moids-misc.cc: New file. + * algol68/a68-moids-to-string.cc: New file. + * algol68/a68-parser-modes.cc: New file. + * algol68/a68-parser-moids-check.cc: New file. + * algol68/a68-parser-moids-coerce.cc: New file. + * algol68/a68-parser-moids-equivalence.cc: New file. + * algol68/a68-postulates.cc: New file. + +2025-11-30 Jose E. Marchesi + Marcel van der Veer + + * algol68/a68-parser-prelude.cc: New file. + +2025-11-30 Jose E. Marchesi + Marcel van der Veer + + * algol68/a68-parser-victal.cc: New file. + +2025-11-30 Jose E. Marchesi + Marcel van der Veer + + * algol68/a68-parser-bottom-up.cc: New file. + +2025-11-30 Jose E. Marchesi + Marcel van der Veer + + * algol68/a68-parser-brackets.cc: New file. + +2025-11-30 Jose E. Marchesi + Marcel van der Veer + + * algol68/a68-parser-top-down.cc: New file. + +2025-11-30 Jose E. Marchesi + Marcel van der Veer + + * algol68/a68-parser-keywords.cc: New file. + +2025-11-30 Jose E. Marchesi + Marcel van der Veer + + * algol68/a68-parser-scanner.cc: New file. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-parser-attrs.def: New file. + +2025-11-30 Jose E. Marchesi + Marcel van der Veer + + * algol68/a68-parser.cc: New file. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-imports.cc: New file. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-exports.cc: New file. + * algol68/ga68-exports.pk: Likewise. + +2025-11-30 Jose E. Marchesi + Marcel van der Veer + + * algol68/a68-diagnostics.cc: New file. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-unistr.c: New file. + +2025-11-30 Jose E. Marchesi + + * algol68/a68-lang.cc: New file. + +2025-11-30 Jose E. Marchesi + + * algol68/a68spec.cc: New file. + * algol68/lang-specs.h: Likewise. + +2025-11-30 Jose E. Marchesi + + * algol68/README: New file. + * algol68/a68-tree.def: Likewise. + * algol68/a68-types.h: Likewise. + * algol68/a68.h: Likewise. + * algol68/ga68.vw: Likewise. + 2025-11-29 Sandra Loosemore * common.opt.urls: Regenerated. diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index a06564385a85..112e13c0bf36 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20251130 +20251201 diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4837ac186ee1..1b0d40b8438f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,7 @@ +2025-11-30 Andrew Pinski + + * gcc-interface/lang.opt.urls: Regenerate. + 2025-11-27 Eric Botcazou * exp_ch6.adb (Expand_Actuals): Do not create activation chain and diff --git a/gcc/c-family/ChangeLog b/gcc/c-family/ChangeLog index 888ed516d0ee..46d0d308059f 100644 --- a/gcc/c-family/ChangeLog +++ b/gcc/c-family/ChangeLog @@ -1,3 +1,7 @@ +2025-11-30 Andrew Pinski + + * c.opt.urls: Regenerate. + 2025-11-26 Alejandro Colomar * c-common.cc (c_common_reswords): Add _Maxof & _Minof keywords. diff --git a/gcc/cobol/ChangeLog b/gcc/cobol/ChangeLog index a7260f8ea508..00b49cc42e16 100644 --- a/gcc/cobol/ChangeLog +++ b/gcc/cobol/ChangeLog @@ -1,3 +1,7 @@ +2025-11-30 Andrew Pinski + + * lang.opt.urls: Regenerate. + 2025-11-17 James K. Lowden PR cobol/122702 diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 6790953f4158..a4c2db7ca013 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,10 @@ +2025-11-30 Jakub Jelinek + + PR c++/122465 + * parser.cc (cp_parser_simple_declaration): Adjust function comment. + Set *maybe_range_for_decl to error_mark_node instead of keeping it + NULL_TREE in error cases or when followed by CPP_COLON. + 2025-11-30 Nathaniel Shead PR c++/119864 diff --git a/gcc/d/ChangeLog b/gcc/d/ChangeLog index ab6042be5288..f2dd24ed1e86 100644 --- a/gcc/d/ChangeLog +++ b/gcc/d/ChangeLog @@ -1,3 +1,7 @@ +2025-11-30 Andrew Pinski + + * lang.opt.urls: Regenerate. + 2025-08-18 Indu Bhagat * d-attribs.cc (d_handle_no_sanitize_attribute): Use diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 81f8e6231c24..bcb008e4ab45 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,7 @@ +2025-11-30 Andrew Pinski + + * lang.opt.urls: Regenerate. + 2025-11-28 Tobias Burnus PR c/122892 diff --git a/gcc/go/ChangeLog b/gcc/go/ChangeLog index 02105c074005..c270b531e202 100644 --- a/gcc/go/ChangeLog +++ b/gcc/go/ChangeLog @@ -1,3 +1,7 @@ +2025-11-30 Andrew Pinski + + * lang.opt.urls: Regenerate. + 2025-11-20 Rainer Orth * gospec.cc (lang_specific_driver) [TARGET_SOLARIS]: Replace diff --git a/gcc/m2/ChangeLog b/gcc/m2/ChangeLog index 737ab124dc1e..3d2a34f66e79 100644 --- a/gcc/m2/ChangeLog +++ b/gcc/m2/ChangeLog @@ -1,3 +1,7 @@ +2025-11-30 Andrew Pinski + + * lang.opt.urls: Regenerate. + 2025-11-02 Gaius Mulley PR modula2/122499 diff --git a/gcc/rust/ChangeLog b/gcc/rust/ChangeLog index 5ba3ddadd180..ec4e2793ccc3 100644 --- a/gcc/rust/ChangeLog +++ b/gcc/rust/ChangeLog @@ -1,3 +1,7 @@ +2025-11-30 Andrew Pinski + + * lang.opt.urls: Regenerate. + 2025-11-27 Jakub Jelinek * lex/rust-lex.cc (rust_input_source_test): Cast char8_t string diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 391cde1b6954..47dbf0ffb821 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,745 @@ +2025-11-30 Kugan Vivekanandarajah + + * gcc.dg/vect/tsvc/vect-tsvc-s293.c: Remove xfail. + * gcc.target/aarch64/vect-ld1r-compile.c: Add + -fno-tree-loop-distribute-patterns to prevent memset detection. + +2025-11-30 Jose E. Marchesi + + PR fortran/122923 + * gfortran.dg/ISO_Fortran_binding_17.f90: Recognize language + list in warning regexp. + * gfortran.dg/c-interop/allocate-errors.f90: Likewise. + * gfortran.dg/c-interop/establish-errors.f90: Likewise. + * gfortran.dg/c-interop/pr113338.f90: Likewise. + * gfortran.dg/c-interop/section-errors.f90: Likewise. + * gfortran.dg/c-interop/select-errors.f90: Likewise. + * gfortran.dg/c-interop/setpointer-errors.f90: Likewise. + +2025-11-30 Jakub Jelinek + + PR c++/122465 + * g++.dg/cpp0x/pr122465.C: New test. + +2025-11-30 Tamar Christina + + PR tree-optimization/115120 + PR tree-optimization/119577 + PR tree-optimization/119860 + * gcc.dg/vect/vect-early-break_39.c: Update. + * gcc.dg/vect/vect-early-break_139.c: New testcase. + * gcc.target/aarch64/sve/peel_ind_10.c: Update. + * gcc.target/aarch64/sve/peel_ind_11.c: Update. + * gcc.target/aarch64/sve/peel_ind_12.c: Update. + * gcc.target/aarch64/sve/peel_ind_5.c: Update. + * gcc.target/aarch64/sve/peel_ind_6.c: Update. + * gcc.target/aarch64/sve/peel_ind_7.c: Update. + * gcc.target/aarch64/sve/peel_ind_9.c: Update. + * gcc.target/aarch64/sve/pr119351.c + +2025-11-30 Jose E. Marchesi + + * algol68/compile/mcgt-1.3b.a68: New file. + * algol68/compile/mcgt-7.1.3a-bis.a68: Likewise. + * algol68/compile/mcgt-7.1.3a.a68: Likewise. + * algol68/execute/mcgt/execute.exp: Likewise. + * algol68/execute/mcgt/mcgt-1.3a.a68: Likewise. + * algol68/execute/mcgt/mcgt-1.3c.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.2.1a.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.2.2a.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.2.3a.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.3a.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.3b.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.3c.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.3e.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.4.2a.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.4.2b.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.4.2c.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.4.3a.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.6a.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.6b.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.7d.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.7e.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.8a.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.8b.a68: Likewise. + * algol68/execute/mcgt/mcgt-2.9.1a.a68: Likewise. + * algol68/execute/mcgt/mcgt-3.5.1a.a68: Likewise. + * algol68/execute/mcgt/mcgt-3.5d.a68: Likewise. + * algol68/execute/mcgt/mcgt-3.7.2a.a68: Likewise. + * algol68/execute/mcgt/mcgt-3.8.2a.a68: Likewise. + * algol68/execute/mcgt/mcgt-3.9.1b.a68: Likewise. + * algol68/execute/mcgt/mcgt-4.1.2a.a68: Likewise. + * algol68/execute/mcgt/mcgt-4.1.3a.a68: Likewise. + * algol68/execute/mcgt/mcgt-4.1.6a.a68: Likewise. + * algol68/execute/mcgt/mcgt-4.1.6b.a68: Likewise. + * algol68/execute/mcgt/mcgt-4.1.6c.a68: Likewise. + * algol68/execute/mcgt/mcgt-4.2.6a.a68: Likewise. + * algol68/execute/mcgt/mcgt-4.2.6b.a68: Likewise. + * algol68/execute/mcgt/mcgt-4.2.6d.a68: Likewise. + * algol68/execute/mcgt/mcgt-4.3.1a.a68: Likewise. + * algol68/execute/mcgt/mcgt-4.3.1b.a68: Likewise. + * algol68/execute/mcgt/mcgt-4.3.2a.a68: Likewise. + * algol68/execute/mcgt/mcgt-5.1.2a.a68: Likewise. + * algol68/execute/mcgt/mcgt-5.1.3a.a68: Likewise. + * algol68/execute/mcgt/mcgt-5.1.3c.a68: Likewise. + * algol68/execute/mcgt/mcgt-5.1.5a.a68: Likewise. + * algol68/execute/mcgt/mcgt-6.2.2a.a68: Likewise. + * algol68/execute/mcgt/mcgt-6.2.2b.a68: Likewise. + * algol68/execute/mcgt/mcgt-6.2.2c.a68: Likewise. + * algol68/execute/mcgt/mcgt-7.1.1a.a68: Likewise. + * algol68/execute/mcgt/mcgt-7.1.1b.a68: Likewise. + * algol68/execute/mcgt/mcgt-7.1.3a.a68: Likewise. + * algol68/execute/mcgt/mcgt-7.3.2a.a68: Likewise. + * algol68/execute/mcgt/mcgt-7.3.6a.a68: Likewise. + * algol68/execute/mcgt/mcgt-7.3.6b.a68: Likewise. + * algol68/execute/mcgt/mcgt-7.5.3a.a68: Likewise. + +2025-11-30 Jose E. Marchesi + + * algol68/README.mcts: New file. + +2025-11-30 Jose E. Marchesi + + * algol68/compile/a68includes/goodbye-supper.a68 + * algol68/compile/a68includes/goodbye.a68: Likewise. + * algol68/compile/a68includes/hello-supper.a68: Likewise. + * algol68/compile/a68includes/hello.a68: Likewise. + * algol68/compile/actual-bounds-expected-1.a68: Likewise. + * algol68/compile/actual-bounds-expected-2.a68: Likewise. + * algol68/compile/actual-bounds-expected-3.a68: Likewise. + * algol68/compile/balancing-1.a68: Likewise. + * algol68/compile/bold-nestable-comment-1.a68: Likewise. + * algol68/compile/bold-taggle-1.a68: Likewise. + * algol68/compile/brief-nestable-comment-1.a68: Likewise. + * algol68/compile/brief-nestable-comment-2.a68: Likewise. + * algol68/compile/char-break-1.a68: Likewise. + * algol68/compile/compile.exp: Likewise. + * algol68/compile/conditional-clause-1.a68: Likewise. + * algol68/compile/error-bold-taggle-1.a68: Likewise. + * algol68/compile/error-coercion-1.a68: Likewise. + * algol68/compile/error-coercion-2.a68: Likewise. + * algol68/compile/error-coercion-flex-1.a68: Likewise. + * algol68/compile/error-conformance-clause-1.a68: Likewise. + * algol68/compile/error-contraction-1.a68: Likewise. + * algol68/compile/error-contraction-2.a68: Likewise. + * algol68/compile/error-incestuous-union-1.a68: Likewise. + * algol68/compile/error-label-after-decl-1.a68: Likewise. + * algol68/compile/error-nestable-comments-1.a68: Likewise. + * algol68/compile/error-nested-comment-1.a68: Likewise. + * algol68/compile/error-no-bounds-allowed-1.a68: Likewise. + * algol68/compile/error-string-break-1.a68: Likewise. + * algol68/compile/error-string-break-2.a68: Likewise. + * algol68/compile/error-string-break-3.a68: Likewise. + * algol68/compile/error-string-break-4.a68: Likewise. + * algol68/compile/error-string-break-5.a68: Likewise. + * algol68/compile/error-string-break-6.a68: Likewise. + * algol68/compile/error-string-break-7.a68: Likewise. + * algol68/compile/error-supper-1.a68: Likewise. + * algol68/compile/error-supper-2.a68: Likewise. + * algol68/compile/error-supper-3.a68: Likewise. + * algol68/compile/error-supper-4.a68: Likewise. + * algol68/compile/error-supper-5.a68: Likewise. + * algol68/compile/error-supper-6.a68: Likewise. + * algol68/compile/error-underscore-in-mode-1.a68: Likewise. + * algol68/compile/error-underscore-in-tag-1.a68: Likewise. + * algol68/compile/error-upper-1.a68: Likewise. + * algol68/compile/error-widening-1.a68: Likewise. + * algol68/compile/error-widening-2.a68: Likewise. + * algol68/compile/error-widening-3.a68: Likewise. + * algol68/compile/error-widening-4.a68: Likewise. + * algol68/compile/error-widening-5.a68: Likewise. + * algol68/compile/error-widening-6.a68: Likewise. + * algol68/compile/error-widening-7.a68: Likewise. + * algol68/compile/error-widening-8.a68: Likewise. + * algol68/compile/error-widening-9.a68: Likewise. + * algol68/compile/hidden-operators-1.a68: Likewise. + * algol68/compile/implicit-widening-1.a68: Likewise. + * algol68/compile/include-supper.a68: Likewise. + * algol68/compile/include.a68: Likewise. + * algol68/compile/labeled-unit-1.a68: Likewise. + * algol68/compile/nested-comment-1.a68: Likewise. + * algol68/compile/nested-comment-2.a68: Likewise. + * algol68/compile/operators-firmly-related.a68: Likewise. + * algol68/compile/recursive-modes-1.a68: Likewise. + * algol68/compile/recursive-modes-2.a68: Likewise. + * algol68/compile/serial-clause-jump-1.a68: Likewise. + * algol68/compile/snobol.a68: Likewise. + * algol68/compile/supper-1.a68: Likewise. + * algol68/compile/supper-10.a68: Likewise. + * algol68/compile/supper-11.a68: Likewise. + * algol68/compile/supper-12.a68: Likewise. + * algol68/compile/supper-13.a68: Likewise. + * algol68/compile/supper-2.a68: Likewise. + * algol68/compile/supper-3.a68: Likewise. + * algol68/compile/supper-4.a68: Likewise. + * algol68/compile/supper-5.a68: Likewise. + * algol68/compile/supper-6.a68: Likewise. + * algol68/compile/supper-7.a68: Likewise. + * algol68/compile/supper-8.a68: Likewise. + * algol68/compile/supper-9.a68: Likewise. + * algol68/compile/uniting-1.a68: Likewise. + * algol68/compile/upper-1.a68: Likewise. + * algol68/compile/warning-scope-1.a68: Likewise. + * algol68/compile/warning-scope-2.a68: Likewise. + * algol68/compile/warning-scope-3.a68: Likewise. + * algol68/compile/warning-scope-4.a68: Likewise. + * algol68/compile/warning-scope-5.a68: Likewise. + * algol68/compile/warning-scope-6.a68: Likewise. + * algol68/compile/warning-scope-7.a68: Likewise. + * algol68/compile/warning-voiding-1.a68: Likewise. + * algol68/compile/warning-voiding-2.a68: Likewise. + * algol68/compile/error-compile-unknown-tag-1.a68: New file. + * algol68/compile/error-def-1.a68: New file. + * algol68/compile/error-mode-stropping-1.a68: New file. + * algol68/compile/error-mode-stropping-10.a68: New file. + * algol68/compile/error-mode-stropping-11.a68: New file. + * algol68/compile/error-mode-stropping-12.a68: New file. + * algol68/compile/error-mode-stropping-13.a68: New file. + * algol68/compile/error-mode-stropping-14.a68: New file. + * algol68/compile/error-mode-stropping-15.a68: New file. + * algol68/compile/error-mode-stropping-16.a68: New file. + * algol68/compile/error-mode-stropping-17.a68: New file. + * algol68/compile/error-mode-stropping-2.a68: New file. + * algol68/compile/error-mode-stropping-3.a68: New file. + * algol68/compile/error-mode-stropping-4.a68: New file. + * algol68/compile/error-mode-stropping-5.a68: New file. + * algol68/compile/error-mode-stropping-6.a68: New file. + * algol68/compile/error-mode-stropping-8.a68: New file. + * algol68/compile/error-mode-stropping-9.a68: New file. + * algol68/compile/error-module-coercions-1.a68: New file. + * algol68/compile/error-module-not-found-1.a68: New file. + * algol68/compile/error-module-ranges-1.a68: New file. + * algol68/compile/error-pragmat-1.a68: New file. + * algol68/compile/error-pragmat-access-1.a68: New file. + * algol68/compile/error-pragmat-access-2.a68: New file. + * algol68/compile/error-pub-loc-1.a68: New file. + * algol68/compile/error-pub-out-of-def-1.a68: New file. + * algol68/compile/error-pub-out-of-def-2.a68: New file. + * algol68/compile/error-string-break-8.a68: New file. + * algol68/compile/error-stropping-5.a68: New file. + * algol68/compile/error-stropping-6.a68: New file. + * algol68/compile/error-stropping-keyword-1.a68: New file. + * algol68/compile/error-stropping-keyword-2.a68: New file. + * algol68/compile/error-stropping-keyword-3.a68: New file. + * algol68/compile/error-stropping-keyword-4.a68: New file. + * algol68/compile/error-vacuum-1.a68: New file. + * algol68/compile/error-vacuum-2.a68: New file. + * algol68/compile/error-vacuum-3.a68: New file. + * algol68/compile/module-1.a68: New file. + * algol68/compile/module-2.a68: New file. + * algol68/compile/module-extracts-1.a68: New file. + * algol68/compile/module-mode-exports-1.a68: New file. + * algol68/compile/module-mode-exports-2.a68: New file. + * algol68/compile/module-mode-exports-3.a68: New file. + * algol68/compile/module-mode-exports-4.a68: New file. + * algol68/compile/module-mode-exports-5.a68: New file. + * algol68/compile/module-mode-exports-6.a68: New file. + * algol68/compile/module-mode-exports-7.a68: New file. + * algol68/compile/module-mode-exports-8.a68: New file. + * algol68/compile/module-mode-exports-9.a68: New file. + * algol68/compile/module-pub-1.a68: New file. + * algol68/compile/module-pub-mangling-1.a68: New file. + * algol68/compile/module-pub-mangling-10.a68: New file. + * algol68/compile/module-pub-mangling-11.a68: New file. + * algol68/compile/module-pub-mangling-12.a68: New file. + * algol68/compile/module-pub-mangling-13.a68: New file. + * algol68/compile/module-pub-mangling-14.a68: New file. + * algol68/compile/module-pub-mangling-15.a68: New file. + * algol68/compile/module-pub-mangling-16.a68: New file. + * algol68/compile/module-pub-mangling-17.a68: New file. + * algol68/compile/module-pub-mangling-18.a68: New file. + * algol68/compile/module-pub-mangling-19.a68: New file. + * algol68/compile/module-pub-mangling-2.a68: New file. + * algol68/compile/module-pub-mangling-20.a68: New file. + * algol68/compile/module-pub-mangling-21.a68: New file. + * algol68/compile/module-pub-mangling-22.a68: New file. + * algol68/compile/module-pub-mangling-3.a68: New file. + * algol68/compile/module-pub-mangling-4.a68: New file. + * algol68/compile/module-pub-mangling-5.a68: New file. + * algol68/compile/module-pub-mangling-6.a68: New file. + * algol68/compile/module-pub-mangling-7.a68: New file. + * algol68/compile/module-pub-mangling-8.a68: New file. + * algol68/compile/module-pub-mangling-9.a68: New file. + * algol68/compile/module-top-down-1.a68: New file. + * algol68/compile/modules/compile.exp: New file. + * algol68/compile/modules/module1.a68: New file. + * algol68/compile/modules/module2.a68: New file. + * algol68/compile/modules/module3.a68: New file. + * algol68/compile/modules/module4.a68: New file. + * algol68/compile/modules/module5.a68: New file. + * algol68/compile/modules/module6.a68: New file. + * algol68/compile/modules/module7.a68: New file. + * algol68/compile/modules/module8.a68: New file. + * algol68/compile/modules/module9.a68: New file. + * algol68/compile/modules/program-7.a68: New file. + * algol68/compile/modules/program-8.a68: New file. + * algol68/compile/modules/program-9.a68: New file. + * algol68/compile/modules/program-error-no-prio-1.a68: New file. + * algol68/compile/modules/program-error-outside-access-1.a68: New file. + * algol68/compile/modules/program-module-accesses-module-1.a68: New file. + * algol68/compile/modules/program-proc-arg-order-1.a68: New file. + * algol68/compile/warning-hidding-1.a68: New file. + * algol68/compile/warning-hidding-2.a68: New file. + * algol68/compile/warning-hidding-3.a68: New file. + * algol68/compile/warning-hidding-4.a68: New file. + * algol68/compile/warning-hidding-5.a68: New file. + * algol68/compile/warning-hidding-6.a68: New file. + * algol68/compile/warning-hidding-7.a68: New file. + * algol68/compile/warning-module-hidding-1.a68: New file. + * algol68/compile/warning-pub-loc-1.a68: New file. + +2025-11-30 Jose E. Marchesi + + * algol68/execute/loop-7.a68: New file. + * algol68/execute/loop-8.a68: Likewise. + * algol68/execute/loop-9.a68: Likewise. + * algol68/execute/loop-overflow-underflow.a68: Likewise. + * algol68/execute/lt-int-1.a68: Likewise. + * algol68/execute/lt-string-stride-1.a68: Likewise. + * algol68/execute/lwb-1.a68: Likewise. + * algol68/execute/minus-int-1.a68: Likewise. + * algol68/execute/minusab-1.a68: Likewise. + * algol68/execute/minusab-2.a68: Likewise. + * algol68/execute/minusab-3.a68: Likewise. + * algol68/execute/minusab-4.a68: Likewise. + * algol68/execute/mod-int-1.a68: Likewise. + * algol68/execute/modab-1.a68: Likewise. + * algol68/execute/modab-2.a68: Likewise. + * algol68/execute/mode-indication-1.a68: Likewise. + * algol68/execute/mult-char-1.a68: Likewise. + * algol68/execute/mult-int-1.a68: Likewise. + * algol68/execute/mult-string-1.a68: Likewise. + * algol68/execute/mult-string-2.a68: Likewise. + * algol68/execute/mult-string-3.a68: Likewise. + * algol68/execute/mult-string-4.a68: Likewise. + * algol68/execute/multab-1.a68: Likewise. + * algol68/execute/multab-2.a68: Likewise. + * algol68/execute/multab-3.a68: Likewise. + * algol68/execute/mutual-recursion-1.a68: Likewise. + * algol68/execute/ne-bits-1.a68: Likewise. + * algol68/execute/ne-char-char-1.a68: Likewise. + * algol68/execute/ne-int-1.a68: Likewise. + * algol68/execute/ne-string-1.a68: Likewise. + * algol68/execute/neg-int-1.a68: Likewise. + * algol68/execute/not-bits-1.a68: Likewise. + * algol68/execute/odd-1.a68: Likewise. + * algol68/execute/op-1.a68: Likewise. + * algol68/execute/op-2.a68: Likewise. + * algol68/execute/op-3.a68: Likewise. + * algol68/execute/operator-declaration-1.a68: Likewise. + * algol68/execute/or-bits-1.a68: Likewise. + * algol68/execute/orf-1.a68: Likewise. + * algol68/execute/over-int-1.a68: Likewise. + * algol68/execute/overab-1.a68: Likewise. + * algol68/execute/overab-2.a68: Likewise. + * algol68/execute/particular-program-1.a68: Likewise. + * algol68/execute/plus-char-1.a68: Likewise. + * algol68/execute/plus-int-1.a68: Likewise. + * algol68/execute/plus-string-1.a68: Likewise. + * algol68/execute/plus-string-2.a68: Likewise. + * algol68/execute/plus-string-stride-1.a68: Likewise. + * algol68/execute/plusab-1.a68: Likewise. + * algol68/execute/plusab-2.a68: Likewise. + * algol68/execute/plusab-3.a68: Likewise. + * algol68/execute/plusab-4.a68: Likewise. + * algol68/execute/plusab-string-1.a68: Likewise. + * algol68/execute/plusto-char-1.a68: Likewise. + * algol68/execute/plusto-string-1.a68: Likewise. + * algol68/execute/posix-argc-argv-1.a68: Likewise. + * algol68/execute/posix-fopen-1.a68: Likewise. + * algol68/execute/posix-fputc-fputs-1.a68: Likewise. + * algol68/execute/posix-getenv-1.a68: Likewise. + * algol68/execute/posix-perror-1.a68: Likewise. + * algol68/execute/posix-putchar-1.a68: Likewise. + * algol68/execute/posix-stdinouterr-1.a68: Likewise. + * algol68/execute/posix-strerror-1.a68: Likewise. + * algol68/execute/posix-stride-1.a68: Likewise. + * algol68/execute/pow-int-1.a68: Likewise. + * algol68/execute/pow-real-1.a68: Likewise. + * algol68/execute/proc-1.a68: Likewise. + * algol68/execute/proc-10.a68: Likewise. + * algol68/execute/proc-12.a68: Likewise. + * algol68/execute/proc-13.a68: Likewise. + * algol68/execute/proc-14.a68: Likewise. + * algol68/execute/proc-15.a68: Likewise. + * algol68/execute/proc-16.a68: Likewise. + * algol68/execute/proc-17.a68: Likewise. + * algol68/execute/proc-18.a68: Likewise. + * algol68/execute/proc-19.a68: Likewise. + * algol68/execute/proc-2.a68: Likewise. + * algol68/execute/proc-20.a68: Likewise. + * algol68/execute/proc-21.a68: Likewise. + * algol68/execute/proc-22.a68: Likewise. + * algol68/execute/proc-23.a68: Likewise. + * algol68/execute/proc-25.a68: Likewise. + * algol68/execute/proc-26.a68: Likewise. + * algol68/execute/proc-27.a68: Likewise. + * algol68/execute/proc-28.a68: Likewise. + * algol68/execute/proc-29.a68: Likewise. + * algol68/execute/proc-3.a68: Likewise. + * algol68/execute/proc-4.a68: Likewise. + * algol68/execute/proc-5.a68: Likewise. + * algol68/execute/proc-6.a68: Likewise. + * algol68/execute/proc-7.a68: Likewise. + * algol68/execute/proc-8.a68: Likewise. + * algol68/execute/procedured-goto-1.a68: Likewise. + * algol68/execute/quine.a68: Likewise. + * algol68/execute/random-1.a68: Likewise. + * algol68/execute/re-im-1.a68: Likewise. + * algol68/execute/rela-string-1.a68: Likewise. + * algol68/execute/repr-1.a68: Likewise. + * algol68/execute/round-1.a68: Likewise. + * algol68/execute/row-display-1.a68: Likewise. + * algol68/execute/row-display-2.a68: Likewise. + * algol68/execute/row-display-3.a68: Likewise. + * algol68/execute/row-display-4.a68: Likewise. + * algol68/execute/row-display-5.a68: Likewise. + * algol68/execute/rowing-1.a68: Likewise. + * algol68/execute/rowing-10.a68: Likewise. + * algol68/execute/rowing-11.a68: Likewise. + * algol68/execute/rowing-12.a68: Likewise. + * algol68/execute/rowing-13.a68: Likewise. + * algol68/execute/rowing-2.a68: Likewise. + * algol68/execute/rowing-3.a68: Likewise. + * algol68/execute/rowing-4.a68: Likewise. + * algol68/execute/rowing-5.a68: Likewise. + * algol68/execute/rowing-6.a68: Likewise. + * algol68/execute/rowing-7.a68: Likewise. + * algol68/execute/rowing-8.a68: Likewise. + * algol68/execute/rowing-9.a68: Likewise. + * algol68/execute/selection-1.a68: Likewise. + * algol68/execute/selection-2.a68: Likewise. + * algol68/execute/selection-3.a68: Likewise. + * algol68/execute/selection-4.a68: Likewise. + * algol68/execute/selection-5.a68: Likewise. + * algol68/execute/selection-multiple-1.a68: Likewise. + * algol68/execute/selection-multiple-2.a68: Likewise. + * algol68/execute/serial-clause-1.a68: Likewise. + * algol68/execute/serial-clause-10.a68: Likewise. + * algol68/execute/serial-clause-2.a68: Likewise. + * algol68/execute/serial-clause-3.a68: Likewise. + * algol68/execute/serial-clause-4.a68: Likewise. + * algol68/execute/serial-clause-5.a68: Likewise. + * algol68/execute/serial-clause-6.a68: Likewise. + * algol68/execute/serial-clause-7.a68: Likewise. + * algol68/execute/serial-clause-8.a68: Likewise. + * algol68/execute/serial-clause-9.a68: Likewise. + * algol68/execute/serial-dsa-1.a68: Likewise. + * algol68/execute/serial-dsa-2.a68: Likewise. + * algol68/execute/serial-dsa-3.a68: Likewise. + * algol68/execute/serial-dsa-4.a68: Likewise. + * algol68/execute/serial-dsa-5.a68: Likewise. + * algol68/execute/serial-dsa-6.a68: Likewise. + * algol68/execute/sign-int-1.a68: Likewise. + * algol68/execute/sign-real-1.a68: Likewise. + * algol68/execute/sin-1.a68: Likewise. + * algol68/execute/skip-1.a68: Likewise. + * algol68/execute/skip-2.a68: Likewise. + * algol68/execute/skip-struct-1.a68: Likewise. + * algol68/execute/slice-indexing-1.a68: Likewise. + * algol68/execute/slice-indexing-2.a68: Likewise. + * algol68/execute/slice-indexing-3.a68: Likewise. + * algol68/execute/slice-indexing-4.a68: Likewise. + * algol68/execute/slice-indexing-5.a68: Likewise. + * algol68/execute/slice-indexing-6.a68: Likewise. + * algol68/execute/slice-indexing-7.a68: Likewise. + * algol68/execute/sqrt-1.a68: Likewise. + * algol68/execute/string-1.a68: Likewise. + * algol68/execute/string-2.a68: Likewise. + * algol68/execute/string-4.a68: Likewise. + * algol68/execute/string-break-1.a68: Likewise. + * algol68/execute/struct-self-1.a68: Likewise. + * algol68/execute/struct-self-2.a68: Likewise. + * algol68/execute/struct-self-3.a68: Likewise. + * algol68/execute/structure-display-1.a68: Likewise. + * algol68/execute/structure-display-2.a68: Likewise. + * algol68/execute/structure-display-3.a68: Likewise. + * algol68/execute/structure-display-4.a68: Likewise. + * algol68/execute/structure-display-5.a68: Likewise. + * algol68/execute/tan-1.a68: Likewise. + * algol68/execute/timesab-string-1.a68: Likewise. + * algol68/execute/trimmer-1.a68: Likewise. + * algol68/execute/trimmer-10.a68: Likewise. + * algol68/execute/trimmer-2.a68: Likewise. + * algol68/execute/trimmer-3.a68: Likewise. + * algol68/execute/trimmer-4.a68: Likewise. + * algol68/execute/trimmer-5.a68: Likewise. + * algol68/execute/trimmer-6.a68: Likewise. + * algol68/execute/trimmer-7.a68: Likewise. + * algol68/execute/trimmer-8.a68: Likewise. + * algol68/execute/trimmer-9.a68: Likewise. + * algol68/execute/trimmer-matrix-1.a68: Likewise. + * algol68/execute/trimmer-matrix-2.a68: Likewise. + * algol68/execute/trimmer-matrix-3.a68: Likewise. + * algol68/execute/trimmer-matrix-4.a68: Likewise. + * algol68/execute/trimmer-matrix-5.a68: Likewise. + * algol68/execute/trimmer-matrix-6.a68: Likewise. + * algol68/execute/trimmer-name-1.a68: Likewise. + * algol68/execute/undefined-1.a68: Likewise. + * algol68/execute/undefined-2.a68: Likewise. + * algol68/execute/undefined-3.a68: Likewise. + * algol68/execute/undefined-4.a68: Likewise. + * algol68/execute/undefined-5.a68: Likewise. + * algol68/execute/uniting-1.a68: Likewise. + * algol68/execute/uniting-2.a68: Likewise. + * algol68/execute/uniting-3.a68: Likewise. + * algol68/execute/uniting-4.a68: Likewise. + * algol68/execute/up-down-bits-1.a68: Likewise. + * algol68/execute/upb-1.a68: Likewise. + * algol68/execute/vacuum-1.a68: Likewise. + * algol68/execute/variable-declaration-1.a68: Likewise. + * algol68/execute/variable-declaration-2.a68: Likewise. + * algol68/execute/variable-declaration-3.a68: Likewise. + * algol68/execute/variable-declaration-4.a68: Likewise. + * algol68/execute/variable-declaration-5.a68: Likewise. + * algol68/execute/variable-declaration-6.a68: Likewise. + * algol68/execute/variable-declaration-heap-1.a68: Likewise. + * algol68/execute/variable-declaration-heap-2.a68: Likewise. + * algol68/execute/variable-declaration-multiple-1.a68: Likewise. + * algol68/execute/variable-declaration-multiple-2.a68: Likewise. + * algol68/execute/variable-declaration-multiple-3.a68: Likewise. + * algol68/execute/variable-declaration-multiple-4.a68: Likewise. + * algol68/execute/variable-declaration-multiple-5.a68: Likewise. + * algol68/execute/variable-declaration-multiple-6.a68: Likewise. + * algol68/execute/variable-declaration-multiple-7.a68: Likewise. + * algol68/execute/variable-declaration-multiple-8.a68: Likewise. + * algol68/execute/variable-declaration-multiple-9.a68: Likewise. + * algol68/execute/voiding-1.a68: Likewise. + * algol68/execute/widening-1.a68: Likewise. + * algol68/execute/widening-2.a68: Likewise. + * algol68/execute/widening-bits-1.a68: Likewise. + * algol68/execute/widening-bits-2.a68: Likewise. + * algol68/execute/widening-bits-3.a68: Likewise. + * algol68/execute/xor-bits-1.a68: Likewise. + * algol68/execute/environment-enquiries-8.a68: Likewise. + * algol68/execute/modules/README: New file. + * algol68/execute/modules/execute.exp: New file. + * algol68/execute/modules/module1.a68: New file. + * algol68/execute/modules/module10.a68: New file. + * algol68/execute/modules/module11.a68: New file. + * algol68/execute/modules/module12.a68: New file. + * algol68/execute/modules/module13.a68: New file. + * algol68/execute/modules/module14.a68: New file. + * algol68/execute/modules/module15.a68: New file. + * algol68/execute/modules/module16.a68: New file. + * algol68/execute/modules/module17.a68: New file. + * algol68/execute/modules/module3.a68: New file. + * algol68/execute/modules/module4.a68: New file. + * algol68/execute/modules/module5.a68: New file. + * algol68/execute/modules/module6.a68: New file. + * algol68/execute/modules/module7.a68: New file. + * algol68/execute/modules/module8.a68: New file. + * algol68/execute/modules/module9.a68: New file. + * algol68/execute/modules/program-1.a68: New file. + * algol68/execute/modules/program-10.a68: New file. + * algol68/execute/modules/program-11.a68: New file. + * algol68/execute/modules/program-12.a68: New file. + * algol68/execute/modules/program-15.a68: New file. + * algol68/execute/modules/program-16.a68: New file. + * algol68/execute/modules/program-17.a68: New file. + * algol68/execute/modules/program-2.a68: New file. + * algol68/execute/modules/program-3.a68: New file. + * algol68/execute/modules/program-4.a68: New file. + * algol68/execute/modules/program-5.a68: New file. + * algol68/execute/modules/program-6.a68: New file. + * algol68/execute/modules/program-7.a68: New file. + * algol68/execute/modules/program-8.a68: New file. + * algol68/execute/posix-lseek.a68: New file. + +2025-11-30 Jose E. Marchesi + + * algol68/execute/abs-bits-1.a68: New file. + * algol68/execute/abs-bool-1.a68: Likewise. + * algol68/execute/abs-char-1.a68: Likewise. + * algol68/execute/abs-int-1.a68: Likewise. + * algol68/execute/abs-int-negative-1.a68: Likewise. + * algol68/execute/abs-int-negative-gnu-1.a68: Likewise. + * algol68/execute/acos-1.a68: Likewise. + * algol68/execute/affirm-int-1.a68: Likewise. + * algol68/execute/and-bits-1.a68: Likewise. + * algol68/execute/andf-1.a68: Likewise. + * algol68/execute/ascription-1.a68: Likewise. + * algol68/execute/asin-1.a68: Likewise. + * algol68/execute/assert-1.a68: Likewise. + * algol68/execute/assignation-char-1.a68: Likewise. + * algol68/execute/assignation-int-1.a68: Likewise. + * algol68/execute/assignation-int-2.a68: Likewise. + * algol68/execute/assignation-int-3.a68: Likewise. + * algol68/execute/assignation-int-4.a68: Likewise. + * algol68/execute/assignation-int-5.a68: Likewise. + * algol68/execute/assignation-multiple-1.a68: Likewise. + * algol68/execute/assignation-multiple-2.a68: Likewise. + * algol68/execute/assignation-struct-1.a68: Likewise. + * algol68/execute/assignation-struct-2.a68: Likewise. + * algol68/execute/atan-1.a68: Likewise. + * algol68/execute/balancing-1.a68: Likewise. + * algol68/execute/balancing-rows-1.a68: Likewise. + * algol68/execute/bin-1.a68: Likewise. + * algol68/execute/bin-negative-1.a68: Likewise. + * algol68/execute/bin-negative-gnu-1.a68: Likewise. + * algol68/execute/boolops-1.a68: Likewise. + * algol68/execute/call-1.a68: Likewise. + * algol68/execute/call-2.a68: Likewise. + * algol68/execute/case-clause-1.a68: Likewise. + * algol68/execute/case-clause-2.a68: Likewise. + * algol68/execute/case-clause-3.a68: Likewise. + * algol68/execute/case-clause-4.a68: Likewise. + * algol68/execute/closed-clause-1.a68: Likewise. + * algol68/execute/closed-clause-2.a68: Likewise. + * algol68/execute/collateral-clause-1.a68: Likewise. + * algol68/execute/collateral-clause-2.a68: Likewise. + * algol68/execute/collateral-clause-3.a68: Likewise. + * algol68/execute/collateral-clause-4.a68: Likewise. + * algol68/execute/collateral-clause-5.a68: Likewise. + * algol68/execute/collateral-clause-6.a68: Likewise. + * algol68/execute/completer-1.a68: Likewise. + * algol68/execute/completer-10.a68: Likewise. + * algol68/execute/completer-2.a68: Likewise. + * algol68/execute/completer-3.a68: Likewise. + * algol68/execute/completer-4.a68: Likewise. + * algol68/execute/completer-5.a68: Likewise. + * algol68/execute/completer-6.a68: Likewise. + * algol68/execute/completer-7.a68: Likewise. + * algol68/execute/completer-8.a68: Likewise. + * algol68/execute/completer-9.a68: Likewise. + * algol68/execute/cond-clause-1.a68: Likewise. + * algol68/execute/cond-clause-2.a68: Likewise. + * algol68/execute/cond-clause-3.a68: Likewise. + * algol68/execute/cond-clause-4.a68: Likewise. + * algol68/execute/cond-clause-5.a68: Likewise. + * algol68/execute/cond-clause-6.a68: Likewise. + * algol68/execute/cond-clause-7.a68: Likewise. + * algol68/execute/cond-clause-8.a68: Likewise. + * algol68/execute/cond-clause-9.a68: Likewise. + * algol68/execute/conformity-clause-1.a68: Likewise. + * algol68/execute/conformity-clause-2.a68: Likewise. + * algol68/execute/conformity-clause-3.a68: Likewise. + * algol68/execute/conformity-clause-4.a68: Likewise. + * algol68/execute/conformity-clause-5.a68: Likewise. + * algol68/execute/conformity-clause-6.a68: Likewise. + * algol68/execute/conformity-clause-7.a68: Likewise. + * algol68/execute/conformity-clause-8.a68: Likewise. + * algol68/execute/conformity-clause-9.a68: Likewise. + * algol68/execute/conj-1.a68: Likewise. + * algol68/execute/cos-1.a68: Likewise. + * algol68/execute/declarer-1.a68: Likewise. + * algol68/execute/declarer-2.a68: Likewise. + * algol68/execute/deprocedure-1.a68: Likewise. + * algol68/execute/deprocedure-2.a68: Likewise. + * algol68/execute/deref-1.a68: Likewise. + * algol68/execute/deref-2.a68: Likewise. + * algol68/execute/deref-3.a68: Likewise. + * algol68/execute/deref-4.a68: Likewise. + * algol68/execute/deref-5.a68: Likewise. + * algol68/execute/deref-6.a68: Likewise. + * algol68/execute/deref-7.a68: Likewise. + * algol68/execute/deref-8.a68: Likewise. + * algol68/execute/div-int-1.a68: Likewise. + * algol68/execute/divab-real-1.a68: Likewise. + * algol68/execute/elem-bits-1.a68: Likewise. + * algol68/execute/elems-1.a68: Likewise. + * algol68/execute/elems-2.a68: Likewise. + * algol68/execute/entier-1.a68: Likewise. + * algol68/execute/environment-enquiries-1.a68: Likewise. + * algol68/execute/environment-enquiries-2.a68: Likewise. + * algol68/execute/environment-enquiries-3.a68: Likewise. + * algol68/execute/environment-enquiries-4.a68: Likewise. + * algol68/execute/environment-enquiries-5.a68: Likewise. + * algol68/execute/environment-enquiries-6.a68: Likewise. + * algol68/execute/environment-enquiries-7.a68: Likewise. + * algol68/execute/environment-enquiries-8.a68: Likewise. + * algol68/execute/eq-bits-1.a68: Likewise. + * algol68/execute/eq-char-char-1.a68: Likewise. + * algol68/execute/eq-int-1.a68: Likewise. + * algol68/execute/eq-string-1.a68: Likewise. + * algol68/execute/eq-string-stride-1.a68: Likewise. + * algol68/execute/execute.exp: Likewise. + * algol68/execute/factorial-1.a68: Likewise. + * algol68/execute/flat-assignation-1.a68: Likewise. + * algol68/execute/flat-assignation-2.a68: Likewise. + * algol68/execute/flex-1.a68: Likewise. + * algol68/execute/flex-2.a68: Likewise. + * algol68/execute/flex-3.a68: Likewise. + * algol68/execute/flex-4.a68: Likewise. + * algol68/execute/flex-5.a68: Likewise. + * algol68/execute/formula-1.a68: Likewise. + * algol68/execute/formula-2.a68: Likewise. + * algol68/execute/fsize-1.a68: Likewise. + * algol68/execute/ge-int-1.a68: Likewise. + * algol68/execute/ge-string-stride-1.a68: Likewise. + * algol68/execute/gen-flex-1.a68: Likewise. + * algol68/execute/gen-heap-1.a68: Likewise. + * algol68/execute/gen-heap-2.a68: Likewise. + * algol68/execute/gen-heap-3.a68: Likewise. + * algol68/execute/gen-heap-bool-1.a68: Likewise. + * algol68/execute/gen-heap-int-1.a68: Likewise. + * algol68/execute/gen-heap-real-1.a68: Likewise. + * algol68/execute/gen-heap-struct-1.a68: Likewise. + * algol68/execute/gen-heap-struct-2.a68: Likewise. + * algol68/execute/gen-heap-struct-3.a68: Likewise. + * algol68/execute/gen-loc-1.a68: Likewise. + * algol68/execute/gen-loc-2.a68: Likewise. + * algol68/execute/gen-loc-3.a68: Likewise. + * algol68/execute/gen-loc-4.a68: Likewise. + * algol68/execute/gen-multiple-1.a68: Likewise. + * algol68/execute/gen-union-1.a68: Likewise. + * algol68/execute/gen-union-2.a68: Likewise. + * algol68/execute/gen-union-3.a68: Likewise. + * algol68/execute/goto-1.a68: Likewise. + * algol68/execute/goto-2.a68: Likewise. + * algol68/execute/goto-3.a68: Likewise. + * algol68/execute/goto-4.a68: Likewise. + * algol68/execute/goto-5.a68: Likewise. + * algol68/execute/gt-int-1.a68: Likewise. + * algol68/execute/gt-string-stride-1.a68: Likewise. + * algol68/execute/i-1.a68: Likewise. + * algol68/execute/i-2.a68: Likewise. + * algol68/execute/identification-1.a68: Likewise. + * algol68/execute/identification-2.a68: Likewise. + * algol68/execute/identity-declaration-1.a68: Likewise. + * algol68/execute/identity-declaration-2.a68: Likewise. + * algol68/execute/identity-declaration-3.a68: Likewise. + * algol68/execute/identity-declaration-4.a68: Likewise. + * algol68/execute/identity-declaration-5.a68: Likewise. + * algol68/execute/identity-declaration-multiple-1.a68: Likewise. + * algol68/execute/identity-declaration-multiple-2.a68: Likewise. + * algol68/execute/identity-declaration-multiple-3.a68: Likewise. + * algol68/execute/identity-declaration-multiple-5.a68: Likewise. + * algol68/execute/identity-declaration-multiple-empty-1.a68: Likewise. + * algol68/execute/identity-declaration-multiple-empty-2.a68: Likewise. + * algol68/execute/identity-declaration-multiple-empty-3.a68: Likewise. + * algol68/execute/identity-declaration-multiple-empty-4.a68: Likewise. + * algol68/execute/identity-declaration-struct-1.a68: Likewise. + * algol68/execute/infinity-1.a68: Likewise. + * algol68/execute/le-ge-bits-1.a68: Likewise. + * algol68/execute/le-int-1.a68: Likewise. + * algol68/execute/le-string-stride-1.a68: Likewise. + * algol68/execute/leng-shorten-bits-1.a68: Likewise. + * algol68/execute/leng-shorten-ints-1.a68: Likewise. + * algol68/execute/leng-shorten-reals-1.a68: Likewise. + * algol68/execute/lengths-shorths-1.a68: Likewise. + * algol68/execute/lisp-1.a68: Likewise. + * algol68/execute/lisp-2.a68: Likewise. + * algol68/execute/ln-1.a68: Likewise. + * algol68/execute/log-1.a68: Likewise. + * algol68/execute/loop-1.a68: Likewise. + * algol68/execute/loop-10.a68: Likewise. + * algol68/execute/loop-11.a68: Likewise. + * algol68/execute/loop-12.a68: Likewise. + * algol68/execute/loop-13.a68: Likewise. + * algol68/execute/loop-14.a68: Likewise. + * algol68/execute/loop-2.a68: Likewise. + * algol68/execute/loop-3.a68: Likewise. + * algol68/execute/loop-4.a68: Likewise. + * algol68/execute/loop-5.a68: Likewise. + * algol68/execute/loop-6.a68: Likewise. + +2025-11-30 Jose E. Marchesi + + * lib/algol68-dg.exp: New file. + * lib/algol68-torture.exp: Likewise. + * lib/algol68.exp: Likewise. + 2025-11-30 Nathaniel Shead PR c++/119864 diff --git a/include/ChangeLog b/include/ChangeLog index e2f71605f1ec..e94e5795dca4 100644 --- a/include/ChangeLog +++ b/include/ChangeLog @@ -1,3 +1,8 @@ +2025-11-30 Jose E. Marchesi + + * dwarf2.h (DW_LANG_Algol68): Define. + (DW_LNAME_Algol68): Likewise. + 2025-11-13 Andrew Stubbs Kwok Cheung Yeung Thomas Schwinge diff --git a/libiberty/ChangeLog b/libiberty/ChangeLog index db4be9c104b6..37c351d33f5f 100644 --- a/libiberty/ChangeLog +++ b/libiberty/ChangeLog @@ -1,3 +1,8 @@ +2025-11-30 Jose E. Marchesi + + * simple-object-mach-o.c + (simple_object_mach_o_segment): Handle non-LTO sections. + 2025-11-06 Peter Damianov PR target/122472 From 8de45537d29ee1c58ec4a2a50a0b511020bd919d Mon Sep 17 00:00:00 2001 From: John David Anglin Date: Sun, 30 Nov 2025 20:51:13 -0500 Subject: [PATCH 198/373] libcc1: Check for libgen.h header The basename() function is declared in libgen.h. 2025-11-30 John David Anglin libcc1/ChangeLog: * configure.ac: Check for libgen.h header. * configure: Regenerate. --- libcc1/configure | 12 ++++++++++++ libcc1/configure.ac | 1 + 2 files changed, 13 insertions(+) diff --git a/libcc1/configure b/libcc1/configure index 00cb83e0c39a..83468ea31c44 100755 --- a/libcc1/configure +++ b/libcc1/configure @@ -15298,6 +15298,18 @@ LDFLAGS="$cet_save_LDFLAGS" +for ac_header in libgen.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "libgen.h" "ac_cv_header_libgen_h" "$ac_includes_default" +if test "x$ac_cv_header_libgen_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBGEN_H 1 +_ACEOF + +fi + +done + ac_fn_c_check_decl "$LINENO" "basename" "ac_cv_have_decl_basename" "$ac_includes_default" if test "x$ac_cv_have_decl_basename" = xyes; then : ac_have_decl=1 diff --git a/libcc1/configure.ac b/libcc1/configure.ac index 87f157568e8b..287c65ead407 100644 --- a/libcc1/configure.ac +++ b/libcc1/configure.ac @@ -48,6 +48,7 @@ AC_SUBST(visibility) GCC_CET_HOST_FLAGS(CET_HOST_FLAGS) AC_SUBST(CET_HOST_FLAGS) +AC_CHECK_HEADERS(libgen.h) AC_CHECK_DECLS([basename]) GCC_BASE_VER From c44586acdc6e107de7ceea173aaaacd8b0525153 Mon Sep 17 00:00:00 2001 From: "H.J. Lu" Date: Mon, 1 Dec 2025 10:05:44 +0800 Subject: [PATCH 199/373] x86: Emit the TLS call after deleted instructions For a basic block with only deleted instructions: (code_label 348 23 349 45 3 (nil) [0 uses]) (note 349 348 436 45 [bb 45] NOTE_INSN_BASIC_BLOCK) (note 436 349 362 45 NOTE_INSN_DELETED) emit the TLS call after deleted instructions. gcc/ PR target/122906 * config/i386/i386-features.cc (ix86_emit_tls_call): Emit the TLS call after deleted instructions. gcc/testsuite/ PR target/122906 * g++.target/i386/pr122906-1.C: New test. Signed-off-by: H.J. Lu --- gcc/config/i386/i386-features.cc | 8 + gcc/testsuite/g++.target/i386/pr122906-1.C | 1065 ++++++++++++++++++++ 2 files changed, 1073 insertions(+) create mode 100644 gcc/testsuite/g++.target/i386/pr122906-1.C diff --git a/gcc/config/i386/i386-features.cc b/gcc/config/i386/i386-features.cc index f1f118d5b755..ce6f40b922c6 100644 --- a/gcc/config/i386/i386-features.cc +++ b/gcc/config/i386/i386-features.cc @@ -3947,11 +3947,19 @@ ix86_emit_tls_call (rtx tls_set, x86_cse_kind kind, basic_block bb, (note 2 3 5 2 NOTE_INSN_FUNCTION_BEG) (debug_insn 5 2 16 2 (debug_marker) "x.c":6:3 -1 (nil)) + or a basic block with only deleted instructions: + + (code_label 348 23 349 45 3 (nil) [0 uses]) + (note 349 348 436 45 [bb 45] NOTE_INSN_BASIC_BLOCK) + (note 436 349 362 45 NOTE_INSN_DELETED) + */ gcc_assert (DEBUG_INSN_P (insn) || (NOTE_P (insn) && ((NOTE_KIND (insn) == NOTE_INSN_FUNCTION_BEG) + || (NOTE_KIND (insn) + == NOTE_INSN_DELETED) || (NOTE_KIND (insn) == NOTE_INSN_BASIC_BLOCK)))); insn = NULL; diff --git a/gcc/testsuite/g++.target/i386/pr122906-1.C b/gcc/testsuite/g++.target/i386/pr122906-1.C new file mode 100644 index 000000000000..6c4be38d892d --- /dev/null +++ b/gcc/testsuite/g++.target/i386/pr122906-1.C @@ -0,0 +1,1065 @@ +// { dg-do compile { target *-*-linux* } } +// { dg-options "-O3 -std=c++20 -ftrivial-auto-var-init=zero -march=x86-64-v3 -fPIC -w -mtls-dialect=gnu " } + +template using b = int; +template struct e; +struct m {}; +template struct aa; +template struct j; +using h = aa>; +template using a = h; +template using k = h; +template struct p { + d ad; +}; +struct ac {}; +template struct al; +template struct al { + typedef g &ah; +}; +template z ::i q(z); +struct w { + e *l; + al *>::ah operator*() { return *l; } + bool operator==(w) { return l; } +}; +template struct n { + using af = g[o]; +}; +template struct ak { + n::af am; +}; +void ab(); +template void ar(ai r, ac) { + ai ag; + for (; r != ag; ++r) + ab(), *r; +} +template void as(ai r, ac) { ar(r, q(r)); } +struct { + template void aj(ai r, ai) { as(r, q(r)); } +} ao; +namespace ap { +template struct bb { + static const bool ax = at; +}; +} // namespace ap +using ap::bb; +namespace av { +template struct c; +template struct c { + static const bool ax = au; + operator bb() { + void *bc; + return *reinterpret_cast *>(bc); + } +}; +template struct ae : c {}; +template struct ae : c {}; +namespace aw { +using namespace ap; +} +} // namespace av +namespace ap { +template struct bd { + typedef bd<1> bh; +}; +} // namespace ap +namespace av { +namespace aw { +template struct be; +template struct bn : bb {}; +template +struct bn : bn> {}; +template <> +struct bn, bb, bb, bb> : bb {}; +template , + typename az = bb, typename bl = bb> +struct br : bn {}; +} // namespace aw +template struct bi { + typedef aq h; +}; +template bi::h bf(); +template struct ba : c {}; +template struct ba : c {}; +template struct bk { + typedef aq const h; +}; +template struct bq { + typedef aq h; +}; +template struct bu { + typedef aq::h h; +}; +template struct by { + typedef bo ::ah h; +}; +template struct bm { + typedef aq h; +}; +template struct bm { + typedef aq h; +}; +namespace aw { +template struct bp { + typedef bg h; +}; +template struct bp { + typedef bj h; +}; +template struct cg { + typedef bp::h h; +}; +template struct bs { + typedef cg::h ::h h; +}; +template struct bx; +template +struct bx : bx> {}; +template <> +struct bx, bb, bb, bb> : bb {}; +template +struct bw : bx, bb, bb> {}; +} // namespace aw +template struct cb { + template static void ca(cc); + template static decltype(ca(bf())) cr(int); + template static int cr(...); + static const bool ax = sizeof(cr(0)) == 1; +}; +template struct cm { + static const bool ax = cb::ax; +}; +template struct cl { + typedef cm h; +}; +template struct ci { + typedef cl::h h; +}; +template struct co : ci::h {}; +template struct ce : c::ax> {}; +namespace aw { +template struct cf { + typedef aq h; +}; +} // namespace aw +template struct arg { + template struct apply { + typedef ck h; + }; +}; +template <> struct arg<2> { + template struct apply { + typedef cu h; + }; +}; +struct cj {}; +template struct cx : aw::bs, aw::cf> {}; +template struct cw : cx {}; +template +struct cn : aw::bs, ce>, aw::cf> {}; +template struct dd : aw::br, ce> {}; +template struct cz : cs, ct {}; +template struct da { + typedef cn::h category; + typedef aw::cg, category, cz>::h h; +}; +template +struct s : aw::bs, aw::cf, da> {}; +namespace aw { +template struct de : df::apply {}; +template +struct u : df::apply {}; +template +struct db : df::apply {}; +template struct bh { + typedef aq::bh h; +}; +template struct cv; +template +struct cv, ck, cu, dm> { + typedef db, ck, cu>::h h; +}; +template struct dh { + template struct apply { + typedef de::h>::h h; + }; +}; +template +struct cv, ck, cu, dm> { + typedef db, ck, cu>::h h; +}; +template struct dg { + template struct apply { + typedef u::h, + typename cv::h>::h h; + }; +}; +template struct di { + typedef aq::h h; +}; +template