From patchwork Mon Feb 12 12:07:18 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Gaius Mulley X-Patchwork-Id: 199707 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a05:7300:50ea:b0:106:860b:bbdd with SMTP id r10csp2384014dyd; Mon, 12 Feb 2024 04:08:43 -0800 (PST) X-Forwarded-Encrypted: i=3; AJvYcCXO80P1rbIEm/MVbO0jd06Kgr6PS1/wfuLQK52VrDCPVJla0yx/yrSKlrD+vi7/I5OIeO6JCLtNP5b/HFUPBIthjzEfng== X-Google-Smtp-Source: AGHT+IHI49h+FzFNBJ7SSq0dcNcaOWrPmP6CVCPzogqLiyv8vexQ+dME4zu4PIRfULkCP2nA7dLl X-Received: by 2002:a05:620a:2fb:b0:785:d9e3:bc2d with SMTP id a27-20020a05620a02fb00b00785d9e3bc2dmr1125675qko.30.1707739723361; Mon, 12 Feb 2024 04:08:43 -0800 (PST) ARC-Seal: i=2; a=rsa-sha256; t=1707739723; cv=pass; d=google.com; s=arc-20160816; b=dvimNyqIoVPLbZ2Z6yMrS1LIKq96wT0FkuKj4okjQ1dBcLlGFAyydowuFiF/Iph1tJ b/x0J0N0NU9r2MDtvhz5kpv308+1oAv1KjrytYxIpQREgTTULsC8Zipym1rY6V46sFWu kUQ0yLl02FoFWVY2NAdYqnjvCjz3b9bwTCeqbsqOYDtuofPVVt/ChFnVL5OOHIfaIck2 u1xQdYL7UhH5UQamPUNTunC457oLScj/4AvcGPZHAraP8kW/QyqWWV4WrzfxlnK36C1S csIaGlVIPqRePbLMIAtmLMi7E473zwGZhGiGYhrWP7yWfzeUjqbZc9MxUBvMOEf+xRGF f8HA== ARC-Message-Signature: i=2; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=errors-to:list-subscribe:list-help:list-post:list-archive :list-unsubscribe:list-id:precedence:mime-version:user-agent :message-id:date:subject:to:from:dkim-signature:arc-filter :dmarc-filter:delivered-to; bh=ZOMb/f9xNV0GqV0YK189zlJOtvKa3sntY584OAzQXHw=; fh=+cJ0OAwYUgvdF/6ZVdu6/HhdwQ2mfQNUKHDJ0vN14sA=; b=GAfnwrV9mBZcP8fSmB68flxaIJeIT5B0QkTFHRLAJNvOIHa6HsWcAUvodRVcLjNtpC 5N50O1gHAA09UcsYVcr7DmEq6U75g7/gAFATgvezxWQ5yYUDN5Aa4TLMheBbzBcfyuKI +eV7IjkhtCKgp25Ps4hsE3ALEpDJfHo0R43Teo/MzEAKgd00yxPREJpKIYaU/N+1hs52 rpJDDA/C9sQlJcBVh9x+oKIbwMTRm8uRQKAH3cU+1VaaHeONueBs7T/xwp8TIuMk6NQH UjU4pTxruOYs3K4LDH05NtLViCDWl86VG4PitvfxerJ37V7aY/4BWdK8cRWoYJR8NjOy UJwg==; dara=google.com ARC-Authentication-Results: i=2; mx.google.com; dkim=pass header.i=@gmail.com header.s=20230601 header.b=nK1RLFbC; arc=pass (i=1); spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=QUARANTINE dis=NONE) header.from=gmail.com X-Forwarded-Encrypted: i=2; AJvYcCWEvQ9RnyRkqFU0XwLJMuYWx1BT2rgWk4TbxYjBRUfy1whL1lPqfqzTQMjIzpQJvJjo7Cai3oP2qX+KFzUKHGHddHDkNw== Received: from server2.sourceware.org (server2.sourceware.org. [2620:52:3:1:0:246e:9693:128c]) by mx.google.com with ESMTPS id bp17-20020a05620a459100b00783f16eee24si6321884qkb.91.2024.02.12.04.08.43 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 12 Feb 2024 04:08:43 -0800 (PST) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) client-ip=2620:52:3:1:0:246e:9693:128c; Authentication-Results: mx.google.com; dkim=pass header.i=@gmail.com header.s=20230601 header.b=nK1RLFbC; arc=pass (i=1); spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 2620:52:3:1:0:246e:9693:128c as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=QUARANTINE dis=NONE) header.from=gmail.com Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id E9D3B3858C78 for ; Mon, 12 Feb 2024 12:08:42 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-lj1-x234.google.com (mail-lj1-x234.google.com [IPv6:2a00:1450:4864:20::234]) by sourceware.org (Postfix) with ESMTPS id 430163858D32 for ; Mon, 12 Feb 2024 12:07:25 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 430163858D32 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmail.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 430163858D32 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::234 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1707739651; cv=none; b=s/63JhAWuF9/0ElHnWleEp4Fz8ASJBN9Ft4Llut4ktT+W+gA8QnI5NP/9P8u2wRV4Ldb33U8gag2gS3cO2fMljsND7IWF06uXv8W1UfLj23VqQAGBSRTe7JN77J5jPIFGC9y+ZppiIFTsLIk7Q0afQOFFkvrZGs5dR2f8j94dyk= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1707739651; c=relaxed/simple; bh=Xsn9F+MlH45j+djJzglL9y1xFsxWtGJfVq9WCbLmx9w=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=Ohkk9pEsfXJD3Ovu9dRxmja3ElLyNBrR0pa8R8l84/hKG6OXV8T+/CWn6DARok3tcHC5r6iI0dcOoERKPPpVwCUpRazd4GX4ZJ0B7aYR1lMgwrR2405eIqZ4DaB9cb3bjXpUazHCyTdDMjesmFcUtD2xMIWDj0D9+PNntLOat0A= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-lj1-x234.google.com with SMTP id 38308e7fff4ca-2d0ce2222a6so39443111fa.3 for ; Mon, 12 Feb 2024 04:07:25 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1707739643; x=1708344443; darn=gcc.gnu.org; h=mime-version:user-agent:message-id:date:subject:to:from:from:to:cc :subject:date:message-id:reply-to; bh=ZOMb/f9xNV0GqV0YK189zlJOtvKa3sntY584OAzQXHw=; b=nK1RLFbCVEf/jftnSC7FslhQQq3LZUDf/lSJbAxO+ULPp3ihzK+RtgOZlsPwoLNyKT ATsSaG/rpd8W8c86mRyj8Azsd1yw46xdhRhEDUMeL5yCQiwBQdTsRX1spAtrCyJPYG/4 E9FBFb6aqCXPI7AlFyq6PXM0WN012Y3niY3lyYaXgTWch7QjqPkq3VceGZLDvh9n8TfA /QuLa3fccGPqfYIgAOAx0xdLxWx7W/ew7jUV1CMwYbgcbsAuXKKvOPmhOa39pUky0sRy QN6z84/4uXeni98F+PLt0SXnLNexqwCGcEhDIql/yVz/EK2mi9k1Ax7+1PVEjT4YNbJg lMLg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1707739643; x=1708344443; h=mime-version:user-agent:message-id:date:subject:to:from :x-gm-message-state:from:to:cc:subject:date:message-id:reply-to; bh=ZOMb/f9xNV0GqV0YK189zlJOtvKa3sntY584OAzQXHw=; b=OAe6hBf4aRlTU6yeke+pdfZZ+QBrF98gYHL6QU9Gm80IL2AXruCmj1xKz4R/yrIYH8 l9Jh+XAccHElfLh3kRh1+zbCTHNnxuUrPP8l4zsrjfWIHqGJNSiN4xpjBdiatqTd/DYu xoLhhj15qKN9LgmnJYibXGQtXBC9+Vki0hVOJIuHVoHQypgQSkAXuMkI0SX/bK/ctnKS WJOWfEg//SgMrWvLdvt91XqpOLQe+MQxTU8RGQHognbfCopiIJtMO75mztuOCtCaLz9S xB2i/J2sGCxYcknHj3D/oG5ckwzECD0WvNWdBGoi7Kw3UxRC/TKfKcRtG5a3/Ct+dU0S x00Q== X-Gm-Message-State: AOJu0Yxp0DzyUEUT4Y6LfSWTWDRcy9Wriwy8Qd5tStj3HQtGzLoNoJ3k JiYLX6dtFk1/uqfoBG27iZLwYlCHRypqu0QoNYERz/xcskSZcSamyHAHiTGr X-Received: by 2002:a2e:9945:0:b0:2d0:aae6:bf2e with SMTP id r5-20020a2e9945000000b002d0aae6bf2emr4123823ljj.34.1707739641487; Mon, 12 Feb 2024 04:07:21 -0800 (PST) X-Forwarded-Encrypted: i=1; AJvYcCUkjxxukIAIyFx27YGjX48AwWLEeiBZhg3G9gMfGz1qVUpvK/YKqM2DP3DAzvU81G5dwIB1D5bo3EX8kGlXbwHWpLQH Received: from lancelot ([82.153.116.109]) by smtp.gmail.com with ESMTPSA id b2-20020a5d5502000000b0033b278cf5fesm6564368wrv.102.2024.02.12.04.07.20 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 12 Feb 2024 04:07:21 -0800 (PST) Received: from gaius by lancelot with local (Exim 4.96) (envelope-from ) id 1rZV5j-000mSD-0J; Mon, 12 Feb 2024 12:07:19 +0000 From: Gaius Mulley To: gcc-patches@gcc.gnu.org Subject: [PATCH] PR modula2/113836 gm2 does not dump gimple or quadruples to a file Date: Mon, 12 Feb 2024 12:07:18 +0000 Message-ID: <87mss5ga2x.fsf@localhost> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.2 (gnu/linux) MIME-Version: 1.0 X-Spam-Status: No, score=-7.6 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, GIT_PATCH_0, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1790694888234917716 X-GMAIL-MSGID: 1790694888234917716 Bootstrapped and regtested on aarch64 and ppc64le with languages=all (no additional test failures seen). Bootstrapped language=m2 on Debian, SUSE, Redhat and also built with clang. Does the patch seem reasonable - in particular lang.opt? -- >8 -- PR modula2/113836 gm2 does not dump gimple or quadruples to a file During the triage of PR113588 it would have been helpful if gm2 had the ability to dump its IR to a file and also filter the IR on procedure name. This patch implements: -fdump-lang-all, -fdump-lang-quad, -fdump-lang-quad=, -fdump-lang-gimple, -fdump-lang-gimple= and -fm2-dump-filter=. The filter must be a comma separated list which can take three forms: the full decl textual name of a procedure, [libname.]module.ident or [filename.]module.ident. Currently it only filters on procedure names, no regexp is allowed and no dependencies are followed. gcc/ChangeLog: PR modula2/113836 * doc/gm2.texi (Compiler options): Document -fdump-lang-all, -fdump-lang-quad, -fdump-lang-quad=, -fdump-lang-gimple, -fdump-lang-gimple= and -fm2-dump-lang-filter=. gcc/m2/ChangeLog: PR modula2/113836 * Make-lang.in (GM2_C_OBJS): Change m2/m2pp.o to m2/gm2-gcc/m2pp.o. (m2/m2pp.o): Change to m2/gm2-gcc/m2pp.o. (GM2-COMP-BOOT-DEFS): Add M2LangDump.def. (GM2-COMP-BOOT-MODS): Add M2LangDump.mod. (GM2-COMP-DEFS): Add M2LangDump.def. (GM2-COMP-MODS): Add M2LangDump.mod. * gm2-compiler/M2CaseList.mod: Remove import of printf1. Add import of WriteCard. (WriteCase): Replace printf1 with WriteCard. * gm2-compiler/M2Code.mod (M2Quads): Remove DisplayQuadruples and DisplayQuadList. Add DumpLangGimple and DumpQuadruples. (TraceQuadruples): New constant. (OptimizationAnalysis): Call DumpQuadruples. (DoCodeBlock): Add filename, len and create gimple dump if DumpLangGimple is true. (Code): Call DumpQuadruples, before any optimization, after dead procedure elimination and after identifying simple subexpression temporaries. (DisplayQuadsInScope): Remove. (DisplayQuadsNumbers): Remove. (CodeBlock): Change DisplayQuadruples to TraceQuadruples. * gm2-compiler/M2GCCDeclare.mod (TraceQuadruples): New constant. (DeclareTypesConstantsProceduresInRange): Change DisplayQuadruples to TraceQuadruples. * gm2-compiler/M2GenGCC.mod (M2Quads): Remove import of DisplayQuadruples. (ResolveConstantExpressions): Remove dead code. * gm2-compiler/M2Options.def (DisplayQuadruples): Remove. (DumpLangQuad): New boolean variable. (DumpLangGimple): New boolean variable. (GetDumpLangQuadFilename): New procedure function. (SetDumpLangQuadFilename): New procedure. (GetDumpLangGimpleFilename): New procedure function. (SetDumpLangGimpleFilename): New procedure. (SetM2DumpFilter): New procedure. (GetM2DumpFilter): New procedure function. (GetDumpLangGimple): New procedure function. * gm2-compiler/M2Options.mod (GetDumpLangQuadFilename): New procedure function. (SetDumpLangQuadFilename): New procedure. (GetDumpLangGimpleFilename): New procedure function. (SetDumpLangGimpleFilename): New procedure. (SetM2DumpFilter): New procedure. (GetM2DumpFilter): New procedure function. (GetDumpLangGimple): New procedure function. (SetQuadDebugging): Reimplement. (M2Options): Remove DisplayQuadruples. Add DumpLangQuad and initialize to FALSE. Add DumpLangQuadFilename and initialize to NIL. Add DumpLangGimpleFilename and initialize to NIL. Add DumpLangGimple and initialize to FALSE. Add M2DumpFilter and initialize to NIL. * gm2-compiler/M2Quads.def (DumpQuadruples): New procedure. (DisplayQuadList): Remove. * gm2-compiler/M2Quads.mod (StrLib): Import StrLen. (M2Printf): Import fprintf0, fprintf1, fprintf3 and fprintf4. (M2Options): Import GetDumpDir, GetM2DumpFilter and DumpLangQuad. (M2LangDump): Import MakeQuadTemplate. (FIO): Import. (SFIO): Import. (StdIO): Import. (DumpWrite): New procedure. (CloseOutput): New procedure. (ConfigureOutput): New procedure. (GetCtorInit): New procedure function. (GetCtorFini): New procedure function. (DumpQuadrupleFilter): New procedure. (DisplayQuadList): Renamed to DumpQuadrupleAll. (DumpQuadruples): New procedure. (DisplayQuad): Replace printf with fprintf and outputFile. (DisplayProcedureAttributes): Ditto. (WriteQuad): Ditto. (WriteOperator): Ditto. (WriteOperand): Ditto. (WriteMode): Ditto. * gm2-compiler/M2Scope.mod (M2Options): Remove DisplayQuadruples. (TraceQuadruples): New constant. (ForeachScopeBlockDo2): Change DisplayQuadruples to TraceQuadruples. (ForeachScopeBlockDo3): Change DisplayQuadruples to TraceQuadruples. * gm2-compiler/SymbolConversion.def (Gcc2Mod): New procedure function. * gm2-compiler/SymbolConversion.mod (Gcc2Mod): New procedure function implemented. (Indexing): Import HighIndice. * gm2-gcc/m2misc.cc (m2misc_DebugTree): Tidy up comment. (m2misc_DebugTreeChain): Correct comment. * gm2-gcc/m2options.h (M2Options_GetDumpLangQuadFilename): New function. (M2Options_SetDumpLangQuadFilename): New function. (M2Options_GetDumpLangGimpleFilename): New function. (M2Options_SetDumpLangGimpleFilename): New function. (M2Options_GetDumpLangGimple): New function. (M2Options_SetM2DumpFilter): New function. (M2Options_GetM2DumpFilter): New function. * m2pp.cc: Moved to... * gm2-gcc/m2pp.cc: ...here. (pretty): Add output field. (initPretty): Add kind parameter. (m2pp_output_file): New array. (do_pf): Add parameter M2PP_DUMP_STDOUT. (pe): Ditto. (pet): Ditto. (pt): Ditto. (pv): Ditto. (getoutput): New function. (m2pp_loc): Change printf to fprintf using file from getoutput. (m2pp_type_lowlevel): Ditto. (hextree): Ditto. (m2pp_module_block): Ditto. (m2pp_var_list): Ditto. (m2pp_recordfield_alignment): Ditto. (m2pp_print_char): Ditto and replace putchar with fputc. (m2pp_CreateDumpGimple): New function. (m2pp_CloseDumpGimple): New function. (m2pp_dump_gimple): New function. * m2pp.h: Moved to... * gm2-gcc/m2pp.h: ...here. (m2pp_dump_kind): New typedef. (m2pp_CreateDumpGimple): New function. (m2pp_CloseDumpGimple): New function. (m2pp_dump_gimple): New function. * gm2-gcc/m2statement.cc (m2statement_BuildEndFunctionCode): Call m2pp_dump_gimple. * gm2-lang.cc (gm2_langhook_handle_option): Add case OPT_fdump_lang_all, OPT_fdump_lang_gimple, OPT_fdump_lang_gimple_, OPT_fdump_lang_quad, OPT_fdump_lang_quad_ and OPT_fm2_dump_filter_. * gm2-libs/DynamicStrings.def (ReverseIndex): New procedure function. (RIndex): Improve comment. * gm2-libs/DynamicStrings.mod (ReverseIndex): New procedure function. (RIndex): Improve comment. * lang.opt: New entries for fdump-lang-all, fdump-lang-gimple, fdump-lang-gimple=, fdump-lang-quad, fdump-lang-quad= and fm2-dump-filter=. * gm2-compiler/M2LangDump.def: New file. * gm2-compiler/M2LangDump.mod: New file. * gm2-gcc/m2langdump.h: New file. * gm2-gcc/m2pp.def: New file. diff --git a/gcc/doc/gm2.texi b/gcc/doc/gm2.texi index 028a0715f64..ee829cd45a7 100644 --- a/gcc/doc/gm2.texi +++ b/gcc/doc/gm2.texi @@ -416,6 +416,25 @@ The default implementation and module filename suffix is @file{.def}. If this option is used GNU Modula-2 will still fall back to this default if a requested definition module is not found. +@item -fdump-lang-all +turn on all modula-2 language dump file. Currently this enables +@samp{-fdump-lang-quad} and @samp{-fdump-lang-gimple}. +This is an internal command line option. + +@item -fdump-lang-quad +generate internal debugging dump files containing the quadruple +intemediate representation of the source. + +@item -fdump-lang-quad=@file{filestem} +dump quadruple representation to the @file{filestem} specified. + +@item -fdump-lang-gimple +generate internal debugging dump files containing a modula-2 gimple +representation of the source. + +@item -fdump-lang-gimple=@file{filestem} +dump modula-2 gimple representation to the @file{filestem} specified. + @item -fdump-system-exports display all inbuilt system items. This is an internal command line option. @@ -474,6 +493,15 @@ this option forces the use of the static version. @c Modula-2 Joined @c set all location values to a specific value (internal switch) +@item -fm2-dump-filter=@samp{rules} +filter the language dumps @samp{-fdump-lang-quad} and +@samp{-fdump-lang-quad} on @samp{rules}. @samp{rules} must be a comma +separated list which can take three forms: the full decl textual name +of a procedure, @samp{[libname.]module.ident} or +@samp{[filename.]module.ident}. This is an internal command line +option. Currently it only filters on procedure names and regexp +matching is not implemented. + @item -fm2-g improve the debugging experience for new programmers at the expense of generating @code{nop} instructions if necessary to ensure single diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in index 45bfa933dca..73f0f3e85d1 100644 --- a/gcc/m2/Make-lang.in +++ b/gcc/m2/Make-lang.in @@ -519,7 +519,7 @@ SO=-O0 -g -fPIC # Language-specific object files for the gm2 compiler. GM2_C_OBJS = m2/gm2-lang.o \ - m2/m2pp.o \ + m2/gm2-gcc/m2pp.o \ m2/gm2-gcc/m2assert.o \ m2/gm2-gcc/m2block.o \ m2/gm2-gcc/m2builtins.o \ @@ -608,11 +608,6 @@ m2/gm2-lang.o: $(srcdir)/m2/gm2-lang.cc gt-m2-gm2-lang.h $(GCC_HEADER_DEPENDENCI $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) $(POSTCOMPILE) -m2/m2pp.o : $(srcdir)/m2/m2pp.cc $(GCC_HEADER_DEPENDENCIES_FOR_M2) - $(COMPILER) $(CM2DEP) -c -g -DGM2 $(ALL_COMPILERFLAGS) \ - $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) - $(POSTCOMPILE) - m2/gm2-gcc/rtegraph.o: $(srcdir)/m2/gm2-gcc/rtegraph.cc $(GCC_HEADER_DEPENDENCIES_FOR_M2) \ gt-m2-rtegraph.h -test -d $(@D)/$(DEPDIR) || $(mkinstalldirs) $(@D)/$(DEPDIR) @@ -761,6 +756,7 @@ GM2-COMP-BOOT-DEFS = \ M2GCCDeclare.def \ M2GenGCC.def \ M2Graph.def \ + M2LangDump.def \ M2LexBuf.def \ M2MetaError.def \ M2Optimize.def \ @@ -834,6 +830,7 @@ GM2-COMP-BOOT-MODS = \ M2GCCDeclare.mod \ M2GenGCC.mod \ M2Graph.mod \ + M2LangDump.mod \ M2LexBuf.mod \ M2MetaError.mod \ M2Optimize.mod \ @@ -886,6 +883,7 @@ GM2-GCC-DEFS = \ m2expr.def \ m2linemap.def \ m2misc.def \ + m2pp.def \ m2statement.def \ m2top.def \ m2tree.def \ @@ -1040,6 +1038,7 @@ GM2-COMP-DEFS = \ M2GCCDeclare.def \ M2GenGCC.def \ M2Graph.def \ + M2LangDump.def \ M2LexBuf.def \ M2MetaError.def \ M2Optimize.def \ @@ -1110,6 +1109,7 @@ GM2-COMP-MODS = \ M2GCCDeclare.mod \ M2GenGCC.mod \ M2Graph.mod \ + M2LangDump.mod \ M2LexBuf.mod \ M2MetaError.mod \ M2Optimize.mod \ diff --git a/gcc/m2/gm2-compiler/M2CaseList.mod b/gcc/m2/gm2-compiler/M2CaseList.mod index 08a6052e796..b98f55375bd 100644 --- a/gcc/m2/gm2-compiler/M2CaseList.mod +++ b/gcc/m2/gm2-compiler/M2CaseList.mod @@ -39,8 +39,8 @@ FROM m2type IMPORT GetMinFrom ; FROM m2expr IMPORT GetIntegerOne, CSTIntToString, CSTIntToChar ; FROM Storage IMPORT ALLOCATE ; FROM M2Base IMPORT IsExpressionCompatible, Char ; -FROM M2Printf IMPORT printf1 ; FROM M2LexBuf IMPORT TokenToLocation ; +FROM NumberIO IMPORT WriteCard ; FROM SymbolTable IMPORT NulSym, IsConst, IsFieldVarient, IsRecord, IsRecordField, GetVarientTag, GetType, ForeachLocalSymDo, GetSymName, IsEnumeration, SkipType, NoOfElements, GetNth, @@ -1191,7 +1191,7 @@ end InRangeList ; PROCEDURE WriteCase (c: CARDINAL) ; BEGIN (* this debugging PROCEDURE should be finished. *) - printf1 ("%d", c) + WriteCard (c, 0) END WriteCase ; diff --git a/gcc/m2/gm2-compiler/M2Code.mod b/gcc/m2/gm2-compiler/M2Code.mod index 010e1d02fca..ea06f362845 100644 --- a/gcc/m2/gm2-compiler/M2Code.mod +++ b/gcc/m2/gm2-compiler/M2Code.mod @@ -23,10 +23,12 @@ IMPLEMENTATION MODULE M2Code ; FROM SYSTEM IMPORT WORD ; -FROM M2Options IMPORT Statistics, DisplayQuadruples, OptimizeUncalledProcedures, - (* OptimizeDynamic, *) OptimizeCommonSubExpressions, - StyleChecking, Optimizing, WholeProgram ; +FROM M2Options IMPORT Statistics, OptimizeUncalledProcedures, + OptimizeCommonSubExpressions, + StyleChecking, Optimizing, WholeProgram, + DumpLangGimple ; +FROM M2LangDump IMPORT MakeGimpleTemplate ; FROM M2Error IMPORT InternalError ; FROM M2Students IMPORT StudentVariableCheck ; @@ -41,7 +43,8 @@ FROM M2Printf IMPORT printf2, printf1, printf0 ; FROM NameKey IMPORT Name ; FROM M2Batch IMPORT ForeachSourceModuleDo ; -FROM M2Quads IMPORT CountQuads, GetFirstQuad, DisplayQuadList, DisplayQuadRange, +FROM M2Quads IMPORT CountQuads, GetFirstQuad, + DumpQuadruples, DisplayQuadRange, BackPatchSubrangesAndOptParam, LoopAnalysis, ForLoopAnalysis, GetQuad, QuadOperator ; @@ -71,12 +74,14 @@ FROM m2flex IMPORT GetTotalLines ; FROM FIO IMPORT FlushBuffer, StdOut ; FROM M2Quiet IMPORT qprintf0 ; FROM M2SSA IMPORT DiscoverSSA ; +FROM m2pp IMPORT CreateDumpGimple, CloseDumpGimple ; +FROM DynamicStrings IMPORT String, KillString ; CONST - MaxOptimTimes = 10 ; (* upper limit of no of times we run through all optimization *) - Debugging = TRUE ; - + MaxOptimTimes = 10 ; (* upper limit of no of times we run through all optimization *) + Debugging = TRUE ; + TraceQuadruples = FALSE ; VAR Total, @@ -139,11 +144,7 @@ BEGIN printf1 ('Total source lines compiled : %6d\n', Count) ; FlushBuffer (StdOut) END ; - IF DisplayQuadruples - THEN - printf0 ('after all front end optimization\n') ; - DisplayQuadList - END + DumpQuadruples ('after all front end optimization\n') END OptimizationAnalysis ; @@ -198,11 +199,17 @@ END PrintModule ; *) PROCEDURE DoCodeBlock ; +VAR + filename: String ; + len : CARDINAL ; BEGIN - IF WholeProgram + IF DumpLangGimple THEN - (* ForeachSourceModuleDo(PrintModule) ; *) - CodeBlock (GetMainModule ()) + filename := MakeGimpleTemplate (len) ; + CreateDumpGimple (filename, len) ; + filename := KillString (filename) ; + CodeBlock (GetMainModule ()) ; + CloseDumpGimple ELSE CodeBlock (GetMainModule ()) END @@ -238,11 +245,7 @@ BEGIN ForLoopAnalysis ; (* must be done before any optimization as the index variable increment quad might change *) - IF DisplayQuadruples - THEN - printf0 ('before any optimization\n') ; - DisplayQuadList - END ; + DumpQuadruples ('before any optimization\n') ; (* now is a suitable time to check for student errors as *) (* we know all the front end symbols must be resolved. *) @@ -258,20 +261,9 @@ BEGIN InitDeclarations ; (* default and fixed sized types are all declared from now on. *) RemoveUnreachableCode ; - - IF DisplayQuadruples - THEN - printf0 ('after dead procedure elimination\n') ; - DisplayQuadList - END ; - + DumpQuadruples ('after dead procedure elimination\n') ; DetermineSubExpTemporaries ; - - IF DisplayQuadruples - THEN - printf0 ('after identifying simple subexpression temporaries\n') ; - DisplayQuadList - END ; + DumpQuadruples ('after identifying simple subexpression temporaries\n') ; qprintf0 (' symbols to gcc trees\n') ; DoModuleDeclare ; @@ -377,20 +369,6 @@ BEGIN END Init ; -(* - DisplayQuadsInScope - -*) - -(* -PROCEDURE DisplayQuadsInScope (sb: ScopeBlock) ; -BEGIN - printf0 ('Quads in scope\n') ; - ForeachScopeBlockDo (sb, DisplayQuadRange) ; - printf0 ('===============\n') -END DisplayQuadsInScope ; -*) - - (* OptimizeScopeBlock - *) @@ -416,21 +394,6 @@ BEGIN END OptimizeScopeBlock ; -(* - DisplayQuadNumbers - the range, start..end. -*) - -(* -PROCEDURE DisplayQuadNumbers (start, end: CARDINAL) ; -BEGIN - IF DisplayQuadruples - THEN - printf2 ('Coding [%d..%d]\n', start, end) - END -END DisplayQuadNumbers ; -*) - - (* CodeProceduresWithinBlock - codes the procedures within the module scope. *) @@ -465,7 +428,7 @@ VAR sb: ScopeBlock ; n : Name ; BEGIN - IF DisplayQuadruples + IF TraceQuadruples THEN n := GetSymName (scope) ; printf1 ('before coding block %a\n', n) @@ -474,7 +437,7 @@ BEGIN OptimizeScopeBlock (sb) ; IF IsProcedure (scope) THEN - IF DisplayQuadruples + IF TraceQuadruples THEN n := GetSymName(scope) ; printf1('before coding procedure %a\n', n) ; @@ -484,7 +447,7 @@ BEGIN ForeachScopeBlockDo2 (sb, ConvertQuadsToTree) ELSIF IsModuleWithinProcedure(scope) THEN - IF DisplayQuadruples + IF TraceQuadruples THEN n := GetSymName(scope) ; printf1('before coding module %a within procedure\n', n) ; @@ -494,7 +457,7 @@ BEGIN ForeachScopeBlockDo2 (sb, ConvertQuadsToTree) ; ForeachProcedureDo(scope, CodeBlock) ELSE - IF DisplayQuadruples + IF TraceQuadruples THEN n := GetSymName(scope) ; printf1('before coding module %a\n', n) ; diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod index dae5a6b34bd..80a4a536c62 100644 --- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod +++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod @@ -38,8 +38,7 @@ FROM M2Quads IMPORT DisplayQuadRange ; IMPORT FIO ; -FROM M2Options IMPORT DisplayQuadruples, - GenerateDebugging, GenerateLineDebug, Iso, Optimizing, WholeProgram, +FROM M2Options IMPORT GenerateDebugging, GenerateLineDebug, Iso, Optimizing, WholeProgram, ScaffoldStatic, GetRuntimeModuleOverride ; FROM M2AsmUtil IMPORT GetFullSymName, GetFullScopeAsmName ; @@ -209,10 +208,11 @@ TYPE CONST - Debugging = FALSE ; - Progress = FALSE ; - EnableSSA = FALSE ; - EnableWatch = FALSE ; + Debugging = FALSE ; + Progress = FALSE ; + EnableSSA = FALSE ; + EnableWatch = FALSE ; + TraceQuadruples = FALSE ; TYPE @@ -2767,7 +2767,7 @@ VAR copy: Group ; loop: CARDINAL ; BEGIN - IF DisplayQuadruples + IF TraceQuadruples THEN DisplayQuadRange (scope, start, end) END ; @@ -2783,7 +2783,7 @@ BEGIN END ; IF loop = DebugLoop THEN - IF DisplayQuadruples + IF TraceQuadruples THEN DisplayQuadRange (scope, start, end) END ; diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod index 25bfbf894aa..99f36413516 100644 --- a/gcc/m2/gm2-compiler/M2GenGCC.mod +++ b/gcc/m2/gm2-compiler/M2GenGCC.mod @@ -92,7 +92,7 @@ FROM M2Error IMPORT InternalError, WriteFormat0, WriteFormat1, WriteFormat2, War FROM M2MetaError IMPORT MetaErrorT0, MetaErrorT1, MetaErrorT2, MetaErrorT3, MetaError1, MetaError2, MetaErrorStringT1 ; -FROM M2Options IMPORT DisplayQuadruples, UnboundedByReference, PedanticCast, +FROM M2Options IMPORT UnboundedByReference, PedanticCast, VerboseUnbounded, Iso, Pim, DebugBuiltins, WholeProgram, StrictTypeChecking, AutoInit, cflag, ScaffoldMain, ScaffoldDynamic, ScaffoldStatic, @@ -256,8 +256,7 @@ FROM m2except IMPORT BuildThrow, BuildTryBegin, BuildTryEnd, FROM M2Quads IMPORT QuadOperator, GetQuad, IsReferenced, GetNextQuad, SubQuad, PutQuad, MustCheckOverflow, GetQuadOtok, QuadToTokenNo, DisplayQuad, GetQuadtok, - GetM2OperatorDesc, GetQuadOp, - DisplayQuadList ; + GetM2OperatorDesc, GetQuadOp ; FROM M2Check IMPORT ParameterTypeCompatible, AssignmentTypeCompatible, ExpressionTypeCompatible ; FROM M2SSA IMPORT EnableSSA ; @@ -640,11 +639,6 @@ BEGIN Changed := TRUE END UNTIL NoChange ; - IF Debugging AND DisplayQuadruples AND FALSE - THEN - printf0('after resolving expressions with gcc\n') ; - DisplayQuadList - END ; RETURN Changed END ResolveConstantExpressions ; diff --git a/gcc/m2/gm2-compiler/M2LangDump.def b/gcc/m2/gm2-compiler/M2LangDump.def new file mode 100644 index 00000000000..8298da2a54d --- /dev/null +++ b/gcc/m2/gm2-compiler/M2LangDump.def @@ -0,0 +1,65 @@ +(* M2LangDump.def provides support routines for the -flang-dump. + +Copyright (C) 2024 Free Software Foundation, Inc. +Contributed by Gaius Mulley . + +This file is part of GNU Modula-2. + +GNU Modula-2 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. + +GNU Modula-2 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 Modula-2; see the file COPYING3. If not see +. *) + +DEFINITION MODULE M2LangDump ; + +FROM m2tree IMPORT Tree ; +FROM DynamicStrings IMPORT String ; + + +(* + IsDumpRequiredTree - return TRUE if the gcc tree should be dumped. +*) + +PROCEDURE IsDumpRequiredTree (tree: Tree) : BOOLEAN ; + + +(* + IsDumpRequired - return TRUE if symbol sym should be dumped + according to the rules of the filter. + No filter specified will always return TRUE. + The filter is a comma separated list of either: + + DECL names for example: m2pim_NumberIO_HexToStr + filename:m2symbolname for example: NumberIO.mod:HexToStr + fully qualified m2name for example: NumberIO.HexToStr +*) + +PROCEDURE IsDumpRequired (sym: CARDINAL) : BOOLEAN ; + + +(* + MakeQuadTemplate - return a template for the quad dump file. +*) + +PROCEDURE MakeQuadTemplate () : String ; + + +(* + MakeGimpleTemplate - return a template for the gimple dump file and assign + len to the max number of characters required to complete + a template. +*) + +PROCEDURE MakeGimpleTemplate (VAR len: CARDINAL) : String ; + + +END M2LangDump. diff --git a/gcc/m2/gm2-compiler/M2LangDump.mod b/gcc/m2/gm2-compiler/M2LangDump.mod new file mode 100644 index 00000000000..ad822a75fc4 --- /dev/null +++ b/gcc/m2/gm2-compiler/M2LangDump.mod @@ -0,0 +1,457 @@ +(* M2LangDump.mod provides support routines for the -flang-dump. + +Copyright (C) 2024 Free Software Foundation, Inc. +Contributed by Gaius Mulley . + +This file is part of GNU Modula-2. + +GNU Modula-2 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. + +GNU Modula-2 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 Modula-2; see the file COPYING3. If not see +. *) + +IMPLEMENTATION MODULE M2LangDump ; + +FROM SYSTEM IMPORT ADDRESS ; + +FROM DynamicStrings IMPORT String, Length, InitString, Mark, Slice, EqualArray, + InitStringCharStar, ConCatChar, ConCat, KillString, + Dup, string, char, Index, ReverseIndex, RIndex, Equal, + PushAllocation, PopAllocationExemption ; + +FROM SymbolTable IMPORT NulSym, + GetSymName, GetLibName, + GetScope, GetModuleScope, GetMainModule, GetDeclaredMod, + IsInnerModule, + IsVar, + IsProcedure, + IsModule, + IsDefImp, + IsExportQualified, IsExportUnQualified, + IsExported, IsPublic, IsExtern, IsMonoName, + IsDefinitionForC ; + +FROM M2Options IMPORT GetM2DumpFilter, GetDumpDir, GetDumpLangQuadFilename, + GetDumpLangGimpleFilename ; + +FROM NameKey IMPORT Name, GetKey, MakeKey, makekey, KeyToCharStar, NulName ; +FROM SymbolConversion IMPORT Gcc2Mod, Mod2Gcc ; +FROM M2AsmUtil IMPORT GetFullScopeAsmName ; +FROM M2LexBuf IMPORT FindFileNameFromToken ; +FROM M2Printf IMPORT printf0, printf1, printf2 ; +FROM M2Error IMPORT InternalError ; +FROM libc IMPORT printf ; + + +CONST + Debugging = FALSE ; + + +(* + IsDumpRequiredTree - return TRUE if the gcc tree should be dumped. +*) + +PROCEDURE IsDumpRequiredTree (tree: Tree) : BOOLEAN ; +VAR + sym: CARDINAL ; +BEGIN + sym := Gcc2Mod (tree) ; + IF sym = NulSym + THEN + RETURN FALSE + ELSE + RETURN IsDumpRequired (sym) + END +END IsDumpRequiredTree ; + + +(* + IsDumpRequired - return TRUE if symbol sym should be dumped + according to the rules of the filter. + No filter specified will always return TRUE. + The filter is a comma separated list. Each element + of the list can specify a symbol three ways. + Firstly by DECL name for example: m2pim_NumberIO_HexToStr + Secondly by qualified scope: [pathname.]NumberIO.HexToStr + Thirdly by filename and scope: NumberIO.mod:HexToStr +*) + +PROCEDURE IsDumpRequired (sym: CARDINAL) : BOOLEAN ; +VAR + filter: String ; +BEGIN + filter := GetM2DumpFilter () ; + IF filter = NIL + THEN + RETURN TRUE + ELSE + RETURN Match (filter, sym) + END +END IsDumpRequired ; + + +(* + Match - return TRUE if sym matches any of the filter rules. +*) + +PROCEDURE Match (filter: ADDRESS; sym: CARDINAL) : BOOLEAN ; +VAR + result: BOOLEAN ; + rule, + full : String ; + start, + i : INTEGER ; +BEGIN + full := InitStringCharStar (filter) ; + start := 0 ; + REPEAT + i := Index (full, ',', start) ; + IF i = -1 + THEN + rule := Slice (full, start, 0) + ELSE + rule := Slice (full, start, i) + END ; + result := MatchRule (rule, sym) ; + rule := KillString (rule) ; + IF result + THEN + full := KillString (full) ; + RETURN TRUE + END ; + start := i+1 ; + UNTIL i = -1 ; + full := KillString (full) ; + RETURN FALSE +END Match ; + + +(* + MatchRule - return TRUE if rule matches sym. +*) + +PROCEDURE MatchRule (rule: String; sym: CARDINAL) : BOOLEAN ; +BEGIN + IF Index (rule, ':', 0) # -1 + THEN + (* Filename and scope qualification tests. *) + RETURN MatchRuleFilenameScope (rule, sym) + ELSIF Index (rule, '.', 0) # -1 + THEN + (* Modula-2 scoping tests. *) + RETURN MatchRuleScope (rule, sym) + ELSE + (* Text decl tests. *) + RETURN MatchRuleText (rule, sym) + END +END MatchRule ; + + +(* + MatchRuleFilenameScope - returns TRUE if rule contains filename.ext:qualident + and it matches sym. +*) + +PROCEDURE MatchRuleFilenameScope (rule: String; sym: CARDINAL) : BOOLEAN ; +VAR + rulefile, + symfile, + subrule : String ; +BEGIN + rulefile := Slice (rule, 0, Index (rule, ':', 0)) ; + (* Do not deallocate symfile. *) + symfile := FindFileNameFromToken (GetDeclaredMod (sym), 0) ; + IF TextMatch (rulefile, symfile) + THEN + subrule := Slice (rule, Index (rule, ':', 0) + 1, 0) ; + IF MatchRuleScope (subrule, sym) + THEN + subrule := KillString (subrule) ; + RETURN TRUE + END + END ; + rulefile := KillString (rulefile) ; + RETURN FALSE +END MatchRuleFilenameScope ; + + +(* + MatchRuleScope - returns TRUE if rule contains a [libname.]qualified.ident + and it matches sym. +*) + +PROCEDURE MatchRuleScope (rule: String; sym: CARDINAL) : BOOLEAN ; +VAR + i : INTEGER ; + name: Name ; +BEGIN + IF Debugging + THEN + name := GetSymName (sym) ; + printf2 ("MatchRuleScope (%s, %a)\n", rule, name) + END ; + (* Compare qualident right to left. *) + i := RIndex (rule, '.', 0) ; + IF i = -1 + THEN + (* No qualification, just the ident. *) + RETURN MatchRuleIdent (rule, sym) + ELSE + RETURN MatchRuleQualident (rule, Slice (rule, i+1, 0), i, sym) + END +END MatchRuleScope ; + + +(* + MatchRuleQualident - returns TRUE if rule matches qualified sym. + PostCondition: subrule will be deallocated upon exit. + TRUE is returned if rule matches qualified sym. +*) + +PROCEDURE MatchRuleQualident (rule, subrule: String; i: INTEGER; sym: CARDINAL) : BOOLEAN ; +VAR + scope: CARDINAL ; +BEGIN + IF TextCompareName (subrule, GetSymName (sym)) + THEN + IF NOT QualifiedScope (rule, sym, i, scope) + THEN + RETURN FALSE + END ; + IF OptionalLibname (rule, sym, i, scope) + THEN + RETURN TRUE + END + END ; + subrule := KillString (subrule) ; + IF Debugging + THEN + printf0 ("MatchRuleQualident FALSE\n") + END ; + RETURN FALSE +END MatchRuleQualident ; + + +(* + QualifiedScope - PostCondition: true is returned is rule matches a qualified sym. + i is -1 if no more qualifications or libname is found. + scope will be the set to the last outer scope seen. +*) + +PROCEDURE QualifiedScope (rule: String; sym: CARDINAL; VAR i: INTEGER; VAR scope: CARDINAL) : BOOLEAN ; +VAR + subrule: String ; + j : INTEGER ; + name : Name ; +BEGIN + IF Debugging + THEN + name := GetSymName (sym) ; + printf2 ("seen ident name, QualifiedScope (rule = %s, %a)\n", rule, name) + END ; + scope := sym ; + subrule := NIL ; + REPEAT + j := i ; + scope := GetScope (scope) ; + i := ReverseIndex (rule, '.', j - 1) ; + IF Debugging + THEN + printf2 (" reverseindex (rule = %s, '.', j = %d)\n", rule, j); + printf1 (" returns i = %d\n", i) + END ; + IF scope # NulSym + THEN + subrule := KillString (subrule) ; + subrule := Slice (rule, i + 1, j) ; + IF Debugging + THEN + name := GetSymName (scope) ; + printf2 ("QualifiedScope (subrule = %s, %a)\n", subrule, name) + END ; + IF NOT TextCompareName (subrule, GetSymName (scope)) + THEN + subrule := KillString (subrule) ; + IF Debugging + THEN + printf0 ("QualifiedScope FALSE\n") + END ; + RETURN FALSE + END + END + UNTIL (i <= 0) OR IsDefImp (scope) OR IsModule (scope) ; + subrule := KillString (subrule) ; + RETURN TRUE +END QualifiedScope ; + + +(* + OptionalLibname - returns TRUE if rule[0..dot] matches syms libname or + if there is no libname the scope is a module or defimp + symbol. +*) + +PROCEDURE OptionalLibname (rule: String; sym: CARDINAL; dot: INTEGER; scope: CARDINAL) : BOOLEAN ; +VAR + subrule: String ; +BEGIN + IF dot > 0 + THEN + (* Check for optional libname. *) + subrule := Slice (rule, 0, dot) ; + IF Debugging + THEN + printf2 ("checking for optional libname (subrule = %s, '.', dot = %d)\n", + rule, dot) + END ; + IF TextCompareName (subrule, GetLibName (GetModuleScope (sym))) + THEN + subrule := KillString (subrule) ; + IF Debugging + THEN + printf0 ("OptionalLibname TRUE\n") + END ; + RETURN TRUE + END ; + subrule := KillString (subrule) + ELSIF (scope # NulSym) AND (IsModule (scope) OR IsDefImp (scope)) + THEN + IF Debugging + THEN + printf0 ("OptionalLibname TRUE\n") + END ; + RETURN TRUE + END ; + RETURN FALSE +END OptionalLibname ; + + +(* + MatchRuleIdent - return TRUE if ident sym matches rule. + The ident must be in a module or defimp scope. +*) + +PROCEDURE MatchRuleIdent (rule: String; sym: CARDINAL) : BOOLEAN ; +VAR + scope: CARDINAL ; +BEGIN + IF TextCompareName (rule, GetSymName (sym)) + THEN + scope := GetScope (sym) ; + RETURN IsModule (scope) OR IsDefImp (scope) + END ; + RETURN FALSE +END MatchRuleIdent ; + + +(* + MatchRuleText - returns TRUE if rule matches sym. +*) + +PROCEDURE MatchRuleText (rule: String; sym: CARDINAL) : BOOLEAN ; +BEGIN + RETURN TextCompareName (rule, GetFullScopeAsmName (sym)) +END MatchRuleText ; + + +(* + TextCompareName - return TRUE if rule matches name. +*) + +PROCEDURE TextCompareName (rule: String; name: Name) : BOOLEAN ; +VAR + result: BOOLEAN ; + text : String ; +BEGIN + text := InitStringCharStar (KeyToCharStar (name)) ; + result := TextMatch (rule, text) ; + text := KillString (text) ; + RETURN result +END TextCompareName ; + + +(* + TextMatch - returns TRUE if rule matches text. Currently this + is a simple string compare, but could be extended + to implement regexp (seen in the rule). +*) + +PROCEDURE TextMatch (rule, text: String) : BOOLEAN ; +BEGIN + IF Debugging + THEN + printf2 ("TextMatch (%s, %s)\n", rule, text) + END ; + RETURN Equal (rule, text) +END TextMatch ; + + +(* + CreateTemplate - create and return a template filename with extension. + If the user has specified "-" then "-" is returned otherwise + a template is formed from "dumpdir + filename + .%03dl.extension". +*) + +PROCEDURE CreateTemplate (filename, extension: String) : String ; +BEGIN + IF filename = NIL + THEN + (* User has not specified a file. *) + IF GetDumpDir () = NIL + THEN + filename := InitStringCharStar (KeyToCharStar (GetSymName (GetMainModule ()))) + ELSE + filename := Dup (GetDumpDir ()) ; + filename := ConCat (filename, Mark (InitStringCharStar (KeyToCharStar (GetSymName (GetMainModule ()))))) + END ; + filename := ConCat (filename, Mark (InitString ('.mod'))) + ELSE + (* We need to duplicate the filename to create a new string before ConCat + is used later on. *) + filename := Dup (filename) + END ; + IF NOT EqualArray (filename, '-') + THEN + filename := ConCat (ConCat (filename, InitString ('.%03dl.')), extension) + END ; + RETURN filename +END CreateTemplate ; + + +(* + MakeQuadTemplate - return a template for the quad dump file. +*) + +PROCEDURE MakeQuadTemplate () : String ; +BEGIN + RETURN CreateTemplate (GetDumpLangQuadFilename (), InitString ('quad')) +END MakeQuadTemplate ; + + +(* + MakeGimpleTemplate - return a template for the gimple dump file and assign + len to the max number of characters required to complete + a template (including a nul terminator). +*) + +PROCEDURE MakeGimpleTemplate (VAR len: CARDINAL) : String ; +VAR + filename: String ; +BEGIN + filename := CreateTemplate (GetDumpLangGimpleFilename (), InitString ('gimple')) ; + len := Length (filename) ; (* This is a short cut based on '%03d' format + specifier used above. *) + RETURN filename +END MakeGimpleTemplate ; + + +END M2LangDump. diff --git a/gcc/m2/gm2-compiler/M2Options.def b/gcc/m2/gm2-compiler/M2Options.def index 4e5f4993f82..0303850e0b0 100644 --- a/gcc/m2/gm2-compiler/M2Options.def +++ b/gcc/m2/gm2-compiler/M2Options.def @@ -55,7 +55,8 @@ VAR PedanticCast, (* -Wpedantic-cast warns if sizes differ. *) Statistics, (* -fstatistics information about code *) StyleChecking, (* -Wstudents checks for common student errs*) - DisplayQuadruples, (* -Wq option will display quadruples. *) + DumpLangQuad, (* -fq, -fdump-lang-quad dump quadruples. *) + DumpLangGimple, (* -fdump-lang-gimple. *) UnboundedByReference, (* -funbounded-by-reference *) VerboseUnbounded, (* -Wverbose-unbounded *) OptimizeUncalledProcedures, (* -Ouncalled removes uncalled procedures *) @@ -1002,6 +1003,56 @@ PROCEDURE SetIEEELongDouble (value: BOOLEAN) ; PROCEDURE GetIEEELongDouble () : BOOLEAN ; +(* + GetDumpLangQuadFilename - returns the DumpLangQuadFilename. +*) + +PROCEDURE GetDumpLangQuadFilename () : String ; + + +(* + SetDumpLangQuadFilename - set DumpLangQuadFilename to filename. +*) + +PROCEDURE SetDumpLangQuadFilename (value: BOOLEAN; filename: ADDRESS) ; + + +(* + GetDumpLangGimpleFilename - returns the DumpLangGimpleFilename. +*) + +PROCEDURE GetDumpLangGimpleFilename () : String ; + + +(* + SetDumpLangGimpleFilename - set DumpLangGimpleFilename to filename. +*) + +PROCEDURE SetDumpLangGimpleFilename (value: BOOLEAN; filename: ADDRESS) ; + + +(* + SetM2DumpFilter - sets the filter to a comma separated list of procedures + and modules. +*) + +PROCEDURE SetM2DumpFilter (value: BOOLEAN; filter: ADDRESS) ; + + +(* + GetM2DumpFilter - returns the dump filter. +*) + +PROCEDURE GetM2DumpFilter () : ADDRESS ; + + +(* + GetDumpLangGimple - return TRUE if -fdump-lang-gimple is set. +*) + +PROCEDURE GetDumpLangGimple () : BOOLEAN ; + + (* FinaliseOptions - once all options have been parsed we set any inferred values. diff --git a/gcc/m2/gm2-compiler/M2Options.mod b/gcc/m2/gm2-compiler/M2Options.mod index ae4980860b0..3b96b7463f2 100644 --- a/gcc/m2/gm2-compiler/M2Options.mod +++ b/gcc/m2/gm2-compiler/M2Options.mod @@ -34,7 +34,6 @@ FROM m2linemap IMPORT location_t ; FROM m2configure IMPORT FullPathCPP, TargetIEEEQuadDefault ; FROM M2Error IMPORT InternalError ; - FROM DynamicStrings IMPORT String, Length, InitString, Mark, Slice, EqualArray, InitStringCharStar, ConCatChar, ConCat, KillString, Dup, string, char, @@ -56,6 +55,9 @@ CONST DefaultRuntimeModuleOverride = "m2iso:RTentity,m2iso:Storage,m2iso:SYSTEM,m2iso:M2RTS,m2iso:RTExceptions,m2iso:IOLink" ; VAR + DumpLangQuadFilename, + DumpLangGimpleFilename, + M2DumpFilter, M2Prefix, M2PathName, Barg, @@ -1049,7 +1051,9 @@ END SetSwig ; PROCEDURE SetQuadDebugging (value: BOOLEAN) ; BEGIN - DisplayQuadruples := value + DumpLangQuad := value ; + DumpLangQuadFilename := KillString (DumpLangQuadFilename) ; + DumpLangQuadFilename := InitString ('-') END SetQuadDebugging ; @@ -1670,6 +1674,96 @@ BEGIN END InitializeLongDoubleFlags ; +(* + GetDumpLangQuadFilename - returns the DumpLangQuadFilename. +*) + +PROCEDURE GetDumpLangQuadFilename () : String ; +BEGIN + RETURN DumpLangQuadFilename +END GetDumpLangQuadFilename ; + + +(* + SetDumpLangQuadFilename - +*) + +PROCEDURE SetDumpLangQuadFilename (value: BOOLEAN; filename: ADDRESS) ; +BEGIN + DumpLangQuad := value ; + DumpLangQuadFilename := KillString (DumpLangQuadFilename) ; + IF filename # NIL + THEN + DumpLangQuadFilename := InitStringCharStar (filename) + END +END SetDumpLangQuadFilename ; + + +(* + GetDumpLangGimpleFilename - returns the DumpLangGimpleFilename. +*) + +PROCEDURE GetDumpLangGimpleFilename () : String ; +BEGIN + RETURN DumpLangGimpleFilename +END GetDumpLangGimpleFilename ; + + +(* + SetDumpLangGimpleFilename - set DumpLangGimpleFilename to filename. +*) + +PROCEDURE SetDumpLangGimpleFilename (value: BOOLEAN; filename: ADDRESS) ; +BEGIN + DumpLangGimple := value ; + DumpLangGimpleFilename := KillString (DumpLangGimpleFilename) ; + IF value AND (filename # NIL) + THEN + DumpLangGimpleFilename := InitStringCharStar (filename) + END +END SetDumpLangGimpleFilename ; + + +(* + SetM2DumpFilter - sets the filter to a comma separated list of procedures + and modules. +*) + +PROCEDURE SetM2DumpFilter (value: BOOLEAN; filter: ADDRESS) ; +BEGIN + M2DumpFilter := KillString (M2DumpFilter) ; + IF value AND (filter # NIL) + THEN + M2DumpFilter := InitStringCharStar (filter) + END +END SetM2DumpFilter ; + + +(* + GetM2DumpFilter - returns the dump filter. +*) + +PROCEDURE GetM2DumpFilter () : ADDRESS ; +BEGIN + IF M2DumpFilter = NIL + THEN + RETURN NIL + ELSE + RETURN string (M2DumpFilter) + END +END GetM2DumpFilter ; + + +(* + GetDumpLangGimple - return TRUE if -fdump-lang-gimple is set. +*) + +PROCEDURE GetDumpLangGimple () : BOOLEAN ; +BEGIN + RETURN DumpLangGimple +END GetDumpLangGimple ; + + BEGIN cflag := FALSE ; (* -c. *) RuntimeModuleOverride := InitString (DefaultRuntimeModuleOverride) ; @@ -1691,7 +1785,7 @@ BEGIN Quiet := TRUE ; CC1Quiet := TRUE ; Profiling := FALSE ; - DisplayQuadruples := FALSE ; + DumpLangQuad := FALSE ; OptimizeBasicBlock := FALSE ; OptimizeUncalledProcedures := FALSE ; OptimizeCommonSubExpressions := FALSE ; @@ -1751,5 +1845,9 @@ BEGIN MQFlag := NIL ; InitializeLongDoubleFlags ; M2Prefix := InitString ('') ; - M2PathName := InitString ('') + M2PathName := InitString ('') ; + DumpLangQuadFilename := NIL ; + DumpLangGimpleFilename := NIL ; + DumpLangGimple := FALSE ; + M2DumpFilter := NIL END M2Options. diff --git a/gcc/m2/gm2-compiler/M2Quads.def b/gcc/m2/gm2-compiler/M2Quads.def index acc49c84b43..db1ec2c2055 100644 --- a/gcc/m2/gm2-compiler/M2Quads.def +++ b/gcc/m2/gm2-compiler/M2Quads.def @@ -125,7 +125,7 @@ EXPORT QUALIFIED StartBuildDefFile, StartBuildModFile, EndBuildFile, IsDefOrModFile, IsInitialisingConst, - DisplayQuadList, DisplayQuadRange, DisplayQuad, + DumpQuadruples, DisplayQuadRange, DisplayQuad, WriteOperator, BackPatchSubrangesAndOptParam, GetQuad, GetFirstQuad, GetNextQuad, PutQuad, @@ -436,10 +436,12 @@ PROCEDURE IsDefOrModFile (QuadNo: CARDINAL) : BOOLEAN ; (* - DisplayQuadList - displays all quads. + DumpQuadruples - dump all quadruples providing the -fq, -fdump-lang-quad, + -fdump-lang-quad= or -fdump-lang-all were issued to the + command line. *) -PROCEDURE DisplayQuadList ; +PROCEDURE DumpQuadruples (title: ARRAY OF CHAR) ; (* diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index a23fa32906e..70a0fbd974b 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -27,6 +27,7 @@ FROM M2Debug IMPORT Assert, WriteDebug ; FROM NameKey IMPORT Name, NulName, MakeKey, GetKey, makekey, KeyToCharStar, WriteKey ; FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3 ; FROM M2DebugStack IMPORT DebugStack ; +FROM StrLib IMPORT StrLen ; FROM M2Scaffold IMPORT DeclareScaffold, mainFunction, initFunction, finiFunction, linkFunction, PopulateCtorArray, ForeachModuleCallInit, ForeachModuleCallFinish ; @@ -159,7 +160,8 @@ FROM M2Error IMPORT Error, ErrorStringAt, ErrorStringAt2, ErrorStringsAt2, WarnStringAt, WarnStringAt2, WarnStringsAt2 ; -FROM M2Printf IMPORT printf0, printf1, printf2, printf3, printf4 ; +FROM M2Printf IMPORT fprintf0, fprintf1, fprintf2, fprintf3, fprintf4, + printf0, printf1, printf2, printf3, printf4 ; FROM M2Reserved IMPORT PlusTok, MinusTok, TimesTok, DivTok, ModTok, DivideTok, RemTok, @@ -217,8 +219,11 @@ FROM M2Options IMPORT NilChecking, UninitVariableChecking, ScaffoldDynamic, ScaffoldStatic, cflag, ScaffoldMain, SharedFlag, WholeProgram, - GetRuntimeModuleOverride ; + GetDumpDir, GetM2DumpFilter, + GetRuntimeModuleOverride, + DumpLangQuad ; +FROM M2LangDump IMPORT MakeQuadTemplate ; FROM M2Pass IMPORT IsPassCodeGeneration, IsNoPass ; FROM M2StackAddress IMPORT StackOfAddress, InitStackAddress, KillStackAddress, @@ -260,8 +265,9 @@ FROM M2Range IMPORT InitAssignmentRangeCheck, FROM M2CaseList IMPORT PushCase, PopCase, AddRange, BeginCaseList, EndCaseList, ElseCase ; FROM PCSymBuild IMPORT SkipConst ; FROM m2builtins IMPORT GetBuiltinTypeInfoType ; +FROM M2LangDump IMPORT IsDumpRequired ; -IMPORT M2Error ; +IMPORT M2Error, FIO, SFIO, DynamicStrings, StdIO ; CONST @@ -5473,9 +5479,9 @@ BEGIN THEN IF i<=ParamTotal THEN - printf0('; ') + printf0 ('; ') ELSE - printf0(' ) ; \n') + printf0 (' ) ; \n') END END END @@ -13182,23 +13188,206 @@ BEGIN END GenQuadOtok ; +VAR + outputFile: FIO.File ; + mustClose : BOOLEAN ; + NoOfDumps : CARDINAL ; + + +(* + DumpWrite - writes a single ch to the dump output. +*) + +PROCEDURE DumpWrite (ch: CHAR) ; +BEGIN + FIO.WriteChar (outputFile, ch) +END DumpWrite ; + + (* - DisplayQuadList - displays all quads. + CloseOutput - close the dump output file. *) -PROCEDURE DisplayQuadList ; +PROCEDURE CloseOutput ; +BEGIN + IF mustClose + THEN + FIO.Close (outputFile) ; + mustClose := FALSE + ELSE + FIO.FlushBuffer (outputFile) + END ; + StdIO.PopOutput ; + outputFile := FIO.StdOut +END CloseOutput ; + + +(* + ConfigureOutput - configure the dump file for a quad dump. +*) + +PROCEDURE ConfigureOutput ; +VAR + filename: String ; +BEGIN + INC (NoOfDumps) ; + filename := MakeQuadTemplate () ; + IF DynamicStrings.EqualArray (filename, '-') + THEN + mustClose := FALSE ; + outputFile := FIO.StdOut + ELSE + filename := Sprintf1 (filename, NoOfDumps) ; + outputFile := SFIO.OpenToWrite (filename) ; + mustClose := FIO.IsNoError (outputFile) + END ; + filename := KillString (filename) ; + StdIO.PushOutput (DumpWrite) +END ConfigureOutput ; + + +(* + DumpUntil - dump all quadruples until we seen the ending quadruple + with procsym in the third operand. + Return the quad number containing the match. +*) + +PROCEDURE DumpUntil (ending: QuadOperator; + procsym: CARDINAL; quad: CARDINAL) : CARDINAL ; +VAR + op : QuadOperator ; + op1, op2, op3: CARDINAL ; + f : QuadFrame ; +BEGIN + fprintf0 (outputFile, '\n...\n\n'); + REPEAT + GetQuad (quad, op, op1, op2, op3) ; + DisplayQuad (quad) ; + f := GetQF (quad) ; + quad := f^.Next + UNTIL (op = ending) AND (op3 = procsym) ; + RETURN quad +END DumpUntil ; + + +(* + GetCtorInit - return the init procedure for the module. +*) + +PROCEDURE GetCtorInit (sym: CARDINAL) : CARDINAL ; +VAR + ctor, init, fini, dep: CARDINAL ; +BEGIN + GetModuleCtors (sym, ctor, init, fini, dep) ; + RETURN init +END GetCtorInit ; + + +(* + GetCtorFini - return the fini procedure for the module. +*) + +PROCEDURE GetCtorFini (sym: CARDINAL) : CARDINAL ; +VAR + ctor, init, fini, dep: CARDINAL ; +BEGIN + GetModuleCtors (sym, ctor, init, fini, dep) ; + RETURN fini +END GetCtorFini ; + + +(* + DumpQuadrupleFilter - +*) + +PROCEDURE DumpQuadrupleFilter ; +VAR + f : QuadFrame ; + i : CARDINAL ; + op : QuadOperator ; + proc, + op1, op2, op3: CARDINAL ; +BEGIN + i := Head ; + WHILE i # 0 DO + GetQuad (i, op, op1, op2, op3) ; + IF (op = ProcedureScopeOp) AND IsDumpRequired (op3) + THEN + i := DumpUntil (KillLocalVarOp, op3, i) + ELSIF (op = InitStartOp) AND IsDumpRequired (GetCtorInit (op3)) + THEN + i := DumpUntil (InitEndOp, op3, i) + ELSIF (op = FinallyStartOp) AND IsDumpRequired (GetCtorFini (op3)) + THEN + i := DumpUntil (FinallyEndOp, op3, i) + ELSE + f := GetQF (i) ; + i := f^.Next + END + END +END DumpQuadrupleFilter ; + + +(* + DumpQuadrupleAll - dump all quadruples. +*) + +PROCEDURE DumpQuadrupleAll ; VAR - i: CARDINAL ; f: QuadFrame ; + i: CARDINAL ; BEGIN - printf0('Quadruples:\n') ; i := Head ; - WHILE i#0 DO - DisplayQuad(i) ; - f := GetQF(i) ; + WHILE i # 0 DO + DisplayQuad (i) ; + f := GetQF (i) ; i := f^.Next END -END DisplayQuadList ; +END DumpQuadrupleAll ; + + +(* + DumpQuadruples - dump all quadruples providing the -fq, -fdump-lang-quad, + -fdump-lang-quad= or -fdump-lang-all were issued to the + command line. +*) + +PROCEDURE DumpQuadruples (title: ARRAY OF CHAR) ; +VAR + len, + text, + i : CARDINAL ; + s : String ; +BEGIN + IF DumpLangQuad + THEN + ConfigureOutput ; + s := Sprintf0 (Mark (InitString (title))) ; + s := KillString (SFIO.WriteS (outputFile, s)) ; + len := StrLen (title) ; + i := 0 ; + text := 0 ; + WHILE i < len DO + IF title[i] = '\' + THEN + INC (i, 2) + ELSE + INC (i) ; + INC (text) + END + END ; + s := DynamicStrings.Mult (Mark (InitString ('=')), text) ; + s := KillString (SFIO.WriteS (outputFile, s)) ; + fprintf0 (outputFile, '\n'); + IF GetM2DumpFilter () = NIL + THEN + DumpQuadrupleAll + ELSE + DumpQuadrupleFilter + END ; + CloseOutput + END +END DumpQuadruples ; (* @@ -13209,7 +13398,7 @@ PROCEDURE DisplayQuadRange (scope: CARDINAL; start, end: CARDINAL) ; VAR f: QuadFrame ; BEGIN - printf1 ('Quadruples for scope: %d\n', scope) ; + fprintf1 (outputFile, 'Quadruples for scope: %d\n', scope) ; WHILE (start <= end) AND (start # 0) DO DisplayQuad (start) ; f := GetQF (start) ; @@ -13341,7 +13530,7 @@ END ds ; PROCEDURE DisplayQuad (QuadNo: CARDINAL) ; BEGIN DSdbEnter ; - printf1('%4d ', QuadNo) ; WriteQuad(QuadNo) ; printf0('\n') ; + fprintf1 (outputFile, '%4d ', QuadNo) ; WriteQuad(QuadNo) ; fprintf0 (outputFile, '\n') ; DSdbExit END DisplayQuad ; @@ -13354,19 +13543,19 @@ PROCEDURE DisplayProcedureAttributes (proc: CARDINAL) ; BEGIN IF IsCtor (proc) THEN - printf0 (" (ctor)") + fprintf0 (outputFile, " (ctor)") END ; IF IsPublic (proc) THEN - printf0 (" (public)") + fprintf0 (outputFile, " (public)") END ; IF IsExtern (proc) THEN - printf0 (" (extern)") + fprintf0 (outputFile, " (extern)") END ; IF IsMonoName (proc) THEN - printf0 (" (mononame)") + fprintf0 (outputFile, " (mononame)") END END DisplayProcedureAttributes ; @@ -13385,11 +13574,11 @@ BEGIN f := GetQF(BufferQuad) ; WITH f^ DO WriteOperator(Operator) ; - printf1(' [%d] ', NoOfTimesReferenced) ; + fprintf1 (outputFile, ' [%d] ', NoOfTimesReferenced) ; CASE Operator OF HighOp : WriteOperand(Operand1) ; - printf1(' %4d ', Operand2) ; + fprintf1 (outputFile, ' %4d ', Operand2) ; WriteOperand(Operand3) | InitAddressOp, SavePriorityOp, @@ -13404,7 +13593,7 @@ BEGIN FunctValueOp, NegateOp, AddrOp : WriteOperand(Operand1) ; - printf0(' ') ; + fprintf0 (outputFile, ' ') ; WriteOperand(Operand3) | ElementSizeOp, IfInOp, @@ -13415,22 +13604,22 @@ BEGIN IfGreOp, IfLessEquOp, IfGreEquOp : WriteOperand(Operand1) ; - printf0(' ') ; + fprintf0 (outputFile, ' ') ; WriteOperand(Operand2) ; - printf1(' %4d', Operand3) | + fprintf1 (outputFile, ' %4d', Operand3) | InlineOp, RetryOp, TryOp, - GotoOp : printf1('%4d', Operand3) | + GotoOp : fprintf1 (outputFile, '%4d', Operand3) | StatementNoteOp : l := TokenToLineNo(Operand3, 0) ; n := GetTokenName (Operand3) ; - printf4('%a:%d:%a (tokenno %d)', Operand1, l, n, Operand3) | - LineNumberOp : printf2('%a:%d', Operand1, Operand3) | + fprintf4 (outputFile, '%a:%d:%a (tokenno %d)', Operand1, l, n, Operand3) | + LineNumberOp : fprintf2 (outputFile, '%a:%d', Operand1, Operand3) | EndFileOp : n1 := GetSymName(Operand3) ; - printf1('%a', n1) | + fprintf1 (outputFile, '%a', n1) | ThrowOp, ReturnOp, @@ -13439,7 +13628,7 @@ BEGIN ProcedureScopeOp : n1 := GetSymName(Operand2) ; n2 := GetSymName(Operand3) ; - printf3(' %4d %a %a', Operand1, n1, n2) ; + fprintf3 (outputFile, ' %4d %a %a', Operand1, n1, n2) ; DisplayProcedureAttributes (Operand3) | NewLocalVarOp, FinallyStartOp, @@ -13447,19 +13636,19 @@ BEGIN InitEndOp, InitStartOp : n1 := GetSymName(Operand2) ; n2 := GetSymName(Operand3) ; - printf3(' %4d %a %a', Operand1, n1, n2) | + fprintf3 (outputFile, ' %4d %a %a', Operand1, n1, n2) | ModuleScopeOp, StartModFileOp : n1 := GetSymName(Operand3) ; - printf4('%a:%d %a(%d)', Operand2, Operand1, n1, Operand3) | + fprintf4 (outputFile, '%a:%d %a(%d)', Operand2, Operand1, n1, Operand3) | StartDefFileOp : n1 := GetSymName(Operand3) ; - printf2(' %4d %a', Operand1, n1) | + fprintf2 (outputFile, ' %4d %a', Operand1, n1) | OptParamOp, - ParamOp : printf1('%4d ', Operand1) ; + ParamOp : fprintf1 (outputFile, '%4d ', Operand1) ; WriteOperand(Operand2) ; - printf0(' ') ; + fprintf0 (outputFile, ' ') ; WriteOperand(Operand3) | SizeOp, RecordFieldOp, @@ -13487,9 +13676,9 @@ BEGIN DivFloorOp, ModTruncOp, DivTruncOp : WriteOperand(Operand1) ; - printf0(' ') ; + fprintf0 (outputFile, ' ') ; WriteOperand(Operand2) ; - printf0(' ') ; + fprintf0 (outputFile, ' ') ; WriteOperand(Operand3) | DummyOp, CodeOnOp, @@ -13499,23 +13688,23 @@ BEGIN OptimizeOnOp, OptimizeOffOp : | BuiltinConstOp : WriteOperand(Operand1) ; - printf1(' %a', Operand3) | + fprintf1 (outputFile, ' %a', Operand3) | BuiltinTypeInfoOp : WriteOperand(Operand1) ; - printf1(' %a', Operand2) ; - printf1(' %a', Operand3) | + fprintf1 (outputFile, ' %a', Operand2) ; + fprintf1 (outputFile, ' %a', Operand3) | StandardFunctionOp: WriteOperand(Operand1) ; - printf0(' ') ; + fprintf0 (outputFile, ' ') ; WriteOperand(Operand2) ; - printf0(' ') ; + fprintf0 (outputFile, ' ') ; WriteOperand(Operand3) | CatchBeginOp, CatchEndOp : | RangeCheckOp, - ErrorOp : WriteRangeCheck(Operand3) | + ErrorOp : WriteRangeCheck (Operand3) | SaveExceptionOp, RestoreExceptionOp: WriteOperand(Operand1) ; - printf0(' ') ; + fprintf0 (outputFile, ' ') ; WriteOperand(Operand3) ELSE @@ -13533,91 +13722,91 @@ PROCEDURE WriteOperator (Operator: QuadOperator) ; BEGIN CASE Operator OF - ArithAddOp : printf0('Arith + ') | - InitAddressOp : printf0('InitAddress ') | - LogicalOrOp : printf0('Or ') | - LogicalAndOp : printf0('And ') | - LogicalXorOp : printf0('Xor ') | - LogicalDiffOp : printf0('Ldiff ') | - LogicalShiftOp : printf0('Shift ') | - LogicalRotateOp : printf0('Rotate ') | - BecomesOp : printf0('Becomes ') | - IndrXOp : printf0('IndrX ') | - XIndrOp : printf0('XIndr ') | - ArrayOp : printf0('Array ') | - ElementSizeOp : printf0('ElementSize ') | - RecordFieldOp : printf0('RecordField ') | - AddrOp : printf0('Addr ') | - SizeOp : printf0('Size ') | - IfInOp : printf0('If IN ') | - IfNotInOp : printf0('If NOT IN ') | - IfNotEquOp : printf0('If <> ') | - IfEquOp : printf0('If = ') | - IfLessEquOp : printf0('If <= ') | - IfGreEquOp : printf0('If >= ') | - IfGreOp : printf0('If > ') | - IfLessOp : printf0('If < ') | - GotoOp : printf0('Goto ') | - DummyOp : printf0('Dummy ') | - ModuleScopeOp : printf0('ModuleScopeOp ') | - StartDefFileOp : printf0('StartDefFile ') | - StartModFileOp : printf0('StartModFile ') | - EndFileOp : printf0('EndFileOp ') | - InitStartOp : printf0('InitStart ') | - InitEndOp : printf0('InitEnd ') | - FinallyStartOp : printf0('FinallyStart ') | - FinallyEndOp : printf0('FinallyEnd ') | - RetryOp : printf0('Retry ') | - TryOp : printf0('Try ') | - ThrowOp : printf0('Throw ') | - CatchBeginOp : printf0('CatchBegin ') | - CatchEndOp : printf0('CatchEnd ') | - AddOp : printf0('+ ') | - SubOp : printf0('- ') | - DivM2Op : printf0('DIV M2 ') | - ModM2Op : printf0('MOD M2 ') | - DivCeilOp : printf0('DIV ceil ') | - ModCeilOp : printf0('MOD ceil ') | - DivFloorOp : printf0('DIV floor ') | - ModFloorOp : printf0('MOD floor ') | - DivTruncOp : printf0('DIV trunc ') | - ModTruncOp : printf0('MOD trunc ') | - MultOp : printf0('* ') | - NegateOp : printf0('Negate ') | - InclOp : printf0('Incl ') | - ExclOp : printf0('Excl ') | - ReturnOp : printf0('Return ') | - ReturnValueOp : printf0('ReturnValue ') | - FunctValueOp : printf0('FunctValue ') | - CallOp : printf0('Call ') | - ParamOp : printf0('Param ') | - OptParamOp : printf0('OptParam ') | - NewLocalVarOp : printf0('NewLocalVar ') | - KillLocalVarOp : printf0('KillLocalVar ') | - ProcedureScopeOp : printf0('ProcedureScope ') | - UnboundedOp : printf0('Unbounded ') | - CoerceOp : printf0('Coerce ') | - ConvertOp : printf0('Convert ') | - CastOp : printf0('Cast ') | - HighOp : printf0('High ') | - CodeOnOp : printf0('CodeOn ') | - CodeOffOp : printf0('CodeOff ') | - ProfileOnOp : printf0('ProfileOn ') | - ProfileOffOp : printf0('ProfileOff ') | - OptimizeOnOp : printf0('OptimizeOn ') | - OptimizeOffOp : printf0('OptimizeOff ') | - InlineOp : printf0('Inline ') | - StatementNoteOp : printf0('StatementNote ') | - LineNumberOp : printf0('LineNumber ') | - BuiltinConstOp : printf0('BuiltinConst ') | - BuiltinTypeInfoOp : printf0('BuiltinTypeInfo ') | - StandardFunctionOp : printf0('StandardFunction ') | - SavePriorityOp : printf0('SavePriority ') | - RestorePriorityOp : printf0('RestorePriority ') | - RangeCheckOp : printf0('RangeCheck ') | - ErrorOp : printf0('Error ') | - SaveExceptionOp : printf0('SaveException ') | - RestoreExceptionOp : printf0('RestoreException ') + ArithAddOp : fprintf0 (outputFile, 'Arith + ') | + InitAddressOp : fprintf0 (outputFile, 'InitAddress ') | + LogicalOrOp : fprintf0 (outputFile, 'Or ') | + LogicalAndOp : fprintf0 (outputFile, 'And ') | + LogicalXorOp : fprintf0 (outputFile, 'Xor ') | + LogicalDiffOp : fprintf0 (outputFile, 'Ldiff ') | + LogicalShiftOp : fprintf0 (outputFile, 'Shift ') | + LogicalRotateOp : fprintf0 (outputFile, 'Rotate ') | + BecomesOp : fprintf0 (outputFile, 'Becomes ') | + IndrXOp : fprintf0 (outputFile, 'IndrX ') | + XIndrOp : fprintf0 (outputFile, 'XIndr ') | + ArrayOp : fprintf0 (outputFile, 'Array ') | + ElementSizeOp : fprintf0 (outputFile, 'ElementSize ') | + RecordFieldOp : fprintf0 (outputFile, 'RecordField ') | + AddrOp : fprintf0 (outputFile, 'Addr ') | + SizeOp : fprintf0 (outputFile, 'Size ') | + IfInOp : fprintf0 (outputFile, 'If IN ') | + IfNotInOp : fprintf0 (outputFile, 'If NOT IN ') | + IfNotEquOp : fprintf0 (outputFile, 'If <> ') | + IfEquOp : fprintf0 (outputFile, 'If = ') | + IfLessEquOp : fprintf0 (outputFile, 'If <= ') | + IfGreEquOp : fprintf0 (outputFile, 'If >= ') | + IfGreOp : fprintf0 (outputFile, 'If > ') | + IfLessOp : fprintf0 (outputFile, 'If < ') | + GotoOp : fprintf0 (outputFile, 'Goto ') | + DummyOp : fprintf0 (outputFile, 'Dummy ') | + ModuleScopeOp : fprintf0 (outputFile, 'ModuleScopeOp ') | + StartDefFileOp : fprintf0 (outputFile, 'StartDefFile ') | + StartModFileOp : fprintf0 (outputFile, 'StartModFile ') | + EndFileOp : fprintf0 (outputFile, 'EndFileOp ') | + InitStartOp : fprintf0 (outputFile, 'InitStart ') | + InitEndOp : fprintf0 (outputFile, 'InitEnd ') | + FinallyStartOp : fprintf0 (outputFile, 'FinallyStart ') | + FinallyEndOp : fprintf0 (outputFile, 'FinallyEnd ') | + RetryOp : fprintf0 (outputFile, 'Retry ') | + TryOp : fprintf0 (outputFile, 'Try ') | + ThrowOp : fprintf0 (outputFile, 'Throw ') | + CatchBeginOp : fprintf0 (outputFile, 'CatchBegin ') | + CatchEndOp : fprintf0 (outputFile, 'CatchEnd ') | + AddOp : fprintf0 (outputFile, '+ ') | + SubOp : fprintf0 (outputFile, '- ') | + DivM2Op : fprintf0 (outputFile, 'DIV M2 ') | + ModM2Op : fprintf0 (outputFile, 'MOD M2 ') | + DivCeilOp : fprintf0 (outputFile, 'DIV ceil ') | + ModCeilOp : fprintf0 (outputFile, 'MOD ceil ') | + DivFloorOp : fprintf0 (outputFile, 'DIV floor ') | + ModFloorOp : fprintf0 (outputFile, 'MOD floor ') | + DivTruncOp : fprintf0 (outputFile, 'DIV trunc ') | + ModTruncOp : fprintf0 (outputFile, 'MOD trunc ') | + MultOp : fprintf0 (outputFile, '* ') | + NegateOp : fprintf0 (outputFile, 'Negate ') | + InclOp : fprintf0 (outputFile, 'Incl ') | + ExclOp : fprintf0 (outputFile, 'Excl ') | + ReturnOp : fprintf0 (outputFile, 'Return ') | + ReturnValueOp : fprintf0 (outputFile, 'ReturnValue ') | + FunctValueOp : fprintf0 (outputFile, 'FunctValue ') | + CallOp : fprintf0 (outputFile, 'Call ') | + ParamOp : fprintf0 (outputFile, 'Param ') | + OptParamOp : fprintf0 (outputFile, 'OptParam ') | + NewLocalVarOp : fprintf0 (outputFile, 'NewLocalVar ') | + KillLocalVarOp : fprintf0 (outputFile, 'KillLocalVar ') | + ProcedureScopeOp : fprintf0 (outputFile, 'ProcedureScope ') | + UnboundedOp : fprintf0 (outputFile, 'Unbounded ') | + CoerceOp : fprintf0 (outputFile, 'Coerce ') | + ConvertOp : fprintf0 (outputFile, 'Convert ') | + CastOp : fprintf0 (outputFile, 'Cast ') | + HighOp : fprintf0 (outputFile, 'High ') | + CodeOnOp : fprintf0 (outputFile, 'CodeOn ') | + CodeOffOp : fprintf0 (outputFile, 'CodeOff ') | + ProfileOnOp : fprintf0 (outputFile, 'ProfileOn ') | + ProfileOffOp : fprintf0 (outputFile, 'ProfileOff ') | + OptimizeOnOp : fprintf0 (outputFile, 'OptimizeOn ') | + OptimizeOffOp : fprintf0 (outputFile, 'OptimizeOff ') | + InlineOp : fprintf0 (outputFile, 'Inline ') | + StatementNoteOp : fprintf0 (outputFile, 'StatementNote ') | + LineNumberOp : fprintf0 (outputFile, 'LineNumber ') | + BuiltinConstOp : fprintf0 (outputFile, 'BuiltinConst ') | + BuiltinTypeInfoOp : fprintf0 (outputFile, 'BuiltinTypeInfo ') | + StandardFunctionOp : fprintf0 (outputFile, 'StandardFunction ') | + SavePriorityOp : fprintf0 (outputFile, 'SavePriority ') | + RestorePriorityOp : fprintf0 (outputFile, 'RestorePriority ') | + RangeCheckOp : fprintf0 (outputFile, 'RangeCheck ') | + ErrorOp : fprintf0 (outputFile, 'Error ') | + SaveExceptionOp : fprintf0 (outputFile, 'SaveException ') | + RestoreExceptionOp : fprintf0 (outputFile, 'RestoreException ') ELSE InternalError ('operator not expected') @@ -13635,15 +13824,15 @@ VAR BEGIN IF Sym = NulSym THEN - printf0 ('') + fprintf0 (outputFile, '') ELSE n := GetSymName (Sym) ; - printf1 ('%a', n) ; + fprintf1 (outputFile, '%a', n) ; IF IsVar (Sym) OR IsConst (Sym) THEN - printf0 ('[') ; WriteMode (GetMode (Sym)) ; printf0(']') + fprintf0 (outputFile, '[') ; WriteMode (GetMode (Sym)) ; fprintf0 (outputFile, ']') END ; - printf1 ('(%d)', Sym) + fprintf1 (outputFile, '(%d)', Sym) END END WriteOperand ; @@ -13652,10 +13841,10 @@ PROCEDURE WriteMode (Mode: ModeOfAddr) ; BEGIN CASE Mode OF - ImmediateValue: printf0('i') | - NoValue : printf0('n') | - RightValue : printf0('r') | - LeftValue : printf0('l') + ImmediateValue: fprintf0 (outputFile, 'i') | + NoValue : fprintf0 (outputFile, 'n') | + RightValue : fprintf0 (outputFile, 'r') | + LeftValue : fprintf0 (outputFile, 'l') ELSE InternalError ('unrecognised mode') @@ -15357,7 +15546,9 @@ BEGIN FreeLineList := NIL ; InitList(VarientFields) ; VarientFieldNo := 0 ; - NoOfQuads := 0 + NoOfQuads := 0 ; + NoOfDumps := 0 ; + outputFile := FIO.StdOut END Init ; diff --git a/gcc/m2/gm2-compiler/M2Scope.mod b/gcc/m2/gm2-compiler/M2Scope.mod index f157ad42ba6..2c2ff459d81 100644 --- a/gcc/m2/gm2-compiler/M2Scope.mod +++ b/gcc/m2/gm2-compiler/M2Scope.mod @@ -29,7 +29,6 @@ FROM SymbolTable IMPORT IsProcedure, IsDefImp, GetProcedureQuads, GetScope, GetProcedureScope, IsModule, IsModuleWithinProcedure, GetSymName, GetErrorScope, NulSym ; -FROM M2Options IMPORT DisplayQuadruples ; FROM M2Printf IMPORT printf0, printf1 ; FROM M2Quads IMPORT QuadOperator, GetFirstQuad, GetNextQuad, GetQuad, DisplayQuadRange ; FROM M2StackWord IMPORT StackOfWord, InitStackWord, KillStackWord, @@ -38,7 +37,8 @@ IMPORT M2Error ; CONST - Debugging = FALSE ; + Debugging = FALSE ; + TraceQuadruples = FALSE ; TYPE scopeKind = (unsetscope, ignorescope, procedurescope, modulescope, definitionscope, implementationscope, programscope) ; @@ -381,7 +381,7 @@ BEGIN ELSE sb := GetGlobalQuads (sb, scope) ; END ; - IF DisplayQuadruples + IF TraceQuadruples THEN DisplayScope (sb) END @@ -416,13 +416,13 @@ END KillScopeBlock ; PROCEDURE ForeachScopeBlockDo2 (sb: ScopeBlock; p: ScopeProcedure2) ; BEGIN - IF DisplayQuadruples + IF TraceQuadruples THEN printf0 ("ForeachScopeBlockDo\n") END ; WHILE sb#NIL DO WITH sb^ DO - IF DisplayQuadruples + IF TraceQuadruples THEN DisplayScope (sb) END ; @@ -435,7 +435,7 @@ BEGIN END ; sb := sb^.next END ; - IF DisplayQuadruples + IF TraceQuadruples THEN printf0 ("end ForeachScopeBlockDo\n\n") END ; @@ -449,13 +449,13 @@ END ForeachScopeBlockDo2 ; PROCEDURE ForeachScopeBlockDo3 (sb: ScopeBlock; p: ScopeProcedure3) ; BEGIN - IF DisplayQuadruples + IF TraceQuadruples THEN printf0 ("ForeachScopeBlockDo\n") END ; WHILE sb#NIL DO WITH sb^ DO - IF DisplayQuadruples + IF TraceQuadruples THEN DisplayScope (sb) END ; @@ -468,7 +468,7 @@ BEGIN END ; sb := sb^.next END ; - IF DisplayQuadruples + IF TraceQuadruples THEN printf0 ("end ForeachScopeBlockDo\n\n") END ; diff --git a/gcc/m2/gm2-compiler/SymbolConversion.def b/gcc/m2/gm2-compiler/SymbolConversion.def index 8f8d4650ce2..81a52e4aa1e 100644 --- a/gcc/m2/gm2-compiler/SymbolConversion.def +++ b/gcc/m2/gm2-compiler/SymbolConversion.def @@ -31,8 +31,6 @@ DEFINITION MODULE SymbolConversion ; FROM m2tree IMPORT Tree ; FROM SYSTEM IMPORT WORD ; -EXPORT QUALIFIED Mod2Gcc, AddModGcc, GccKnowsAbout, AddTemporaryKnown, - RemoveTemporaryKnown, Poison, RemoveMod2Gcc ; (* @@ -42,6 +40,13 @@ EXPORT QUALIFIED Mod2Gcc, AddModGcc, GccKnowsAbout, AddTemporaryKnown, PROCEDURE Mod2Gcc (sym: CARDINAL) : Tree ; +(* + Gcc2Mod - given a gcc tree return the modula-2 symbol. +*) + +PROCEDURE Gcc2Mod (tree: Tree) : CARDINAL ; + + (* AddModGcc - adds the tuple [ sym, gcc ] into the database. *) diff --git a/gcc/m2/gm2-compiler/SymbolConversion.mod b/gcc/m2/gm2-compiler/SymbolConversion.mod index c3c484db00a..39d23e1fd7f 100644 --- a/gcc/m2/gm2-compiler/SymbolConversion.mod +++ b/gcc/m2/gm2-compiler/SymbolConversion.mod @@ -24,10 +24,10 @@ IMPLEMENTATION MODULE SymbolConversion ; FROM NameKey IMPORT Name ; FROM Indexing IMPORT Index, InitIndex, PutIndice, GetIndice, InBounds, - DebugIndex ; + DebugIndex, HighIndice ; FROM SymbolTable IMPORT IsConst, PopValue, IsValueSolved, GetSymName, - GetType, SkipType ; + GetType, SkipType, NulSym ; FROM M2Error IMPORT InternalError ; FROM M2ALU IMPORT PushTypeOfTree ; @@ -87,6 +87,27 @@ BEGIN END Mod2Gcc ; +(* + Gcc2Mod - given a gcc tree return the modula-2 symbol. +*) + +PROCEDURE Gcc2Mod (tree: Tree) : CARDINAL ; +VAR + high, i: CARDINAL ; +BEGIN + i := 1 ; + high := HighIndice (mod2gcc) ; + WHILE i <= high DO + IF GetIndice (mod2gcc, i) = tree + THEN + RETURN i + END ; + INC (i) + END ; + RETURN NulSym +END Gcc2Mod ; + + (* AddModGcc - adds the tuple [ sym, gcc ] into the database. *) diff --git a/gcc/m2/gm2-gcc/m2langdump.h b/gcc/m2/gm2-gcc/m2langdump.h new file mode 100644 index 00000000000..ba0e54e2c41 --- /dev/null +++ b/gcc/m2/gm2-gcc/m2langdump.h @@ -0,0 +1,41 @@ +/* m2langdump.h header file for m2langdump.cc. + +Copyright (C) 2024 Free Software Foundation, Inc. +Contributed by Gaius Mulley . + +This file is part of GNU Modula-2. + +GNU Modula-2 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. + +GNU Modula-2 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 Modula-2; see the file COPYING3. If not see +. */ + +#if !defined(m2langdump_h) +#define m2langdump_h +#if defined(m2langdump_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else /* !m2langdump_c. */ +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ +#endif /* !m2langdump_c. */ + +EXTERN bool M2LangDump_IsDumpRequiredTree (tree t); + +#undef EXTERN +#endif /* m2langdump_h. */ diff --git a/gcc/m2/gm2-gcc/m2misc.cc b/gcc/m2/gm2-gcc/m2misc.cc index d69f33c003d..451abfe14f9 100644 --- a/gcc/m2/gm2-gcc/m2misc.cc +++ b/gcc/m2/gm2-gcc/m2misc.cc @@ -29,7 +29,7 @@ along with GNU Modula-2; see the file COPYING3. If not see #include "m2misc.h" #include "m2tree.h" -/* DebugTree - display the tree, t. */ +/* DebugTree - display the tree t. */ void m2misc_DebugTree (tree t) @@ -37,7 +37,7 @@ m2misc_DebugTree (tree t) debug_tree (t); } -/* DebugTree - display the tree, t. */ +/* DebugTree - display the trees chained in t. */ void m2misc_DebugTreeChain (tree t) @@ -46,7 +46,7 @@ m2misc_DebugTreeChain (tree t) debug_tree (t); } -/* DebugTree - display the tree, t. */ +/* DebugTree - display the current statement list. */ void m2misc_printStmt (void) diff --git a/gcc/m2/gm2-gcc/m2options.h b/gcc/m2/gm2-gcc/m2options.h index 01256a9fc80..7bcd6962f6d 100644 --- a/gcc/m2/gm2-gcc/m2options.h +++ b/gcc/m2/gm2-gcc/m2options.h @@ -152,6 +152,13 @@ EXTERN void M2Options_SetIBMLongDouble (bool value); EXTERN bool M2Options_GetIBMLongDouble (void); EXTERN void M2Options_SetIEEELongDouble (bool value); EXTERN bool M2Options_GetIEEELongDouble (void); +EXTERN bool M2Options_GetDumpLangQuadFilename (void); +EXTERN void M2Options_SetDumpLangQuadFilename (bool value, const char *arg); +EXTERN bool M2Options_GetDumpLangGimpleFilename (void); +EXTERN void M2Options_SetDumpLangGimpleFilename (bool value, const char *arg); +EXTERN bool M2Options_GetDumpLangGimple (void); +EXTERN void M2Options_SetM2DumpFilter (bool value, const char *args); +EXTERN char *M2Options_GetM2DumpFilter (void); #undef EXTERN #endif /* m2options_h. */ diff --git a/gcc/m2/m2pp.cc b/gcc/m2/gm2-gcc/m2pp.cc similarity index 93% rename from gcc/m2/m2pp.cc rename to gcc/m2/gm2-gcc/m2pp.cc index 2f4c45ced14..ff2e3ee224f 100644 --- a/gcc/m2/m2pp.cc +++ b/gcc/m2/gm2-gcc/m2pp.cc @@ -19,28 +19,27 @@ You should have received a copy of the GNU General Public License along with GNU Modula-2; see the file COPYING3. If not see . */ -#if defined(GM2) -#include "gm2-gcc/gcc-consolidation.h" +#include "gcc-consolidation.h" -#include "m2-tree.h" -#include "gm2-lang.h" +#include "../m2-tree.h" +#include "../gm2-lang.h" -#include "gm2-gcc/m2tree.h" -#include "gm2-gcc/m2expr.h" -#include "gm2-gcc/m2type.h" -#include "gm2-gcc/m2decl.h" -#else -#include "config.h" -#include "system.h" -#include "coretypes.h" -#include "cp/cp-tree.h" -#include "stringpool.h" -#include "gm2-gcc/gcc-consolidation.h" -#include "../cp/cp-tree.h" -#endif +#include "m2tree.h" +#include "m2expr.h" +#include "m2type.h" +#include "m2decl.h" +#include "m2options.h" +#include "m2langdump.h" #define M2PP_C -#include "m2/m2pp.h" +#include "m2pp.h" + +const char *m2pp_dump_description[M2PP_DUMP_END] = +{ + "interactive user invoked output", + "modula-2 gimple trees pre genercize", + "modula-2 gimple trees post genercize", +}; namespace modula2 { @@ -48,6 +47,7 @@ namespace modula2 { typedef struct pretty_t { + m2pp_dump_kind output; int needs_space; int needs_indent; int curpos; @@ -67,7 +67,7 @@ typedef struct m2stack_t /* Prototypes. */ -static pretty *initPretty (int bits); +static pretty *initPretty (m2pp_dump_kind kind, int bits); static pretty *dupPretty (pretty *s); static int getindent (pretty *s); static void setindent (pretty *s, int n); @@ -156,6 +156,8 @@ static void pop (void); static int begin_printed (tree t); static void m2pp_decl_list (pretty *s, tree t); static void m2pp_loc (pretty *s, tree t); +static FILE *getoutput (pretty *s); + void pet (tree t); void m2pp_integer (pretty *s, tree t); @@ -163,13 +165,14 @@ void m2pp_integer (pretty *s, tree t); extern void stop (void); static stack *stackPtr = NULL; +static FILE *m2pp_output_file[M2PP_DUMP_END]; /* do_pf helper function for pf. */ void do_pf (tree t, int bits) { - pretty *state = initPretty (bits); + pretty *state = initPretty (M2PP_DUMP_STDOUT, bits); if (TREE_CODE (t) == TRANSLATION_UNIT_DECL) m2pp_translation (state, t); @@ -197,7 +200,7 @@ pf (tree t) void pe (tree t) { - pretty *state = initPretty (FALSE); + pretty *state = initPretty (M2PP_DUMP_STDOUT, FALSE); m2pp_expression (state, t); m2pp_needspace (state); @@ -212,7 +215,7 @@ pe (tree t) void pet (tree t) { - pretty *state = initPretty (FALSE); + pretty *state = initPretty (M2PP_DUMP_STDOUT, FALSE); m2pp_expression (state, t); m2pp_needspace (state); @@ -228,7 +231,7 @@ pet (tree t) void pt (tree t) { - pretty *state = initPretty (FALSE); + pretty *state = initPretty (M2PP_DUMP_STDOUT, FALSE); m2pp_type (state, t); m2pp_needspace (state); m2pp_print (state, ";\n"); @@ -241,7 +244,7 @@ pt (tree t) void ptl (tree t) { - pretty *state = initPretty (FALSE); + pretty *state = initPretty (M2PP_DUMP_STDOUT, FALSE); m2pp_type_lowlevel (state, t); m2pp_needspace (state); m2pp_print (state, ";\n"); @@ -253,7 +256,7 @@ ptl (tree t) void ptcl (tree t) { - pretty *state = initPretty (FALSE); + pretty *state = initPretty (M2PP_DUMP_STDOUT, FALSE); m2pp_decl_list (state, t); m2pp_print (state, "\n"); @@ -278,7 +281,7 @@ m2pp_loc (pretty *s, tree t) m2pp_print (s, "(* "); m2pp_print (s, l.file); m2pp_print (s, ":"); - printf ("%d", l.line); + fprintf (getoutput (s), "%d", l.line); m2pp_print (s, " *)"); m2pp_print (s, "\n"); } @@ -332,7 +335,7 @@ pv (tree t) if (code == PARM_DECL) { - pretty *state = initPretty (FALSE); + pretty *state = initPretty (M2PP_DUMP_STDOUT, FALSE); m2pp_identifier (state, t); m2pp_needspace (state); m2pp_print (state, " context = %p*)\n", (void *)decl_function_context (t)); @@ -647,12 +658,12 @@ m2pp_module_block (pretty *s, tree t) if (!DECL_EXTERNAL (t)) { pretty *p = dupPretty (s); - printf ("\n"); + fprintf (getoutput (s), "\n"); p->in_vars = FALSE; p->in_types = FALSE; m2pp_function (p, t); killPretty (p); - printf ("\n"); + fprintf (getoutput (s), "\n"); s->in_vars = FALSE; s->in_types = FALSE; } @@ -691,7 +702,7 @@ m2pp_module_block (pretty *s, tree t) break; case DECL_EXPR: - printf ("is this node legal here? \n"); + fprintf (getoutput (s), "is this node legal here? \n"); m2pp_decl_expr (s, t); break; @@ -817,18 +828,18 @@ m2pp_var_list (pretty *s, tree t) if (TREE_CODE (t) == FUNCTION_DECL) { pretty *p = dupPretty (s); - printf ("\n"); + fprintf (getoutput (s), "\n"); p->in_vars = FALSE; p->in_types = FALSE; m2pp_function (p, t); killPretty (p); - printf ("\n"); + fprintf (getoutput (s), "\n"); } else if (TREE_CODE (t) == TYPE_DECL) m2pp_identifier (s, t); else if (TREE_CODE (t) == DECL_EXPR) { - printf ("is this node legal here? \n"); + fprintf (getoutput (s), "is this node legal here? \n"); // is it legal to have a DECL_EXPR here ? m2pp_var_type_decl (s, DECL_EXPR_DECL (t)); } @@ -1158,7 +1169,7 @@ m2pp_print (pretty *s, const char *p) if (s->needs_space) { - printf (" "); + fprintf (getoutput (s), " "); s->needs_space = FALSE; s->curpos++; } @@ -1169,19 +1180,19 @@ m2pp_print (pretty *s, const char *p) { s->needs_indent = TRUE; s->curpos = 0; - printf ("\n"); + fprintf (getoutput (s), "\n"); } else { if (s->needs_indent) { if (s->indent > 0) - printf ("%*c", s->indent, ' '); + fprintf (getoutput (s), "%*c", s->indent, ' '); s->needs_indent = FALSE; s->curpos += s->indent; } s->curpos++; - putchar (p[i]); + fputc (p[i], getoutput (s)); } i++; } @@ -1196,25 +1207,25 @@ m2pp_print_char (pretty *s, char ch) { if (s->needs_space) { - printf (" "); + fprintf (getoutput (s), " "); s->needs_space = FALSE; s->curpos++; } if (s->needs_indent) { if (s->indent > 0) - printf ("%*c", s->indent, ' '); + fprintf (getoutput (s), "%*c", s->indent, ' '); s->needs_indent = FALSE; s->curpos += s->indent; } if (ch == '\n') { s->curpos++; - putchar ('\\'); - putchar ('n'); + fputc ('\\', getoutput (s)); + fputc ('n', getoutput (s)); } else - putchar (ch); + fputc (ch, getoutput (s)); s->curpos++; } @@ -1531,7 +1542,7 @@ m2pp_recordfield_alignment (pretty *s, tree t) m2pp_print (s, "<* bytealignment ("); setindent (s, p + 18); - printf ("%d", aligned / BITS_PER_UNIT); + fprintf (getoutput (s), "%d", aligned / BITS_PER_UNIT); m2pp_print (s, ")"); m2pp_needspace (s); @@ -2738,3 +2749,63 @@ m2pp_component_ref (pretty *s, tree t) } } + +/* Code interface to this module. */ + +/* CreateDumpGimple creates the dump files using the template name. */ + +void m2pp_CreateDumpGimple (char *template_name, int template_len) +{ + int kind = M2PP_DUMP_STDOUT; + modula2::m2pp_output_file[kind] = stdout; + kind++; + for (; kind < M2PP_DUMP_END; kind++) + { + char *name = (char *)alloca (template_len); + + snprintf (name, template_len, template_name, kind); + modula2::m2pp_output_file[kind] = fopen (name, "w"); + if (modula2::m2pp_output_file[kind] == NULL) + { + fprintf (stderr, "unable to create dump file %s: %s\n", + name, xstrerror (errno)); + exit (1); + } + fprintf (modula2::m2pp_output_file[kind], "%s\n\n", + m2pp_dump_description[kind]); + } +} + +/* Close all dump files and fflush stdout. */ + +void m2pp_CloseDumpGimple (void) +{ + int kind = M2PP_DUMP_STDOUT; + fflush (modula2::m2pp_output_file[kind]); + kind++; + for (; kind < M2PP_DUMP_END; kind++) + fclose (modula2::m2pp_output_file[kind]); +} + + +/* Generate modula-2 style gimple for fndecl. */ + +void m2pp_dump_gimple (m2pp_dump_kind kind, tree fndecl) +{ + if (M2Options_GetDumpLangGimple () + && M2LangDump_IsDumpRequiredTree (fndecl)) + { + modula2::pretty *state = modula2::initPretty (kind, FALSE); + + modula2::m2pp_print (state, "\n"); + if (TREE_CODE (fndecl) == TRANSLATION_UNIT_DECL) + modula2::m2pp_translation (state, fndecl); + else if (TREE_CODE (fndecl) == BLOCK) + modula2::m2pp_module_block (state, fndecl); + else if (TREE_CODE (fndecl) == FUNCTION_DECL) + modula2::m2pp_function (state, fndecl); + else + modula2::m2pp_statement_sequence (state, fndecl); + modula2::killPretty (state); + } +} diff --git a/gcc/m2/gm2-gcc/m2pp.def b/gcc/m2/gm2-gcc/m2pp.def new file mode 100644 index 00000000000..030c1aa07bd --- /dev/null +++ b/gcc/m2/gm2-gcc/m2pp.def @@ -0,0 +1,41 @@ +(* m2pp.def definition module for m2pp.cc. + +Copyright (C) 2024 Free Software Foundation, Inc. +Contributed by Gaius Mulley . + +This file is part of GNU Modula-2. + +GNU Modula-2 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. + +GNU Modula-2 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 Modula-2; see the file COPYING3. If not see +. *) + +DEFINITION MODULE FOR "C" m2pp ; + +FROM SYSTEM IMPORT ADDRESS ; + + +(* + CreateDumpGimple - create the gimple dump files. +*) + +PROCEDURE CreateDumpGimple (templatename: ADDRESS; templatelen: CARDINAL) ; + + +(* + CloseDumpGimple - close the gimple dump files. +*) + +PROCEDURE CloseDumpGimple ; + + +END m2pp. diff --git a/gcc/m2/m2pp.h b/gcc/m2/gm2-gcc/m2pp.h similarity index 57% rename from gcc/m2/m2pp.h rename to gcc/m2/gm2-gcc/m2pp.h index e901102fab7..d1c526c2b98 100644 --- a/gcc/m2/m2pp.h +++ b/gcc/m2/gm2-gcc/m2pp.h @@ -19,17 +19,37 @@ You should have received a copy of the GNU General Public License along with GNU Modula-2; see the file COPYING3. If not see . */ -#if !defined(M2PP_H) -# define M2PP_H - -# if defined(M2PP_C) -# define EXTERN -# else -# define EXTERN extern -# endif +#if !defined(m2pp_h) +#define m2pp_h +#if defined(m2pp_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else /* !m2pp_c. */ +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ +#endif /* !m2pp_c. */ + +typedef enum +{ + M2PP_DUMP_STDOUT, /* This must remain the first field. */ + M2PP_DUMP_PRE_GENERICIZE, + M2PP_DUMP_POST_GENERICIZE, + M2PP_DUMP_END, +} m2pp_dump_kind; + +EXTERN void m2pp_CreateDumpGimple (char *template_name, int template_len); +EXTERN void m2pp_dump_gimple (m2pp_dump_kind kind, tree fndecl); +EXTERN void m2pp_CloseDumpGimple (void); namespace modula2 { -/* These functions allow a maintainer to dump the trees in Modula-2. */ +/* GDB Interactive interface to m2pp. Allow a maintainer to dump + the trees in Modula-2. */ EXTERN void pf (tree t); EXTERN void pe (tree t); diff --git a/gcc/m2/gm2-gcc/m2statement.cc b/gcc/m2/gm2-gcc/m2statement.cc index 3c048d40a99..dd7f2529f5d 100644 --- a/gcc/m2/gm2-gcc/m2statement.cc +++ b/gcc/m2/gm2-gcc/m2statement.cc @@ -36,6 +36,7 @@ along with GNU Modula-2; see the file COPYING3. If not see #include "m2treelib.h" #include "m2type.h" #include "m2convert.h" +#include "m2pp.h" static GTY (()) tree param_list = NULL_TREE; /* Ready for the next time we call/define a function. */ @@ -102,11 +103,15 @@ m2statement_BuildEndFunctionCode (location_t location, tree fndecl, bool nested) m2block_finishFunctionCode (fndecl); m2statement_SetEndLocation (location); + m2pp_dump_gimple (M2PP_DUMP_PRE_GENERICIZE, fndecl); gm2_genericize (fndecl); if (nested) (void)cgraph_node::get_create (fndecl); else - cgraph_node::finalize_function (fndecl, false); + { + m2pp_dump_gimple (M2PP_DUMP_POST_GENERICIZE, fndecl); + cgraph_node::finalize_function (fndecl, false); + } m2block_popFunctionScope (); diff --git a/gcc/m2/gm2-lang.cc b/gcc/m2/gm2-lang.cc index 86124df603a..603f3ab2ffd 100644 --- a/gcc/m2/gm2-lang.cc +++ b/gcc/m2/gm2-lang.cc @@ -214,8 +214,7 @@ gm2_langhook_init_options (unsigned int decoded_options_count, M2Options_Setc (value); break; case OPT_dumpdir: - if (building_cpp_command) - M2Options_SetDumpDir (arg); + M2Options_SetDumpDir (arg); break; case OPT_save_temps: if (building_cpp_command) @@ -407,6 +406,9 @@ gm2_langhook_handle_option ( switch (code) { + case OPT_dumpdir: + M2Options_SetDumpDir (arg); + return 1; case OPT_I: push_back_Ipath (arg); return 1; @@ -479,6 +481,22 @@ gm2_langhook_handle_option ( case OPT_fdebug_function_line_numbers: M2Options_SetDebugFunctionLineNumbers (value); return 1; + case OPT_fdump_lang_all: + M2Options_SetDumpLangQuadFilename (value, NULL); + M2Options_SetDumpLangGimpleFilename (value, NULL); + return 1; + case OPT_fdump_lang_gimple: + M2Options_SetDumpLangGimpleFilename (value, NULL); + return 1; + case OPT_fdump_lang_gimple_: + M2Options_SetDumpLangGimpleFilename (value, arg); + return 1; + case OPT_fdump_lang_quad: + M2Options_SetDumpLangQuadFilename (value, NULL); + return 1; + case OPT_fdump_lang_quad_: + M2Options_SetDumpLangQuadFilename (value, arg); + return 1; case OPT_fauto_init: M2Options_SetAutoInit (value); return 1; @@ -519,6 +537,9 @@ gm2_langhook_handle_option ( case OPT_fm2_strict_type: M2Options_SetStrictTypeChecking (value); return 1; + case OPT_fm2_dump_filter_: + M2Options_SetM2DumpFilter (value, arg); + return 1; case OPT_Wall: M2Options_SetWall (value); return 1; diff --git a/gcc/m2/gm2-libs/DynamicStrings.def b/gcc/m2/gm2-libs/DynamicStrings.def index 29f4989b794..25c27e8a939 100644 --- a/gcc/m2/gm2-libs/DynamicStrings.def +++ b/gcc/m2/gm2-libs/DynamicStrings.def @@ -29,7 +29,7 @@ DEFINITION MODULE DynamicStrings ; FROM SYSTEM IMPORT ADDRESS ; EXPORT QUALIFIED String, InitString, KillString, Fin, InitStringCharStar, - InitStringChar, Index, RIndex, + InitStringChar, Index, RIndex, ReverseIndex, Mark, Length, ConCat, ConCatChar, Assign, Dup, Add, Equal, EqualCharStar, EqualArray, ToUpper, ToLower, CopyOut, Mult, Slice, ReplaceChar, @@ -201,13 +201,27 @@ PROCEDURE Index (s: String; ch: CHAR; o: CARDINAL) : INTEGER ; (* RIndex - returns the indice of the last occurance of, ch, - in String, s. The search starts at position, o. - -1 is returned if, ch, is not found. + in String, s. The search starts at position, o. + -1 is returned if ch is not found. The search + is performed left to right. *) PROCEDURE RIndex (s: String; ch: CHAR; o: CARDINAL) : INTEGER ; +(* + ReverseIndex - returns the indice of the last occurance of ch + in String s. The search starts at position o + and searches from right to left. The start position + may be indexed negatively from the right (-1 is the + last index). + The return value if ch is found will always be positive. + -1 is returned if ch is not found. +*) + +PROCEDURE ReverseIndex (s: String; ch: CHAR; o: INTEGER) : INTEGER ; + + (* RemoveComment - assuming that, comment, is a comment delimiter which indicates anything to its right is a comment diff --git a/gcc/m2/gm2-libs/DynamicStrings.mod b/gcc/m2/gm2-libs/DynamicStrings.mod index c79e21c12be..b53f0f285b5 100644 --- a/gcc/m2/gm2-libs/DynamicStrings.mod +++ b/gcc/m2/gm2-libs/DynamicStrings.mod @@ -1466,8 +1466,9 @@ END Index ; (* RIndex - returns the indice of the last occurance of, ch, - in String, s. The search starts at position, o. - -1 is returned if, ch, is not found. + in String, s. The search starts at position, o. + -1 is returned if, ch, is not found. The search + is performed left to right. *) PROCEDURE RIndex (s: String; ch: CHAR; o: CARDINAL) : INTEGER ; @@ -1509,6 +1510,47 @@ BEGIN END RIndex ; +(* + ReverseIndex - returns the indice of the last occurance of ch + in String s. The search starts at position o + and searches from right to left. The start position + may be indexed negatively from the right (-1 is the + last index). + The return value if ch is found will always be positive. + -1 is returned if ch is not found. +*) + +PROCEDURE ReverseIndex (s: String; ch: CHAR; o: INTEGER) : INTEGER ; +VAR + c: CARDINAL ; +BEGIN + IF PoisonOn + THEN + s := CheckPoisoned (s) + END ; + IF o < 0 + THEN + o := VAL (INTEGER, Length (s)) + o ; + IF o < 0 + THEN + RETURN -1 + END + END ; + IF VAL (CARDINAL, o) < Length (s) + THEN + WHILE o >= 0 DO + IF char (s, o) = ch + THEN + RETURN o + ELSE + DEC (o) + END + END + END ; + RETURN -1 +END ReverseIndex ; + + (* RemoveComment - assuming that, comment, is a comment delimiter which indicates anything to its right is a comment diff --git a/gcc/m2/lang.opt b/gcc/m2/lang.opt index 505f4b56e8a..7ae413e70bc 100644 --- a/gcc/m2/lang.opt +++ b/gcc/m2/lang.opt @@ -106,6 +106,26 @@ fdef= Modula-2 Joined recognise the specified suffix as a definition module filename +fdump-lang-all +Modula-2 +dump all Modula-2 internal intemediate representation + +fdump-lang-gimple +Modula-2 +dump gimple in Modula-2 + +fdump-lang-gimple= +Modula-2 Joined +dump gimple in Modula-2 to the filename stem specified + +fdump-lang-quad +Modula-2 +dump quadruple representation + +fdump-lang-quad= +Modula-2 Joined +dump quadruple representation to the filename stem specified + fdump-system-exports Modula-2 display all inbuilt system items @@ -138,6 +158,10 @@ flocation= Modula-2 Joined set all location values to a specific value (internal switch) +fm2-dump-filter= +Modula-2 Joined +filter the language dump using a comma separated list of procedures and modules + fm2-g Modula-2 generate extra nops to improve debugging, producing an instruction for every code related keyword