From patchwork Tue Dec 6 14:47:25 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Gaius Mulley X-Patchwork-Id: 61576 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 812DA3834C1A for ; Tue, 6 Dec 2022 14:49:08 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 812DA3834C1A DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1670338148; bh=d6K28ipUKuys0TQ8z49UvRLHg3yMeIdos/2/HK8GbkA=; h=Subject:To:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=k64NrDttaYgLFgBYjPVhgqLARcUrn6DV+Lbov65zhGcYsln4gKlCwiC1ZGo34+rRd rAyRttoddxhN82f0N3DNtKtZ0MlL7FznXKAprT6l9zjsvIwDNZOPzAe8rxQ/MziK13 Xv749PAQFj4oe76DFwXDODyzMt5Vh53xyaac3JUg= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32d.google.com (mail-wm1-x32d.google.com [IPv6:2a00:1450:4864:20::32d]) by sourceware.org (Postfix) with ESMTPS id 00B1A3864A3A for ; Tue, 6 Dec 2022 14:47:28 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 00B1A3864A3A Received: by mail-wm1-x32d.google.com with SMTP id n9-20020a05600c3b8900b003d0944dba41so8149760wms.4 for ; Tue, 06 Dec 2022 06:47:28 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=date:message-id:to:subject:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=d6K28ipUKuys0TQ8z49UvRLHg3yMeIdos/2/HK8GbkA=; b=e8t94638+n848CqeR6IBzPZ8UOFqvBWoMhOr7KPp43kC2aB/hbAhiBRp7iSkpwApHE cSHG4k47z20b9ijvhgYg8JTlCXFte2Ec915VDtNYsBY7rtjVlSzvLiZgdcZlfwROVrys tZss9tnJjuhEsTuH5+w08U+wd3BrNM99pp5/ZDsG9xDtqnNsjG3jGQXyqm03QxiETh3a PkgvncJCa5uZO4PDuCtMVcP8kt6vhBWKAhwqjX6WQV8M8LKiJXTVA4YXSWAlePJjNSTF ADIFVlCbbOTVaYqZnmeeKf23vG63HffTjYr/N+vgeWYBeSxSsG0VQKQRPU/x6PL7CbeO WhzQ== X-Gm-Message-State: ANoB5pmGo/Ixi42Btlg8ft6yzl0bnQKXCHX4OKAKhPGK2+lmngmC6ZR7 ZPhe4p8pXqQ/W3P0guM2QfQD/lE3V4M= X-Google-Smtp-Source: AA0mqf6tujn8kwW4SJZlHtl0eh9g4HHm9EMobIxrLXf9dnjW40DSrE+AT+3kVcjfvEBkFVJTu3V1fg== X-Received: by 2002:a7b:ca45:0:b0:3c4:bda1:7c57 with SMTP id m5-20020a7bca45000000b003c4bda17c57mr67529724wml.6.1670338047493; Tue, 06 Dec 2022 06:47:27 -0800 (PST) Received: from lancelot ([195.147.220.46]) by smtp.gmail.com with ESMTPSA id u11-20020a5d6acb000000b00241c4bd6c09sm16741063wrw.33.2022.12.06.06.47.26 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Dec 2022 06:47:27 -0800 (PST) X-Google-Original-From: Gaius Mulley Received: from gaius by lancelot with local (Exim 4.94.2) (envelope-from ) id 1p2ZED-004Qdq-Gg for gcc-patches@gcc.gnu.org; Tue, 06 Dec 2022 14:47:25 +0000 Subject: [PATCH v3 1/19] modula2 front end: changes outside gcc/m2, libgm2 and gcc/testsuite. To: X-Mailer: mail (GNU Mailutils 3.10) Message-Id: Date: Tue, 06 Dec 2022 14:47:25 +0000 X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Gaius Mulley via Gcc-patches From: Gaius Mulley Reply-To: Gaius Mulley Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patch set contains the non machine generated changes found in / for example the language die and documentation changes. It also contains the changes to the top level build Makefile infastructure and the install.texi sourcebuild.texi documentation. ------8<----------8<----------8<----------8<----------8<----------8<---- diff -ruw gcc-git-master/configure.ac gcc-git-devel-modula2/configure.ac --- gcc-git-master/configure.ac 2022-12-06 02:56:41.628643384 +0000 +++ gcc-git-devel-modula2/configure.ac 2022-12-06 02:56:51.240773327 +0000 @@ -140,7 +140,7 @@ # binutils, gas and ld appear in that order because it makes sense to run # "make check" in that particular order. # If --enable-gold is used, "gold" may replace "ld". -host_tools="texinfo flex bison binutils gas ld fixincludes gcc cgen sid sim gdb gdbserver gprof etc expect dejagnu m4 utils guile fastjar gnattools libcc1 gotools c++tools" +host_tools="texinfo flex bison binutils gas ld fixincludes gcc cgen sid sim gdb gdbserver gprof etc expect dejagnu m4 utils guile fastjar gnattools libcc1 gm2tools gotools c++tools" # these libraries are built for the target environment, and are built after # the host libraries and the host tools (which may be a cross compiler) @@ -161,6 +161,7 @@ target-libffi \ target-libobjc \ target-libada \ + target-libgm2 \ target-libgo \ target-libphobos \ target-zlib" @@ -464,6 +465,14 @@ noconfigdirs="$noconfigdirs gnattools" fi +AC_ARG_ENABLE(libgm2, +[AS_HELP_STRING([--enable-libgm2], [build libgm2 directory])], +ENABLE_LIBGM2=$enableval, +ENABLE_LIBGM2=no) +if test "${ENABLE_LIBGM2}" != "yes" ; then + noconfigdirs="$noconfigdirs gm2tools" +fi + AC_ARG_ENABLE(libssp, [AS_HELP_STRING([--enable-libssp], [build libssp directory])], ENABLE_LIBSSP=$enableval, @@ -3569,6 +3578,7 @@ NCN_STRICT_CHECK_TARGET_TOOLS(GFORTRAN_FOR_TARGET, gfortran) 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) ACX_CHECK_INSTALLED_TARGET_TOOL(AR_FOR_TARGET, ar) ACX_CHECK_INSTALLED_TARGET_TOOL(AS_FOR_TARGET, as) @@ -3607,6 +3617,8 @@ [gcc/gccgo -B$$r/$(HOST_SUBDIR)/gcc/], go) GCC_TARGET_TOOL(gdc, GDC_FOR_TARGET, GDC, [gcc/gdc -B$$r/$(HOST_SUBDIR)/gcc/], d) +GCC_TARGET_TOOL(gm2, GM2_FOR_TARGET, GM2, + [gcc/gm2 -B$$r/$(HOST_SUBDIR)/gcc/], m2) GCC_TARGET_TOOL(ld, LD_FOR_TARGET, LD, [ld/ld-new]) GCC_TARGET_TOOL(lipo, LIPO_FOR_TARGET, LIPO) GCC_TARGET_TOOL(nm, NM_FOR_TARGET, NM, [binutils/nm-new]) @@ -3733,6 +3745,9 @@ # Specify what files to not compare during bootstrap. compare_exclusions="gcc/cc*-checksum\$(objext) | gcc/ada/*tools/*" +compare_exclusions="$compare_exclusions | gcc/m2/gm2-compiler-boot/M2Version*" +compare_exclusions="$compare_exclusions | gcc/m2/gm2-compiler-boot/SYSTEM*" +compare_exclusions="$compare_exclusions | gcc/m2/gm2version*" case "$target" in hppa*64*-*-hpux*) ;; powerpc*-ibm-aix*) compare_exclusions="$compare_exclusions | *libgomp*\$(objext)" ;; diff -ruw gcc-git-master/gcc/doc/sourcebuild.texi gcc-git-devel-modula2/gcc/doc/sourcebuild.texi diff -ruw gcc-git-master/gcc/doc/install.texi gcc-git-devel-modula2/gcc/doc/install.texi diff -ruw gcc-git-master/gcc/dwarf2out.cc gcc-git-devel-modula2/gcc/dwarf2out.cc --- gcc-git-master/gcc/dwarf2out.cc 2022-12-06 02:56:42.392653713 +0000 +++ gcc-git-devel-modula2/gcc/dwarf2out.cc 2022-12-06 02:56:51.312774299 +0000 @@ -25206,6 +25206,8 @@ } else if (strcmp (language_string, "GNU F77") == 0) language = DW_LANG_Fortran77; + else if (strcmp (language_string, "GNU Modula-2") == 0) + language = DW_LANG_Modula2; else if (dwarf_version >= 3 || !dwarf_strict) { if (strcmp (language_string, "GNU Ada") == 0) diff -ruw gcc-git-master/Makefile.def gcc-git-devel-modula2/Makefile.def --- gcc-git-master/Makefile.def 2022-12-06 02:56:41.612643168 +0000 +++ gcc-git-devel-modula2/Makefile.def 2022-12-06 02:56:51.228773165 +0000 @@ -184,6 +184,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= libgomp; bootstrap= true; lib_path=.libs; }; target_modules = { module= libitm; lib_path=.libs; }; target_modules = { module= libatomic; bootstrap=true; lib_path=.libs; }; @@ -306,6 +307,8 @@ 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= GM2_FOR_TARGET ; }; +flags_to_pass = { flag= GM2FLAGS_FOR_TARGET ; }; flags_to_pass = { flag= LD_FOR_TARGET ; }; flags_to_pass = { flag= LIPO_FOR_TARGET ; }; flags_to_pass = { flag= LDFLAGS_FOR_TARGET ; }; @@ -617,6 +620,8 @@ dependencies = { module=all-target-libgo; on=all-target-libbacktrace; }; dependencies = { module=all-target-libgo; on=all-target-libffi; }; dependencies = { module=all-target-libgo; on=all-target-libatomic; }; +dependencies = { module=configure-target-libgm2; on=all-target-libstdc++-v3; }; +dependencies = { module=all-target-libgm2; on=all-target-libatomic; }; dependencies = { module=configure-target-libphobos; on=configure-target-libbacktrace; }; dependencies = { module=configure-target-libphobos; on=configure-target-zlib; }; dependencies = { module=all-target-libphobos; on=all-target-libbacktrace; }; @@ -672,6 +677,8 @@ languages = { language=go; gcc-check-target=check-go; lib-check-target=check-target-libgo; lib-check-target=check-gotools; }; +languages = { language=m2; gcc-check-target=check-m2; + lib-check-target=check-target-libgm2; }; languages = { language=d; gcc-check-target=check-d; lib-check-target=check-target-libphobos; }; languages = { language=jit; gcc-check-target=check-jit; }; diff -ruw gcc-git-master/Makefile.tpl gcc-git-devel-modula2/Makefile.tpl --- gcc-git-master/Makefile.tpl 2022-12-06 02:56:41.620643276 +0000 +++ gcc-git-devel-modula2/Makefile.tpl 2022-12-06 02:56:51.236773273 +0000 @@ -166,6 +166,8 @@ GOCFLAGS="$(GOCFLAGS_FOR_BUILD)"; export GOCFLAGS; \ GDC="$(GDC_FOR_BUILD)"; export GDC; \ GDCFLAGS="$(GDCFLAGS_FOR_BUILD)"; export GDCFLAGS; \ + GM2="$(GM2_FOR_BUILD)"; export GM2; \ + GM2FLAGS="$(GM2FLAGS_FOR_BUILD)"; export GM2FLAGS; \ DLLTOOL="$(DLLTOOL_FOR_BUILD)"; export DLLTOOL; \ DSYMUTIL="$(DSYMUTIL_FOR_BUILD)"; export DSYMUTIL; \ LD="$(LD_FOR_BUILD)"; export LD; \ @@ -204,6 +206,7 @@ GFORTRAN="$(GFORTRAN)"; export GFORTRAN; \ GOC="$(GOC)"; export GOC; \ GDC="$(GDC)"; export GDC; \ + GM2="$(GM2)"; export GM2; \ AR="$(AR)"; export AR; \ AS="$(AS)"; export AS; \ CC_FOR_BUILD="$(CC_FOR_BUILD)"; export CC_FOR_BUILD; \ @@ -307,6 +310,7 @@ GFORTRAN="$(GFORTRAN_FOR_TARGET) $(XGCC_FLAGS_FOR_TARGET) $$TFLAGS"; export GFORTRAN; \ 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; \ DLLTOOL="$(DLLTOOL_FOR_TARGET)"; export DLLTOOL; \ DSYMUTIL="$(DSYMUTIL_FOR_TARGET)"; export DSYMUTIL; \ LD="$(COMPILER_LD_FOR_TARGET)"; export LD; \ @@ -373,6 +377,7 @@ GFORTRAN_FOR_BUILD = @GFORTRAN_FOR_BUILD@ GOC_FOR_BUILD = @GOC_FOR_BUILD@ GDC_FOR_BUILD = @GDC_FOR_BUILD@ +GM2_FOR_BUILD = @GM2_FOR_BUILD@ LDFLAGS_FOR_BUILD = @LDFLAGS_FOR_BUILD@ LD_FOR_BUILD = @LD_FOR_BUILD@ NM_FOR_BUILD = @NM_FOR_BUILD@ @@ -443,6 +448,7 @@ LIBCXXFLAGS = $(CXXFLAGS) -fno-implicit-templates GOCFLAGS = $(CFLAGS) GDCFLAGS = $(CFLAGS) +GM2FLAGS = $(CFLAGS) # Pass additional PGO and LTO compiler options to the PGO build. BUILD_CFLAGS = $(PGO_BUILD_CFLAGS) $(PGO_BUILD_LTO_CFLAGS) @@ -578,6 +584,7 @@ GFORTRAN_FOR_TARGET=$(STAGE_CC_WRAPPER) @GFORTRAN_FOR_TARGET@ GOC_FOR_TARGET=$(STAGE_CC_WRAPPER) @GOC_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@ DSYMUTIL_FOR_TARGET=@DSYMUTIL_FOR_TARGET@ LD_FOR_TARGET=@LD_FOR_TARGET@ @@ -603,6 +610,7 @@ LIBCFLAGS_FOR_TARGET = $(CFLAGS_FOR_TARGET) 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 GDCFLAGS_FOR_TARGET = -O2 -g @@ -709,6 +717,7 @@ 'GFORTRAN=$(GFORTRAN)' \ 'GOC=$(GOC)' \ 'GDC=$(GDC)' \ + 'GM2=$(GM2)' \ 'LD=$(LD)' \ 'LIPO=$(LIPO)' \ 'NM=$(NM)' \ @@ -735,6 +744,7 @@ CC="$${CC}" CC_FOR_BUILD="$${CC_FOR_BUILD}" \ CXX="$${CXX}" CXX_FOR_BUILD="$${CXX_FOR_BUILD}" \ GDC="$${GDC}" GDC_FOR_BUILD="$${GDC_FOR_BUILD}" \ + GM2="$${GM2}" GM2_FOR_BUILD="$${GM2_FOR_BUILD}" \ GNATBIND="$${GNATBIND}" \ LDFLAGS="$${LDFLAGS}" \ HOST_LIBS="$${HOST_LIBS}" \ @@ -770,6 +780,8 @@ 'GOCFLAGS=$$(GOCFLAGS_FOR_TARGET)' \ 'GDC=$$(GDC_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \ 'GDCFLAGS=$$(GDCFLAGS_FOR_TARGET)' \ + 'GM2=$$(GM2_FOR_TARGET) $$(XGCC_FLAGS_FOR_TARGET) $$(TFLAGS)' \ + 'GM2FLAGS=$$(GM2FLAGS_FOR_TARGET)' \ 'LD=$(COMPILER_LD_FOR_TARGET)' \ 'LDFLAGS=$$(LDFLAGS_FOR_TARGET)' \ 'LIBCFLAGS=$$(LIBCFLAGS_FOR_TARGET)' \ @@ -796,6 +808,7 @@ # cross-building scheme. EXTRA_GCC_FLAGS = \ "GCC_FOR_TARGET=$(GCC_FOR_TARGET) $$TFLAGS" \ + "GM2_FOR_TARGET=$(GM2_FOR_TARGET) $$TFLAGS" \ "`echo 'STMP_FIXPROTO=$(STMP_FIXPROTO)' | sed -e s'/[^=][^=]*=$$/XFOO=/'`" \ "`echo 'LIMITS_H_TEST=$(LIMITS_H_TEST)' | sed -e s'/[^=][^=]*=$$/XFOO=/'`" From patchwork Tue Dec 6 14:47:25 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Gaius Mulley X-Patchwork-Id: 61583 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 8EAAE392B118 for ; Tue, 6 Dec 2022 14:51:12 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 8EAAE392B118 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1670338272; bh=Mei9WMncJyZuTYVumKbINULsrNoD6giRQxmGVc54krE=; h=Subject:To:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=gBsQGkBEAda5Ms+Q9TNMNjlBl2PHwpJ0kNFdzy3VYhmm8XtKM+alvNMUvQqOxeYL6 r05KOpcYK/yeYZa2bz/Moba1bHsrPl/4rc/UOp38sqnvRO5PfHNKAU4SuaI/48enR3 HZJ7OC9GCuD/cC6kc0X8/NqCIBYHZT83wyrQuFvg= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x431.google.com (mail-wr1-x431.google.com [IPv6:2a00:1450:4864:20::431]) by sourceware.org (Postfix) with ESMTPS id 0ACC33848E3B for ; Tue, 6 Dec 2022 14:47:30 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 0ACC33848E3B Received: by mail-wr1-x431.google.com with SMTP id d1so23760475wrs.12 for ; Tue, 06 Dec 2022 06:47:29 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=date:message-id:to:subject:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=Mei9WMncJyZuTYVumKbINULsrNoD6giRQxmGVc54krE=; b=CUAQJJr7WQV7cmmLV/0k02aul7UUv8Bn69FVTcbfaptQgKPfXyVK00u8A2y+9ooedB csuz5nv7aSqMyb0lsLFQimW02Kuka+wXYAKyWpIFrO46YNqAhN1O+7t4VuWxC4VtDAdU G4B2LLiu7HZmAg1B/LvIhxlN8Cml3fJWi/1WmmcG0YjUYpzGfPjQhfviqr4UJd3dZUyV 18vrT6guAlfguEi7Si4xsJQ22jSelC812QJkndPa+ZT9cWDMpwcrn2iG+U7aeXqAJvk4 v0VJa0zdpvMcNXIwyeWzITqEJTWSEjG788YeKtHxQL/fBMm44qxrfriEnqE2jaojDKYi qt5Q== X-Gm-Message-State: ANoB5pkYV9Cjb+UTttBvYMLQSLFb1sqclY2fZaHftBjPKLlwoS0/iXTE /qe2wV6f7c8ECH10LDvjI2EN9vzUhkE= X-Google-Smtp-Source: AA0mqf7FvoXOgphxQuo+LNZC6/CBqzVvAEi1KkeRKGbAoHrJP+smnbbsvoxc2AKW4u7FsPr1QS4Iyg== X-Received: by 2002:adf:e105:0:b0:236:73af:f9ad with SMTP id t5-20020adfe105000000b0023673aff9admr51400662wrz.225.1670338048243; Tue, 06 Dec 2022 06:47:28 -0800 (PST) Received: from lancelot ([195.147.220.46]) by smtp.gmail.com with ESMTPSA id v7-20020adfe287000000b00241fea203b6sm16909651wri.87.2022.12.06.06.47.26 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Dec 2022 06:47:27 -0800 (PST) X-Google-Original-From: Gaius Mulley Received: from gaius by lancelot with local (Exim 4.94.2) (envelope-from ) id 1p2ZED-004Qe5-LO for gcc-patches@gcc.gnu.org; Tue, 06 Dec 2022 14:47:25 +0000 Subject: [PATCH v3 2/19] modula2 front end: Make-lang.in To: X-Mailer: mail (GNU Mailutils 3.10) Message-Id: Date: Tue, 06 Dec 2022 14:47:25 +0000 X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Gaius Mulley via Gcc-patches From: Gaius Mulley Reply-To: Gaius Mulley Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" The makefile fragment for modula2 which builds the gm2 driver and cc1gm2. ------8<----------8<----------8<----------8<----------8<----------8<---- diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/Make-lang.in --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/Make-lang.in 2022-12-06 02:56:51.328774517 +0000 @@ -0,0 +1,1649 @@ +# Top level -*- makefile -*- fragment for GNU M2. + +# Copyright (C) 2000-2022 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 +#. + +# Actual names to use when installing a native compiler. +GM2_INSTALL_NAME = $(shell echo gm2|sed '$(program_transform_name)') +GM2_TARGET_INSTALL_NAME = $(target_noncanonical)-$(shell echo gm2|sed '$(program_transform_name)') + +# Actual names to use when installing a cross-compiler. +GM2_CROSS_NAME = `echo gm2|sed '$(program_transform_cross_name)'` + +M2_MAINTAINER = no + +GM2_1 = ./gm2 -B./stage1/m2 -g -fm2-g + +GM2_FOR_TARGET = $(STAGE_CC_WRAPPER) ./gm2 -B./ -B$(build_tooldir)/bin/ -L$(objdir)/../ld $(TFLAGS) + +TEXISRC = $(objdir)/m2/images/gnu.eps \ + $(srcdir)/doc/gm2.texi \ + m2/gm2-libs.texi \ + m2/gm2-ebnf.texi \ + m2/SYSTEM-pim.texi \ + m2/SYSTEM-iso.texi \ + m2/Builtins.texi + +RSTSRC = $(objdir)/m2/images/gnu.eps \ + $(srcdir)/doc/gm2.texi \ + m2/gm2-libs.rst \ + m2/gm2-ebnf.rst \ + m2/SYSTEM-pim.rst \ + m2/SYSTEM-iso.rst \ + m2/Builtins.rst + +# Define the names for selecting modula-2 in LANGUAGES. +m2 modula-2 modula2: gm2$(exeext) xgcc$(exeext) cc1gm2$(exeext) \ + $(GCC_PASSES) $(GCC_PARTS) +m2.serial = cc1gm2$(exeext) + +# Tell GNU make to ignore these if they exist. +.PHONY: m2 modula-2 modula2 + +GM2_PROG_DEP=gm2$(exeext) xgcc$(exeext) cc1gm2$(exeext) + +include m2/config-make + +LIBSTDCXX=../$(TARGET_SUBDIR)/libstdc++-v3/src/.libs/libstdc++.a + +PGE=m2/pge$(exeext) + +SRC_PREFIX=G + +m2/gm2spec.o: $(srcdir)/m2/gm2spec.cc $(SYSTEM_H) $(GCC_H) $(CONFIG_H) \ + m2/gm2config.h $(TARGET_H) $(PLUGIN_HEADERS) \ + $(generated_files) $(C_TREE_H) insn-attr-common.h + (SHLIB_LINK='$(SHLIB_LINK)' \ + SHLIB_MULTILIB='$(SHLIB_MULTILIB)'; \ + $(COMPILER) $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ + $(DRIVER_DEFINES) \ + -DLIBSUBDIR=\"$(libsubdir)\" \ + -DPREFIX=\"$(prefix)\" \ + -c $(srcdir)/m2/gm2spec.cc $(OUTPUT_OPTION)) + +# Create the compiler driver for M2. +CFLAGS-m2/m2/gm2spec.o += $(DRIVER_DEFINES) + +GM2_OBJS = $(GCC_OBJS) prefix.o intl.o m2/gm2spec.o + +# Create the compiler driver for gm2. +gm2$(exeext): $(GM2_OBJS) $(EXTRA_GCC_OBJS) libcommon-target.a $(LIBDEPS) \ + m2/gm2config.h + +$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ \ + $(GM2_OBJS) $(EXTRA_GCC_OBJS) libcommon-target.a \ + $(EXTRA_GCC_LIBS) $(LIBS) + +# Create a version of the gm2 driver which calls the cross-compiler. +gm2-cross$(exeext): gm2$(exeext) + -rm -f gm2-cross$(exeext) + cp gm2$(exeext) gm2-cross$(exeext) + +po-generated: + +# Build hooks: + +m2.all.cross: gm2-cross$(exeext) plugin/m2rte$(exeext).so + +m2.start.encap: gm2$(exeext) plugin/m2rte$(exeext).so +m2.rest.encap: + + +m2.info: doc/m2.info + +m2.man: doc/m2.1 + +m2.install-man: $(DESTDIR)$(man1dir)/$(GM2_INSTALL_NAME)$(man1ext) + +$(DESTDIR)$(man1dir)/$(GM2_INSTALL_NAME)$(man1ext): doc/m2.1 installdirs + -rm -f $@ + -$(INSTALL_DATA) $< $@ + -chmod a-x $@ + +m2.dvi: $(TEXISRC) + $(TEXI2DVI) -I $(objdir)/m2 -I $(srcdir)/doc/include $(srcdir)/doc/gm2.texi -o $@ + +m2.ps: m2.dvi + dvips -o $@ $< + +m2.pdf: m2.ps + gs -q -dBATCH -dNOPAUSE -sDEVICE=pdfwrite -sOutputFile=$@ $< + +.INTERMEDIATE: gm2.pod + +m2.pod: doc/gm2.texi $(TEXISRC) + -$(TEXI2POD) -I $(objdir)/m2 -D m2 < $< > $@ + +doc/m2.info: $(TEXISRC) + if test "x$(BUILD_INFO)" = xinfo; then \ + rm -f doc/m2.info*; \ + $(MAKEINFO) -I$(objdir)/m2 -I$(srcdir)/doc/include \ + -o $@ $(srcdir)/doc/gm2.texi ; \ + else true; fi + +$(objdir)/m2/images/gnu.eps: $(srcdir)/m2/images/gnupng + test -d m2/images || mkdir -p m2/images + if [ -f $(srcdir)/m2/images/gnu.eps ] ; then \ + cp $(srcdir)/m2/images/gnu.eps $@ ; \ + else \ + pngtopnm $< | pnmtops -noturn > $@ ; \ + fi + +.INTERMEDIATE: gm2.pod + +# gm2-libs.texi + +m2/gm2-libs.texi: gm2-libs.texi-check; @true + +ifeq ($(HAVE_PYTHON),yes) +gm2-libs.texi-check: m2/SYSTEM-pim.texi m2/SYSTEM-iso.texi m2/Builtins.texi \ + $(objdir)/m2/gm2-libs-coroutines/SYSTEM.def + $(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -t -uLibraries -s$(srcdir)/m2 -b$(objdir)/m2 -o $(objdir)/m2/gm2-libs.texi + $(STAMP) gm2-libs.texi-check +else +gm2-libs.texi-check: + echo "not building gm2-libs.texi as python3 has not been found" + touch $(objdir)/m2/gm2-libs.texi +endif + +# gm2-libs.rst + +m2/gm2-libs.rst: gm2-libs.rst-check; @true + +ifeq ($(HAVE_PYTHON),yes) +gm2-libs.rst-check: m2/SYSTEM-pim.texi m2/SYSTEM-iso.texi m2/Builtins.texi \ + $(objdir)/m2/gm2-libs-coroutines/SYSTEM.def + $(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -x -uLibraries -s$(srcdir)/m2 -b$(objdir)/m2 -o $(objdir)/m2/gm2-libs.rst + $(STAMP) gm2-libs.rst-check +else +gm2-libs.rst-check: + echo "not building gm2-libs.rst as python3 has not been found" + touch $(objdir)/m2/gm2-libs.rst +endif + +# gm2-ebnf.texi + +m2/gm2-ebnf.texi: gm2-ebnf.texi-check; @true + +gm2-ebnf.texi-check: $(PGE) $(srcdir)/m2/gm2-compiler/P0SyntaxCheck.bnf + $(PGE) -c -p -t -f $(srcdir)/m2/gm2-compiler/P0SyntaxCheck.bnf -o m2/gm2-ebnf.texi + $(STAMP) gm2-ebnf.texi-check + +# gm2-ebnf.rst + +m2/gm2-ebnf.rst: gm2-ebnf.rst-check; @true + +gm2-ebnf.rst-check: $(PGE) $(srcdir)/m2/gm2-compiler/P0SyntaxCheck.bnf + $(PGE) -c -p -t -f $(srcdir)/m2/gm2-compiler/P0SyntaxCheck.bnf -o m2/gm2-ebnf.rst + $(STAMP) gm2-ebnf.rst-check + +# SYSTEM-pim.texi + +m2/SYSTEM-pim.texi: SYSTEM-pim-texi-check; @true + +ifeq ($(HAVE_PYTHON),yes) +SYSTEM-pim-texi-check: $(objdir)/m2/gm2-libs/SYSTEM.def + $(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -t -b$(objdir)/m2 -f$(objdir)/m2/gm2-libs/SYSTEM.def -o $(objdir)/m2/SYSTEM-pim.texi + $(STAMP) SYSTEM-pim-texi-check +else +SYSTEM-pim-texi-check: $(objdir)/m2/gm2-libs/SYSTEM.def + echo "not building SYSTEM-pim.texi as python3 has not been found" + touch $(objdir)/m2/SYSTEM-pim.texi +endif + +# SYSTEM-pim.rst + +m2/SYSTEM-pim.rst: SYSTEM-pim-rst-check; @true + +ifeq ($(HAVE_PYTHON),yes) +SYSTEM-pim-rst-check: $(objdir)/m2/gm2-libs/SYSTEM.def + $(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -x -b$(objdir)/m2 -f$(objdir)/m2/gm2-libs/SYSTEM.def -o $(objdir)/m2/SYSTEM-pim.rst + $(STAMP) SYSTEM-pim-rst-check +else +SYSTEM-pim-rst-check: $(objdir)/m2/gm2-libs/SYSTEM.def + echo "not building SYSTEM-pim.rst as python3 has not been found" + touch $(objdir)/m2/SYSTEM-pim.rst +endif + +# SYSTEM-pim.texi + +m2/SYSTEM-iso.texi: SYSTEM-iso.texi-check; @true + +ifeq ($(HAVE_PYTHON),yes) +SYSTEM-iso.texi-check: $(objdir)/m2/gm2-libs-iso/SYSTEM.def + $(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -t -b$(objdir)/m2 -f$(objdir)/m2/gm2-libs-iso/SYSTEM.def -o $(objdir)/m2/SYSTEM-iso.texi + $(STAMP) SYSTEM-iso.texi-check +else +SYSTEM-iso.texi-check: $(objdir)/m2/gm2-libs-iso/SYSTEM.def + echo "not building SYSTEM-iso.texi as python3 has not been found" + touch $(objdir)/m2/SYSTEM-iso.texi +endif + +# SYSTEM-pim.rst + +m2/SYSTEM-iso.rst: SYSTEM-iso.rst-check; @true + +ifeq ($(HAVE_PYTHON),yes) +SYSTEM-iso.rst-check: $(objdir)/m2/gm2-libs-iso/SYSTEM.def + $(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -x -b$(objdir)/m2 -f$(objdir)/m2/gm2-libs-iso/SYSTEM.def -o $(objdir)/m2/SYSTEM-iso.rst + $(STAMP) SYSTEM-iso.rst-check +else +SYSTEM-iso.rst-check: $(objdir)/m2/gm2-libs-iso/SYSTEM.def + echo "not building SYSTEM-iso.rst as python3 has not been found" + touch $(objdir)/m2/SYSTEM-iso.rst +endif + +# m2/Builtins.texi + +m2/Builtins.texi: Builtins.texi-check; @true + +ifeq ($(HAVE_PYTHON),yes) +Builtins.texi-check: m2/gm2-libs/Builtins.def + $(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -t -b./ -f$(srcdir)/m2/gm2-libs/Builtins.def -o $(objdir)/m2/Builtins.texi + $(STAMP) Builtins.texi-check +else +Builtins.texi-check: m2/gm2-libs/Builtins.def + echo "not building SYSTEM-iso.texi as python3 has not been found" + touch $(objdir)/m2/Builtins.texi +endif + +# m2/Builtins.rst + +m2/Builtins.rst: Builtins.rst-check; @true + +ifeq ($(HAVE_PYTHON),yes) +Builtins.rst-check: m2/gm2-libs/Builtins.def + $(PYTHON) $(srcdir)/m2/tools-src/def2doc.py -x -b./ -f$(srcdir)/m2/gm2-libs/Builtins.def -o $(objdir)/m2/Builtins.rst + $(STAMP) Builtins.rst-check +else +Builtins.rst-check: m2/gm2-libs/Builtins.def + echo "not building SYSTEM-iso.rst as python3 has not been found" + touch $(objdir)/m2/Builtins.rst +endif + +$(objdir)/m2/gm2-compiler-boot: + test -d $@ || mkdir $@ + +$(objdir)/m2/gm2-libs-boot: + test -d $@ || mkdir $@ + +$(objdir)/m2/gm2-libiberty: + test -d $@ || mkdir $@ + +$(objdir)/m2/gm2-gcc: + test -d $@ || mkdir $@ + +$(objdir)/m2/gm2-compiler: + test -d $@ || mkdir $@ + +$(objdir)/m2/gm2-libs: + test -d $@ || mkdir $@ + +$(objdir)/m2/gm2-libs-iso: + test -d $@ || mkdir $@ + +$(objdir)/m2/gm2-libs-min: + test -d $@ || mkdir $@ + +$(objdir)/m2/gm2-compiler-paranoid: + test -d $@ || mkdir $@ + +$(objdir)/m2/gm2-libs-paranoid: + test -d $@ || mkdir $@ + +$(objdir)/m2/gm2-compiler-verify: + test -d $@ || mkdir $@ + +$(objdir)/m2/boot-bin: + test -d $@ || mkdir $@ + +$(objdir)/m2/gm2-libs-pim: + test -d $@ || mkdir $@ + +$(objdir)/m2/gm2-libs-coroutines: + test -d $@ || mkdir $@ + +stage1/m2: + -test -d $@ || mkdir -p stage1/m2 + +stage2/m2: + -test -d $@ || mkdir -p stage2/m2 + +stage3/m2: + -test -d $@ || mkdir -p stage3/m2 + +stage4/m2: + -test -d $@ || mkdir -p stage4/m2 + +# No gm2-specific selftests +selftest-m2: + +# Install hooks: +# cc1gm2 is installed elsewhere as part of $(COMPILERS). +# $(COMPILERS) is defined in `config-lang.in' + +m2.install-common: installdirs + -rm -f $(DESTDIR)$(bindir)/$(GM2_INSTALL_NAME)$(exeext) + $(INSTALL_PROGRAM) gm2$(exeext) $(DESTDIR)$(bindir)/$(GM2_INSTALL_NAME)$(exeext) + -if test -f cc1gm2$(exeext); then \ + if test -f gm2-cross$(exeext); then \ + :; \ + else \ + rm -f $(DESTDIR)$(bindir)/$(GM2_TARGET_INSTALL_NAME)$(exeext); \ + ( cd $(DESTDIR)$(bindir) && \ + $(LN) $(GM2_INSTALL_NAME)$(exeext) $(GM2_TARGET_INSTALL_NAME)$(exeext) ); \ + fi; \ + fi + -for tool in cc1gm2$(exeext); do \ + if [ -f $$tool ]; then \ + rm -f $(DESTDIR)$(libexecsubdir)/$$tool; \ + $(INSTALL_PROGRAM) $$tool $(DESTDIR)$(libexecsubdir)/$$tool; \ + chmod a+x $(DESTDIR)$(libexecsubdir)/$$tool; \ + else \ + echo "cannot find $$tool" ; \ + fi ; \ + done + +m2.install-info: installdirs + if [ -d gm2$(exeext) ] ; then \ + if [ -f $(objdir)/doc/gm2.info ]; then \ + rm -f $(DESTDIR)$(infodir)/gm2.info*; \ + for f in $(objdir)/doc/gm2.info*; do \ + realfile=`echo $$f | sed -e 's|.*/\([^/]*\)$$|\1|'`; \ + rm -f $(DESTDIR)$(infodir)/`basename $$realfile`; \ + $(INSTALL_DATA) $$f $(DESTDIR)$(infodir)/`basename $$realfile`; \ + done; \ + chmod a-x $(DESTDIR)$(infodir)/gm2.info*; \ + else true; fi; \ + else true; fi + -if [ -f gm2$(exeext) ] && [ -f $(DESTDIR)$(infodir)/gm2.info ]; then \ + if $(SHELL) -c 'install-info --version' >/dev/null 2>&1; then \ + install-info --dir-file=$(infodir)/dir $(DESTDIR)$(infodir)/gm2.info; \ + else true; fi; \ + else true; fi + +m2.install-normal: m2.install-common m2.install-info m2.install-man + +# This target will install GM2 into an existing GCC installation, +# without overwriting existing files. +# The semicolon is to prevent the install.sh -> install default rule +# from doing anything. Having it run true helps avoid problems and +# noise from versions of make which don't like to have null commands. +m2.install: m2.install-normal; @true + +gm2.install-with-gcc: $(INSTALL_HEADERS) gm2.install $(INSTALL_LIBGCC) + for file in $(GCC_PASSES); do \ + if [ x"$$file" != x"xgcc$(exeext)" ]; then \ + rm -f $(DESTDIR)$(libsubdir)/$$file; \ + $(INSTALL_PROGRAM) $$file $(DESTDIR)$(libsubdir)/$$file || exit 1; \ + fi; \ + done; exit 0 + +m2.uninstall: + -rm -rf $(bindir)/$(GM2_INSTALL_NAME) + -rm -rf $(bindir)/$(GM2_CROSS_NAME) + +m2.install-plugin: installdirs + $(mkinstalldirs) $(DESTDIR)$(plugin_resourcesdir) + $(INSTALL_PROGRAM) plugin/m2rte$(exeext).so $(DESTDIR)$(plugin_resourcesdir)/m2rte$(exeext).so + chmod a+x $(DESTDIR)$(plugin_resourcesdir)/m2rte$(exeext).so + +plugin/m2rte$(exeext).so: $(srcdir)/m2/plugin/m2rte.cc $(GCC_HEADER_DEPENDENCIES_FOR_M2) \ + insn-attr-common.h insn-flags.h $(generated_files) + test -d plugin || mkdir plugin + $(PLUGINCC) $(PLUGINCFLAGS) -fno-rtti -I. -I$(srcdir) -I$(srcdir)/m2 -I$(srcdir)/m2/gm2-gcc -I$(srcdir)/../include -I$(srcdir)/../libcpp/include -Wall $(GMPINC) -Wno-literal-suffix -fPIC -c -o plugin/m2rte.o $(srcdir)/m2/plugin/m2rte.cc + $(PLUGINCC) $(PLUGINCFLAGS) $(PLUGINLIBS) -fno-rtti plugin/m2rte.o -shared -o $@ + + +# Clean hooks: +# A lot of the ancillary files are deleted by the main makefile. +# We just have to delete files specific to us. + +m2.mostlyclean: + -rm -f m2/*.o + +m2.clean: + -rm -f m2/*.o + -rm -f m2/gm2-libs/config.* + -rm m2/gm2-libs/gm2-libs-host.h m2/gm2config.h + +m2.extraclean: +m2.realclean: + +# Stage hooks: + +m2.stage1: stage1-start + -mv m2/*$(objext) stage1/m2 + +m2.stage2: stage2-start + -mv m2/*$(objext) stage2/m2 + +m2.stage3: stage3-start + -mv m2/*$(objext) stage3/m2 + +m2.stage4: stage4-start + -mv m2/*$(objext) stage4/m2 + +quit: force + echo "calling exit" + exit 1 + +# Rules to build the compiler, pge and mc. + +# MC_COPYRIGHT=--gpl-header --project="GNU Modula-2" +MC_COPYRIGHT= + +MC_ARGS= --olang=c++ \ + --h-file-prefix=$(SRC_PREFIX) \ + -I$(srcdir)/m2/gm2-libs \ + -I$(srcdir)/m2/gm2-compiler \ + -I$(srcdir)/m2/gm2-libiberty \ + -I$(srcdir)/m2/gm2-gcc \ + --quiet \ + $(MC_COPYRIGHT) \ + --gcc-config-system + +MCDEPS=m2/boot-bin/mc$(exeext) + +MC=m2/boot-bin/mc$(exeext) $(MC_ARGS) + +MC_LIBS=m2/mc-boot-ch/Glibc.o m2/mc-boot-ch/Gmcrts.o + +M2LINK=m2/boot-bin/mklink$(exeext) +GM2_O= +GM2_O_S3=-O +GM2_OS=-Os +GM2_G=-g -fm2-g +GM2_CPP= +# GM2_DEBUG_STRMEM=-fcpp +GM2_DEBUG_STRMEM= +GM2_FLAGS=-Wunused-variable -fsoft-check-all $(GM2_G) $(GM2_O) \ + -funbounded-by-reference -fpim -fextended-opaque \ + -Wpedantic-cast -Wpedantic-param-names -ffunction-sections \ + -fdata-sections $(GM2_CPP) # -fauto-init +GM2_ISO_FLAGS=-fsoft-check-all $(GM2_G) $(GM2_O) \ + -funbounded-by-reference -fiso -fextended-opaque \ + -Wpedantic-cast -Wpedantic-param-names -ffunction-sections \ + -fdata-sections $(GM2_CPP) +GM2_MIN_FLAGS=$(GM2_G) $(GM2_OS) \ + -funbounded-by-reference -fextended-opaque \ + -Wpedantic-cast -Wpedantic-param-names -fno-exceptions \ + -ffunction-sections -fdata-sections $(GM2_CPP) + +O2=-O2 -g +SO_O2=-O2 -g -fPIC +SO=-O0 -g -fPIC + +# Language-specific object files for the gm2 compiler. + +GM2_C_OBJS = m2/gm2-lang.o \ + m2/stor-layout.o \ + m2/m2pp.o \ + m2/gm2-gcc/m2assert.o \ + m2/gm2-gcc/m2block.o \ + m2/gm2-gcc/m2builtins.o \ + m2/gm2-gcc/m2except.o \ + m2/gm2-gcc/m2color.o \ + m2/gm2-gcc/m2configure.o \ + m2/gm2-gcc/m2convert.o \ + m2/gm2-gcc/m2decl.o \ + m2/gm2-gcc/m2expr.o \ + m2/gm2-gcc/m2linemap.o \ + m2/gm2-gcc/m2statement.o \ + m2/gm2-gcc/m2type.o \ + m2/gm2-gcc/m2tree.o \ + m2/gm2-gcc/m2treelib.o \ + m2/gm2-gcc/m2top.o \ + m2/gm2-gcc/m2misc.o \ + m2/gm2-gcc/init.o +GM2_LIBS = m2/gm2-compiler/gm2.a \ + ../$(target_subdir)/libgm2/libm2pim/.libs/libm2pim.a m2/gm2-libs-boot/choosetemp.o + +GM2_LIBS_BOOT = m2/gm2-compiler-boot/gm2.a \ + m2/gm2-libs-boot/libgm2.a \ + $(GM2-BOOT-O) + +cc1gm2$(exeext): stage1/m2/cc1gm2$(exeext) $(m2.prev) + cp -p $< $@ + +stage2/m2/cc1gm2$(exeext): stage1/m2/cc1gm2$(exeext) m2/gm2-compiler/m2flex.o $(P) \ + $(GM2_C_OBJS) $(BACKEND) $(LIBDEPS) $(GM2_LIBS) \ + m2/gm2-gcc/rtegraph.o plugin/m2rte$(exeext).so m2/gm2-libs-boot/M2LINK.o + @$(call LINK_PROGRESS,$(INDEX.m2),start) + +$(LLINKER) $(ALL_CFLAGS) $(LDFLAGS) -o $@ $(GM2_C_OBJS) m2/gm2-compiler/m2flex.o \ + attribs.o \ + $(GM2_LIBS) \ + $(BACKEND) $(LIBS) m2/gm2-gcc/rtegraph.o m2/gm2-libs-boot/M2LINK.o \ + $(BACKENDLIBS) $(LIBSTDCXX) -lm + @$(call LINK_PROGRESS,$(INDEX.m2),end) + +stage1/m2/cc1gm2$(exeext): gm2$(exeext) m2/gm2-compiler-boot/m2flex.o \ + $(P) $(GM2_C_OBJS) $(BACKEND) $(LIBDEPS) \ + $(GM2_LIBS_BOOT) $(MC_LIBS) \ + m2/gm2-gcc/rtegraph.o plugin/m2rte$(exeext).so \ + m2/gm2-libs-boot/M2LINK.o \ + $(m2.prev) + @$(call LINK_PROGRESS,$(INDEX.m2),start) + +$(LLINKER) $(ALL_CFLAGS) $(LDFLAGS) -o $@ $(GM2_C_OBJS) m2/gm2-compiler-boot/m2flex.o \ + attribs.o \ + $(GM2_LIBS_BOOT) $(MC_LIBS) \ + m2/gm2-gcc/rtegraph.o m2/gm2-libs-boot/M2LINK.o \ + $(BACKEND) $(LIBS) $(BACKENDLIBS) + @$(call LINK_PROGRESS,$(INDEX.m2),end) + +# Compiling object files from source files. + +GCC_HEADER_DEPENDENCIES_FOR_M2 = $(BUILD-BOOT-H) $(TIMEVAR_H) m2/gm2config.h $(CONFIG_H) \ + $(TREE_H) $(RTL_H) $(TARGET_H) $(PLUGIN_HEADERS) \ + $(BCONFIG_H) $(CORETYPES_H) $(SYSTEM_H) \ + $(srcdir)/flags.h gtype-m2.h \ + $(generated_files) insn-attr-common.h + +m2/gm2-gcc/%.o: $(srcdir)/m2/gm2-gcc/%.cc $(GCC_HEADER_DEPENDENCIES_FOR_M2) + $(COMPILER) -c -g $(ALL_COMPILERFLAGS) \ + $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) + +m2/gm2-gcc/m2configure.o: $(srcdir)/m2/gm2-gcc/m2configure.cc \ + $(SYSTEM_H) $(GCC_H) $(CONFIG_H) \ + m2/gm2config.h $(TARGET_H) $(PLUGIN_HEADERS) \ + $(generated_files) $(C_TREE_H) insn-attr-common.h + $(COMPILER) $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ + $(DRIVER_DEFINES) \ + -DLIBSUBDIR=\"$(libsubdir)\" \ + -DPREFIX=\"$(prefix)\" \ + -c $(srcdir)/m2/gm2-gcc/m2configure.cc $(OUTPUT_OPTION) + +m2/gm2-lang.o: $(srcdir)/m2/gm2-lang.cc gt-m2-gm2-lang.h $(GCC_HEADER_DEPENDENCIES_FOR_M2) + $(COMPILER) -c -g -I$(GM2GCC) $(ALL_COMPILERFLAGS) \ + $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) + +m2/stor-layout.o: $(srcdir)/stor-layout.cc $(GCC_HEADER_DEPENDENCIES_FOR_M2) + $(COMPILER) -c -DSET_WORD_SIZE=INT_TYPE_SIZE $(ALL_COMPILERFLAGS) \ + $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) + +m2/m2pp.o : $(srcdir)/m2/m2pp.cc $(GCC_HEADER_DEPENDENCIES_FOR_M2) + $(COMPILER) -c -g -DGM2 $(ALL_COMPILERFLAGS) \ + $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) + +m2/gm2-gcc/rtegraph.o: $(srcdir)/m2/gm2-gcc/rtegraph.cc $(GCC_HEADER_DEPENDENCIES_FOR_M2) \ + gt-m2-rtegraph.h + $(COMPILER) -c -g -I$(GM2GCC) $(ALL_COMPILERFLAGS) \ + $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) + +c-family/m2pp.o : $(srcdir)/m2/m2pp.cc $(GCC_HEADER_DEPENDENCIES_FOR_M2) + $(COMPILER) -c -g $(ALL_COMPILERFLAGS) \ + $(ALL_CPPFLAGS) $(INCLUDES) $< $(OUTPUT_OPTION) + +m2/gm2-gcc/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-gcc/%.def $(MCDEPS) + $(MC) -o=$@ $(srcdir)/m2/gm2-gcc/$*.def + +# The following tables define the source files which are translated into C using mc +# and defines the system interface C files. + +# Core library definition modules found in gm2-libs. + +GM2-LIBS-BOOT-DEFS = \ + ASCII.def \ + Args.def \ + Assertion.def \ + Break.def \ + CmdArgs.def \ + Debug.def \ + DynamicStrings.def \ + Environment.def \ + FIO.def \ + FormatStrings.def \ + FpuIO.def \ + IO.def \ + Indexing.def \ + M2Dependent.def \ + M2EXCEPTION.def \ + M2LINK.def \ + M2RTS.def \ + NumberIO.def \ + PushBackInput.def \ + RTExceptions.def \ + SArgs.def \ + SEnvironment.def \ + SFIO.def \ + SYSTEM.def \ + Scan.def \ + StdIO.def \ + Storage.def \ + StrCase.def \ + StrIO.def \ + StrLib.def \ + StringConvert.def \ + SysExceptions.def \ + SysStorage.def \ + TimeString.def \ + UnixArgs.def \ + dtoa.def \ + errno.def \ + ldtoa.def \ + libc.def \ + libm.def \ + termios.def \ + wrapc.def \ + +# Core library implementation modules found in gm2-libs. + +GM2-LIBS-BOOT-MODS = \ + ASCII.mod \ + Args.mod \ + Assertion.mod \ + Break.mod \ + CmdArgs.mod \ + Debug.mod \ + DynamicStrings.mod \ + Environment.mod \ + FIO.mod \ + FormatStrings.mod \ + FpuIO.mod \ + IO.mod \ + Indexing.mod \ + M2Dependent.mod \ + M2EXCEPTION.mod \ + M2RTS.mod \ + NumberIO.mod \ + PushBackInput.mod \ + RTExceptions.mod \ + SArgs.mod \ + SEnvironment.mod \ + SFIO.mod \ + Scan.mod \ + Storage.mod \ + StrCase.mod \ + StrIO.mod \ + StrLib.mod \ + StringConvert.mod \ + SysStorage.mod \ + TimeString.mod \ + +# Hand translated C files and C files for definition module for "C" modules +# found in gm2-libs-ch. + +GM2-LIBS-BOOT-C = \ + StdIO.c \ + SysExceptions.c \ + choosetemp.c \ + errno.c \ + termios.c \ + wrapc.c \ + +# C++ implemented modules found in gm2-libs-ch. + +GM2-LIBS-BOOT-CC = \ + UnixArgs.cc \ + dtoa.cc \ + ldtoa.cc + +# Definition modules for the front end found in gm2-compiler. + +GM2-COMP-BOOT-DEFS = \ + FifoQueue.def \ + Lists.def \ + M2ALU.def \ + M2AsmUtil.def \ + M2Base.def \ + M2BasicBlock.def \ + M2Batch.def \ + M2Bitset.def \ + M2CaseList.def \ + M2Check.def \ + M2Code.def \ + M2ColorString.def \ + M2Comp.def \ + M2Const.def \ + M2Debug.def \ + M2DebugStack.def \ + M2Defaults.def \ + M2DriverOptions.def \ + M2Emit.def \ + M2Error.def \ + M2EvalSym.def \ + M2FileName.def \ + M2GCCDeclare.def \ + M2GenGCC.def \ + M2Graph.def \ + M2LexBuf.def \ + M2MetaError.def \ + M2Optimize.def \ + M2Options.def \ + M2Pass.def \ + M2Preprocess.def \ + M2Printf.def \ + M2Quads.def \ + M2Quiet.def \ + M2Range.def \ + M2Reserved.def \ + M2SSA.def \ + M2Scaffold.def \ + M2Scope.def \ + M2Search.def \ + M2Size.def \ + M2StackAddress.def \ + M2StackWord.def \ + M2Students.def \ + M2Swig.def \ + M2System.def \ + NameKey.def \ + ObjectFiles.def \ + Output.def \ + P0SymBuild.def \ + P0SyntaxCheck.def \ + P1Build.def \ + P1SymBuild.def \ + P2Build.def \ + P2SymBuild.def \ + P3Build.def \ + P3SymBuild.def \ + PCBuild.def \ + PCSymBuild.def \ + PHBuild.def \ + Sets.def \ + SymbolConversion.def \ + SymbolKey.def \ + SymbolTable.def \ + bnflex.def \ + m2flex.def \ + +# Implementation modules for the front end found in gm2-compiler. + +GM2-COMP-BOOT-MODS = \ + FifoQueue.mod \ + Lists.mod \ + Lists.mod \ + M2ALU.mod \ + M2AsmUtil.mod \ + M2Base.mod \ + M2BasicBlock.mod \ + M2Batch.mod \ + M2Bitset.mod \ + M2CaseList.mod \ + M2Check.mod \ + M2Code.mod \ + M2ColorString.mod \ + M2Comp.mod \ + M2Const.mod \ + M2Debug.mod \ + M2DebugStack.mod \ + M2Defaults.mod \ + M2DriverOptions.mod \ + M2Emit.mod \ + M2Error.mod \ + M2FileName.mod \ + M2GCCDeclare.mod \ + M2GenGCC.mod \ + M2Graph.mod \ + M2LexBuf.mod \ + M2MetaError.mod \ + M2Optimize.mod \ + M2Options.mod \ + M2Pass.mod \ + M2Preprocess.mod \ + M2Printf.mod \ + M2Quads.mod \ + M2Quiet.mod \ + M2Range.mod \ + M2Reserved.mod \ + M2SSA.mod \ + M2Scaffold.mod \ + M2Scope.mod \ + M2Search.mod \ + M2Size.mod \ + M2StackAddress.mod \ + M2StackWord.mod \ + M2Students.mod \ + M2Swig.mod \ + M2System.mod \ + NameKey.mod \ + NameKey.mod \ + ObjectFiles.mod \ + Output.mod \ + P0SymBuild.mod \ + P1SymBuild.mod \ + P2SymBuild.mod \ + P3SymBuild.mod \ + PCSymBuild.mod \ + Sets.mod \ + SymbolConversion.mod \ + SymbolKey.mod \ + SymbolKey.mod \ + SymbolTable.mod \ + bnflex.mod \ + +# The interface between the modula-2 front end and gimple/trees found in directory gm2-gcc. + +GM2-GCC-DEFS = \ + m2block.def \ + m2builtins.def \ + m2color.def \ + m2configure.def \ + m2convert.def \ + m2decl.def \ + m2except.def \ + m2except.def \ + m2expr.def \ + m2linemap.def \ + m2misc.def \ + m2statement.def \ + m2top.def \ + m2tree.def \ + m2treelib.def \ + m2type.def \ + +# The following lists define the source files used to build gm2 using Modula-2 +# sources directly. +# +# cc1gm2$(exeext) uses these definition modules from the core libraries. + +GM2-LIBS-DEFS = \ + ASCII.def \ + Args.def \ + Assertion.def \ + Break.def \ + Builtins.def \ + COROUTINES.def \ + CmdArgs.def \ + Debug.def \ + DynamicStrings.def \ + Environment.def \ + FIO.def \ + FormatStrings.def \ + FpuIO.def \ + GetOpt.def \ + IO.def \ + Indexing.def \ + LMathLib0.def \ + LegacyReal.def \ + M2Dependent.def \ + M2EXCEPTION.def \ + M2LINK.def \ + M2RTS.def \ + MathLib0.def \ + MemUtils.def \ + NumberIO.def \ + PushBackInput.def \ + RTExceptions.def \ + RTint.def \ + SArgs.def \ + SEnvironment.def \ + SFIO.def \ + SMathLib0.def \ + SYSTEM.def \ + Scan.def \ + StdIO.def \ + Storage.def \ + StrCase.def \ + StrIO.def \ + StrLib.def \ + StringConvert.def \ + SysStorage.def \ + TimeString.def \ + UnixArgs.def \ + cbuiltin.def \ + dtoa.def \ + ldtoa.def \ + libc.def \ + termios.def \ + wrapc.def \ + +# cc1gm2$(exeext) uses these implementation modules from the core libraries. + +GM2-LIBS-MODS = \ + ASCII.mod \ + Args.mod \ + Assertion.mod \ + Break.mod \ + Builtins.mod \ + COROUTINES.mod \ + CmdArgs.mod \ + Debug.mod \ + DynamicStrings.mod \ + Environment.mod \ + FIO.mod \ + FormatStrings.mod \ + FpuIO.mod \ + GetOpt.mod \ + IO.mod \ + Indexing.mod \ + LMathLib0.mod \ + LegacyReal.mod \ + M2Dependent.mod \ + M2EXCEPTION.mod \ + M2RTS.mod \ + MathLib0.mod \ + MemUtils.mod \ + NumberIO.mod \ + PushBackInput.mod \ + RTExceptions.mod \ + RTint.mod \ + SArgs.mod \ + SEnvironment.mod \ + SFIO.mod \ + SMathLib0.mod \ + SYSTEM.mod \ + Scan.mod \ + StdIO.mod \ + Storage.mod \ + StrCase.mod \ + StrIO.mod \ + StrLib.mod \ + StringConvert.mod \ + SysStorage.mod \ + TimeString.mod \ + +# cc1gm2$(exeext) uses these C modules from the core libraries. + +GM2-LIBS-C = \ + Selective.c \ + SysExceptions.c \ + cgetopt.c \ + choosetemp.c \ + errno.c \ + host.c \ + termios.c \ + wrapc.c \ + +# cc1gm2$(exeext) uses these C++ modules from the core libraries. + +GM2-LIBS-CC = \ + UnixArgs.cc \ + dtoa.cc \ + ldtoa.cc \ + +# cc1gm2$(exeext) uses these definition modules found in the gm2-compiler directory. + +GM2-COMP-DEFS = \ + FifoQueue.def \ + Lists.def \ + M2ALU.def \ + M2AsmUtil.def \ + M2Base.def \ + M2BasicBlock.def \ + M2Batch.def \ + M2Bitset.def \ + M2CaseList.def \ + M2Check.def \ + M2Code.def \ + M2ColorString.def \ + M2Comp.def \ + M2Const.def \ + M2Debug.def \ + M2DebugStack.def \ + M2Defaults.def \ + M2DriverOptions.def \ + M2Emit.def \ + M2Error.def \ + M2FileName.def \ + M2GCCDeclare.def \ + M2GenGCC.def \ + M2Graph.def \ + M2LexBuf.def \ + M2MetaError.def \ + M2Optimize.def \ + M2Options.def \ + M2Pass.def \ + M2Preprocess.def \ + M2Printf.def \ + M2Quads.def \ + M2Quiet.def \ + M2Range.def \ + M2Reserved.def \ + M2SSA.def \ + M2Scaffold.def \ + M2Scope.def \ + M2Search.def \ + M2Size.def \ + M2StackAddress.def \ + M2StackWord.def \ + M2Students.def \ + M2Swig.def \ + M2System.def \ + NameKey.def \ + ObjectFiles.def \ + P0SymBuild.def \ + P0SyntaxCheck.def \ + P1Build.def \ + P1SymBuild.def \ + P2Build.def \ + P2SymBuild.def \ + P3Build.def \ + P3SymBuild.def \ + PCBuild.def \ + PCSymBuild.def \ + PHBuild.def \ + Sets.def \ + SymbolConversion.def \ + SymbolKey.def \ + SymbolTable.def \ + bnflex.def \ + +# cc1gm2$(exeext) uses these implementation modules found in the gm2-compiler directory. + +GM2-COMP-MODS = \ + FifoQueue.mod \ + Lists.mod \ + M2ALU.mod \ + M2AsmUtil.mod \ + M2Base.mod \ + M2BasicBlock.mod \ + M2Batch.mod \ + M2Bitset.mod \ + M2CaseList.mod \ + M2Check.mod \ + M2Code.mod \ + M2ColorString.mod \ + M2Comp.mod \ + M2Const.mod \ + M2Debug.mod \ + M2DebugStack.mod \ + M2Defaults.mod \ + M2DriverOptions.mod \ + M2Emit.mod \ + M2Error.mod \ + M2FileName.mod \ + M2GCCDeclare.mod \ + M2GenGCC.mod \ + M2Graph.mod \ + M2LexBuf.mod \ + M2MetaError.mod \ + M2Optimize.mod \ + M2Options.mod \ + M2Pass.mod \ + M2Preprocess.mod \ + M2Printf.mod \ + M2Quads.mod \ + M2Quiet.mod \ + M2Range.mod \ + M2Reserved.mod \ + M2SSA.mod \ + M2Scaffold.mod \ + M2Scope.mod \ + M2Search.mod \ + M2Size.mod \ + M2StackAddress.mod \ + M2StackWord.mod \ + M2Students.mod \ + M2Swig.mod \ + M2System.mod \ + NameKey.mod \ + ObjectFiles.mod \ + Output.mod \ + P0SymBuild.mod \ + P1SymBuild.mod \ + P2SymBuild.mod \ + P3SymBuild.mod \ + PCSymBuild.mod \ + Sets.mod \ + SymbolConversion.mod \ + SymbolKey.mod \ + SymbolTable.mod \ + bnflex.mod \ + +# Implementation modules created by the parser generator pge from .bnf files. + +GM2-AUTO-MODS = \ + P2Build.mod \ + P3Build.mod \ + PHBuild.mod \ + PCBuild.mod \ + P1Build.mod \ + P0SyntaxCheck.mod \ + +# LIBIBERTY interface definition modules + +GM2-LIBIBERTY-DEFS = \ + choosetemp.def \ + pexecute.def + +BUILD-LIBS-BOOT-H = $(GM2-LIBS-BOOT-DEFS:%.def=m2/gm2-libs-boot/$(SRC_PREFIX)%.h) + +BUILD-LIBS-BOOT = $(BUILD-LIBS-BOOT-H) \ + $(GM2-LIBS-BOOT-MODS:%.mod=m2/gm2-libs-boot/%.o) \ + $(GM2-LIBS-BOOT-CC:%.cc=m2/gm2-libs-boot/%.o) \ + $(GM2-LIBS-BOOT-C:%.c=m2/gm2-libs-boot/%.o) + +BUILD-COMPILER-BOOT-H = $(GM2-COMP-BOOT-DEFS:%.def=m2/gm2-compiler-boot/$(SRC_PREFIX)%.h) \ + $(GM2-LIBIBERTY-DEFS:%.def=m2/gm2-libiberty/$(SRC_PREFIX)%.h) \ + $(GM2-GCC-DEFS:%.def=m2/gm2-gcc/$(SRC_PREFIX)%.h) + +BUILD-COMPILER-BOOT = $(BUILD-COMPILER-BOOT-H) \ + $(GM2-COMP-BOOT-DEFS:%.def=m2/gm2-compiler-boot/$(SRC_PREFIX)%.h) \ + $(GM2-AUTO-MODS:%.mod=m2/gm2-compiler-boot/%.o) \ + $(GM2-COMP-BOOT-MODS:%.mod=m2/gm2-compiler-boot/%.o) \ + m2/gm2-compiler-boot/m2flex.o + +BUILD-BOOT-H = m2/boot-bin/mc$(exeext) \ + $(BUILD-LIBS-BOOT-H) $(BUILD-COMPILER-BOOT-H) $(TARGET_H) $(PLUGIN_HEADERS) + +# Core library definition modules used by the modula-2 to C++ translator. + +MC-LIB-DEFS = \ + ASCII.def \ + Args.def \ + Assertion.def \ + Break.def \ + COROUTINES.def \ + CmdArgs.def \ + Debug.def \ + DynamicStrings.def \ + Environment.def \ + FIO.def \ + FormatStrings.def \ + FpuIO.def \ + IO.def \ + M2Dependent.def \ + M2EXCEPTION.def \ + M2LINK.def \ + M2RTS.def \ + MemUtils.def \ + NumberIO.def \ + PushBackInput.def \ + RTExceptions.def \ + RTco.def \ + RTint.def \ + SArgs.def \ + SFIO.def \ + SYSTEM.def \ + Selective.def \ + StdIO.def \ + Storage.def \ + StrCase.def \ + StrIO.def \ + StrLib.def \ + StringConvert.def \ + SysExceptions.def \ + SysStorage.def \ + TimeString.def \ + UnixArgs.def \ + dtoa.def \ + errno.def \ + ldtoa.def \ + libc.def \ + libm.def \ + termios.def \ + wrapc.def \ + +# Core library implementation modules used by the modula-2 to C++ translator. + +MC-LIB-MODS = \ + ASCII.mod \ + Args.mod \ + Assertion.mod \ + Break.mod \ + CmdArgs.mod \ + Debug.mod \ + DynamicStrings.mod \ + Environment.mod \ + FIO.mod \ + FormatStrings.mod \ + FpuIO.mod \ + IO.mod \ + M2Dependent.mod \ + M2EXCEPTION.mod \ + M2RTS.mod \ + MemUtils.mod \ + NumberIO.mod \ + PushBackInput.mod \ + RTExceptions.mod \ + RTint.mod \ + SArgs.mod \ + SFIO.mod \ + StdIO.mod \ + Storage.mod \ + StrCase.mod \ + StrIO.mod \ + StrLib.mod \ + StringConvert.mod \ + SysStorage.mod \ + TimeString.mod \ + +MC-LIB-BOOT-C = $(MC-LIB-MODS:%.mod=%.c) + +# Definition modules for the modula-2 to C++ translator found in mc. + +MC-DEFS = \ + Indexing.def \ + alists.def \ + decl.def \ + keyc.def \ + lists.def \ + mcComment.def \ + mcComp.def \ + mcDebug.def \ + mcError.def \ + mcFileName.def \ + mcLexBuf.def \ + mcMetaError.def \ + mcOptions.def \ + mcPreprocess.def \ + mcPretty.def \ + mcPrintf.def \ + mcQuiet.def \ + mcReserved.def \ + mcSearch.def \ + mcStack.def \ + mcStream.def \ + mcflex.def \ + mcp1.def \ + mcp2.def \ + mcp3.def \ + mcp4.def \ + mcp5.def \ + nameKey.def \ + symbolKey.def \ + varargs.def \ + wlists.def \ + +# Implementation modules for the modula-2 to C++ translator found in mc. + +MC-MODS = \ + Indexing.mod \ + alists.mod \ + decl.mod \ + keyc.mod \ + lists.mod \ + mcComment.mod \ + mcComp.mod \ + mcDebug.mod \ + mcError.mod \ + mcFileName.mod \ + mcLexBuf.mod \ + mcMetaError.mod \ + mcOptions.mod \ + mcPreprocess.mod \ + mcPretty.mod \ + mcPrintf.mod \ + mcQuiet.mod \ + mcReserved.mod \ + mcSearch.mod \ + mcStack.mod \ + mcStream.mod \ + nameKey.mod \ + symbolKey.mod \ + top.mod \ + varargs.mod \ + wlists.mod \ + +# Parser files generated by pge from .bnf files. + +MC-AUTO-MODS = \ + mcp1.mod \ + mcp2.mod \ + mcp3.mod \ + mcp4.mod \ + mcp5.mod + +MC-BOOT-C = $(MC-MODS:%.mod=%.c) $(MC-AUTO-MODS:%.mod=%.c) + +# C interface files for mc. + +MC-INTERFACE-C = \ + M2LINK.c \ + SYSTEM.c \ + Selective.c \ + SysExceptions.c \ + abort.c \ + errno.c \ + libc.c \ + mcrts.c \ + termios.c \ + wrapc.c \ + +# C++ interface files for mc. + +MC-INTERFACE-CC = \ + UnixArgs.cc \ + dtoa.cc \ + ldtoa.cc \ + +BUILD-MC-BOOT-H = $(MC-LIB-DEFS:%.def=m2/mc-boot-gen/$(SRC_PREFIX)%.h) \ + $(MC-DEFS:%.def=m2/mc-boot-gen/$(SRC_PREFIX)%.h) + +BUILD-MC-BOOT-C = $(MC-LIB-MODS:%.mod=m2/mc-boot-gen/$(SRC_PREFIX)%.c) \ + $(MC-MODS:%.mod=m2/mc-boot-gen/$(SRC_PREFIX)%.c) + +BUILD-MC-BOOT-AUTO-C = $(MC-AUTO-MODS:%.mod=m2/mc-boot-gen/$(SRC_PREFIX)%.c) + +BUILD-MC-BOOT-O = $(MC-LIB-BOOT-C:%.c=m2/mc-boot/$(SRC_PREFIX)%.o) \ + $(MC-BOOT-C:%.c=m2/mc-boot/$(SRC_PREFIX)%.o) + +BUILD-MC-INTERFACE-O = $(MC-INTERFACE-C:%.c=m2/mc-boot-ch/$(SRC_PREFIX)%.o) \ + $(MC-INTERFACE-CC:%.cc=m2/mc-boot-ch/$(SRC_PREFIX)%.o) + +GM2GCC = -I$(srcdir)/m2 -Im2 -I$(srcdir)/m2/gm2-gcc -Im2/gm2-gcc + +MCINCLUDES= -I$(srcdir)/m2/mc-boot-ch +LOCAL_INCLUDES = -I. -I$(srcdir)/../include -I$(srcdir) + +GCC_COLOR=m2/gm2-gcc/m2color.o diagnostic-color.o + +m2/boot-bin/mc$(exeext): $(BUILD-MC-BOOT-O) $(BUILD-MC-INTERFACE-O) \ + m2/mc-boot/main.o mcflex.o m2/gm2-libs-boot/RTcodummy.o + +$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ $(BUILD-MC-BOOT-O) \ + $(BUILD-MC-INTERFACE-O) m2/mc-boot/main.o \ + mcflex.o m2/gm2-libs-boot/RTcodummy.o -lm + +m2/mc-boot/$(SRC_PREFIX)%.o: m2/mc-boot/$(SRC_PREFIX)%.c + $(CXX) -g -c -I. -I$(srcdir)/m2/mc-boot-ch -I$(srcdir)/m2/mc-boot -I$(srcdir)/../include -I$(srcdir) $(INCLUDES) $< -o $@ + +m2/mc-boot-ch/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.c m2/gm2-libs/gm2-libs-host.h + $(CXX) -DHAVE_CONFIG_H -g -c -I. -Im2/gm2-libs -I$(srcdir)/../include -I$(srcdir) $(INCLUDES) -Im2/gm2-libs $< -o $@ + +m2/mc-boot-ch/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.cc m2/gm2-libs/gm2-libs-host.h + $(CXX) -DHAVE_CONFIG_H -g -c -I. -Im2/gm2-libs -I$(srcdir)/../include -I$(srcdir) $(INCLUDES) -Im2/gm2-libs $< -o $@ + +m2/mc-boot/main.o: $(M2LINK) $(srcdir)/m2/init/mcinit + unset CC ; $(M2LINK) -s --langc++ --exit --name m2/mc-boot/main.c $(srcdir)/m2/init/mcinit + $(CXX) -g -c -I. -I$(srcdir)/../include -I$(srcdir) $(INCLUDES) m2/mc-boot/main.c -o $@ + +mcflex.o: mcflex.c + $(CC) -I$(srcdir)/m2/mc -g -c $< -o $@ # remember that mcReserved.h is copied into m2/mc + +mcflex.c: $(srcdir)/m2/mc/mc.flex + flex -t $< > $@ + +m2/gm2-libs-boot/%.o: $(srcdir)/m2/gm2-libs-boot/%.mod $(MCDEPS) $(BUILD-BOOT-H) + $(MC) -o=m2/gm2-libs-boot/$*.c $(srcdir)/m2/gm2-libs-boot/$*.mod + $(COMPILER) -c -DIN_GCC $(CFLAGS) $(MCINCLUDES) m2/gm2-libs-boot/$*.c -o $@ + +m2/gm2-libs-boot/%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-H) + $(MC) -o=m2/gm2-libs-boot/$*.c $(srcdir)/m2/gm2-libs/$*.mod + $(COMPILER) -c -DIN_GCC $(CFLAGS) -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(MCINCLUDES) $(INCLUDES) m2/gm2-libs-boot/$*.c -o $@ + +m2/gm2-libs-boot/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-libs/%.def $(MCDEPS) + $(MC) -o=$@ $(srcdir)/m2/gm2-libs/$*.def + +m2/gm2-libs-boot/RTcodummy.o: $(srcdir)/m2/gm2-libs-ch/RTcodummy.c m2/gm2-libs/gm2-libs-host.h + $(CXX) -c -DIN_GCC $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@ + +m2/gm2-libs-boot/RTintdummy.o: $(srcdir)/m2/gm2-libs-ch/RTintdummy.c m2/gm2-libs/gm2-libs-host.h + $(CXX) -c -DIN_GCC $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@ + +m2/gm2-libs-boot/wrapc.o: $(srcdir)/m2/gm2-libs-ch/wrapc.c m2/gm2-libs-boot/$(SRC_PREFIX)wrapc.h m2/gm2-libs/gm2-libs-host.h + $(CXX) -c -DHAVE_CONFIG_H $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot -Im2/gm2-libs $(INCLUDES) $< -o $@ + +m2/gm2-libs-boot/M2LINK.o: $(srcdir)/m2/gm2-libs-ch/M2LINK.c m2/gm2-libs-boot/$(SRC_PREFIX)M2LINK.h m2/gm2-libs/gm2-libs-host.h + $(CXX) -c -DHAVE_CONFIG_H $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot -Im2/gm2-libs $(INCLUDES) $< -o $@ + +m2/gm2-libs-boot/UnixArgs.o: $(srcdir)/m2/gm2-libs-ch/UnixArgs.cc m2/gm2-libs-boot/$(SRC_PREFIX)UnixArgs.h m2/gm2-libs/gm2-libs-host.h + $(CXX) -c -DIN_GCC $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@ + +m2/gm2-libs-boot/choosetemp.o: m2/gm2-libs-ch/choosetemp.c m2/gm2-libiberty/Gchoosetemp.h m2/gm2-libs/gm2-libs-host.h + $(CXX) -c $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot -Im2/gm2-libiberty -I$(srcdir)/m2/gm2-libiberty/ $(INCLUDES) $< -o $@ + +m2/gm2-libs-boot/errno.o: $(srcdir)/m2/gm2-libs-ch/errno.c m2/gm2-libs-boot/$(SRC_PREFIX)errno.h m2/gm2-libs/gm2-libs-host.h + $(CXX) -c $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@ + +m2/gm2-libs-boot/dtoa.o: $(srcdir)/m2/gm2-libs-ch/dtoa.cc m2/gm2-libs/gm2-libs-host.h + $(CXX) -c $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@ + +m2/gm2-libs-boot/ldtoa.o: $(srcdir)/m2/gm2-libs-ch/ldtoa.cc m2/gm2-libs/gm2-libs-host.h + $(CXX) -c $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@ + +m2/gm2-libs-boot/termios.o: $(srcdir)/m2/gm2-libs-ch/termios.c $(BUILD-LIBS-BOOT-H) m2/gm2-libs/gm2-libs-host.h + $(CXX) -c $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@ + +m2/gm2-libs-boot/SysExceptions.o: $(srcdir)/m2/gm2-libs-ch/SysExceptions.c \ + m2/gm2-libs-boot/$(SRC_PREFIX)SysExceptions.h m2/gm2-libs/gm2-libs-host.h + $(CXX) -c $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(INCLUDES) $< -o $@ + +m2/gm2-libs-boot/SysStorage.o: $(srcdir)/m2/gm2-libs/SysStorage.mod $(MCDEPS) $(BUILD-BOOT-H) + $(MC) -o=m2/gm2-libs-boot/SysStorage.c $(srcdir)/m2/gm2-libs/SysStorage.mod + $(COMPILER) -DIN_GCC -c $(CFLAGS) \ + -I$(srcdir)/m2 -Im2 -I. -Im2/gm2-libs-boot $(MCINCLUDES) $(INCLUDES) \ + m2/gm2-libs-boot/SysStorage.c -o m2/gm2-libs-boot/SysStorage.o + +m2/gm2-compiler-boot/M2GCCDeclare.o: $(srcdir)/m2/gm2-compiler/M2GCCDeclare.mod $(MCDEPS) $(BUILD-BOOT-H) + $(MC) --extended-opaque -o=m2/gm2-compiler-boot/M2GCCDeclare.c $< + $(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(GM2GCC) \ + -I. -I$(srcdir)/../include -I$(srcdir) \ + -I. -Im2/gm2-libs-boot -Im2/gm2-compiler-boot \ + -I$(srcdir)/m2/gm2-libiberty $(MCINCLUDES) $(INCLUDES) m2/gm2-compiler-boot/M2GCCDeclare.c -o $@ + +m2/gm2-compiler-boot/M2Error.o: $(srcdir)/m2/gm2-compiler/M2Error.mod $(MCDEPS) $(BUILD-BOOT-H) + $(MC) --extended-opaque -o=m2/gm2-compiler-boot/M2Error.c $< + $(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(GM2GCC) \ + -I. -I$(srcdir)/../include -I$(srcdir) \ + -I. -Im2/gm2-libs-boot -Im2/gm2-compiler-boot \ + -I$(srcdir)/m2/gm2-libiberty $(MCINCLUDES) $(INCLUDES) m2/gm2-compiler-boot/M2Error.c -o $@ + +m2/gm2-compiler-boot/%.o: $(srcdir)/m2/gm2-compiler/%.mod $(BUILD-BOOT-H) $(MCDEPS) $(BUILD-BOOT-H) + $(MC) -o=m2/gm2-compiler-boot/$*.c $(srcdir)/m2/gm2-compiler/$*.mod + $(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(GM2GCC) \ + -I. -I$(srcdir)/../include -I$(srcdir) \ + -I. -Im2/gm2-libs-boot -Im2/gm2-compiler-boot -Im2/gm2-libiberty \ + -I$(srcdir)/m2/gm2-libiberty $(MCINCLUDES) $(INCLUDES) m2/gm2-compiler-boot/$*.c -o $@ + +m2/gm2-compiler-boot/%.o: m2/gm2-compiler-boot/%.mod $(MCDEPS) $(BUILD-BOOT-H) + $(MC) -o=m2/gm2-compiler-boot/$*.c m2/gm2-compiler-boot/$*.mod + $(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(GM2GCC) \ + -I. -I$(srcdir)/../include -I$(srcdir) \ + -I. -Im2/gm2-libs-boot -Im2/gm2-compiler-boot \ + -I$(srcdir)/m2/gm2-libiberty $(MCINCLUDES) $(INCLUDES) m2/gm2-compiler-boot/$*.c -o $@ + +m2/gm2-compiler-boot/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-compiler/%.def $(MCDEPS) + $(MC) -o=$@ $(srcdir)/m2/gm2-compiler/$*.def + +m2/gm2-compiler-boot/m2flex.o: m2/gm2-compiler/m2flex.c $(BUILD-BOOT-H) $(TIMEVAR_H) \ + $(BUILD-LIBS-BOOT-H) m2/gm2-compiler-boot/$(SRC_PREFIX)NameKey.h \ + $(CONFIG_H) m2/gm2config.h $(TARGET_H) $(PLUGIN_HEADERS) + $(COMPILER) -c -g $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ + $(GM2GCC) $(INCLUDES) -I$(srcdir)/m2 \ + -Im2 -Im2/gm2-compiler-boot -Im2/gm2-libs-boot $< -o $@ + +m2/gm2-compiler/m2flex.c: $(srcdir)/m2/m2.flex $(TIMEVAR_H) insn-attr-common.h + flex -t $< | sed -e 's/ malloc/ xmalloc/' | sed -e 's/ realloc/ xrealloc/' > $@ + +m2/gm2-libiberty/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-libiberty/%.def $(MCDEPS) + $(MC) -o=$@ $(srcdir)/m2/gm2-libiberty/$*.def + +# The rules to build objects in gm2-compiler and gm2-libs directories. + +m2/gm2-compiler/%.o: $(srcdir)/m2/gm2-compiler/%.mod + $(GM2_1) $(GM2_FLAGS) -c -I$(srcdir)/m2/gm2-compiler -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-gcc -I$(srcdir)/m2/gm2-libiberty $< -o $@ + +m2/gm2-compiler/m2flex.o: m2/gm2-compiler/m2flex.c m2/gm2-libs/gm2-libs-host.h $(TIMEVAR_H) + $(COMPILER) -c -g $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(INCLUDES) \ + $(GM2GCC) -Im2/gm2-compiler-boot -Im2/gm2-libs-boot $< -o $@ + +m2/gm2-compiler/%.o: m2/gm2-compiler/%.mod + $(GM2_1) $(GM2_FLAGS) -c -I$(srcdir)/m2/gm2-compiler -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-gcc -I$(srcdir)/m2/gm2-libiberty $< -o $@ + +m2/gm2-libs-iso/%.o: $(srcdir)/m2/gm2-libs-iso/%.c m2/gm2-libs/gm2-libs-host.h + $(CXX) -DBUILD_GM2_LIBS_TARGET -DBUILD_GM2_LIBS -c $(CFLAGS) -Im2/gm2-libs -I$(srcdir)/m2 -Im2/gm2-libs-boot $(INCLUDES) $< -o $@ + +m2/gm2-libs-iso/%.o: $(srcdir)/m2/gm2-libs-iso/%.mod + $(GM2_1) $(GM2_ISO_FLAGS) -c -B./ -Im2/gm2-libs-iso:$(srcdir)/m2/gm2-libs-iso -I$(srcdir)/m2/gm2-libs $< -o $@ + + +# We build the cc1gm2$(exeext) from the boot stage and then proceed to build it +# again using itself. + +m2/gm2-libs/gm2-libs-host.h: + echo "Configuring to build libraries using native compiler" ; \ + NEW_SRCDIR=`${srcdir}/m2/tools-src/calcpath ../../ ${srcdir} m2/gm2-libs` ; \ + export NEW_SRCDIR ; \ + cd m2/gm2-libs ; \ + $(SHELL) -c '$${NEW_SRCDIR}/config-host \ + --srcdir=$${NEW_SRCDIR} \ + --target=$(target) \ + --program-suffix=$(exeext)' + +# Autoconf inserts -DCROSS_DIRECTORY_STRUCTURE if we are building a +# cross compiler and the ../Makefile.in above appends this to INTERNAL_CFLAGS. + +m2/gm2config.h: + NEW_SRCDIR=`${srcdir}/m2/tools-src/calcpath ../ ${srcdir} m2` ; \ + export NEW_SRCDIR ; \ + cd m2 ; \ + if echo $(INTERNAL_CFLAGS) | grep \\-DCROSS_DIRECTORY_STRUCTURE; then \ + AR=$(echo $(AR_FOR_TARGET) | sed -e "s/^ //") ; \ + export AR ; \ + RANLIB=$(echo $(RANLIB_FOR_TARGET) | sed -e "s/^ //") ; \ + export RANLIB ; \ + $(SHELL) -c '$${NEW_SRCDIR}/configure --srcdir=$${NEW_SRCDIR} \ + --target=$(target) --program-suffix=$(exeext) \ + --includedir=$(SYSTEM_HEADER_DIR) --libdir=$(libdir) \ + --libexecdir=$(libexecdir)' ; \ + else \ + $(SHELL) -c '$${NEW_SRCDIR}/configure --srcdir=$(NEW_SRCDIR) \ + --target=$(target) --program-suffix=$(exeext)' ; \ + fi + +$(objdir)/m2/gm2-libs-min/SYSTEM.def: $(GM2_PROG_DEP) + $(SHELL) $(srcdir)/m2/tools-src/makeSystem -fpim \ + $(srcdir)/m2/gm2-libs-min/SYSTEM.def \ + $(srcdir)/m2/gm2-libs-min/SYSTEM.mod \ + -I$(srcdir)/m2/gm2-libs-min:$(srcdir)/m2/gm2-libs \ + "$(GM2_FOR_TARGET)" $@ + +$(objdir)/m2/gm2-libs/SYSTEM.def: $(GM2_PROG_DEP) + echo "GM2_FOR_TARGET $(GM2_FOR_TARGET)" + echo "GCC_FOR_TARGET $(GCC_FOR_TARGET)" + $(SHELL) $(srcdir)/m2/tools-src/makeSystem -fpim \ + $(srcdir)/m2/gm2-libs/SYSTEM.def \ + $(srcdir)/m2/gm2-libs/SYSTEM.mod \ + -I$(srcdir)/m2/gm2-libs \ + "$(GM2_FOR_TARGET)" $@ + +$(objdir)/m2/gm2-libs-iso/SYSTEM.def: $(GM2_PROG_DEP) + $(SHELL) $(srcdir)/m2/tools-src/makeSystem -fiso \ + $(srcdir)/m2/gm2-libs-iso/SYSTEM.def \ + $(srcdir)/m2/gm2-libs-iso/SYSTEM.mod \ + -I$(srcdir)/m2/gm2-libs-iso:$(srcdir)/m2/gm2-libs \ + "$(GM2_FOR_TARGET)" $@ + +$(objdir)/m2/gm2-libs-coroutines/SYSTEM.def: $(GM2_PROG_DEP) + $(SHELL) $(srcdir)/m2/tools-src/makeSystem -fpim \ + $(srcdir)/m2/gm2-libs-coroutines/SYSTEM.def \ + $(srcdir)/m2/gm2-libs-coroutines/SYSTEM.mod \ + -I$(srcdir)/m2/gm2-libs-coroutines:$(srcdir)/m2/gm2-libs-iso:$(srcdir)/m2/gm2-libs \ + "$(GM2_FOR_TARGET)" $@ + +build-compiler: $(GM2-COMP-MODS:%.mod=m2/gm2-compiler/%.o) \ + $(GM2-AUTO-MODS:%.mod=m2/gm2-compiler/%.o) \ + m2/gm2-compiler/m2flex.o + +m2/gm2-compiler/gm2.a: build-compiler gm2$(exeext) + $(AR_FOR_TARGET) cr $@ $(GM2-COMP-MODS:%.mod=m2/gm2-compiler/%.o) \ + $(GM2-AUTO-MODS:%.mod=m2/gm2-compiler/%.o) + $(RANLIB) $@ + +m2/gm2-libs-boot/libgm2.a: m2/boot-bin/mc$(exeext) $(BUILD-LIBS-BOOT) + $(AR) cr $@ $(GM2-LIBS-BOOT-MODS:%.mod=m2/gm2-libs-boot/%.o) \ + $(GM2-LIBS-BOOT-CC:%.cc=m2/gm2-libs-boot/%.o) \ + $(GM2-LIBS-BOOT-C:%.c=m2/gm2-libs-boot/%.o) + $(RANLIB) $@ + +m2/gm2-compiler-boot/gm2.a: m2/boot-bin/mc$(exeext) m2/boot-bin/mklink$(exeext) \ + $(BUILD-LIBS-BOOT) $(BUILD-COMPILER-BOOT) + $(AR) cr $@ $(GM2-COMP-BOOT-MODS:%.mod=m2/gm2-compiler-boot/%.o) \ + $(GM2-AUTO-MODS:%.mod=m2/gm2-compiler-boot/%.o) + $(RANLIB) $@ + +m2/gm2-compiler-boot/gm2.a: m2/boot-bin/mc$(exeext) + +m2/boot-bin/mklink$(exeext): $(srcdir)/m2/tools-src/mklink.c + $(CXX) $(CFLAGS) -I$(srcdir)/m2 -Im2/gm2-libs-boot -Im2/gm2-compiler-boot -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) $< -o $@ + +m2/gm2-compiler-boot/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-compiler-boot/%.def $(MCDEPS) + $(MC) --quiet -o=$@ $(srcdir)/m2/gm2-compiler-boot/$*.def + +m2/gm2-compiler/%.mod: $(srcdir)/m2/gm2-compiler/%.bnf $(PGE) + $(PGE) -k -l $< -o $@ + +m2/gm2-compiler-boot/%.mod: $(srcdir)/m2/gm2-compiler/%.bnf $(PGE) + $(PGE) -k -l $< -o $@ + +check-m2: check-gm2 +check_m2: check-gm2 +check_gm2: check-gm2 +check-modula2: check-gm2 +check_modula2: check-gm2 +check-modula-2: check-gm2 +check_modula-2: check-gm2 +check_modula_2: check-gm2 + +lang_checks += check-gm2 +lang_checks_parallelized += check-gm2 +# For description see the check_$lang_parallelize comment in gcc/Makefile.in. +check_gm2_parallelize = 10000 + +check-gm2-local: $(GM2TESTSUITEDIR)/site.exp + -(rootme=`${PWD_COMMAND}`; export rootme; \ + srcdir=`cd ${srcdir}; ${PWD_COMMAND}` ; export srcdir ; \ + cd $(TESTSUITEDIR); \ + EXPECT=${EXPECT} ; export EXPECT ; \ + if [ -f $${rootme}/../expect/expect ] ; then \ + TCL_LIBRARY=`cd .. ; cd ${srcdir}/../tcl/library ; ${PWD_COMMAND}` ; \ + export TCL_LIBRARY ; fi ; \ + $(RUNTEST) --tool gm2 --directory testsuite/m2/pim/pass) + +BUILD-PGE-O = \ + m2/pge-boot/GArgs.o \ + m2/pge-boot/GASCII.o \ + m2/pge-boot/GAssertion.o \ + m2/pge-boot/Gbnflex.o \ + m2/pge-boot/GDebug.o \ + m2/pge-boot/GDynamicStrings.o \ + m2/pge-boot/GFIO.o \ + m2/pge-boot/GIndexing.o \ + m2/pge-boot/GIO.o \ + m2/pge-boot/GLists.o \ + m2/pge-boot/GM2Dependent.o \ + m2/pge-boot/GM2EXCEPTION.o \ + m2/pge-boot/GM2RTS.o \ + m2/pge-boot/GNameKey.o \ + m2/pge-boot/GNumberIO.o \ + m2/pge-boot/GOutput.o \ + m2/pge-boot/Gpge.o \ + m2/pge-boot/GPushBackInput.o \ + m2/pge-boot/GRTExceptions.o \ + m2/pge-boot/GSFIO.o \ + m2/pge-boot/GStdIO.o \ + m2/pge-boot/GStorage.o \ + m2/pge-boot/GStrCase.o \ + m2/pge-boot/GStrIO.o \ + m2/pge-boot/GStrLib.o \ + m2/pge-boot/GSymbolKey.o \ + m2/pge-boot/GSysStorage.o \ + m2/pge-boot/Glibc.o \ + m2/pge-boot/Gerrno.o \ + m2/pge-boot/GUnixArgs.o \ + m2/pge-boot/GM2LINK.o \ + m2/pge-boot/Gtermios.o \ + m2/pge-boot/GSysExceptions.o \ + m2/pge-boot/Gabort.o \ + m2/pge-boot/Gmcrts.o \ + m2/pge-boot/main.o + +ifeq ($(M2_MAINTAINER),yes) +include m2/Make-maintainer +else +m2/pge-boot/%.o: m2/pge-boot/%.c m2/gm2-libs/gm2-libs-host.h + $(CXX) $(INCLUDES) -I$(srcdir)/m2/pge-boot -Im2/gm2-libs -g -c $< -o $@ + +m2/pge-boot/%.o: m2/pge-boot/%.cc m2/gm2-libs/gm2-libs-host.h + $(CXX) $(INCLUDES) -I$(srcdir)/m2/pge-boot -Im2/gm2-libs -g -c $< -o $@ + +$(PGE): $(BUILD-PGE-O) + +$(LINKER) $(ALL_LINKERFLAGS) $(LDFLAGS) -o $@ $(BUILD-PGE-O) -lm + +endif From patchwork Tue Dec 6 14:47:25 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Gaius Mulley X-Patchwork-Id: 61580 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id F052A383B6C9 for ; Tue, 6 Dec 2022 14:50:09 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org F052A383B6C9 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1670338210; bh=p60OM8NrOXFrUxQFDuBF5gfauLjZlJRHuRqk3FqBUYo=; h=Subject:To:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=ldeDe9n0dk7BuObqbHW04oKVYDLDIgGCbF4spp52OY/Qc/bkW4jdMYh23FVNn3mSK 6nMfR2VxHY86FRHUGwpPr8IEmxqA356IscPOuOH4dXITVtF5zbbVeO9BhtY5UHxncE rU6FkAp8XvLiYEGY/ym8sVVuKyeZWOXB6R7QeVFo= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x430.google.com (mail-wr1-x430.google.com [IPv6:2a00:1450:4864:20::430]) by sourceware.org (Postfix) with ESMTPS id EC23A3848E35 for ; Tue, 6 Dec 2022 14:47:29 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org EC23A3848E35 Received: by mail-wr1-x430.google.com with SMTP id h11so23732364wrw.13 for ; Tue, 06 Dec 2022 06:47:29 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=date:message-id:to:subject:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=p60OM8NrOXFrUxQFDuBF5gfauLjZlJRHuRqk3FqBUYo=; b=3mhqEcwZ3BuoQQ+CdCR9te79e1Si+UMJycPmQQFo+9wJWzw93xXMMOap3+NGIeBRLp 34xn28Fi477NTTrfnh3GdIzwIZ6EMQUrjmmX0cbzWg3pu+QfieeQcZUmcUAI3C+0UVKi ZAm5hnotVZDdOSU/iy1OC/l97Lq2RtOfAtlBEh2R0nMGBKtMcpIV1E6YE0Ro2/m3VKYs 0r9yJ2stZ8uekIZCpJ76g/PWTjTvvsysLD2z+3ELM/D7XArUoUSW2GuqNHsqitfyZzga Vx6dw1RCjkhgd1vaGATlWJqdgjm0C452Zl+A8sPGN3C3JDrBwZSVPXFkcA4+GEz8CROk ROUQ== X-Gm-Message-State: ANoB5pl5ZlBcBiSaL9a6XfD+2SC5Z2xTasPPv1lmSfbtxdNp75mwQKjc pIFk7CzdKyN9W7tK6scbx2gGDbDSH1o= X-Google-Smtp-Source: AA0mqf43YeCmHH3HOuo+sbjeftRKJqnN3kNGdhDl1nBL0J1HI0PNByY7cG+KckCdFcUt5N0/yzU6BA== X-Received: by 2002:adf:a319:0:b0:242:45fe:740 with SMTP id c25-20020adfa319000000b0024245fe0740mr10810295wrb.408.1670338048026; Tue, 06 Dec 2022 06:47:28 -0800 (PST) Received: from lancelot ([195.147.220.46]) by smtp.gmail.com with ESMTPSA id q6-20020a05600c2e4600b003c6bd91caa5sm19567046wmf.17.2022.12.06.06.47.26 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Dec 2022 06:47:27 -0800 (PST) X-Google-Original-From: Gaius Mulley Received: from gaius by lancelot with local (Exim 4.94.2) (envelope-from ) id 1p2ZED-004QeL-Qd for gcc-patches@gcc.gnu.org; Tue, 06 Dec 2022 14:47:25 +0000 Subject: [PATCH v3 3/19] modula2 front end: gm2 driver files. To: X-Mailer: mail (GNU Mailutils 3.10) Message-Id: Date: Tue, 06 Dec 2022 14:47:25 +0000 X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Gaius Mulley via Gcc-patches From: Gaius Mulley Reply-To: Gaius Mulley Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patchset contains the c++, h and option related files necessary to build the driver program gm2. The patch also consists of the autoconf/configure related build infastructure sources found in gcc/m2. The reviewer might need to look at the 01-02-make patchset. The gm2 driver is heavily based on the fortran driver, it also adds the c++ libraries and modula-2 search paths and libraries depending upon dialect for user convenience. Users could link modula-2 objects using g++ if they supply the include and link paths. ------8<----------8<----------8<----------8<----------8<----------8<---- diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2spec.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2spec.cc 2022-12-06 02:56:51.360774949 +0000 @@ -0,0 +1,946 @@ +/* gm2spec.cc specific flags and argument handling within GNU Modula-2. + +Copyright (C) 2007-2022 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 +. */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "tm.h" +#include "xregex.h" +#include "obstack.h" +#include "intl.h" +#include "prefix.h" +#include "opt-suggestions.h" +#include "gcc.h" +#include "opts.h" +#include "vec.h" + +#include "m2/gm2config.h" + +#ifdef HAVE_DIRENT_H +#include +#else +#ifdef HAVE_SYS_NDIR_H +#include +#endif +#ifdef HAVE_SYS_DIR_H +#include +#endif +#ifdef HAVE_NDIR_H +#include +#endif +#endif + +/* This bit is set if we saw a `-xfoo' language specification. */ +#define LANGSPEC (1<<1) +/* This bit is set if they did `-lm' or `-lmath'. */ +#define MATHLIB (1<<2) +/* This bit is set if they did `-lc'. */ +#define WITHLIBC (1<<3) +/* Skip this option. */ +#define SKIPOPT (1<<4) + +#ifndef MATH_LIBRARY +#define MATH_LIBRARY "m" +#endif +#ifndef MATH_LIBRARY_PROFILE +#define MATH_LIBRARY_PROFILE MATH_LIBRARY +#endif + +#ifndef LIBSTDCXX +#define LIBSTDCXX "stdc++" +#endif +#ifndef LIBSTDCXX_PROFILE +#define LIBSTDCXX_PROFILE LIBSTDCXX +#endif +#ifndef LIBSTDCXX_STATIC +#define LIBSTDCXX_STATIC NULL +#endif + +#ifndef LIBCXX +#define LIBCXX "c++" +#endif +#ifndef LIBCXX_PROFILE +#define LIBCXX_PROFILE LIBCXX +#endif +#ifndef LIBCXX_STATIC +#define LIBCXX_STATIC NULL +#endif + +#ifndef LIBCXXABI +#define LIBCXXABI "c++abi" +#endif +#ifndef LIBCXXABI_PROFILE +#define LIBCXXABI_PROFILE LIBCXXABI +#endif +#ifndef LIBCXXABI_STATIC +#define LIBCXXABI_STATIC NULL +#endif + +/* The values used here must match those of the stdlib_kind enumeration + in c.opt. */ +enum stdcxxlib_kind +{ + USE_LIBSTDCXX = 1, + USE_LIBCXX = 2 +}; + +#define DEFAULT_DIALECT "pim" +#undef DEBUG_ARG + +typedef enum { iso, pim, min, logitech, pimcoroutine, maxlib } libs; + +/* These are the library names which are installed as part of gm2 and reflect + -flibs=name. The -flibs= option provides the user with a short cut to add + libraries without having to know the include and link path. */ + +static const char *library_name[maxlib] + = { "m2iso", "m2pim", "m2min", "m2log", "m2cor" }; + +/* They match the installed archive name for example libm2iso.a, + libm2pim.a, libm2min.a, libm2log.a and libm2cor.a. They also match a + subdirectory name where the definition modules are kept. The driver + checks the argument to -flibs= for an entry in library_name or + alternatively the existance of the subdirectory (to allow for third + party libraries to coexist). */ + +static const char *library_abbrev[maxlib] + = { "iso", "pim", "min", "log", "cor" }; + +/* Users may specifiy -flibs=pim,iso etc which are mapped onto + -flibs=m2pim,m2iso respectively. This provides a match between + the dialect of Modula-2 and the library set. */ + +static const char *add_include (const char *libpath, const char *library); + +static bool seen_scaffold_static = false; +static bool seen_scaffold_dynamic = false; +static bool scaffold_static = false; +static bool scaffold_dynamic = true; // Default uses -fscaffold-dynamic. +static bool seen_gen_module_list = false; +static bool seen_uselist = false; +static bool uselist = false; +static bool gen_module_list = true; // Default uses -fgen-module-list=-. +static const char *gen_module_filename = "-"; +static const char *multilib_dir = NULL; +/* The original argument list and related info is copied here. */ +static unsigned int gm2_xargc; +static const struct cl_decoded_option *gm2_x_decoded_options; +static void append_arg (const struct cl_decoded_option *); + +/* The new argument list will be built here. */ +static unsigned int gm2_newargc; +static struct cl_decoded_option *gm2_new_decoded_options; + + +/* Return whether strings S1 and S2 are both NULL or both the same + string. */ + +static bool +strings_same (const char *s1, const char *s2) +{ + return s1 == s2 || (s1 != NULL && s2 != NULL && strcmp (s1, s2) == 0); +} + +bool +options_same (const struct cl_decoded_option *opt1, + const struct cl_decoded_option *opt2) +{ + return (opt1->opt_index == opt2->opt_index + && strings_same (opt1->arg, opt2->arg) + && strings_same (opt1->orig_option_with_args_text, + opt2->orig_option_with_args_text) + && strings_same (opt1->canonical_option[0], + opt2->canonical_option[0]) + && strings_same (opt1->canonical_option[1], + opt2->canonical_option[1]) + && strings_same (opt1->canonical_option[2], + opt2->canonical_option[2]) + && strings_same (opt1->canonical_option[3], + opt2->canonical_option[3]) + && (opt1->canonical_option_num_elements + == opt2->canonical_option_num_elements) + && opt1->value == opt2->value + && opt1->errors == opt2->errors); +} + +/* Append another argument to the list being built. */ + +static void +append_arg (const struct cl_decoded_option *arg) +{ + static unsigned int newargsize; + + if (gm2_new_decoded_options == gm2_x_decoded_options + && gm2_newargc < gm2_xargc + && options_same (arg, &gm2_x_decoded_options[gm2_newargc])) + { + ++gm2_newargc; + return; /* Nothing new here. */ + } + + if (gm2_new_decoded_options == gm2_x_decoded_options) + { /* Make new arglist. */ + unsigned int i; + + newargsize = (gm2_xargc << 2) + 20; /* This should handle all. */ + gm2_new_decoded_options = XNEWVEC (struct cl_decoded_option, newargsize); + + /* Copy what has been done so far. */ + for (i = 0; i < gm2_newargc; ++i) + gm2_new_decoded_options[i] = gm2_x_decoded_options[i]; + } + + if (gm2_newargc == newargsize) + fatal_error (input_location, "overflowed output argument list for %qs", + arg->orig_option_with_args_text); + + gm2_new_decoded_options[gm2_newargc++] = *arg; +} + +/* Append an option described by OPT_INDEX, ARG and VALUE to the list + being built. */ + +static void +append_option (size_t opt_index, const char *arg, int value) +{ + struct cl_decoded_option decoded; + + generate_option (opt_index, arg, value, CL_DRIVER, &decoded); + append_arg (&decoded); +} + +/* build_archive_path returns a string containing the path to the + archive defined by libpath and dialectLib. */ + +static const char * +build_archive_path (const char *libpath, const char *library) +{ + if (library != NULL) + { + const char *libdir = (const char *)library; + + if (libdir != NULL) + { + int machine_length = 0; + char dir_sep[2]; + + dir_sep[0] = DIR_SEPARATOR; + dir_sep[1] = (char)0; + + if (multilib_dir != NULL) + { + machine_length = strlen (multilib_dir); + machine_length += strlen (dir_sep); + } + + int l = strlen (libpath) + 1 + strlen ("m2") + 1 + + strlen (libdir) + 1 + machine_length + 1; + char *s = (char *)xmalloc (l); + + strcpy (s, libpath); + strcat (s, dir_sep); + if (machine_length > 0) + { + strcat (s, multilib_dir); + strcat (s, dir_sep); + } + strcat (s, "m2"); + strcat (s, dir_sep); + strcat (s, libdir); + return s; + } + } + return NULL; +} + +/* safe_strdup safely duplicates a string. */ + +static char * +safe_strdup (const char *s) +{ + if (s != NULL) + return xstrdup (s); + return NULL; +} + +/* add_default_combination adds the correct link path and then the + library name. */ + +static bool +add_default_combination (const char *libpath, const char *library) +{ + if (library != NULL) + { + append_option (OPT_L, build_archive_path (libpath, library), 1); + append_option (OPT_l, safe_strdup (library), 1); + return true; + } + return false; +} + +/* add_default_archives adds the default archives to the end of the + current command line. */ + +static int +add_default_archives (const char *libpath, const char *libraries) +{ + const char *l = libraries; + const char *e; + char *libname; + unsigned int libcount = 0; + + do + { + e = index (l, ','); + if (e == NULL) + { + libname = xstrdup (l); + l = NULL; + if (add_default_combination (libpath, libname)) + libcount++; + free (libname); + } + else + { + libname = xstrndup (l, e - l); + l = e + 1; + if (add_default_combination (libpath, libname)) + libcount++; + free (libname); + } + } + while ((l != NULL) && (l[0] != (char)0)); + return libcount; +} + +/* build_include_path builds the component of the include path + referenced by the library. */ + +static const char * +build_include_path (const char *libpath, const char *library) +{ + char dir_sep[2]; + char *gm2libs; + unsigned int machine_length = 0; + + dir_sep[0] = DIR_SEPARATOR; + dir_sep[1] = (char)0; + + if (multilib_dir != NULL) + { + machine_length = strlen (multilib_dir); + machine_length += strlen (dir_sep); + } + + gm2libs = (char *)alloca (strlen (libpath) + strlen (dir_sep) + strlen ("m2") + + strlen (dir_sep) + strlen (library) + 1 + + machine_length + 1); + strcpy (gm2libs, libpath); + strcat (gm2libs, dir_sep); + if (machine_length > 0) + { + strcat (gm2libs, multilib_dir); + strcat (gm2libs, dir_sep); + } + strcat (gm2libs, "m2"); + strcat (gm2libs, dir_sep); + strcat (gm2libs, library); + + return xstrdup (gm2libs); +} + +/* add_include add the correct include path given the libpath and + library. The new path is returned. */ + +static const char * +add_include (const char *libpath, const char *library) +{ + if (library == NULL) + return NULL; + else + return build_include_path (libpath, library); +} + +/* add_default_includes add the appropriate default include paths + depending upon the style of libraries chosen. */ + +static void +add_default_includes (const char *libpath, const char *libraries) +{ + const char *l = libraries; + const char *e; + const char *c; + const char *path; + + do + { + e = index (l, ','); + if (e == NULL) + { + c = xstrdup (l); + l = NULL; + } + else + { + c = xstrndup (l, e - l); + l = e + 1; + } + path = add_include (libpath, c); + append_option (OPT_I, path, 1); + } + while ((l != NULL) && (l[0] != (char)0)); +} + +/* library_installed returns true if directory library is found under + libpath. */ + +static bool +library_installed (const char *libpath, const char *library) +{ +#if defined(HAVE_OPENDIR) && defined(HAVE_DIRENT_H) + const char *complete = build_archive_path (libpath, library); + DIR *directory = opendir (complete); + + if (directory == NULL || (errno == ENOENT)) + return false; + /* Directory exists and therefore the library also exists. */ + closedir (directory); + return true; +#else + return false; +#endif +} + +/* check_valid check to see that the library is valid. + It check the library against the default library set in gm2 and + also against any additional libraries installed in the prefix tree. */ + +static bool +check_valid_library (const char *libpath, const char *library) +{ + /* Firstly check against the default libraries (which might not be + installed yet). */ + for (int i = 0; i < maxlib; i++) + if (strcmp (library, library_name[i]) == 0) + return true; + /* Secondly check whether it is installed (a third party library). */ + return library_installed (libpath, library); +} + +/* check_valid_list check to see that the libraries specified are valid. + It checks against the default library set in gm2 and also against + any additional libraries installed in the libpath tree. */ + +static bool +check_valid_list (const char *libpath, const char *libraries) +{ + const char *start = libraries; + const char *end; + const char *copy; + + do + { + end = index (start, ','); + if (end == NULL) + { + copy = xstrdup (start); + start = NULL; + } + else + { + copy = xstrndup (start, end - start); + start = end + 1; + } + if (! check_valid_library (libpath, copy)) + { + error ("library specified %sq is either not installed or does not exist", + copy); + return false; + } + } + while ((start != NULL) && (start[0] != (char)0)); + return true; +} + +/* add_word returns a new string which has the contents of lib + appended to list. If list is NULL then lib is duplicated and + returned otherwise the list is appended by "," and the contents of + lib. */ + +static const char * +add_word (const char *list, const char *lib) +{ + char *copy; + if (list == NULL) + return xstrdup (lib); + copy = (char *) xmalloc (strlen (list) + strlen (lib) + 1 + 1); + strcpy (copy, list); + strcat (copy, ","); + strcat (copy, lib); + return copy; +} + +/* convert_abbreviation checks abbreviation against known library + abbreviations. If an abbreviation is found it converts the element + to the full library name, otherwise the user supplied name is added + to the full_libraries list. A new string is returned. */ + +static const char * +convert_abbreviation (const char *full_libraries, const char *abbreviation) +{ + for (int i = 0; i < maxlib; i++) + if (strcmp (abbreviation, library_abbrev[i]) == 0) + return add_word (full_libraries, library_name[i]); + /* No abbreviation found therefore assume user specified full library name. */ + return add_word (full_libraries, abbreviation); +} + +/* convert_abbreviations checks each element in the library list to + see if an a known library abbreviation was used. If found it + converts the element to the full library name, otherwise the + element is copied into the list. A new string is returned. */ + +static const char * +convert_abbreviations (const char *libraries) +{ + const char *start = libraries; + const char *end; + const char *full_libraries = NULL; + + do + { + end = index (start, ','); + if (end == NULL) + { + full_libraries = convert_abbreviation (full_libraries, start); + start = NULL; + } + else + { + full_libraries = convert_abbreviation (full_libraries, xstrndup (start, end - start)); + start = end + 1; + } + } + while ((start != NULL) && (start[0] != (char)0)); + return full_libraries; +} + + +void +lang_specific_driver (struct cl_decoded_option **in_decoded_options, + unsigned int *in_decoded_options_count, + int *in_added_libraries) +{ + unsigned int argc = *in_decoded_options_count; + struct cl_decoded_option *decoded_options = *in_decoded_options; + unsigned int i; + + /* True if we saw a `-xfoo' language specification on the command + line. This function will add a -xmodula-2 if the user has not + already placed one onto the command line. */ + bool seen_x_flag = false; + const char *language = NULL; + + /* If nonzero, the user gave us the `-p' or `-pg' flag. */ + int saw_profile_flag = 0; + + /* What action to take for the c++ runtime library: + -1 means we should not link it in. + 0 means we should link it if it is needed. + 1 means it is needed and should be linked in. + 2 means it is needed but should be linked statically. */ + int library = 0; + + /* Which c++ runtime library to link. */ + stdcxxlib_kind which_library = USE_LIBSTDCXX; + + const char *libraries = NULL; + const char *dialect = DEFAULT_DIALECT; + const char *libpath = LIBSUBDIR; + + /* An array used to flag each argument that needs a bit set for + LANGSPEC, MATHLIB, or WITHLIBC. */ + int *args; + + /* Have we seen -fmod=? */ + bool seen_module_extension = false; + + /* Should the driver perform a link? */ + bool linking = true; + + /* "-lm" or "-lmath" if it appears on the command line. */ + const struct cl_decoded_option *saw_math = NULL; + + /* "-lc" if it appears on the command line. */ + const struct cl_decoded_option *saw_libc = NULL; + + /* By default, we throw on the math library if we have one. */ + int need_math = (MATH_LIBRARY[0] != '\0'); + + /* 1 if we should add -lpthread to the command-line. */ + int need_pthread = 1; + + /* True if we saw -static. */ + int static_link = 0; + + /* True if we should add -shared-libgcc to the command-line. */ + int shared_libgcc = 1; + + /* Have we seen the -v flag? */ + bool verbose = false; + + /* The number of libraries added in. */ + int added_libraries; + +#ifdef ENABLE_PLUGIN + /* True if we should add -fplugin=m2rte to the command-line. */ + bool need_plugin = true; +#else + bool need_plugin = false; +#endif + + /* True if we should set up include paths and library paths. */ + bool allow_libraries = true; + +#if defined(DEBUG_ARG) + printf ("argc = %d\n", argc); + fprintf (stderr, "Incoming:"); + for (i = 0; i < argc; i++) + fprintf (stderr, " %s", decoded_options[i].orig_option_with_args_text); + fprintf (stderr, "\n"); +#endif + + gm2_xargc = argc; + gm2_x_decoded_options = decoded_options; + gm2_newargc = 0; + gm2_new_decoded_options = decoded_options; + added_libraries = *in_added_libraries; + args = XCNEWVEC (int, argc); + + /* First pass through arglist. + + If -nostdlib or a "turn-off-linking" option is anywhere in the + command line, don't do any library-option processing (except + relating to -x). */ + + for (i = 1; i < argc; i++) + { + const char *arg = decoded_options[i].arg; + args[i] = 0; +#if defined(DEBUG_ARG) + printf ("1st pass: %s\n", + decoded_options[i].orig_option_with_args_text); +#endif + switch (decoded_options[i].opt_index) + { + case OPT_fiso: + dialect = "iso"; + break; + case OPT_fpim2: + dialect = "pim2"; + break; + case OPT_fpim3: + dialect = "pim3"; + break; + case OPT_fpim4: + dialect = "pim4"; + break; + case OPT_fpim: + dialect = "pim"; + break; + case OPT_flibs_: + libraries = xstrdup (arg); + allow_libraries = decoded_options[i].value; + break; + case OPT_fmod_: + seen_module_extension = true; + break; + case OPT_fpthread: + need_pthread = decoded_options[i].value; + break; + case OPT_fm2_plugin: + need_plugin = decoded_options[i].value; +#ifndef ENABLE_PLUGIN + if (need_plugin) + error ("plugin support is disabled; configure with " + "%<--enable-plugin%>"); +#endif + break; + case OPT_fscaffold_dynamic: + seen_scaffold_dynamic = true; + scaffold_dynamic = decoded_options[i].value; + break; + case OPT_fscaffold_static: + seen_scaffold_static = true; + scaffold_static = decoded_options[i].value; + break; + case OPT_fgen_module_list_: + seen_gen_module_list = true; + gen_module_list = decoded_options[i].value; + if (gen_module_list) + gen_module_filename = decoded_options[i].arg; + break; + case OPT_fuse_list_: + seen_uselist = true; + uselist = decoded_options[i].value; + break; + + case OPT_nostdlib: + case OPT_nostdlib__: + case OPT_nodefaultlibs: + library = -1; + break; + + case OPT_l: + if (strcmp (arg, MATH_LIBRARY) == 0) + { + args[i] |= MATHLIB; + need_math = 0; + } + else if (strcmp (arg, "c") == 0) + args[i] |= WITHLIBC; + else + /* Unrecognized libraries (e.g. -lfoo) may require libstdc++. */ + library = (library == 0) ? 1 : library; + break; + + case OPT_pg: + case OPT_p: + saw_profile_flag++; + break; + + case OPT_x: + seen_x_flag = true; + language = arg; + break; + + case OPT_v: + verbose = true; + break; + + case OPT_Xlinker: + case OPT_Wl_: + /* Arguments that go directly to the linker might be .o files, + or something, and so might cause libstdc++ to be needed. */ + if (library == 0) + library = 1; + break; + + case OPT_c: + case OPT_r: + case OPT_S: + case OPT_E: + case OPT_M: + case OPT_MM: + case OPT_fsyntax_only: + /* Don't specify libraries if we won't link, since that would + cause a warning. */ + linking = false; + library = -1; + break; + + case OPT_static: + static_link = 1; + break; + + case OPT_static_libgcc: + shared_libgcc = 0; + break; + + case OPT_static_libstdc__: + library = library >= 0 ? 2 : library; + args[i] |= SKIPOPT; + break; + + case OPT_stdlib_: + which_library = (stdcxxlib_kind) decoded_options[i].value; + break; + + default: + if ((decoded_options[i].orig_option_with_args_text != NULL) + && (strncmp (decoded_options[i].orig_option_with_args_text, + "-m", 2) == 0)) + multilib_dir = xstrdup (decoded_options[i].orig_option_with_args_text + + 2); + } + } + if (language != NULL && (strcmp (language, "modula-2") != 0)) + return; + + if (scaffold_static && scaffold_dynamic) + { + if (! seen_scaffold_dynamic) + scaffold_dynamic = false; + if (scaffold_dynamic && scaffold_static) + error ("%qs and %qs cannot both be enabled", + "-fscaffold-dynamic", "-fscaffold-static"); + } + if (uselist && gen_module_list) + { + if (! seen_gen_module_list) + gen_module_list = false; + if (uselist && gen_module_list) + error ("%qs and %qs cannot both be enabled", + "-fgen-module-list=", "-fuse-list="); + } + + + /* There's no point adding -shared-libgcc if we don't have a shared + libgcc. */ +#ifndef ENABLE_SHARED_LIBGCC + shared_libgcc = 0; +#endif + + /* Second pass through arglist, transforming arguments as appropriate. */ + + append_arg (&decoded_options[0]); /* Start with command name, of course. */ + for (i = 1; i < argc; ++i) + { +#if defined(DEBUG_ARG) + printf ("2nd pass: %s\n", + decoded_options[i].orig_option_with_args_text); +#endif + if ((args[i] & SKIPOPT) == 0) + { + append_arg (&decoded_options[i]); + /* Make sure -lstdc++ is before the math library, since libstdc++ + itself uses those math routines. */ + if (!saw_math && (args[i] & MATHLIB) && library > 0) + saw_math = &decoded_options[i]; + + if (!saw_libc && (args[i] & WITHLIBC) && library > 0) + saw_libc = &decoded_options[i]; + } +#if defined(DEBUG_ARG) + else + printf ("skipping: %s\n", + decoded_options[i].orig_option_with_args_text); +#endif + } + + /* We now add in extra arguments to facilitate a successful + compile or link. For example include paths for dialect of Modula-2, + library paths and default scaffold linking options. */ + + /* If we have not seen either uselist or gen_module_list and we need + to link then we turn on -fgen_module_list=- as the default. */ + if ((! (seen_uselist || seen_gen_module_list)) && linking) + append_option (OPT_fgen_module_list_, "-", 1); + + if (allow_libraries) + { + /* If the libraries have not been specified by the user but the + dialect has been specified then select the appropriate libraries. */ + if (libraries == NULL) + { + if (strcmp (dialect, "iso") == 0) + libraries = xstrdup ("m2iso,m2pim"); + else + /* Default to pim libraries if none specified. */ + libraries = xstrdup ("m2pim,m2log,m2iso"); + } + libraries = convert_abbreviations (libraries); + if (! check_valid_list (libpath, libraries)) + return; + add_default_includes (libpath, libraries); + } + if ((! seen_x_flag) && seen_module_extension) + append_option (OPT_x, "modula-2", 1); + + if (need_plugin) + append_option (OPT_fplugin_, "m2rte", 1); + + if (linking) + { + if (allow_libraries) + add_default_archives (libpath, libraries); + /* Add `-lstdc++' if we haven't already done so. */ +#ifdef HAVE_LD_STATIC_DYNAMIC + if (library > 1 && !static_link) + append_option (OPT_Wl_, LD_STATIC_OPTION, 1); +#endif + if (which_library == USE_LIBCXX) + { + append_option (OPT_l, saw_profile_flag ? LIBCXX_PROFILE : LIBCXX, 1); + added_libraries++; + if (LIBCXXABI != NULL) + { + append_option (OPT_l, saw_profile_flag ? LIBCXXABI_PROFILE + : LIBCXXABI, 1); + added_libraries++; + } + } + else + { + append_option (OPT_l, saw_profile_flag ? LIBSTDCXX_PROFILE + : LIBSTDCXX, 1); + added_libraries++; + } + /* Add target-dependent static library, if necessary. */ + if ((static_link || library > 1) && LIBSTDCXX_STATIC != NULL) + { + append_option (OPT_l, LIBSTDCXX_STATIC, 1); + added_libraries++; + } +#ifdef HAVE_LD_STATIC_DYNAMIC + if (library > 1 && !static_link) + append_option (OPT_Wl_, LD_DYNAMIC_OPTION, 1); +#endif + } + if (need_math) + { + append_option (OPT_l, saw_profile_flag ? MATH_LIBRARY_PROFILE : + MATH_LIBRARY, 1); + added_libraries++; + } + if (need_pthread) + { + append_option (OPT_l, "pthread", 1); + added_libraries++; + } + if (shared_libgcc && !static_link) + append_option (OPT_shared_libgcc, NULL, 1); + + if (verbose && gm2_new_decoded_options != gm2_x_decoded_options) + { + fprintf (stderr, _("Driving:")); + for (i = 0; i < gm2_newargc; i++) + fprintf (stderr, " %s", + gm2_new_decoded_options[i].orig_option_with_args_text); + fprintf (stderr, "\n"); + fprintf (stderr, "new argc = %d, added_libraries = %d\n", + gm2_newargc, added_libraries); + } + + *in_decoded_options_count = gm2_newargc; + *in_decoded_options = gm2_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) /* Not used for M2. */ +{ + return 0; +} + +/* Number of extra output files that lang_specific_pre_link may generate. */ +int lang_specific_extra_outfiles = 0; diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/lang.opt --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/lang.opt 2022-12-06 02:56:51.360774949 +0000 @@ -0,0 +1,356 @@ +; Options for the Modula-2 front end. +; +; Copyright (C) 2016-2022 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 COPYING. 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. + +Language +Modula-2 + +B +Modula-2 +; Documented in c.opt + +D +Modula-2 +; Documented in c.opt + +E +Modula-2 +; Documented in c.opt (passed to the preprocessor if -fcpp is used) + +I +Modula-2 Joined Separate +; Documented in c.opt + +L +Modula-2 Joined Separate +; Not documented + +M +Modula-2 +; Documented in c.opt + +O +Modula-2 +; Documented in c.opt + +Wall +Modula-2 +; Documented in c.opt + +Wpedantic +Modula-2 +; Documented in common.opt + +Wpedantic-param-names +Modula-2 +compiler checks to force definition module procedure parameter names with their implementation module counterpart + +Wpedantic-cast +Modula-2 +compiler warns if a cast is being used on types of differing sizes + +Wverbose-unbounded +Modula-2 +inform user which parameters will be passed by reference + +Wstyle +Modula-2 +extra compile time semantic checking, typically tries to catch poor programming style + +Wunused-variable +Modula-2 +; Documented in c.opt + +Wunused-parameter +Modula-2 +; Documented in c.opt + +c +Modula-2 +; Documented in c.opt + +fauto-init +Modula-2 +automatically initializes all pointers to NIL + +fbounds +Modula-2 +turns on runtime subrange, array index and indirection via NIL pointer checking + +fcase +Modula-2 +turns on runtime checking to check whether a CASE statement requires an ELSE clause when on was not specified + +fobjc-std=objc1 +Modula-2 +; Documented in c.opt + +fcpp +Modula-2 +use cpp to preprocess the module + +fcpp-end +Modula-2 +passed to the preprocessor if -fcpp is used (internal switch) + +fcpp-begin +Modula-2 +passed to the preprocessor if -fcpp is used (internal switch) + +fdebug-builtins +Modula-2 +call a real function, rather than the builtin equivalent + +fdump-system-exports +Modula-2 +display all inbuilt system items + +fd +Modula-2 +turn on internal debugging of the compiler + +fdebug-trace-quad +Modula-2 +turn on quadruple tracing (internal switch) + +fdebug-trace-api +Modula-2 +turn on the Modula-2 api tracing (internal switch) + +fdebug-function-line-numbers +Modula-2 +turn on the Modula-2 function line number generation (internal switch) + +fdef= +Modula-2 Joined +recognise the specified suffix as a definition module filename + +fexceptions +Modula-2 +; Documented in common.opt + +fextended-opaque +Modula-2 +allows opaque types to be implemented as any type (a GNU Modula-2 extension) + +ffloatvalue +Modula-2 +turns on runtime checking to check whether a floating point number is about to exceed range + +fgen-module-list= +Modula-2 Joined +create a topologically sorted module list from all dependent modules used in the application + +findex +Modula-2 +turns on all range checking for numerical values + +fiso +Modula-2 +use ISO dialect of Modula-2 + +flibs= +Modula-2 Joined +specify the library order, currently legal entries include: log, min, pim, iso or their directory name equivalent m2log, m2min, m2pim, m2iso. + +flocation= +Modula-2 Joined +set all location values to a specific value (internal switch) + +fm2-g +Modula-2 +generate extra nops to improve debugging, producing an instruction for every code related keyword + +fm2-lower-case +Modula-2 +generate error messages which render keywords in lower case + +fm2-plugin +Modula-2 +insert plugin to identify runtime errors at compiletime (default on) + +fm2-statistics +Modula-2 +display statistics about the amount of source lines compiled and symbols used + +fm2-strict-type +Modula-2 +experimental flag to turn on the new strict type checker + +fm2-whole-program +Modula-2 +compile all implementation modules and program module at once + +fmod= +Modula-2 Joined +recognise the specified suffix as implementation and module filenames + +fnil +Modula-2 +turns on runtime checking to detect accessing data through a NIL value pointer + +fpim +Modula-2 +use PIM [234] dialect of Modula-2 + +fpim2 +Modula-2 +use PIM 2 dialect of Modula-2 + +fpim3 +Modula-2 +use PIM 3 dialect of Modula-2 + +fpim4 +Modula-2 +use PIM 4 dialect of Modula-2 + +fpositive-mod-floor-div +Modula-2 +force positive result from MOD and DIV result floor + +fpthread +Modula-2 +link against the pthread library (default on) + +fq +Modula-2 +internal compiler debugging information, dump the list of quadruples + +frange +Modula-2 +turns on all range checking for numerical values + +freturn +Modula-2 +turns on runtime checking for functions which finish without executing a RETURN statement + +fruntime-modules= +Modula-2 Joined +specify the list of runtime modules and their initialization order + +fscaffold-static +Modula-2 +generate static scaffold initialization and finalization for every module inside main + +fscaffold-dynamic +Modula-2 +the modules initialization order is dynamically determined by M2RTS and application dependancies + +fscaffold-c +Modula-2 +generate a C source scaffold for the current module being compiled + +fscaffold-c++ +Modula-2 +generate a C++ source scaffold for the current module being compiled + +fscaffold-main +Modula-2 +generate the main function + +fshared +Modula-2 +generate a shared library from the module + +fsoft-check-all +Modula-2 +turns on all software runtime checking (an abbreviation for -fnil -frange -findex -fwholediv -fcase -freturn -fwholediv -ffloatvalue) + +fsources +Modula-2 +display the location of module source files as they are compiled + +fswig +Modula-2 +create a swig interface file for the module + +funbounded-by-reference +Modula-2 +optimize non var unbounded parameters by passing it by reference, providing it is not written to within the callee procedure. + +fuse-list= +Modula-2 Joined +orders the initialization/finalializations for scaffold-static or force linking of modules if scaffold-dynamic + +fversion +Modula-2 +; Documented in common.opt + +fwholediv +Modula-2 +turns on all division and modulus by zero checking for ordinal values + +fwholevalue +Modula-2 +turns on runtime checking to check whether a whole number is about to exceed range + +fxcode +Modula-2 +issue all errors and warnings in the Xcode format + +iprefix +Modula-2 +; Documented in c.opt + +isystem +Modula-2 +; Documented in c.opt + +idirafter +Modula-2 +; Documented in c.opt + +imultilib +Modula-2 +; Documented in c.opt + +lang-asm +Modula-2 +; Documented in c.opt + +-save-temps +Modula-2 Alias(save-temps) + +save-temps +Modula-2 +save temporary preprocessed files + +save-temps= +Modula-2 Joined +save temporary preprocessed files + +traditional-cpp +Modula-2 +; Documented in c.opt + +v +Modula-2 +; Documented in c.opt + +x +Modula-2 Joined +specify the language from the compiler driver + +; This comment is to ensure we retain the blank line above. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/lang-specs.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/lang-specs.h 2022-12-06 02:56:51.360774949 +0000 @@ -0,0 +1,38 @@ +/* Definitions for specs for GNU Modula-2. + Copyright (C) 2001-2022 Free Software Foundation, Inc. + Contributed by Gaius Mulley. + +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 is the contribution to the `default_compilers' array in gcc.c for + GNU Modula-2. */ + +/* Pass the preprocessor options on the command line together with + the exec prefix. */ + +#define M2CPP "%{fcpp:-fcpp-begin " \ + " -E -lang-asm -traditional-cpp " \ + " %(cpp_unique_options) -fcpp-end}" + + {".mod", "@modula-2", 0, 0, 0}, + {"@modula-2", + "cc1gm2 " M2CPP + " %(cc1_options) %{B*} %{c*} %{f*} %{+e*} %{I*} " + " %{MD} %{MMD} %{M} %{MM} %{MA} %{MT*} %{MF*} %V" + " %{save-temps*}" + " %i %{!fsyntax-only:%(invoke_as)}", + 0, 0, 0}, diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/config-lang.in --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/config-lang.in 2022-12-06 02:56:51.328774517 +0000 @@ -0,0 +1,83 @@ +# Top level configure fragment for GNU Modula-2. +# Copyright (C) 2000-2022 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 +# . + +# 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) +# stagestuff - files to add to $(STAGESTUFF) + +language="m2" + +compilers="cc1gm2\$(exeext)" + +stagestuff="gm2\$(exeext) cc1gm2\$(exeext) cc1gm2-cross\$(exeext)" + +target_libs="target-libstdc++-v3 target-libgm2" + +# The Modula-2 frontend needs C++ compiler during stage 1. +lang_requires_boot_languages=c++ + +# Do not build by default. +build_by_default="no" + +gtfiles="\$(srcdir)/m2/gm2-lang.cc \ + \$(srcdir)/m2/gm2-lang.h \ + \$(srcdir)/m2/gm2-gcc/rtegraph.cc \ + \$(srcdir)/m2/gm2-gcc/m2block.cc \ + \$(srcdir)/m2/gm2-gcc/m2builtins.cc \ + \$(srcdir)/m2/gm2-gcc/m2decl.cc \ + \$(srcdir)/m2/gm2-gcc/m2except.cc \ + \$(srcdir)/m2/gm2-gcc/m2expr.cc \ + \$(srcdir)/m2/gm2-gcc/m2statement.cc \ + \$(srcdir)/m2/gm2-gcc/m2type.cc" + +outputs="m2/config-make \ + m2/Make-maintainer \ + " + +mkdir -p m2/gm2-compiler-boot +mkdir -p m2/gm2-libs-boot +mkdir -p m2/gm2-ici-boot +mkdir -p m2/gm2-libiberty +mkdir -p m2/gm2-gcc +mkdir -p m2/gm2-compiler +mkdir -p m2/gm2-libs +mkdir -p m2/gm2-libs-iso +mkdir -p m2/gm2-compiler-paranoid +mkdir -p m2/gm2-libs-paranoid +mkdir -p m2/gm2-compiler-verify +mkdir -p m2/boot-bin +mkdir -p m2/gm2-libs-pim +mkdir -p m2/gm2-libs-coroutines +mkdir -p m2/gm2-libs-min +mkdir -p m2/pge-boot +mkdir -p plugin +mkdir -p stage1/m2 stage2/m2 stage3/m2 stage4/m2 + +# directories used by Make-maintainer + +mkdir -p m2/gm2-auto +mkdir -p m2/gm2-pg-boot +mkdir -p m2/gm2-pge-boot +mkdir -p m2/gm2-ppg-boot +mkdir -p m2/mc-boot +mkdir -p m2/mc-boot-ch +mkdir -p m2/mc-boot-gen diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/config-make.in --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/config-make.in 2022-12-06 02:56:51.328774517 +0000 @@ -0,0 +1,6 @@ +# Target libraries are put under this directory: +TARGET_SUBDIR = @target_subdir@ +# Python3 executable name if it exists +PYTHON = @PYTHON@ +# Does Python3 exist? (yes/no). +HAVE_PYTHON = @HAVE_PYTHON@ \ No newline at end of file diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/configure.ac --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/configure.ac 2022-12-06 02:56:51.328774517 +0000 @@ -0,0 +1,38 @@ +# configure.ac provides gm2spec.c with access to config values. + +# Copyright (C) 2001-2022 Free Software Foundation, Inc. +# Contributed by Gaius Mulley . + +# 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 +# . + +AC_INIT(m2, [ ]) + +# Determine the host, build, and target systems +AC_CANONICAL_BUILD +AC_CANONICAL_HOST +AC_CANONICAL_TARGET + +AC_CHECK_PROGS(regex_realpath, realpath) +if test x$regex_realpath = "x" ; then + AC_MSG_ERROR([realpath is required to build GNU Modula-2 (hint install coreutils).]) +fi + +AC_CHECK_FUNCS([stpcpy]) + +AC_CHECK_HEADERS(sys/types.h) +AC_HEADER_DIRENT +AC_CHECK_LIB([c],[opendir],[AC_DEFINE([HAVE_OPENDIR],[1],[found opendir])]) +AC_CONFIG_HEADERS(gm2config.h, [echo timestamp > stamp-h]) +AC_OUTPUT diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2config.h.in --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2config.h.in 2022-12-06 02:56:51.360774949 +0000 @@ -0,0 +1,56 @@ +/* gm2config.h.in template file for values required by gm2spec.c. + +Copyright (C) 2006-2022 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 +. */ + +#ifndef PACKAGE_BUGREPORT +/* Define to the address where bug reports for this package should be sent. */ +#undef PACKAGE_BUGREPORT +#endif + +#ifndef PACKAGE_NAME +/* Define to the full name of this package. */ +#undef PACKAGE_NAME +#endif + +#ifndef PACKAGE_STRING +/* Define to the full name and version of this package. */ +#undef PACKAGE_STRING +#endif + +/* Define to 1 if you have the `stpcmp' function. */ +#undef HAVE_STPCMP + +/* Define to 1 if you have the dirent.h header. */ +#undef HAVE_DIRENT_H + +/* Define to 1 if you have the sys/ndir.h header. */ +#undef HAVE_SYS_NDIR_H + +/* Define to 1 if you have the sys/dir.h header. */ +#undef HAVE_SYS_DIR_H + +/* Define to 1 if you have the ndir.h header. */ +#undef HAVE_NDIR_H + +/* Define to 1 if you have the sys/types.h header. */ +#undef HAVE_SYS_TYPES_H + +/* Define to 1 if you have the opendir function. */ +#undef HAVE_OPENDIR From patchwork Tue Dec 6 14:47:25 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Gaius Mulley X-Patchwork-Id: 61582 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 32D323846995 for ; Tue, 6 Dec 2022 14:50:58 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 32D323846995 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1670338258; bh=gdQmOFlGNzPsVHD6G05b1L1Sf7UjC53/RPkUndLkvNg=; h=Subject:To:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=U69U3j/+qwbvd8RYMxPR8Xka/akDxkolLHVTkaiQ0+rY18G39EPltuZuq1YOQmZsb G3pJ9A5xgsdhpAgzB2tdzLIkHEU67FtqaF13qi9g7VdvpcHrKnAVh2U00MRx1KnF86 k7YEQ+6463ogFIemsDMD3fpB0BwuqgncjPpgNuag= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x436.google.com (mail-wr1-x436.google.com [IPv6:2a00:1450:4864:20::436]) by sourceware.org (Postfix) with ESMTPS id 1D32C3875B79 for ; Tue, 6 Dec 2022 14:47:55 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 1D32C3875B79 Received: by mail-wr1-x436.google.com with SMTP id h12so23748467wrv.10 for ; Tue, 06 Dec 2022 06:47:55 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=date:message-id:to:subject:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=gdQmOFlGNzPsVHD6G05b1L1Sf7UjC53/RPkUndLkvNg=; b=rUSI9nqiIA+JkA+ehYgPdPK0tiP2jcFuBDy52HLHhCIcdI2uPxKGI+/+QpRWN76AjY Bpk28Hwmw8uoQ1lNTugJcIAu7mbneY/5YIksNKLgCwSuLu0VOU4iQjPOntttUBU8BB6r f8FzQALb46s4FfF7y1k3kvGQ13D5BejQ9OUGmSjoEONhfe93iVErC5+hIPYv2XQhHir/ AUurVN37uNJTXnkGEh1B6DAXSwgh9jPLQZYVACdzflLt3O/HNTVFwOtPtI821Ab32sUJ R/vylpi5BzSw+GTK80J6m+UEPn6jUqUXs793gyhcoJrMq+ubk3dszeWGK+N7vik6uLDR NsHA== X-Gm-Message-State: ANoB5pn0GP5/RglOFi5VW7QEr/2MOozONQraPF5cACZEtyuDl0TpwhSB hlyOQH15qHgND5HN4fBFXTObF86ZjTQ= X-Google-Smtp-Source: AA0mqf4SJ2J4txfy1HHWDc3LtAfpV29Y3LpSqdCq7F4DG7GJQAdSay+grHhPrguHVPU72RzDLjQkAQ== X-Received: by 2002:a05:6000:124d:b0:242:10a:6667 with SMTP id j13-20020a056000124d00b00242010a6667mr36092902wrx.39.1670338073165; Tue, 06 Dec 2022 06:47:53 -0800 (PST) Received: from lancelot ([195.147.220.46]) by smtp.gmail.com with ESMTPSA id l9-20020a1c7909000000b003d1e4120700sm4689146wme.41.2022.12.06.06.47.28 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Dec 2022 06:47:52 -0800 (PST) X-Google-Original-From: Gaius Mulley Received: from gaius by lancelot with local (Exim 4.94.2) (envelope-from ) id 1p2ZED-004QeZ-WE for gcc-patches@gcc.gnu.org; Tue, 06 Dec 2022 14:47:26 +0000 Subject: [PATCH v3 4/19] modula2 front end: libgm2/libm2pim contents To: X-Mailer: mail (GNU Mailutils 3.10) Message-Id: Date: Tue, 06 Dec 2022 14:47:25 +0000 X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Gaius Mulley via Gcc-patches From: Gaius Mulley Reply-To: Gaius Mulley Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patch set consists of the makefiles, autoconf sources necessary to build the various libgm2/libm2pim libraries. The c/c++/h files are included in the patch set. The modula-2 sources are found in gcc/m2/ as they are used by the compiler. ------8<----------8<----------8<----------8<----------8<----------8<---- diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2pim/target.c --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2pim/target.c 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,61 @@ +/* target.c provide access to miscellaneous math functions. + +Copyright (C) 2005-2022 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. + +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 + +#if defined(HAVE_MATH_H) +#include +#endif + +#if !defined(HAVE_EXP10) +#if defined(M_LN10) +double +exp10 (double x) +{ + return exp (x * M_LN10); +} +#endif +#endif + +#if !defined(HAVE_EXP10F) +#if defined(M_LN10) +float +exp10f (float x) +{ + return expf (x * M_LN10); +} +#endif +#endif + +#if !defined(HAVE_EXP10L) +#if defined(M_LN10) +long double +exp10l (long double x) +{ + return expl (x * M_LN10); +} +#endif +#endif diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2pim/Selective.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2pim/Selective.cc 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,319 @@ +/* Selective.c provide access to timeval and select. + +Copyright (C) 2009-2022 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. + +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 + +#if defined(HAVE_STDDEF_H) +/* Obtain a definition for NULL. */ +#include +#endif + +#if defined(HAVE_STDIO_H) +/* Obtain a definition for NULL. */ +#include +#endif + +#if defined(HAVE_SYS_TIME_H) +#include +#endif + +#if defined(HAVE_TIME_H) +/* Obtain a definition for NULL. */ +#include +#endif + +#if defined(HAVE_STRING_H) +/* Obtain a definition for NULL. */ +#include +#endif + +#if defined(HAVE_WCHAR_H) +/* Obtain a definition for NULL. */ +#include +#endif + +#if defined(HAVE_STDLIB_H) +/* Obtain a prototype for free and malloc. */ +#include +#endif + +#if defined(HAVE_SYS_TYPES_H) +#include +#endif + +#if defined(HAVE_UNISTD_H) +#include +#endif + +#if !defined(NULL) +#define NULL (void *)0 +#endif + +#if defined(HAVE_SELECT) +#define FDSET_T fd_set +#else +#define FDSET_T void +#endif + +/* Select wrap a call to the C select. */ + +#if defined(HAVE_STRUCT_TIMEVAL) +extern "C" int +Selective_Select (int nooffds, fd_set *readfds, fd_set *writefds, + fd_set *exceptfds, struct timeval *timeout) +{ + return select (nooffds, readfds, writefds, exceptfds, timeout); +} +#else +extern "C" int +Selective_Select (int nooffds, void *readfds, void *writefds, void *exceptfds, + void *timeout) +{ + return 0; +} +#endif + +/* InitTime initializes a timeval structure and returns a pointer to it. */ + +#if defined(HAVE_STRUCT_TIMEVAL) +extern "C" struct timeval * +Selective_InitTime (unsigned int sec, unsigned int usec) +{ + struct timeval *t = (struct timeval *)malloc (sizeof (struct timeval)); + + t->tv_sec = (long int)sec; + t->tv_usec = (long int)usec; + return t; +} + +extern "C" void +Selective_GetTime (struct timeval *t, unsigned int *sec, unsigned int *usec) +{ + *sec = (unsigned int)t->tv_sec; + *usec = (unsigned int)t->tv_usec; +} + +extern "C" void +Selective_SetTime (struct timeval *t, unsigned int sec, unsigned int usec) +{ + t->tv_sec = sec; + t->tv_usec = usec; +} + +/* KillTime frees the timeval structure and returns NULL. */ + +extern "C" struct timeval * +Selective_KillTime (struct timeval *t) +{ +#if defined(HAVE_STDLIB_H) + free (t); +#endif + return NULL; +} + +/* InitSet returns a pointer to a FD_SET. */ + +extern "C" FDSET_T * +Selective_InitSet (void) +{ +#if defined(HAVE_STDLIB_H) + FDSET_T *s = (FDSET_T *)malloc (sizeof (FDSET_T)); + + return s; +#else + return NULL +#endif +} + +/* KillSet frees the FD_SET and returns NULL. */ + +extern "C" FDSET_T * +Selective_KillSet (FDSET_T *s) +{ +#if defined(HAVE_STDLIB_H) + free (s); +#endif + return NULL; +} + +/* FdZero generate an empty set. */ + +extern "C" void +Selective_FdZero (FDSET_T *s) +{ + FD_ZERO (s); +} + +/* FS_Set include an element, fd, into set, s. */ + +extern "C" void +Selective_FdSet (int fd, FDSET_T *s) +{ + FD_SET (fd, s); +} + +/* FdClr exclude an element, fd, from the set, s. */ + +extern "C" void +Selective_FdClr (int fd, FDSET_T *s) +{ + FD_CLR (fd, s); +} + +/* FdIsSet return TRUE if, fd, is present in set, s. */ + +extern "C" int +Selective_FdIsSet (int fd, FDSET_T *s) +{ + return FD_ISSET (fd, s); +} + +/* GetTimeOfDay fills in a record, Timeval, filled in with the + current system time in seconds and microseconds. + It returns zero (see man 3p gettimeofday). */ + +extern "C" int +Selective_GetTimeOfDay (struct timeval *t) +{ + return gettimeofday (t, NULL); +} +#else + +extern "C" void * +Selective_InitTime (unsigned int sec, unsigned int usec) +{ + return NULL; +} + +extern "C" void * +Selective_KillTime (void *t) +{ + return NULL; +} + +extern "C" void +Selective_GetTime (void *t, unsigned int *sec, unsigned int *usec) +{ +} + +extern "C" void +Selective_SetTime (void *t, unsigned int sec, unsigned int usec) +{ +} + +extern "C" FDSET_T * +Selective_InitSet (void) +{ + return NULL; +} + +extern "C" FDSET_T * +Selective_KillSet (void) +{ + return NULL; +} + +extern "C" void +Selective_FdZero (void *s) +{ +} + +extern "C" void +Selective_FdSet (int fd, void *s) +{ +} + +extern "C" void +Selective_FdClr (int fd, void *s) +{ +} + +extern "C" int +Selective_FdIsSet (int fd, void *s) +{ + return 0; +} + +extern "C" int +Selective_GetTimeOfDay (void *t) +{ + return -1; +} +#endif + +/* MaxFdsPlusOne returns max (a + 1, b + 1). */ + +extern "C" int +Selective_MaxFdsPlusOne (int a, int b) +{ + if (a > b) + return a + 1; + else + return b + 1; +} + +/* WriteCharRaw writes a single character to the file descriptor. */ + +extern "C" void +Selective_WriteCharRaw (int fd, char ch) +{ + write (fd, &ch, 1); +} + +/* ReadCharRaw read and return a single char from file descriptor, fd. */ + +extern "C" char +Selective_ReadCharRaw (int fd) +{ + char ch; + + read (fd, &ch, 1); + return ch; +} + +extern "C" void +_M2_Selective_init (int argc, char *argv[], char *envp[]) +{ +} + +extern "C" void +_M2_Selective_fini (int argc, char *argv[], char *envp[]) +{ +} + +extern "C" void +_M2_Selective_dep (void) +{ +} + +struct _M2_Selective_ctor { _M2_Selective_ctor (); } _M2_Selective_ctor; + +_M2_Selective_ctor::_M2_Selective_ctor (void) +{ + M2RTS_RegisterModule ("Selective", _M2_Selective_init, _M2_Selective_fini, + _M2_Selective_dep); +} diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2pim/dtoa.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2pim/dtoa.cc 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,265 @@ +/* dtoa.cc convert double to ascii and visa versa. + +Copyright (C) 2009-2022 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. + +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 +. */ + +#define GM2 + +#include +#include + +#if defined(HAVE_STRINGS) +#include +#endif + +#if defined(HAVE_STRING) +#include +#endif + +#if defined(HAVE_STDDEF_H) +/* Obtain a definition for NULL. */ +#include +#endif + +#if defined(HAVE_STDIO_H) +/* Obtain a definition for NULL. */ +#include +#endif + +#if defined(HAVE_TIME_H) +/* Obtain a definition for NULL. */ +#include +#endif + +#if defined(HAVE_STRING_H) +/* Obtain a definition for NULL. */ +#include +#endif + +#if defined(HAVE_WCHAR_H) +/* Obtain a definition for NULL. */ +#include +#endif + +#if defined(HAVE_STDLIB_H) +/* Obtain a prototype for free and malloc. */ +#include +#endif + +#if !defined(NULL) +#define NULL (void *)0 +#endif + +#if !defined(TRUE) +#define TRUE (1 == 1) +#endif +#if !defined(FALSE) +#define FALSE (1 == 0) +#endif + +#if defined(HAVE_STDLIB_H) +#if !defined(_ISOC99_SOURCE) +#define _ISOC99_SOURCE +#endif +#include +#endif + +#if defined(HAVE_ERRNO_H) +#include +#endif + +#if defined(HAVE_SYS_ERRNO_H) +#include +#endif + +#if defined(HAVE_STRING_H) + +#define MAX_FP_DIGITS 500 + +typedef enum Mode { maxsignicant, decimaldigits } Mode; + +/* maxsignicant: return a string containing max(1,ndigits) significant + digits. The return string contains the string produced by ecvt. + + decimaldigits: return a string produced by fcvt. The string will + contain ndigits past the decimal point (ndigits may be negative). */ + +extern "C" double +dtoa_strtod (const char *s, int *error) +{ + char *endp; + double d; + +#if defined(HAVE_ERRNO_H) + errno = 0; +#endif + d = strtod (s, &endp); + if (endp != NULL && (*endp == '\0')) +#if defined(HAVE_ERRNO_H) + *error = (errno != 0); +#else + *error = FALSE; +#endif + else + *error = TRUE; + return d; +} + +/* dtoa_calcmaxsig calculates the position of the decimal point + it also removes the decimal point and exponent from string, p. */ + +extern "C" int +dtoa_calcmaxsig (char *p, int ndigits) +{ + char *e; + char *o; + int x; + + e = strchr (p, 'E'); + if (e == NULL) + x = 0; + else + { + *e = (char)0; + x = atoi (e + 1); + } + + o = strchr (p, '.'); + if (o == NULL) + return strlen (p) + x; + else + { + memmove (o, o + 1, ndigits - (o - p)); + return o - p + x; + } +} + +/* dtoa_calcdecimal calculates the position of the decimal point + it also removes the decimal point and exponent from string, p. + It truncates the digits in p accordingly to ndigits. + Ie ndigits is the number of digits after the '.'. */ + +extern "C" int +dtoa_calcdecimal (char *p, int str_size, int ndigits) +{ + char *e; + char *o; + int x; + int l; + + e = strchr (p, 'E'); + if (e == NULL) + x = 0; + else + { + *e = (char)0; + x = atoi (e + 1); + } + + l = strlen (p); + o = strchr (p, '.'); + if (o == NULL) + x += strlen (p); + else + { + int m = strlen (o); + memmove (o, o + 1, l - (o - p)); + if (m > 0) + o[m - 1] = '0'; + x += o - p; + } + if ((x + ndigits >= 0) && (x + ndigits < str_size)) + p[x + ndigits] = (char)0; + return x; +} + +extern "C" int +dtoa_calcsign (char *p, int str_size) +{ + if (p[0] == '-') + { + memmove (p, p + 1, str_size - 1); + return TRUE; + } + else + return FALSE; +} + +extern "C" char * +dtoa_dtoa (double d, int mode, int ndigits, int *decpt, int *sign) +{ + char format[50]; + char *p; + int r; + switch (mode) + { + + case maxsignicant: + ndigits += 20; /* Enough for exponent. */ + p = (char *) malloc (ndigits); + snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "E"); + snprintf (p, ndigits, format, d); + *sign = dtoa_calcsign (p, ndigits); + *decpt = dtoa_calcmaxsig (p, ndigits); + return p; + case decimaldigits: + p = (char *) malloc (MAX_FP_DIGITS + 20); + snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "E"); + snprintf (p, MAX_FP_DIGITS + 20, format, d); + *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20); + *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits); + return p; + default: + abort (); + } +} + +#endif + +#if defined(GM2) +/* GNU Modula-2 linking hooks. */ + +extern "C" void +_M2_dtoa_init (int, char **, char **) +{ +} + +extern "C" void +_M2_dtoa_fini (int, char **, char **) +{ +} + +extern "C" void +_M2_dtoa_dep (void) +{ +} + +struct _M2_dtoa_ctor { _M2_dtoa_ctor (); } _M2_dtoa_ctor; + +_M2_dtoa_ctor::_M2_dtoa_ctor (void) +{ + M2RTS_RegisterModule ("dtoa", _M2_dtoa_init, _M2_dtoa_fini, + _M2_dtoa_dep); +} +#endif diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2pim/wrapc.c --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2pim/wrapc.c 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,296 @@ +/* wrapc.c provide access to miscellaneous C library functions. + +Copyright (C) 2005-2022 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. + +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 + +#if defined(HAVE_MATH_H) +#include +#endif + +#if defined(HAVE_STDLIB_H) +#include +#endif + +#if defined(HAVE_UNISTD_H) +#include +#endif + +#if defined(HAVE_SYS_STAT_H) +#include +#endif + +#ifdef HAVE_STDIO_H +#include +#endif + +#if defined(HAVE_SYS_TYPES_H) +#include +#endif + +#if defined(HAVE_TIME_H) +#include +#endif + +/* Define FALSE if one hasn't already been defined. */ + +#if !defined(FALSE) +#define FALSE (1 == 0) +#endif + +/* Define a generic NULL if one hasn't already been defined. */ + +#if !defined(NULL) +#define NULL 0 +#endif + +/* strtime returns the address of a string which describes the + local time. */ + +char * +wrapc_strtime (void) +{ +#if defined(HAVE_CTIME) + time_t clock = time ((void *)0); + char *string = ctime (&clock); + + string[24] = (char)0; + + return string; +#else + return ""; +#endif +} + +int +wrapc_filesize (int f, unsigned int *low, unsigned int *high) +{ +#if defined(HAVE_SYS_STAT_H) && defined(HAVE_STRUCT_STAT) + struct stat s; + int res = fstat (f, (struct stat *)&s); + + if (res == 0) + { + *low = (unsigned int)s.st_size; + *high = (unsigned int)(s.st_size >> (sizeof (unsigned int) * 8)); + } + return res; +#else + return -1; +#endif +} + +/* filemtime returns the mtime of a file, f. */ + +int +wrapc_filemtime (int f) +{ +#if defined(HAVE_SYS_STAT_H) && defined(HAVE_STRUCT_STAT) + struct stat s; + + if (fstat (f, (struct stat *)&s) == 0) + return s.st_mtime; + else + return -1; +#else + return -1; +#endif +} + +/* fileinode returns the inode associated with a file, f. */ + +#if defined(HAVE_SYS_STAT_H) && defined(HAVE_STRUCT_STAT) +ino_t +wrapc_fileinode (int f, unsigned int *low, unsigned int *high) +{ + struct stat s; + + if (fstat (f, (struct stat *)&s) == 0) + { + *low = (unsigned int)s.st_ino; + if ((sizeof (s.st_ino) == (sizeof (unsigned int)))) + *high = 0; + else + *high = (unsigned int)(s.st_ino >> (sizeof (unsigned int) * 8)); + return 0; + } + else + return -1; +} +#else +int +wrapc_fileinode (int f, unsigned int *low, unsigned int *high) +{ + *low = 0; + *high = 0; + return -1; +} +#endif + +/* getrand returns a random number between 0..n-1. */ + +int +wrapc_getrand (int n) +{ + return rand () % n; +} + +#if defined(HAVE_PWD_H) +#include + +char * +wrapc_getusername (void) +{ + return getpwuid (getuid ())->pw_gecos; +} + +/* getnameuidgid fills in the, uid, and, gid, which represents + user, name. */ + +void +wrapc_getnameuidgid (char *name, int *uid, int *gid) +{ + struct passwd *p = getpwnam (name); + + if (p == NULL) + { + *uid = -1; + *gid = -1; + } + else + { + *uid = p->pw_uid; + *gid = p->pw_gid; + } +} +#else +char * +wrapc_getusername (void) +{ + return "unknown"; +} + +void +wrapc_getnameuidgid (char *name, int *uid, int *gid) +{ + *uid = -1; + *gid = -1; +} +#endif + +int +wrapc_signbit (double r) +{ +#if defined(HAVE_SIGNBIT) + + /* signbit is a macro which tests its argument against sizeof(float), + sizeof(double). */ + return signbit (r); +#else + return FALSE; +#endif +} + +int +wrapc_signbitl (long double r) +{ +#if defined(HAVE_SIGNBITL) + + /* signbit is a macro which tests its argument against sizeof(float), + sizeof(double). */ + return signbitl (r); +#else + return FALSE; +#endif +} + +int +wrapc_signbitf (float r) +{ +#if defined(HAVE_SIGNBITF) + + /* signbit is a macro which tests its argument against sizeof(float), + sizeof(double). */ + return signbitf (r); +#else + return FALSE; +#endif +} + +/* isfinite provide non builtin alternative to the gcc builtin + isfinite. Returns 1 if x is finite and 0 if it is not. */ + +int +wrapc_isfinite (double x) +{ +#if defined(FP_NAN) && defined(FP_INFINITE) + return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE); +#else + return FALSE; +#endif +} + +/* isfinitel provide non builtin alternative to the gcc builtin + isfinite. Returns 1 if x is finite and 0 if it is not. */ + +int +wrapc_isfinitel (long double x) +{ +#if defined(FP_NAN) && defined(FP_INFINITE) + return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE); +#else + return FALSE; +#endif +} + +/* isfinitef provide non builtin alternative to the gcc builtin + isfinite. Returns 1 if x is finite and 0 if it is not. */ + +int +wrapc_isfinitef (float x) +{ +#if defined(FP_NAN) && defined(FP_INFINITE) + return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE); +#else + return FALSE; +#endif +} + +/* init/finish are GNU Modula-2 linking fodder. */ + +void +_M2_wrapc_init () +{ +} + +void +_M2_wrapc_fini () +{ +} + +void +_M2_wrapc_ctor () +{ +} diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2pim/SysExceptions.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2pim/SysExceptions.cc 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,259 @@ +/* SysExceptions.c configure the signals to create m2 exceptions. + +Copyright (C) 2009-2022 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. + +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 + +#if defined(HAVE_SIGNAL_H) +#include +#endif + +#if defined(HAVE_ERRNO_H) +#include +#endif + +#if defined(HAVE_SYS_ERRNO_H) +#include +#endif + +#if defined(HAVE_STDIO_H) +#include +#endif + +#include "m2rts.h" + +#if 0 +/* Signals. */ +#define SIGHUP 1 /* Hangup (POSIX). */ +#define SIGINT 2 /* Interrupt (ANSI). */ +#define SIGQUIT 3 /* Quit (POSIX). */ +#define SIGILL 4 /* Illegal instruction (ANSI). */ +#define SIGTRAP 5 /* Trace trap (POSIX). */ +#define SIGABRT 6 /* Abort (ANSI). */ +#define SIGIOT 6 /* IOT trap (4.2 BSD). */ +#define SIGBUS 7 /* BUS error (4.2 BSD). */ +#define SIGFPE 8 /* Floating-point exception (ANSI). */ +#define SIGKILL 9 /* Kill, unblockable (POSIX). */ +#define SIGUSR1 10 /* User-defined signal 1 (POSIX). */ +#define SIGSEGV 11 /* Segmentation violation (ANSI). */ +#define SIGUSR2 12 /* User-defined signal 2 (POSIX). */ +#define SIGPIPE 13 /* Broken pipe (POSIX). */ +#define SIGALRM 14 /* Alarm clock (POSIX). */ +#define SIGTERM 15 /* Termination (ANSI). */ +#define SIGSTKFLT 16 /* Stack fault. */ +#define SIGCLD SIGCHLD /* Same as SIGCHLD (System V). */ +#define SIGCHLD 17 /* Child status has changed (POSIX). */ +#define SIGCONT 18 /* Continue (POSIX). */ +#define SIGSTOP 19 /* Stop, unblockable (POSIX). */ +#define SIGTSTP 20 /* Keyboard stop (POSIX). */ +#define SIGTTIN 21 /* Background read from tty (POSIX). */ +#define SIGTTOU 22 /* Background write to tty (POSIX). */ +#define SIGURG 23 /* Urgent condition on socket (4.2 BSD). */ +#define SIGXCPU 24 /* CPU limit exceeded (4.2 BSD). */ +#define SIGXFSZ 25 /* File size limit exceeded (4.2 BSD). */ +#define SIGVTALRM 26 /* Virtual alarm clock (4.2 BSD). */ +#define SIGPROF 27 /* Profiling alarm clock (4.2 BSD). */ +#define SIGWINCH 28 /* Window size change (4.3 BSD, Sun). */ +#define SIGPOLL SIGIO /* Pollable event occurred (System V). */ +#define SIGIO 29 /* I/O now possible (4.2 BSD). */ +#define SIGPWR 30 /* Power failure restart (System V). */ +#define SIGSYS 31 /* Bad system call. */ +#define SIGUNUSED 31 + +/* The list of Modula-2 exceptions is shown below */ + + (indexException, rangeException, caseSelectException, invalidLocation, + functionException, wholeValueException, wholeDivException, realValueException, + realDivException, complexValueException, complexDivException, protException, + sysException, coException, exException + ); + +#endif + +/* Note: wholeDivException and realDivException are caught by SIGFPE + and depatched to the appropriate Modula-2 runtime routine upon + testing FPE_INTDIV or FPE_FLTDIV. realValueException is also + caught by SIGFPE and dispatched by testing FFE_FLTOVF or FPE_FLTUND + or FPE_FLTRES or FPE_FLTINV. indexException is caught by SIGFPE + and dispatched by FPE_FLTSUB. */ + +#if defined(HAVE_SIGNAL_H) +static struct sigaction sigbus; +static struct sigaction sigfpe; +static struct sigaction sigsegv; + +static void (*indexProc) (void *); +static void (*rangeProc) (void *); +static void (*assignmentrangeProc) (void *); +static void (*caseProc) (void *); +static void (*invalidlocProc) (void *); +static void (*functionProc) (void *); +static void (*wholevalueProc) (void *); +static void (*wholedivProc) (void *); +static void (*realvalueProc) (void *); +static void (*realdivProc) (void *); +static void (*complexvalueProc) (void *); +static void (*complexdivProc) (void *); +static void (*protectionProc) (void *); +static void (*systemProc) (void *); +static void (*coroutineProc) (void *); +static void (*exceptionProc) (void *); + +static void +sigbusDespatcher (int signum, siginfo_t *info, void *ucontext) +{ + switch (signum) + { + + case SIGSEGV: + case SIGBUS: + if (info) + (*invalidlocProc) (info->si_addr); + break; + default: + perror ("not expecting to arrive here with this signal"); + } +} + +static void +sigfpeDespatcher (int signum, siginfo_t *info, void *ucontext) +{ + switch (signum) + { + + case SIGFPE: + if (info) + { + if (info->si_code | FPE_INTDIV) + (*wholedivProc) (info->si_addr); /* Integer divide by zero. */ + if (info->si_code | FPE_INTOVF) + (*wholevalueProc) (info->si_addr); /* Integer overflow. */ + if (info->si_code | FPE_FLTDIV) + (*realdivProc) (info->si_addr); /* Floating-point divide by zero. */ + if (info->si_code | FPE_FLTOVF) + (*realvalueProc) (info->si_addr); /* Floating-point overflow. */ + if (info->si_code | FPE_FLTUND) + (*realvalueProc) (info->si_addr); /* Floating-point underflow. */ + if (info->si_code | FPE_FLTRES) + (*realvalueProc) ( + info->si_addr); /* Floating-point inexact result. */ + if (info->si_code | FPE_FLTINV) + (*realvalueProc) ( + info->si_addr); /* Floating-point invalid result. */ + if (info->si_code | FPE_FLTSUB) + (*indexProc) (info->si_addr); /* Subscript out of range. */ + } + break; + default: + perror ("not expecting to arrive here with this signal"); + } +} + +extern "C" void +SysExceptions_InitExceptionHandlers ( + void (*indexf) (void *), void (*range) (void *), void (*casef) (void *), + void (*invalidloc) (void *), void (*function) (void *), + void (*wholevalue) (void *), void (*wholediv) (void *), + void (*realvalue) (void *), void (*realdiv) (void *), + void (*complexvalue) (void *), void (*complexdiv) (void *), + void (*protection) (void *), void (*systemf) (void *), + void (*coroutine) (void *), void (*exception) (void *)) +{ + struct sigaction old; + + indexProc = indexf; + rangeProc = range; + caseProc = casef; + invalidlocProc = invalidloc; + functionProc = function; + wholevalueProc = wholevalue; + wholedivProc = wholediv; + realvalueProc = realvalue; + realdivProc = realdiv; + complexvalueProc = complexvalue; + complexdivProc = complexdiv; + protectionProc = protection; + systemProc = systemf; + coroutineProc = coroutine; + exceptionProc = exception; + + sigbus.sa_sigaction = sigbusDespatcher; + sigbus.sa_flags = (SA_SIGINFO); + sigemptyset (&sigbus.sa_mask); + + if (sigaction (SIGBUS, &sigbus, &old) != 0) + perror ("unable to install the sigbus signal handler"); + + sigsegv.sa_sigaction = sigbusDespatcher; + sigsegv.sa_flags = (SA_SIGINFO); + sigemptyset (&sigsegv.sa_mask); + + if (sigaction (SIGSEGV, &sigsegv, &old) != 0) + perror ("unable to install the sigsegv signal handler"); + + sigfpe.sa_sigaction = sigfpeDespatcher; + sigfpe.sa_flags = (SA_SIGINFO); + sigemptyset (&sigfpe.sa_mask); + + if (sigaction (SIGFPE, &sigfpe, &old) != 0) + perror ("unable to install the sigfpe signal handler"); +} + +#else +extern "C" void +SysExceptions_InitExceptionHandlers (void *indexf, void *range, void *casef, + void *invalidloc, void *function, + void *wholevalue, void *wholediv, + void *realvalue, void *realdiv, + void *complexvalue, void *complexdiv, + void *protection, void *systemf, + void *coroutine, void *exception) +{ +} +#endif + + +extern "C" void +_M2_SysExceptions_init (int, char *[], char *[]) +{ +} + +extern "C" void +_M2_SysExceptions_fini (int, char *[], char *[]) +{ +} + +extern "C" void +_M2_SysExceptions_dep (void) +{ +} + +struct _M2_SysExceptions_ctor { _M2_SysExceptions_ctor (); } _M2_SysExceptions_ctor; + +_M2_SysExceptions_ctor::_M2_SysExceptions_ctor (void) +{ + M2RTS_RegisterModule ("SysExceptions", _M2_SysExceptions_init, _M2_SysExceptions_fini, + _M2_SysExceptions_dep); +} diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2pim/Makefile.am --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2pim/Makefile.am 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,209 @@ +# Makefile for libm2pim. +# Copyright 2013-2022 Free Software Foundation, Inc. +# +# 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 +# . + +SUFFIXES = .c .mod .def .o .obj .lo .a .la + +ACLOCAL_AMFLAGS = -I . -I .. -I ../config + +VPATH = . @srcdir@ @srcdir@/../../gcc/m2/gm2-libs + +# Multilib support. +MAKEOVERRIDES= + +version := $(shell $(CC) -dumpversion) + +# Directory in which the compiler finds libraries etc. +libsubdir = $(libdir)/gcc/$(target_alias)/$(version) +# Used to install the shared libgcc. +slibdir = @slibdir@ + +toolexeclibdir=@toolexeclibdir@ +toolexecdir=@toolexecdir@ +GM2_FOR_TARGET=@GM2_FOR_TARGET@ + +MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory) +MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory) + +MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi) +inst_libdir = $(libsubdir)$(MULTISUBDIR) +inst_slibdir = $(slibdir)$(MULTIOSSUBDIR) + + +# 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)" \ + "GM2_SRC=$(GM2_SRC)" \ + "AR_FLAGS=$(AR_FLAGS)" \ + "CC_FOR_BUILD=$(CC_FOR_BUILD)" \ + "CC_FOR_TARGET=$(CC_FOR_TARGET)" \ + "GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \ + "CFLAGS=$(CFLAGS)" \ + "CXXFLAGS=$(CXXFLAGS)" \ + "CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \ + "CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \ + "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)" \ + "MULTISUBDIR=$(MULTISUBDIR)" \ + "MULTIOSDIR=$(MULTIOSDIR)" \ + "MULTIBUILDTOP=$(MULTIBUILDTOP)" \ + "MULTIFLAGS=$(MULTIFLAGS)" \ + "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)" \ + "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_libgm2=$(TARGET_LIB_PATH_libgm2)" + +# Subdir rules rely on $(FLAGS_TO_PASS) +FLAGS_TO_PASS = $(AM_MAKEFLAGS) + +if BUILD_PIMLIB +toolexeclib_LTLIBRARIES = libm2pim.la + +M2MODS = ASCII.mod IO.mod \ + Args.mod M2RTS.mod \ + M2Dependent.mod \ + Assertion.mod NumberIO.mod \ + Break.mod SYSTEM.mod \ + CmdArgs.mod Scan.mod \ + StrCase.mod FIO.mod \ + StrIO.mod StrLib.mod \ + TimeString.mod Environment.mod \ + FpuIO.mod Debug.mod \ + SysStorage.mod Storage.mod \ + StdIO.mod SEnvironment.mod \ + DynamicStrings.mod SFIO.mod \ + SArgs.mod SCmdArgs.mod \ + PushBackInput.mod \ + StringConvert.mod FormatStrings.mod \ + Builtins.mod MathLib0.mod \ + M2EXCEPTION.mod RTExceptions.mod \ + SMathLib0.mod RTint.mod \ + Indexing.mod \ + LMathLib0.mod LegacyReal.mod \ + MemUtils.mod gdbif.mod \ + GetOpt.mod OptLib.mod + +# COROUTINES.mod has been removed as it is implemented in ../libm2iso. + +M2DEFS = Args.def ASCII.def \ + Assertion.def Break.def \ + Builtins.def cbuiltin.def \ + CmdArgs.def COROUTINES.def \ + cxxabi.def Debug.def \ + dtoa.def DynamicStrings.def \ + Environment.def errno.def \ + FIO.def FormatStrings.def \ + FpuIO.def gdbif.def \ + Indexing.def \ + IO.def ldtoa.def \ + LegacyReal.def libc.def \ + libm.def LMathLib0.def \ + M2Dependent.def \ + M2EXCEPTION.def M2LINK.def \ + M2RTS.def \ + MathLib0.def MemUtils.def \ + NumberIO.def PushBackInput.def \ + RTExceptions.def RTint.def \ + SArgs.def SCmdArgs.def \ + Scan.def \ + sckt.def Selective.def \ + SEnvironment.def SFIO.def \ + SMathLib0.def StdIO.def \ + Storage.def StrCase.def \ + StringConvert.def StrIO.def \ + StrLib.def SysExceptions.def \ + SysStorage.def SYSTEM.def \ + termios.def TimeString.def \ + UnixArgs.def wrapc.def \ + GetOpt.def OptLib.def \ + cgetopt.def + +libm2pim_la_SOURCES = $(M2MODS) \ + UnixArgs.cc \ + Selective.cc sckt.cc \ + errno.cc dtoa.cc \ + ldtoa.cc termios.cc \ + SysExceptions.cc target.c \ + wrapc.c cgetopt.cc + +libm2pimdir = libm2pim +libm2pim_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2pim_la_SOURCES))) +libm2pim_la_CFLAGS = -I. -I.. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../ -I@srcdir@/../libm2iso +libm2pim_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -fm2-g -g +libm2pim_la_LINK = $(LINK) -version-info $(libtool_VERSION) +BUILT_SOURCES = SYSTEM.def +CLEANFILES = SYSTEM.def + +M2LIBDIR = /m2/m2pim/ + +SYSTEM.def: Makefile + bash $(GM2_SRC)/tools-src/makeSystem -fpim \ + $(GM2_SRC)/gm2-libs/SYSTEM.def \ + $(GM2_SRC)/gm2-libs/SYSTEM.mod \ + -I$(GM2_SRC)/gm2-libs \ + "$(GM2_FOR_TARGET)" $@ + +.mod.lo: SYSTEM.def + $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2pim_la_M2FLAGS) $< -o $@ + +.cc.lo: + $(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2pim_la_CFLAGS) $< -o $@ + +install-data-local: force + mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) + $(INSTALL_DATA) .libs/libm2pim.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) + chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2pim.la + $(INSTALL_DATA) .libs/libm2pim.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) + $(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2pim.a + for i in $(M2DEFS) $(M2MODS) ; do \ + if [ -f $$i ] ; then \ + $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \ + elif [ -f @srcdir@/../../gcc/m2/gm2-libs/$$i ] ; then \ + $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \ + else \ + echo "cannot find $$i" ; exit 1 ; \ + fi ; \ + chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \ + done + +force: + +endif diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2pim/ldtoa.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2pim/ldtoa.cc 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,190 @@ +/* ldtoa.c convert long double to ascii and visa versa. + +Copyright (C) 2009-2022 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. + +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 +. */ + +#define GM2 + +#include +#include + +#if defined(HAVE_STRINGS) +#include +#endif + +#if defined(HAVE_STRING) +#include +#endif + +#if defined(HAVE_STDDEF_H) +/* Obtain a definition for NULL. */ +#include +#endif + +#if defined(HAVE_STDIO_H) +/* Obtain a definition for NULL. */ +#include +#endif + +#if defined(HAVE_TIME_H) +/* Obtain a definition for NULL. */ +#include +#endif + +#if defined(HAVE_STRING_H) +/* Obtain a definition for NULL. */ +#include +#endif + +#if defined(HAVE_WCHAR_H) +/* Obtain a definition for NULL. */ +#include +#endif + +#if defined(HAVE_STDLIB_H) +#if !defined(_ISOC99_SOURCE) +#define _ISOC99_SOURCE +#endif +#include +#endif + +#if defined(HAVE_ERRNO_H) +#include +#endif + +#if defined(HAVE_SYS_ERRNO_H) +#include +#endif + +#if defined(HAVE_STDLIB_H) +/* Obtain a prototype for free and malloc. */ +#include +#endif + +#if !defined(NULL) +#define NULL (void *)0 +#endif + +#if !defined(TRUE) +#define TRUE (1 == 1) +#endif +#if !defined(FALSE) +#define FALSE (1 == 0) +#endif + +#define MAX_FP_DIGITS 500 + +typedef enum Mode { maxsignicant, decimaldigits } Mode; + +extern "C" int dtoa_calcmaxsig (char *p, int ndigits); +extern "C" int dtoa_calcdecimal (char *p, int str_size, int ndigits); +extern "C" int dtoa_calcsign (char *p, int str_size); + +/* maxsignicant return a string containing max(1,ndigits) significant + digits. The return string contains the string produced by snprintf. + + decimaldigits: return a string produced by fcvt. The string will + contain ndigits past the decimal point (ndigits may be negative). */ + +extern "C" long double +ldtoa_strtold (const char *s, int *error) +{ + char *endp; + long double d; + +#if defined(HAVE_ERRNO_H) + errno = 0; +#endif +#if defined(HAVE_STRTOLD) + d = strtold (s, &endp); +#else + /* Fall back to using strtod. */ + d = (long double)strtod (s, &endp); +#endif + if (endp != NULL && (*endp == '\0')) +#if defined(HAVE_ERRNO_H) + *error = (errno != 0); +#else + *error = FALSE; +#endif + else + *error = TRUE; + return d; +} + +extern "C" char * +ldtoa_ldtoa (long double d, int mode, int ndigits, int *decpt, int *sign) +{ + char format[50]; + char *p; + int r; + switch (mode) + { + + case maxsignicant: + ndigits += 20; /* Enough for exponent. */ + p = (char *) malloc (ndigits); + snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "LE"); + snprintf (p, ndigits, format, d); + *sign = dtoa_calcsign (p, ndigits); + *decpt = dtoa_calcmaxsig (p, ndigits); + return p; + case decimaldigits: + p = (char *) malloc (MAX_FP_DIGITS + 20); + snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "LE"); + snprintf (p, MAX_FP_DIGITS + 20, format, d); + *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20); + *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits); + return p; + default: + abort (); + } +} + +#if defined(GM2) +/* GNU Modula-2 linking hooks. */ + +extern "C" void +_M2_ldtoa_init (int, char **, char **) +{ +} + +extern "C" void +_M2_ldtoa_fini (int, char **, char **) +{ +} + +extern "C" void +_M2_ldtoa_dep (void) +{ +} + +struct _M2_ldtoa_ctor { _M2_ldtoa_ctor (); } _M2_ldtoa_ctor; + +_M2_ldtoa_ctor::_M2_ldtoa_ctor (void) +{ + M2RTS_RegisterModule ("ldtoa", _M2_ldtoa_init, _M2_ldtoa_fini, + _M2_ldtoa_dep); +} +#endif diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2pim/cgetopt.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2pim/cgetopt.cc 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,158 @@ +/* cgetopt.cc provide access to the C getopt library. + +Copyright (C) 2009-2022 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. + +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 +#include +#include + +extern "C" {char *cgetopt_optarg;} +extern "C" {int cgetopt_optind;} +extern "C" {int cgetopt_opterr;} +extern "C" {int cgetopt_optopt;} + +extern "C" char +cgetopt_getopt (int argc, char *argv[], char *optstring) +{ + char r = getopt (argc, argv, optstring); + + cgetopt_optarg = optarg; + cgetopt_optind = optind; + cgetopt_opterr = opterr; + cgetopt_optopt = optopt; + + if (r == (char)-1) + return (char)0; + return r; +} + +extern "C" int +cgetopt_getopt_long (int argc, char *argv[], char *optstring, + const struct option *longopts, int *longindex) +{ + int r = getopt_long (argc, argv, optstring, longopts, longindex); + + cgetopt_optarg = optarg; + cgetopt_optind = optind; + cgetopt_opterr = opterr; + cgetopt_optopt = optopt; + + return r; +} + +extern "C" int +cgetopt_getopt_long_only (int argc, char *argv[], char *optstring, + const struct option *longopts, int *longindex) +{ + int r = getopt_long_only (argc, argv, optstring, longopts, longindex); + + cgetopt_optarg = optarg; + cgetopt_optind = optind; + cgetopt_opterr = opterr; + cgetopt_optopt = optopt; + + return r; +} + +typedef struct cgetopt_Options_s +{ + struct option *cinfo; + unsigned int high; +} cgetopt_Options; + +/* InitOptions a constructor for Options. */ + +extern "C" cgetopt_Options * +cgetopt_InitOptions (void) +{ + cgetopt_Options *o = (cgetopt_Options *)malloc (sizeof (cgetopt_Options)); + o->cinfo = (struct option *)malloc (sizeof (struct option)); + o->high = 0; + return o; +} + +/* KillOptions a deconstructor for Options. Returns NULL after freeing + up all allocated memory associated with o. */ + +extern "C" cgetopt_Options * +cgetopt_KillOptions (cgetopt_Options *o) +{ + free (o->cinfo); + free (o); + return NULL; +} + +/* SetOption set option[index] with {name, has_arg, flag, val}. */ + +extern "C" void +cgetopt_SetOption (cgetopt_Options *o, unsigned int index, char *name, + unsigned int has_arg, int *flag, int val) +{ + if (index > o->high) + { + o->cinfo + = (struct option *)malloc (sizeof (struct option) * (index + 1)); + o->high = index + 1; + } + o->cinfo[index].name = name; + o->cinfo[index].has_arg = has_arg; + o->cinfo[index].flag = flag; + o->cinfo[index].val = val; +} + +/* GetLongOptionArray returns a pointer to the C array containing all + long options. */ + +extern "C" struct option * +cgetopt_GetLongOptionArray (cgetopt_Options *o) +{ + return o->cinfo; +} + +/* GNU Modula-2 linking fodder. */ + +extern "C" void +_M2_cgetopt_init (int, char *argv[], char *env[]) +{ +} + +extern "C" void +_M2_cgetopt_fini (int, char *argv[], char *env[]) +{ +} + +extern "C" void +_M2_cgetopt_dep (void) +{ +} + +struct _M2_cgetopt_ctor { _M2_cgetopt_ctor (); } _M2_cgetopt_ctor; + +_M2_cgetopt_ctor::_M2_cgetopt_ctor (void) +{ + M2RTS_RegisterModule ("cgetopt", _M2_cgetopt_init, _M2_cgetopt_fini, + _M2_cgetopt_dep); +} diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2pim/errno.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2pim/errno.cc 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,70 @@ +/* errno.c provide access to the errno value. + +Copyright (C) 2009-2022 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. + +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 + +#if defined(HAVE_SYS_ERRNO_H) +#include +#endif + +#if defined(HAVE_ERRNO_H) +#include +#endif + +#include "m2rts.h" + +extern "C" int +errno_geterrno (void) +{ +#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H) + return errno; +#else + return -1; +#endif +} + +extern "C" void +_M2_errno_init (int, char *[], char *[]) +{ +} + +extern "C" void +_M2_errno_fini (int, char *[], char *[]) +{ +} + +extern "C" void +_M2_errno_dep (void) +{ +} + +struct _M2_errno_ctor { _M2_errno_ctor (); } _M2_errno_ctor; + +_M2_errno_ctor::_M2_errno_ctor (void) +{ + M2RTS_RegisterModule ("errno", _M2_errno_init, _M2_errno_fini, + _M2_errno_dep); +} diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2pim/UnixArgs.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2pim/UnixArgs.cc 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,91 @@ +/* UnixArgs.cc record argc, argv as global variables. + +Copyright (C) 2009-2022 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. + +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 + + +extern "C" int UnixArgs_GetArgC (void); +extern "C" char **UnixArgs_GetArgV (void); +extern "C" char **UnixArgs_GetEnvV (void); + +static int UnixArgs_ArgC; +static char **UnixArgs_ArgV; +static char **UnixArgs_EnvV; + + +/* GetArgC returns argc. */ + +extern "C" int +UnixArgs_GetArgC (void) +{ + return UnixArgs_ArgC; +} + + +/* GetArgV returns argv. */ + +extern "C" char ** +UnixArgs_GetArgV (void) +{ + return UnixArgs_ArgV; +} + + +/* GetEnvV returns envv. */ + +extern "C" char ** +UnixArgs_GetEnvV (void) +{ + return UnixArgs_EnvV; +} + + +extern "C" void +_M2_UnixArgs_init (int argc, char *argv[], char *envp[]) +{ + UnixArgs_ArgC = argc; + UnixArgs_ArgV = argv; + UnixArgs_EnvV = envp; +} + +extern "C" void +_M2_UnixArgs_fini (int argc, char *argv[], char *envp[]) +{ +} + +extern "C" void +_M2_UnixArgs_dep (void) +{ +} + +struct _M2_UnixArgs_ctor { _M2_UnixArgs_ctor (); } _M2_UnixArgs_ctor; + +_M2_UnixArgs_ctor::_M2_UnixArgs_ctor (void) +{ + M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_fini, + _M2_UnixArgs_dep); +} diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2pim/termios.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2pim/termios.cc 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,1987 @@ +/* termios.cc provide access to the terminal. + +Copyright (C) 2010-2022 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. + +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 + +#if defined(HAVE_STDIO_H) +#include +#endif +#if defined(HAVE_STDARG_H) +#include +#endif +#if defined(HAVE_STDLIB_H) +#include +#endif +#if defined(HAVE_STRING_H) +#include +#endif +#if defined(HAVE_STRINGS_H) +#include +#endif + +#ifdef TERMIOS_NEEDS_XOPEN_SOURCE +#define _XOPEN_SOURCE +#endif + +#if defined(HAVE_SYS_TYPES_H) +#include +#endif + +#if defined(HAVE_TERMIOS_H) +#include +#endif + +void _M2_termios_init (void); +void _M2_termios_finish (void); + +#if defined(HAVE_TERMIOS_H) + +#define EXPORT(X) termios##_##X + +typedef enum { + vintr, + vquit, + verase, + vkill, + veof, + vtime, + vmin, + vswtc, + vstart, + vstop, + vsusp, + veol, + vreprint, + vdiscard, + vwerase, + vlnext, + veol2 +} ControlChar; + +typedef enum { + /* Input flag bits. */ + ignbrk, + ibrkint, + ignpar, + iparmrk, + inpck, + istrip, + inlcr, + igncr, + icrnl, + iuclc, + ixon, + ixany, + ixoff, + imaxbel, + /* Output flag bits. */ + opost, + olcuc, + onlcr, + ocrnl, + onocr, + onlret, + ofill, + ofdel, + onl0, + onl1, + ocr0, + ocr1, + ocr2, + ocr3, + otab0, + otab1, + otab2, + otab3, + obs0, + obs1, + off0, + off1, + ovt0, + ovt1, + /* Baud rate. */ + b0, + b50, + b75, + b110, + b135, + b150, + b200, + b300, + b600, + b1200, + b1800, + b2400, + b4800, + b9600, + b19200, + b38400, + b57600, + b115200, + b240400, + b460800, + b500000, + b576000, + b921600, + b1000000, + b1152000, + b1500000, + b2000000, + b2500000, + b3000000, + b3500000, + b4000000, + maxbaud, + crtscts, + /* Character size. */ + cs5, + cs6, + cs7, + cs8, + cstopb, + cread, + parenb, + parodd, + hupcl, + clocal, + /* Local flags. */ + lisig, + licanon, + lxcase, + lecho, + lechoe, + lechok, + lechonl, + lnoflsh, + ltopstop, + lechoctl, + lechoprt, + lechoke, + lflusho, + lpendin, + liexten +} Flag; + +/* Prototypes. */ +extern "C" void *EXPORT (InitTermios) (void); +extern "C" void *EXPORT (KillTermios) (struct termios *p); +extern "C" int EXPORT (cfgetospeed) (struct termios *t); +extern "C" int EXPORT (cfgetispeed) (struct termios *t); +extern "C" int EXPORT (cfsetospeed) (struct termios *t, unsigned int b); +extern "C" int EXPORT (cfsetispeed) (struct termios *t, unsigned int b); +extern "C" int EXPORT (cfsetspeed) (struct termios *t, unsigned int b); +extern "C" int EXPORT (tcgetattr) (int fd, struct termios *t); +extern "C" int EXPORT (tcsetattr) (int fd, int option, struct termios *t); +extern "C" void EXPORT (cfmakeraw) (struct termios *t); +extern "C" int EXPORT (tcsendbreak) (int fd, int duration); +extern "C" int EXPORT (tcdrain) (int fd); +extern "C" int EXPORT (tcflushi) (int fd); +extern "C" int EXPORT (tcflusho) (int fd); +extern "C" int EXPORT (tcflushio) (int fd); +extern "C" int EXPORT (tcflowoni) (int fd); +extern "C" int EXPORT (tcflowoffi) (int fd); +extern "C" int EXPORT (tcflowono) (int fd); +extern "C" int EXPORT (tcflowoffo) (int fd); +extern "C" int EXPORT (GetFlag) (struct termios *t, Flag f, int *b); +extern "C" int EXPORT (SetFlag) (struct termios *t, Flag f, int b); +extern "C" int EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch); +extern "C" int EXPORT (SetChar) (struct termios *t, ControlChar c, char ch); +extern "C" int EXPORT (tcsnow) (void); +extern "C" int EXPORT (tcsflush) (void); +extern "C" int EXPORT (tcsdrain) (void); +extern "C" int doSetUnset (tcflag_t *bitset, unsigned int mask, int value); + +/* InitTermios new data structure. */ + +extern "C" void +*EXPORT (InitTermios) (void) +{ + struct termios *p = (struct termios *)malloc (sizeof (struct termios)); + + memset (p, 0, sizeof (struct termios)); + return p; +} + +/* KillTermios delete data structure. */ + +extern "C" void* +EXPORT (KillTermios) (struct termios *p) +{ + free (p); + return NULL; +} + +/* tcsnow return the value of TCSANOW. */ + +extern "C" int +EXPORT (tcsnow) (void) { return TCSANOW; } + +/* tcsdrain return the value of TCSADRAIN. */ + +extern "C" int +EXPORT (tcsdrain) (void) { return TCSADRAIN; } + +/* tcsflush return the value of TCSAFLUSH. */ + +extern "C" int +EXPORT (tcsflush) (void) { return TCSAFLUSH; } + +/* cfgetospeed return output baud rate. */ + +extern "C" int +EXPORT (cfgetospeed) (struct termios *t) { return cfgetospeed (t); } + +/* cfgetispeed return input baud rate. */ + +extern "C" int +EXPORT (cfgetispeed) (struct termios *t) { return cfgetispeed (t); } + +/* cfsetospeed set output baud rate. */ + +extern "C" int +EXPORT (cfsetospeed) (struct termios *t, unsigned int b) +{ + return cfsetospeed (t, b); +} + +/* cfsetispeed set input baud rate. */ + +extern "C" int +EXPORT (cfsetispeed) (struct termios *t, unsigned int b) +{ + return cfsetispeed (t, b); +} + +/* cfsetspeed set input and output baud rate. */ + +extern "C" int +EXPORT (cfsetspeed) (struct termios *t, unsigned int b) +{ + int val = cfsetispeed (t, b); + if (val == 0) + return cfsetospeed (t, b); + cfsetospeed (t, b); + return val; +} + +/* tcgetattr get state of, fd, into, t. */ + +extern "C" int +EXPORT (tcgetattr) (int fd, struct termios *t) +{ + return tcgetattr (fd, t); +} + +/* tcsetattr set state of, fd, to, t, using option. */ + +int EXPORT (tcsetattr) (int fd, int option, struct termios *t) +{ + return tcsetattr (fd, option, t); +} + +/* cfmakeraw sets the terminal to raw mode. */ + +extern "C" void +EXPORT (cfmakeraw) (struct termios *t) +{ +#if defined(HAVE_CFMAKERAW) + return cfmakeraw (t); +#endif +} + +/* tcsendbreak send zero bits for duration. */ + +extern "C" int +EXPORT (tcsendbreak) (int fd, int duration) +{ + return tcsendbreak (fd, duration); +} + +/* tcdrain waits for pending output to be written on, fd. */ + +extern "C" int +EXPORT (tcdrain) (int fd) { return tcdrain (fd); } + +/* tcflushi flush input. */ + +extern "C" int +EXPORT (tcflushi) (int fd) +{ +#if defined(TCIFLUSH) + return tcflush (fd, TCIFLUSH); +#else + return 1; +#endif +} + +/* tcflusho flush output. */ + +extern "C" int +EXPORT (tcflusho) (int fd) +{ +#if defined(TCOFLUSH) + return tcflush (fd, TCOFLUSH); +#else + return 1; +#endif +} + +/* tcflushio flush input and output. */ + +extern "C" int +EXPORT (tcflushio) (int fd) +{ +#if defined(TCIOFLUSH) + return tcflush (fd, TCIOFLUSH); +#else + return 1; +#endif +} + +/* tcflowoni restart input on, fd. */ + +extern "C" int +EXPORT (tcflowoni) (int fd) +{ +#if defined(TCION) + return tcflow (fd, TCION); +#else + return 1; +#endif +} + +/* tcflowoffi stop input on, fd. */ + +extern "C" int +EXPORT (tcflowoffi) (int fd) +{ +#if defined(TCIOFF) + return tcflow (fd, TCIOFF); +#else + return 1; +#endif +} + +/* tcflowono restart output on, fd. */ + +extern "C" int +EXPORT (tcflowono) (int fd) +{ +#if defined(TCOON) + return tcflow (fd, TCOON); +#else + return 1; +#endif +} + +/* tcflowoffo stop output on, fd. */ + +extern "C" int +EXPORT (tcflowoffo) (int fd) +{ +#if defined(TCOOFF) + return tcflow (fd, TCOOFF); +#else + return 1; +#endif +} + +/* doSetUnset applies mask or undoes mask depending upon value. */ + +extern "C" int +doSetUnset (tcflag_t *bitset, unsigned int mask, int value) +{ + if (value) + (*bitset) |= mask; + else + (*bitset) &= (~mask); + return 1; +} + +/* GetFlag sets a flag value from, t, in, b, and returns TRUE + if, t, supports, f. */ + +extern "C" int +EXPORT (GetFlag) (struct termios *t, Flag f, int *b) +{ + switch (f) + { + + case ignbrk: +#if defined(IGNBRK) + *b = ((t->c_iflag & IGNBRK) == IGNBRK); + return 1; +#else + return 0; +#endif + case ibrkint: +#if defined(BRKINT) + *b = ((t->c_iflag & BRKINT) == BRKINT); + return 1; +#else + return 0; +#endif + case ignpar: +#if defined(IGNPAR) + *b = ((t->c_iflag & IGNPAR) == IGNPAR); + return 1; +#else + return 0; +#endif + case iparmrk: +#if defined(PARMRK) + *b = ((t->c_iflag & PARMRK) == PARMRK); + return 1; +#else + return 0; +#endif + case inpck: +#if defined(INPCK) + *b = ((t->c_iflag & INPCK) == INPCK); + return 1; +#else + return 0; +#endif + case istrip: +#if defined(ISTRIP) + *b = ((t->c_iflag & ISTRIP) == ISTRIP); + return 1; +#else + return 0; +#endif + case inlcr: +#if defined(INLCR) + *b = ((t->c_iflag & INLCR) == INLCR); + return 1; +#else + return 0; +#endif + case igncr: +#if defined(IGNCR) + *b = ((t->c_iflag & IGNCR) == IGNCR); + return 1; +#else + return 0; +#endif + case icrnl: +#if defined(ICRNL) + *b = ((t->c_iflag & ICRNL) == ICRNL); + return 1; +#else + return 0; +#endif + case iuclc: +#if defined(IUCLC) + *b = ((t->c_iflag & IUCLC) == IUCLC); + return 1; +#else + return 0; +#endif + case ixon: +#if defined(IXON) + *b = ((t->c_iflag & IXON) == IXON); + return 1; +#else + return 0; +#endif + case ixany: +#if defined(IXANY) + *b = ((t->c_iflag & IXANY) == IXANY); + return 1; +#else + return 0; +#endif + case ixoff: +#if defined(IXOFF) + *b = ((t->c_iflag & IXOFF) == IXOFF); + return 1; +#else + return 0; +#endif + case imaxbel: +#if defined(IMAXBEL) + *b = ((t->c_iflag & IMAXBEL) == IMAXBEL); + return 1; +#else + return 0; +#endif + case opost: +#if defined(OPOST) + *b = ((t->c_oflag & OPOST) == OPOST); + return 1; +#else + return 0; +#endif + case olcuc: +#if defined(OLCUC) + *b = ((t->c_oflag & OLCUC) == OLCUC); + return 1; +#else + return 0; +#endif + case onlcr: +#if defined(ONLCR) + *b = ((t->c_oflag & ONLCR) == ONLCR); + return 1; +#else + return 0; +#endif + case ocrnl: +#if defined(OCRNL) + *b = ((t->c_oflag & OCRNL) == OCRNL); + return 1; +#else + return 0; +#endif + case onocr: +#if defined(ONOCR) + *b = ((t->c_oflag & ONOCR) == ONOCR); + return 1; +#else + return 0; +#endif + case onlret: +#if defined(ONLRET) + *b = ((t->c_oflag & ONLRET) == ONLRET); + return 1; +#else + return 0; +#endif + case ofill: +#if defined(OFILL) + *b = ((t->c_oflag & OFILL) == OFILL); + return 1; +#else + return 0; +#endif + case ofdel: +#if defined(OFDEL) + *b = ((t->c_oflag & OFDEL) == OFDEL); + return 1; +#else + return 0; +#endif + case onl0: +#if defined(NL0) + *b = ((t->c_oflag & NL0) == NL0); + return 1; +#else + return 0; +#endif + case onl1: +#if defined(NL1) + *b = ((t->c_oflag & NL1) == NL1); + return 1; +#else + return 0; +#endif + case ocr0: +#if defined(CR0) + *b = ((t->c_oflag & CR0) == CR0); + return 1; +#else + return 0; +#endif + case ocr1: +#if defined(CR1) + *b = ((t->c_oflag & CR1) == CR1); + return 1; +#else + return 0; +#endif + case ocr2: +#if defined(CR2) + *b = ((t->c_oflag & CR2) == CR2); + return 1; +#else + return 0; +#endif + case ocr3: +#if defined(CR3) + *b = ((t->c_oflag & CR3) == CR3); + return 1; +#else + return 0; +#endif + case otab0: +#if defined(TAB0) + *b = ((t->c_oflag & TAB0) == TAB0); + return 1; +#else + return 0; +#endif + case otab1: +#if defined(TAB1) + *b = ((t->c_oflag & TAB1) == TAB1); + return 1; +#else + return 0; +#endif + case otab2: +#if defined(TAB2) + *b = ((t->c_oflag & TAB2) == TAB2); + return 1; +#else + return 0; +#endif + case otab3: +#if defined(TAB3) + *b = ((t->c_oflag & TAB3) == TAB3); + return 1; +#else + return 0; +#endif + case obs0: +#if defined(BS0) + *b = ((t->c_oflag & BS0) == BS0); + return 1; +#else + return 0; +#endif + case obs1: +#if defined(BS1) + *b = ((t->c_oflag & BS1) == BS1); + return 1; +#else + return 0; +#endif + case off0: +#if defined(FF0) + *b = ((t->c_oflag & FF0) == FF0); + return 1; +#else + return 0; +#endif + case off1: +#if defined(FF1) + *b = ((t->c_oflag & FF1) == FF1); + return 1; +#else + return 0; +#endif + case ovt0: +#if defined(VT0) + *b = ((t->c_oflag & VT0) == VT0); + return 1; +#else + return 0; +#endif + case ovt1: +#if defined(VT1) + *b = ((t->c_oflag & VT1) == VT1); + return 1; +#else + return 0; +#endif + case b0: +#if defined(B0) + *b = ((t->c_cflag & B0) == B0); + return 1; +#else + return 0; +#endif + case b50: +#if defined(B50) + *b = ((t->c_cflag & B50) == B50); + return 1; +#else + return 0; +#endif + case b75: +#if defined(B75) + *b = ((t->c_cflag & B75) == B75); + return 1; +#else + return 0; +#endif + case b110: +#if defined(B110) + *b = ((t->c_cflag & B110) == B110); + return 1; +#else + return 0; +#endif + case b135: +#if defined(B134) + *b = ((t->c_cflag & B134) == B134); + return 1; +#else + return 0; +#endif + case b150: +#if defined(B150) + *b = ((t->c_cflag & B150) == B150); + return 1; +#else + return 0; +#endif + case b200: +#if defined(B200) + *b = ((t->c_cflag & B200) == B200); + return 1; +#else + return 0; +#endif + case b300: +#if defined(B300) + *b = ((t->c_cflag & B300) == B300); + return 1; +#else + return 0; +#endif + case b600: +#if defined(B600) + *b = ((t->c_cflag & B600) == B600); + return 1; +#else + return 0; +#endif + case b1200: +#if defined(B1200) + *b = ((t->c_cflag & B1200) == B1200); + return 1; +#else + return 0; +#endif + case b1800: +#if defined(B1800) + *b = ((t->c_cflag & B1800) == B1800); + return 1; +#else + return 0; +#endif + case b2400: +#if defined(B2400) + *b = ((t->c_cflag & B2400) == B2400); + return 1; +#else + return 0; +#endif + case b4800: +#if defined(B4800) + *b = ((t->c_cflag & B4800) == B4800); + return 1; +#else + return 0; +#endif + case b9600: +#if defined(B9600) + *b = ((t->c_cflag & B9600) == B9600); + return 1; +#else + return 0; +#endif + case b19200: +#if defined(B19200) + *b = ((t->c_cflag & B19200) == B19200); + return 1; +#else + return 0; +#endif + case b38400: +#if defined(B38400) + *b = ((t->c_cflag & B38400) == B38400); + return 1; +#else + return 0; +#endif + case b57600: +#if defined(B57600) + *b = ((t->c_cflag & B57600) == B57600); + return 1; +#else + return 0; +#endif + case b115200: +#if defined(B115200) + *b = ((t->c_cflag & B115200) == B115200); + return 1; +#else + return 0; +#endif + case b240400: +#if defined(B230400) + *b = ((t->c_cflag & B230400) == B230400); + return 1; +#else + return 0; +#endif + case b460800: +#if defined(B460800) + *b = ((t->c_cflag & B460800) == B460800); + return 1; +#else + return 0; +#endif + case b500000: +#if defined(B500000) + *b = ((t->c_cflag & B500000) == B500000); + return 1; +#else + return 0; +#endif + case b576000: +#if defined(B576000) + *b = ((t->c_cflag & B576000) == B576000); + return 1; +#else + return 0; +#endif + case b921600: +#if defined(B921600) + *b = ((t->c_cflag & B921600) == B921600); + return 1; +#else + return 0; +#endif + case b1000000: +#if defined(B1000000) + *b = ((t->c_cflag & B1000000) == B1000000); + return 1; +#else + return 0; +#endif + case b1152000: +#if defined(B1152000) + *b = ((t->c_cflag & B1152000) == B1152000); + return 1; +#else + return 0; +#endif + case b1500000: +#if defined(B1500000) + *b = ((t->c_cflag & B1500000) == B1500000); + return 1; +#else + return 0; +#endif + case b2000000: +#if defined(B2000000) + *b = ((t->c_cflag & B2000000) == B2000000); + return 1; +#else + return 0; +#endif + case b2500000: +#if defined(B2500000) + *b = ((t->c_cflag & B2500000) == B2500000); + return 1; +#else + return 0; +#endif + case b3000000: +#if defined(B3000000) + *b = ((t->c_cflag & B3000000) == B3000000); + return 1; +#else + return 0; +#endif + case b3500000: +#if defined(B3500000) + *b = ((t->c_cflag & B3500000) == B3500000); + return 1; +#else + return 0; +#endif + case b4000000: +#if defined(B4000000) + *b = ((t->c_cflag & B4000000) == B4000000); + return 1; +#else + return 0; +#endif + case maxbaud: +#if defined(MAX) + *b = ((t->c_cflag & __MAX_BAUD) == __MAX_BAUD); + return 1; +#else + return 0; +#endif + case crtscts: +#if defined(CRTSCTS) + *b = ((t->c_cflag & CRTSCTS) == CRTSCTS); + return 1; +#else + return 0; +#endif + case cs5: +#if defined(CS5) + *b = ((t->c_cflag & CS5) == CS5); + return 1; +#else + return 0; +#endif + case cs6: +#if defined(CS6) + *b = ((t->c_cflag & CS6) == CS6); + return 1; +#else + return 0; +#endif + case cs7: +#if defined(CS7) + *b = ((t->c_cflag & CS7) == CS7); + return 1; +#else + return 0; +#endif + case cs8: +#if defined(CS8) + *b = ((t->c_cflag & CS8) == CS8); + return 1; +#else + return 0; +#endif + case cstopb: +#if defined(CSTOPB) + *b = ((t->c_cflag & CSTOPB) == CSTOPB); + return 1; +#else + return 0; +#endif + case cread: +#if defined(CREAD) + *b = ((t->c_cflag & CREAD) == CREAD); + return 1; +#else + return 0; +#endif + case parenb: +#if defined(PARENB) + *b = ((t->c_cflag & PARENB) == PARENB); + return 1; +#else + return 0; +#endif + case parodd: +#if defined(PARODD) + *b = ((t->c_cflag & PARODD) == PARODD); + return 1; +#else + return 0; +#endif + case hupcl: +#if defined(HUPCL) + *b = ((t->c_cflag & HUPCL) == HUPCL); + return 1; +#else + return 0; +#endif + case clocal: +#if defined(CLOCAL) + *b = ((t->c_cflag & CLOCAL) == CLOCAL); + return 1; +#else + return 0; +#endif + case lisig: +#if defined(ISIG) + *b = ((t->c_lflag & ISIG) == ISIG); + return 1; +#else + return 0; +#endif + case licanon: +#if defined(ICANON) + *b = ((t->c_lflag & ICANON) == ICANON); + return 1; +#else + return 0; +#endif + case lxcase: +#if defined(XCASE) + *b = ((t->c_lflag & XCASE) == XCASE); + return 1; +#else + return 0; +#endif + case lecho: +#if defined(ECHO) + *b = ((t->c_lflag & ECHO) == ECHO); + return 1; +#else + return 0; +#endif + case lechoe: +#if defined(ECHOE) + *b = ((t->c_lflag & ECHOE) == ECHOE); + return 1; +#else + return 0; +#endif + case lechok: +#if defined(ECHOK) + *b = ((t->c_lflag & ECHOK) == ECHOK); + return 1; +#else + return 0; +#endif + case lechonl: +#if defined(ECHONL) + *b = ((t->c_lflag & ECHONL) == ECHONL); + return 1; +#else + return 0; +#endif + case lnoflsh: +#if defined(NOFLSH) + *b = ((t->c_lflag & NOFLSH) == NOFLSH); + return 1; +#else + return 0; +#endif + case ltopstop: +#if defined(TOSTOP) + *b = ((t->c_lflag & TOSTOP) == TOSTOP); + return 1; +#else + return 0; +#endif + case lechoctl: +#if defined(ECHOCTL) + *b = ((t->c_lflag & ECHOCTL) == ECHOCTL); + return 1; +#else + return 0; +#endif + case lechoprt: +#if defined(ECHOPRT) + *b = ((t->c_lflag & ECHOPRT) == ECHOPRT); + return 1; +#else + return 0; +#endif + case lechoke: +#if defined(ECHOKE) + *b = ((t->c_lflag & ECHOKE) == ECHOKE); + return 1; +#else + return 0; +#endif + case lflusho: +#if defined(FLUSHO) + *b = ((t->c_lflag & FLUSHO) == FLUSHO); + return 1; +#else + return 0; +#endif + case lpendin: +#if defined(PENDIN) + *b = ((t->c_lflag & PENDIN) == PENDIN); + return 1; +#else + return 0; +#endif + case liexten: +#if defined(IEXTEN) + *b = ((t->c_lflag & IEXTEN) == IEXTEN); + return 1; +#else + return 0; +#endif + } + return 0; +} + +/* SetFlag sets a flag value in, t, to, b, and returns TRUE if + this flag value is supported. */ + +extern "C" int +EXPORT (SetFlag) (struct termios *t, Flag f, int b) +{ + switch (f) + { + + case ignbrk: +#if defined(IGNBRK) + return doSetUnset (&t->c_iflag, IGNBRK, b); +#else + return 0; +#endif + case ibrkint: +#if defined(BRKINT) + return doSetUnset (&t->c_iflag, BRKINT, b); +#else + return 0; +#endif + case ignpar: +#if defined(IGNPAR) + return doSetUnset (&t->c_iflag, IGNPAR, b); +#else + return 0; +#endif + case iparmrk: +#if defined(PARMRK) + return doSetUnset (&t->c_iflag, PARMRK, b); +#else + return 0; +#endif + case inpck: +#if defined(INPCK) + return doSetUnset (&t->c_iflag, INPCK, b); +#else + return 0; +#endif + case istrip: +#if defined(ISTRIP) + return doSetUnset (&t->c_iflag, ISTRIP, b); +#else + return 0; +#endif + case inlcr: +#if defined(INLCR) + return doSetUnset (&t->c_iflag, INLCR, b); +#else + return 0; +#endif + case igncr: +#if defined(IGNCR) + return doSetUnset (&t->c_iflag, IGNCR, b); +#else + return 0; +#endif + case icrnl: +#if defined(ICRNL) + return doSetUnset (&t->c_iflag, ICRNL, b); +#else + return 0; +#endif + case iuclc: +#if defined(IUCLC) + return doSetUnset (&t->c_iflag, IUCLC, b); +#else + return 0; +#endif + case ixon: +#if defined(IXON) + return doSetUnset (&t->c_iflag, IXON, b); +#else + return 0; +#endif + case ixany: +#if defined(IXANY) + return doSetUnset (&t->c_iflag, IXANY, b); +#else + return 0; +#endif + case ixoff: +#if defined(IXOFF) + return doSetUnset (&t->c_iflag, IXOFF, b); +#else + return 0; +#endif + case imaxbel: +#if defined(IMAXBEL) + return doSetUnset (&t->c_iflag, IMAXBEL, b); +#else + return 0; +#endif + case opost: +#if defined(OPOST) + return doSetUnset (&t->c_oflag, OPOST, b); +#else + return 0; +#endif + case olcuc: +#if defined(OLCUC) + return doSetUnset (&t->c_oflag, OLCUC, b); +#else + return 0; +#endif + case onlcr: +#if defined(ONLCR) + return doSetUnset (&t->c_oflag, ONLCR, b); +#else + return 0; +#endif + case ocrnl: +#if defined(OCRNL) + return doSetUnset (&t->c_oflag, OCRNL, b); +#else + return 0; +#endif + case onocr: +#if defined(ONOCR) + return doSetUnset (&t->c_oflag, ONOCR, b); +#else + return 0; +#endif + case onlret: +#if defined(ONLRET) + return doSetUnset (&t->c_oflag, ONLRET, b); +#else + return 0; +#endif + case ofill: +#if defined(OFILL) + return doSetUnset (&t->c_oflag, OFILL, b); +#else + return 0; +#endif + case ofdel: +#if defined(OFDEL) + return doSetUnset (&t->c_oflag, OFDEL, b); +#else + return 0; +#endif + case onl0: +#if defined(NL0) + return doSetUnset (&t->c_oflag, NL0, b); +#else + return 0; +#endif + case onl1: +#if defined(NL1) + return doSetUnset (&t->c_oflag, NL1, b); +#else + return 0; +#endif + case ocr0: +#if defined(CR0) + return doSetUnset (&t->c_oflag, CR0, b); +#else + return 0; +#endif + case ocr1: +#if defined(CR1) + return doSetUnset (&t->c_oflag, CR1, b); +#else + return 0; +#endif + case ocr2: +#if defined(CR2) + return doSetUnset (&t->c_oflag, CR2, b); +#else + return 0; +#endif + case ocr3: +#if defined(CR3) + return doSetUnset (&t->c_oflag, CR3, b); +#else + return 0; +#endif + case otab0: +#if defined(TAB0) + return doSetUnset (&t->c_oflag, TAB0, b); +#else + return 0; +#endif + case otab1: +#if defined(TAB1) + return doSetUnset (&t->c_oflag, TAB1, b); +#else + return 0; +#endif + case otab2: +#if defined(TAB2) + return doSetUnset (&t->c_oflag, TAB2, b); +#else + return 0; +#endif + case otab3: +#if defined(TAB3) + return doSetUnset (&t->c_oflag, TAB3, b); +#else + return 0; +#endif + case obs0: +#if defined(BS0) + return doSetUnset (&t->c_oflag, BS0, b); +#else + return 0; +#endif + case obs1: +#if defined(BS1) + return doSetUnset (&t->c_oflag, BS1, b); +#else + return 0; +#endif + case off0: +#if defined(FF0) + return doSetUnset (&t->c_oflag, FF0, b); +#else + return 0; +#endif + case off1: +#if defined(FF1) + return doSetUnset (&t->c_oflag, FF1, b); +#else + return 0; +#endif + case ovt0: +#if defined(VT0) + return doSetUnset (&t->c_oflag, VT0, b); +#else + return 0; +#endif + case ovt1: +#if defined(VT1) + return doSetUnset (&t->c_oflag, VT1, b); +#else + return 0; +#endif + case b0: +#if defined(B0) + return doSetUnset (&t->c_cflag, B0, b); +#else + return 0; +#endif + case b50: +#if defined(B50) + return doSetUnset (&t->c_cflag, B50, b); +#else + return 0; +#endif + case b75: +#if defined(B75) + return doSetUnset (&t->c_cflag, B75, b); +#else + return 0; +#endif + case b110: +#if defined(B110) + return doSetUnset (&t->c_cflag, B110, b); +#else + return 0; +#endif + case b135: +#if defined(B134) + return doSetUnset (&t->c_cflag, B134, b); +#else + return 0; +#endif + case b150: +#if defined(B150) + return doSetUnset (&t->c_cflag, B150, b); +#else + return 0; +#endif + case b200: +#if defined(B200) + return doSetUnset (&t->c_cflag, B200, b); +#else + return 0; +#endif + case b300: +#if defined(B300) + return doSetUnset (&t->c_cflag, B300, b); +#else + return 0; +#endif + case b600: +#if defined(B600) + return doSetUnset (&t->c_cflag, B600, b); +#else + return 0; +#endif + case b1200: +#if defined(B1200) + return doSetUnset (&t->c_cflag, B1200, b); +#else + return 0; +#endif + case b1800: +#if defined(B1800) + return doSetUnset (&t->c_cflag, B1800, b); +#else + return 0; +#endif + case b2400: +#if defined(B2400) + return doSetUnset (&t->c_cflag, B2400, b); +#else + return 0; +#endif + case b4800: +#if defined(B4800) + return doSetUnset (&t->c_cflag, B4800, b); +#else + return 0; +#endif + case b9600: +#if defined(B9600) + return doSetUnset (&t->c_cflag, B9600, b); +#else + return 0; +#endif + case b19200: +#if defined(B19200) + return doSetUnset (&t->c_cflag, B19200, b); +#else + return 0; +#endif + case b38400: +#if defined(B38400) + return doSetUnset (&t->c_cflag, B38400, b); +#else + return 0; +#endif + case b57600: +#if defined(B57600) + return doSetUnset (&t->c_cflag, B57600, b); +#else + return 0; +#endif + case b115200: +#if defined(B115200) + return doSetUnset (&t->c_cflag, B115200, b); +#else + return 0; +#endif + case b240400: +#if defined(B230400) + return doSetUnset (&t->c_cflag, B230400, b); +#else + return 0; +#endif + case b460800: +#if defined(B460800) + return doSetUnset (&t->c_cflag, B460800, b); +#else + return 0; +#endif + case b500000: +#if defined(B500000) + return doSetUnset (&t->c_cflag, B500000, b); +#else + return 0; +#endif + case b576000: +#if defined(B576000) + return doSetUnset (&t->c_cflag, B576000, b); +#else + return 0; +#endif + case b921600: +#if defined(B921600) + return doSetUnset (&t->c_cflag, B921600, b); +#else + return 0; +#endif + case b1000000: +#if defined(B1000000) + return doSetUnset (&t->c_cflag, B1000000, b); +#else + return 0; +#endif + case b1152000: +#if defined(B1152000) + return doSetUnset (&t->c_cflag, B1152000, b); +#else + return 0; +#endif + case b1500000: +#if defined(B1500000) + return doSetUnset (&t->c_cflag, B1500000, b); +#else + return 0; +#endif + case b2000000: +#if defined(B2000000) + return doSetUnset (&t->c_cflag, B2000000, b); +#else + return 0; +#endif + case b2500000: +#if defined(B2500000) + return doSetUnset (&t->c_cflag, B2500000, b); +#else + return 0; +#endif + case b3000000: +#if defined(B3000000) + return doSetUnset (&t->c_cflag, B3000000, b); +#else + return 0; +#endif + case b3500000: +#if defined(B3500000) + return doSetUnset (&t->c_cflag, B3500000, b); +#else + return 0; +#endif + case b4000000: +#if defined(B4000000) + return doSetUnset (&t->c_cflag, B4000000, b); +#else + return 0; +#endif + case maxbaud: +#if defined(__MAX_BAUD) + return doSetUnset (&t->c_cflag, __MAX_BAUD, b); +#else + return 0; +#endif + case crtscts: +#if defined(CRTSCTS) + return doSetUnset (&t->c_cflag, CRTSCTS, b); +#else + return 0; +#endif + case cs5: +#if defined(CS5) + return doSetUnset (&t->c_cflag, CS5, b); +#else + return 0; +#endif + case cs6: +#if defined(CS6) + return doSetUnset (&t->c_cflag, CS6, b); +#else + return 0; +#endif + case cs7: +#if defined(CS7) + return doSetUnset (&t->c_cflag, CS7, b); +#else + return 0; +#endif + case cs8: +#if defined(CS8) + return doSetUnset (&t->c_cflag, CS8, b); +#else + return 0; +#endif + case cstopb: +#if defined(CSTOPB) + return doSetUnset (&t->c_cflag, CSTOPB, b); +#else + return 0; +#endif + case cread: +#if defined(CREAD) + return doSetUnset (&t->c_cflag, CREAD, b); +#else + return 0; +#endif + case parenb: +#if defined(PARENB) + return doSetUnset (&t->c_cflag, PARENB, b); +#else + return 0; +#endif + case parodd: +#if defined(PARODD) + return doSetUnset (&t->c_cflag, PARODD, b); +#else + return 0; +#endif + case hupcl: +#if defined(HUPCL) + return doSetUnset (&t->c_cflag, HUPCL, b); +#else + return 0; +#endif + case clocal: +#if defined(CLOCAL) + return doSetUnset (&t->c_cflag, CLOCAL, b); +#else + return 0; +#endif + case lisig: +#if defined(ISIG) + return doSetUnset (&t->c_lflag, ISIG, b); +#else + return 0; +#endif + case licanon: +#if defined(ICANON) + return doSetUnset (&t->c_lflag, ICANON, b); +#else + return 0; +#endif + case lxcase: +#if defined(XCASE) + return doSetUnset (&t->c_lflag, XCASE, b); +#else + return 0; +#endif + case lecho: +#if defined(ECHO) + return doSetUnset (&t->c_lflag, ECHO, b); +#else + return 0; +#endif + case lechoe: +#if defined(ECHOE) + return doSetUnset (&t->c_lflag, ECHOE, b); +#else + return 0; +#endif + case lechok: +#if defined(ECHOK) + return doSetUnset (&t->c_lflag, ECHOK, b); +#else + return 0; +#endif + case lechonl: +#if defined(ECHONL) + return doSetUnset (&t->c_lflag, ECHONL, b); +#else + return 0; +#endif + case lnoflsh: +#if defined(NOFLSH) + return doSetUnset (&t->c_lflag, NOFLSH, b); +#else + return 0; +#endif + case ltopstop: +#if defined(TOSTOP) + return doSetUnset (&t->c_lflag, TOSTOP, b); +#else + return 0; +#endif + case lechoctl: +#if defined(ECHOCTL) + return doSetUnset (&t->c_lflag, ECHOCTL, b); +#else + return 0; +#endif + case lechoprt: +#if defined(ECHOPRT) + return doSetUnset (&t->c_lflag, ECHOPRT, b); +#else + return 0; +#endif + case lechoke: +#if defined(ECHOKE) + return doSetUnset (&t->c_lflag, ECHOKE, b); +#else + return 0; +#endif + case lflusho: +#if defined(FLUSHO) + return doSetUnset (&t->c_lflag, FLUSHO, b); +#else + return 0; +#endif + case lpendin: +#if defined(PENDIN) + return doSetUnset (&t->c_lflag, PENDIN, b); +#else + return 0; +#endif + case liexten: +#if defined(IEXTEN) + return doSetUnset (&t->c_lflag, IEXTEN, b); +#else + return 0; +#endif + } + return 0; +} + +/* GetChar sets a CHAR, ch, value from, t, and returns TRUE if + this value is supported. */ + +extern "C" int +EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch) +{ + switch (c) + { + + case vintr: +#if defined(VINTR) + *ch = t->c_cc[VINTR]; + return 1; +#else + return 0; +#endif + case vquit: +#if defined(VQUIT) + *ch = t->c_cc[VQUIT]; + return 1; +#else + return 0; +#endif + case verase: +#if defined(VERASE) + *ch = t->c_cc[VERASE]; + return 1; +#else + return 0; +#endif + case vkill: +#if defined(VKILL) + *ch = t->c_cc[VKILL]; + return 1; +#else + return 0; +#endif + case veof: +#if defined(VEOF) + *ch = t->c_cc[VEOF]; + return 1; +#else + return 0; +#endif + case vtime: +#if defined(VTIME) + *ch = t->c_cc[VTIME]; + return 1; +#else + return 0; +#endif + case vmin: +#if defined(VMIN) + *ch = t->c_cc[VMIN]; + return 1; +#else + return 0; +#endif + case vswtc: +#if defined(VSWTC) + *ch = t->c_cc[VSWTC]; + return 1; +#else + return 0; +#endif + case vstart: +#if defined(VSTART) + *ch = t->c_cc[VSTART]; + return 1; +#else + return 0; +#endif + case vstop: +#if defined(VSTOP) + *ch = t->c_cc[VSTOP]; + return 1; +#else + return 0; +#endif + case vsusp: +#if defined(VSUSP) + *ch = t->c_cc[VSUSP]; + return 1; +#else + return 0; +#endif + case veol: +#if defined(VEOL) + *ch = t->c_cc[VEOL]; + return 1; +#else + return 0; +#endif + case vreprint: +#if defined(VREPRINT) + *ch = t->c_cc[VREPRINT]; + return 1; +#else + return 0; +#endif + case vdiscard: +#if defined(VDISCARD) + *ch = t->c_cc[VDISCARD]; + return 1; +#else + return 0; +#endif + case vwerase: +#if defined(VWERASE) + *ch = t->c_cc[VWERASE]; + return 1; +#else + return 0; +#endif + case vlnext: +#if defined(VLNEXT) + *ch = t->c_cc[VLNEXT]; + return 1; +#else + return 0; +#endif + case veol2: +#if defined(VEOL2) + *ch = t->c_cc[VEOL2]; + return 1; +#else + return 0; +#endif + default: + return 0; + } +} + +/* SetChar sets a CHAR value in, t, and returns TRUE if, c, + is supported. */ + +extern "C" int +EXPORT (SetChar) (struct termios *t, ControlChar c, char ch) +{ + switch (c) + { + + case vintr: +#if defined(VINTR) + t->c_cc[VINTR] = ch; + return 1; +#else + return 0; +#endif + case vquit: +#if defined(VQUIT) + t->c_cc[VQUIT] = ch; + return 1; +#else + return 0; +#endif + case verase: +#if defined(VERASE) + t->c_cc[VERASE] = ch; + return 1; +#else + return 0; +#endif + case vkill: +#if defined(VKILL) + t->c_cc[VKILL] = ch; + return 1; +#else + return 0; +#endif + case veof: +#if defined(VEOF) + t->c_cc[VEOF] = ch; + return 1; +#else + return 0; +#endif + case vtime: +#if defined(VTIME) + t->c_cc[VTIME] = ch; + return 1; +#else + return 0; +#endif + case vmin: +#if defined(VMIN) + t->c_cc[VMIN] = ch; + return 1; +#else + return 0; +#endif + case vswtc: +#if defined(VSWTC) + t->c_cc[VSWTC] = ch; + return 1; +#else + return 0; +#endif + case vstart: +#if defined(VSTART) + t->c_cc[VSTART] = ch; + return 1; +#else + return 0; +#endif + case vstop: +#if defined(VSTOP) + t->c_cc[VSTOP] = ch; + return 1; +#else + return 0; +#endif + case vsusp: +#if defined(VSUSP) + t->c_cc[VSUSP] = ch; + return 1; +#else + return 0; +#endif + case veol: +#if defined(VEOL) + t->c_cc[VEOL] = ch; + return 1; +#else + return 0; +#endif + case vreprint: +#if defined(VREPRINT) + t->c_cc[VREPRINT] = ch; + return 1; +#else + return 0; +#endif + case vdiscard: +#if defined(VDISCARD) + t->c_cc[VDISCARD] = ch; + return 1; +#else + return 0; +#endif + case vwerase: +#if defined(VWERASE) + t->c_cc[VWERASE] = ch; + return 1; +#else + return 0; +#endif + case vlnext: +#if defined(VLNEXT) + t->c_cc[VLNEXT] = ch; + return 1; +#else + return 0; +#endif + case veol2: +#if defined(VEOL2) + t->c_cc[VEOL2] = ch; + return 1; +#else + return 0; +#endif + default: + return 0; + } +} +#endif + +extern "C" void +_M2_termios_init (int, char *[], char *[]) +{ +} + +extern "C" void +_M2_termios_fini (int, char *[], char *[]) +{ +} + +extern "C" void +_M2_termios_dep (void) +{ +} + +struct _M2_termios_ctor { _M2_termios_ctor (); } _M2_termios_ctor; + +_M2_termios_ctor::_M2_termios_ctor (void) +{ + M2RTS_RegisterModule ("termios", _M2_termios_init, _M2_termios_fini, + _M2_termios_dep); +} diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2pim/sckt.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2pim/sckt.cc 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,430 @@ +/* sckt.c provide access to the socket layer. + +Copyright (C) 2005-2022 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. + +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 + +#if defined(HAVE_SYS_TYPES_H) +#include +#endif + +#if defined(HAVE_SYS_SOCKET_H) +#include +#endif + +#if defined(HAVE_NETINET_IN_H) +#include +#endif + +#if defined(HAVE_NETDB_H) +#include +#endif + +#if defined(HAVE_UNISTD_H) +#include +#endif + +#if defined(HAVE_SIGNAL_H) +#include +#endif + +#if defined(HAVE_SYS_ERRNO_H) +#include +#endif + +#if defined(HAVE_ERRNO_H) +#include +#endif + +#if defined(HAVE_MALLOC_H) +#include +#endif + +#if defined(HAVE_STRING_H) +#include +#endif + +#if defined(HAVE_STDLIB_H) +#include +#endif + +#if defined(HAVE_STDIO_H) +#include +#endif + +#define PORTSTART 7000 +#define NOOFTRIES 100 +#define MAXHOSTNAME 256 + +#undef DEBUGGING + +#if !defined(TRUE) +#define TRUE (1 == 1) +#endif +#if !defined(FALSE) +#define FALSE (1 == 0) +#endif + +#if defined(HAVE_SYS_SOCKET_H) + +#define ERROR(X) \ + { \ + printf ("%s:%d:%s\n", __FILE__, __LINE__, X); \ + localExit (1); \ + } + +#define ASSERT(X) \ + { \ + if (!(X)) \ + { \ + printf ("%s:%d: assert(%s) failed\n", __FILE__, __LINE__, #X); \ + exit (1); \ + } \ + } + +typedef struct +{ + char hostname[MAXHOSTNAME]; + struct hostent *hp; + struct sockaddr_in sa, isa; + int sockFd; + int portNo; +} tcpServerState; + +int +localExit (int i) +{ + exit (1); +} + +/* tcpServerEstablishPort returns a tcpState containing the relevant + information about a socket declared to receive tcp connections. + This method attempts to use the port specified by the parameter. */ + +extern "C" tcpServerState * +tcpServerEstablishPort (int portNo) +{ + tcpServerState *s = (tcpServerState *)malloc (sizeof (tcpServerState)); + int b, p, n; + + if (s == NULL) + ERROR ("no more memory"); + + /* Remove SIGPIPE which is raised on the server if the client is killed. */ + signal (SIGPIPE, SIG_IGN); + + if (gethostname (s->hostname, MAXHOSTNAME) < 0) + ERROR ("cannot find our hostname"); + + s->hp = gethostbyname (s->hostname); + if (s->hp == NULL) + ERROR ("cannot get host name"); + + p = -1; + n = 0; + do + { + p++; + /* Open a TCP socket (an Internet stream socket). */ + + s->sockFd = socket (s->hp->h_addrtype, SOCK_STREAM, 0); + if (s->sockFd < 0) + ERROR ("socket"); + + memset ((void *)&s->sa, 0, sizeof (s->sa)); + ASSERT ((s->hp->h_addrtype == AF_INET)); + s->sa.sin_family = s->hp->h_addrtype; + s->sa.sin_addr.s_addr = htonl (INADDR_ANY); + s->sa.sin_port = htons (portNo + p); + + b = bind (s->sockFd, (struct sockaddr *)&s->sa, sizeof (s->sa)); + } + while ((b < 0) && (n < NOOFTRIES)); + + if (b < 0) + ERROR ("bind"); + + s->portNo = portNo + p; +#if defined(DEBUGGING) + printf ("the receiving host is: %s, the port is %d\n", s->hostname, + s->portNo); +#endif + listen (s->sockFd, 1); + return s; +} + +/* tcpServerEstablish returns a tcpServerState containing the relevant + information about a socket declared to receive tcp connections. */ + +extern "C" tcpServerState * +tcpServerEstablish (void) +{ + return tcpServerEstablishPort (PORTSTART); +} + +/* tcpServerAccept returns a file descriptor once a client has connected and + been accepted. */ + +extern "C" int +tcpServerAccept (tcpServerState *s) +{ + socklen_t i = sizeof (s->isa); + int t; + +#if defined(DEBUGGING) + printf ("before accept %d\n", s->sockFd); +#endif + t = accept (s->sockFd, (struct sockaddr *)&s->isa, &i); + return t; +} + +/* tcpServerPortNo returns the portNo from structure, s. */ + +extern "C" int +tcpServerPortNo (tcpServerState *s) +{ + return s->portNo; +} + +/* tcpServerSocketFd returns the sockFd from structure, s. */ + +extern "C" int +tcpServerSocketFd (tcpServerState *s) +{ + return s->sockFd; +} + +/* getLocalIP returns the IP address of this machine. */ + +extern "C" unsigned int +getLocalIP (tcpServerState *s) +{ + char hostname[1024]; + struct hostent *hp; + struct sockaddr_in sa; + unsigned int ip; + int ret = gethostname (hostname, sizeof (hostname)); + + if (ret == -1) + { + ERROR ("gethostname"); + return 0; + } + + hp = gethostbyname (hostname); + if (hp == NULL) + { + ERROR ("gethostbyname"); + return 0; + } + + if (sizeof (unsigned int) != sizeof (in_addr_t)) + { + ERROR ("bad ip length"); + return 0; + } + + memset (&sa, sizeof (struct sockaddr_in), 0); + sa.sin_family = AF_INET; + sa.sin_port = htons (80); + if (hp->h_length == sizeof (unsigned int)) + { + memcpy (&ip, hp->h_addr_list[0], hp->h_length); + return ip; + } + + return 0; +} + +/* tcpServerIP returns the IP address from structure s. */ + +extern "C" int +tcpServerIP (tcpServerState *s) +{ + return *((int *)s->hp->h_addr_list[0]); +} + +/* tcpServerClientIP returns the IP address of the client who + has connected to server s. */ + +extern "C" unsigned int +tcpServerClientIP (tcpServerState *s) +{ + unsigned int ip; + + ASSERT (s->isa.sin_family == AF_INET); + ASSERT (sizeof (ip) == 4); + memcpy (&ip, &s->isa.sin_addr, sizeof (ip)); + return ip; +} + +/* tcpServerClientPortNo returns the port number of the client who + has connected to server s. */ + +extern "C" unsigned int +tcpServerClientPortNo (tcpServerState *s) +{ + return s->isa.sin_port; +} + +/* +**************************************************************** +*** C L I E N T R O U T I N E S +**************************************************************** + */ + +typedef struct +{ + char hostname[MAXHOSTNAME]; + struct hostent *hp; + struct sockaddr_in sa; + int sockFd; + int portNo; +} tcpClientState; + +/* tcpClientSocket returns a file descriptor (socket) which has + connected to, serverName:portNo. */ + +extern "C" tcpClientState * +tcpClientSocket (char *serverName, int portNo) +{ + tcpClientState *s = (tcpClientState *)malloc (sizeof (tcpClientState)); + + if (s == NULL) + ERROR ("no more memory"); + + /* Remove SIGPIPE which is raised on the server if the client is killed. */ + signal (SIGPIPE, SIG_IGN); + + s->hp = gethostbyname (serverName); + if (s->hp == NULL) + { + fprintf (stderr, "cannot find host: %s\n", serverName); + exit (1); + } + + memset ((void *)&s->sa, 0, sizeof (s->sa)); + s->sa.sin_family = AF_INET; + memcpy ((void *)&s->sa.sin_addr, (void *)s->hp->h_addr, s->hp->h_length); + s->portNo = portNo; + s->sa.sin_port = htons (portNo); + + /* Open a TCP socket (an Internet stream socket). */ + + s->sockFd = socket (s->hp->h_addrtype, SOCK_STREAM, 0); + return s; +} + +/* tcpClientSocketIP returns a file descriptor (socket) which has + connected to, ip:portNo. */ + +extern "C" tcpClientState * +tcpClientSocketIP (unsigned int ip, int portNo) +{ + tcpClientState *s = (tcpClientState *)malloc (sizeof (tcpClientState)); + + if (s == NULL) + ERROR ("no more memory"); + + /* Remove SIGPIPE which is raised on the server if the client is killed. */ + signal (SIGPIPE, SIG_IGN); + + memset ((void *)&s->sa, 0, sizeof (s->sa)); + s->sa.sin_family = AF_INET; + memcpy ((void *)&s->sa.sin_addr, (void *)&ip, sizeof (ip)); + s->portNo = portNo; + s->sa.sin_port = htons (portNo); + + /* Open a TCP socket (an Internet stream socket). */ + + s->sockFd = socket (PF_INET, SOCK_STREAM, 0); + return s; +} + +/* tcpClientConnect returns the file descriptor associated with s, + once a connect has been performed. */ + +extern "C" int +tcpClientConnect (tcpClientState *s) +{ + if (connect (s->sockFd, (struct sockaddr *)&s->sa, sizeof (s->sa)) < 0) + ERROR ("failed to connect to the TCP server"); + + return s->sockFd; +} + +/* tcpClientPortNo returns the portNo from structure s. */ + +extern "C" int +tcpClientPortNo (tcpClientState *s) +{ + return s->portNo; +} + +/* tcpClientSocketFd returns the sockFd from structure s. */ + +extern "C" int +tcpClientSocketFd (tcpClientState *s) +{ + return s->sockFd; +} + +/* tcpClientIP returns the sockFd from structure s. */ + +extern "C" int +tcpClientIP (tcpClientState *s) +{ +#if defined(DEBUGGING) + printf ("client ip = %s\n", inet_ntoa (s->sa.sin_addr.s_addr)); +#endif + return s->sa.sin_addr.s_addr; +} +#endif + +/* GNU Modula-2 link fodder. */ + +extern "C" void +_M2_sckt_init (int, char *[], char *[]) +{ +} + +extern "C" void +_M2_sckt_finish (int, char *[], char *[]) +{ +} + +extern "C" void +_M2_sckt_dep (void) +{ +} + +struct _M2_sckt_ctor { _M2_sckt_ctor (); } _M2_sckt_ctor; + +_M2_sckt_ctor::_M2_sckt_ctor (void) +{ + M2RTS_RegisterModule ("sckt", _M2_sckt_init, _M2_sckt_finish, + _M2_sckt_dep); +} From patchwork Tue Dec 6 14:47:26 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Gaius Mulley X-Patchwork-Id: 61575 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 4275E383B690 for ; Tue, 6 Dec 2022 14:48:30 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 4275E383B690 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1670338110; bh=no/yErhIMwdhKIsRrOmB1CtZYxCep3FU9B1CfTbqbKU=; h=Subject:To:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=g1HaMm7OPP6t6uRvkIWc4scZ1AEEc4rbcwFVfcLW63XuQgJPAnu6U3ixf3XKW7Y56 S26XBZ7qt0cXNIi+auI3OM96mjoLzrpY5dy6UQHjP4FFlhZCZBXunixtJgX2yxVj+x qZTaZkeCaOwWmXmQSuNPvEWG3U91wXdAkYNwARSQ= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x429.google.com (mail-wr1-x429.google.com [IPv6:2a00:1450:4864:20::429]) by sourceware.org (Postfix) with ESMTPS id D2658384C912 for ; Tue, 6 Dec 2022 14:47:32 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org D2658384C912 Received: by mail-wr1-x429.google.com with SMTP id d1so23760704wrs.12 for ; Tue, 06 Dec 2022 06:47:32 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=date:message-id:to:subject:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=no/yErhIMwdhKIsRrOmB1CtZYxCep3FU9B1CfTbqbKU=; b=nsVkApJz9MbgpBfRJnM5jy87iPTr2leOwxhQwrfkC/XWbeBuew4tzcZjTNtAxtwkaX WyfXsY56IiavFhiPCQMKVKW3Zj/u6m9yaUYWjcrdoYYbEOI9xK5aQuynZdG/48zuWSAI rwVS+02DpCwHNGDlczvxL8ktWuFXnjHhphzy/O744VetpLwbL0sI4MfO4oejzC8aO1YO zURiAo2AjzT5NVTaPxRby5AI14XJP/mXUKn5/5NY1fGCqKl4ouXb7ejfDut5aPWs9SVz dRAMjPwTDGGScAhleOnY4ZEC1FZbXFzcKtH9PcK7H5NdYGEdSCrgmdZcNZBCYmXPvuz6 oYdw== X-Gm-Message-State: ANoB5plEO047vdN3/6RjRu4hvHwXwv5H4mwVhbiP9PZ9Isvux9Qn9Ngt M6JWoDMiRFQ6N6qeSNoETFyfOeIL0Cc= X-Google-Smtp-Source: AA0mqf7ewQcdAI9A98lrlqxeyaeL4xoaCrcf+yI0j1xLzDKuKSoFF7+KaWFXs7inp3map3gBUJeGjA== X-Received: by 2002:a5d:4943:0:b0:242:3ca3:b7bd with SMTP id r3-20020a5d4943000000b002423ca3b7bdmr13633866wrs.583.1670338051066; Tue, 06 Dec 2022 06:47:31 -0800 (PST) Received: from lancelot ([195.147.220.46]) by smtp.gmail.com with ESMTPSA id s13-20020a5d424d000000b002427bfd17b6sm1654122wrr.63.2022.12.06.06.47.28 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Dec 2022 06:47:30 -0800 (PST) X-Google-Original-From: Gaius Mulley Received: from gaius by lancelot with local (Exim 4.94.2) (envelope-from ) id 1p2ZEE-004Qen-6m for gcc-patches@gcc.gnu.org; Tue, 06 Dec 2022 14:47:26 +0000 Subject: [PATCH v3 5/19] modula2 front end: libgm2/libm2iso contents To: X-Mailer: mail (GNU Mailutils 3.10) Message-Id: Date: Tue, 06 Dec 2022 14:47:26 +0000 X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Gaius Mulley via Gcc-patches From: Gaius Mulley Reply-To: Gaius Mulley Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patch set consists of the makefiles, autoconf sources necessary to build the various libgm2/libm2iso libraries. The c/c++/h files are also included in the patch set. The modula-2 sources are found in gcc/m2. ------8<----------8<----------8<----------8<----------8<----------8<---- diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2iso/wrapsock.c --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2iso/wrapsock.c 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,250 @@ +/* wrapsock.c provides access to socket related system calls. + +Copyright (C) 2008-2022 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. + +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 "config.h" + +#if defined(HAVE_SYS_TYPES_H) +#include "sys/types.h" +#endif + +#if defined(HAVE_SYS_SOCKET_H) +#include "sys/socket.h" +#endif + +#if defined(HAVE_NETINET_IN_H) +#include "netinet/in.h" +#endif + +#if defined(HAVE_NETDB_H) +#include "netdb.h" +#endif + +#if defined(HAVE_UNISTD_H) +#include "unistd.h" +#endif + +#if defined(HAVE_SIGNAL_H) +#include "signal.h" +#endif + +#if defined(HAVE_SYS_ERRNO_H) +#include "sys/errno.h" +#endif + +#if defined(HAVE_ERRNO_H) +#include "errno.h" +#endif + +#if defined(HAVE_MALLOC_H) +#include "malloc.h" +#endif + +#if defined(HAVE_MALLOC_H) +#include "signal.h" +#endif + +#if defined(HAVE_STRING_H) +#include "string.h" +#endif + +#if defined(HAVE_STDLIB_H) +#include "stdlib.h" +#endif + +#if !defined(TRUE) +#define TRUE (1 == 1) +#endif +#if !defined(FALSE) +#define FALSE (1 == 0) +#endif + +#include "ChanConsts.h" + +#define MAXHOSTNAME 1024 +#define MAXPBBUF 1024 + +#if defined(HAVE_NETINET_IN_H) + +typedef struct +{ + char hostname[MAXHOSTNAME]; + struct hostent *hp; + struct sockaddr_in sa; + int sockFd; + int portNo; + int hasChar; + char pbChar[MAXPBBUF]; +} clientInfo; + +static openResults clientConnect (clientInfo *c); + +/* clientOpen - returns an ISO Modula-2 OpenResult. It attempts to + connect to: hostname:portNo. If successful then the data + structure, c, will have its fields initialized. */ + +openResults +wrapsock_clientOpen (clientInfo *c, char *hostname, unsigned int length, + int portNo) +{ + /* remove SIGPIPE which is raised on the server if the client is killed. */ + signal (SIGPIPE, SIG_IGN); + + c->hp = gethostbyname (hostname); + if (c->hp == NULL) + return noSuchFile; + + memset ((void *)&c->sa, 0, sizeof (c->sa)); + c->sa.sin_family = AF_INET; + memcpy ((void *)&c->sa.sin_addr, (void *)c->hp->h_addr, c->hp->h_length); + c->portNo = portNo; + c->sa.sin_port = htons (portNo); + c->hasChar = 0; + /* Open a TCP socket (an Internet stream socket) */ + + c->sockFd = socket (c->hp->h_addrtype, SOCK_STREAM, 0); + return clientConnect (c); +} + +/* clientOpenIP - returns an ISO Modula-2 OpenResult. It attempts to + connect to: ipaddress:portNo. If successful then the data + structure, c, will have its fields initialized. */ + +openResults +wrapsock_clientOpenIP (clientInfo *c, unsigned int ip, int portNo) +{ + /* remove SIGPIPE which is raised on the server if the client is killed. */ + signal (SIGPIPE, SIG_IGN); + + memset ((void *)&c->sa, 0, sizeof (c->sa)); + c->sa.sin_family = AF_INET; + memcpy ((void *)&c->sa.sin_addr, (void *)&ip, sizeof (ip)); + c->portNo = portNo; + c->sa.sin_port = htons (portNo); + + /* Open a TCP socket (an Internet stream socket) */ + + c->sockFd = socket (PF_INET, SOCK_STREAM, 0); + return clientConnect (c); +} + +/* clientConnect - returns an ISO Modula-2 OpenResult once a connect + has been performed. If successful the clientInfo will include the + file descriptor ready for read/write operations. */ + +static openResults +clientConnect (clientInfo *c) +{ + if (connect (c->sockFd, (struct sockaddr *)&c->sa, sizeof (c->sa)) < 0) + return noSuchFile; + + return opened; +} + +/* getClientPortNo - returns the portNo from structure, c. */ + +int +wrapsock_getClientPortNo (clientInfo *c) +{ + return c->portNo; +} + +/* getClientHostname - fills in the hostname of the server the to + which the client is connecting. */ + +void +wrapsock_getClientHostname (clientInfo *c, char *hostname, unsigned int high) +{ + strncpy (hostname, c->hostname, high + 1); +} + +/* getClientSocketFd - returns the sockFd from structure, c. */ + +int +wrapsock_getClientSocketFd (clientInfo *c) +{ + return c->sockFd; +} + +/* getClientIP - returns the sockFd from structure, s. */ + +unsigned int +wrapsock_getClientIP (clientInfo *c) +{ +#if 0 + printf("client ip = %s\n", inet_ntoa (c->sa.sin_addr.s_addr)); +#endif + return c->sa.sin_addr.s_addr; +} + +/* getPushBackChar - returns TRUE if a pushed back character is + available. */ + +unsigned int +wrapsock_getPushBackChar (clientInfo *c, char *ch) +{ + if (c->hasChar > 0) + { + c->hasChar--; + *ch = c->pbChar[c->hasChar]; + return TRUE; + } + return FALSE; +} + +/* setPushBackChar - returns TRUE if it is able to push back a + character. */ + +unsigned int +wrapsock_setPushBackChar (clientInfo *c, char ch) +{ + if (c->hasChar == MAXPBBUF) + return FALSE; + c->pbChar[c->hasChar] = ch; + c->hasChar++; + return TRUE; +} + +/* getSizeOfClientInfo - returns the sizeof (opaque data type). */ + +unsigned int +wrapsock_getSizeOfClientInfo (void) +{ + return sizeof (clientInfo); +} + +#endif + +/* GNU Modula-2 link fodder. */ + +void +_M2_wrapsock_init (void) +{ +} + +void +_M2_wrapsock_fini (void) +{ +} diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2iso/m2rts.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2iso/m2rts.h 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,41 @@ +/* m2rts.h provides a C interface to M2RTS.mod. + +Copyright (C) 2019-2022 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. + +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 +. */ + + +typedef void (*proc_con) (int, char **, char **); +typedef void (*proc_dep) (void); + +extern "C" void M2RTS_RequestDependant (const char *modulename, const char *dependancy); +extern "C" void M2RTS_RegisterModule (const char *modulename, + proc_con init, proc_con fini, proc_dep dependencies); +extern "C" void _M2_M2RTS_init (void); + +extern "C" void M2RTS_ConstructModules (const char *, + int argc, char *argv[], char *envp[]); +extern "C" void M2RTS_Terminate (void); +extern "C" void M2RTS_DeconstructModules (void); + +extern "C" void M2RTS_Halt (const char *, int, const char *, const char *) __attribute__ ((noreturn)); diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2iso/ChanConsts.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2iso/ChanConsts.h 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,57 @@ +/* ChanConsts.h provides a C header file for ISO ChanConst.def. + +Copyright (C) 2009-2022 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. + +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 +. */ + +/* taken from ChanConsts.def */ + +typedef enum openResults { + opened, /* the open succeeded as requested. */ + wrongNameFormat, /* given name is in the wrong format for the implementation. + */ + wrongFlags, /* given flags include a value that does not apply to the device. + */ + tooManyOpen, /* this device cannot support any more open channels. */ + outOfChans, /* no more channels can be allocated. */ + wrongPermissions, /* file or directory permissions do not allow request. */ + noRoomOnDevice, /* storage limits on the device prevent the open. */ + noSuchFile, /* a needed file does not exist. */ + fileExists, /* a file of the given name already exists when a new one is + required. */ + wrongFileType, /* the file is of the wrong type to support the required + operations. */ + noTextOperations, /* text operations have been requested, but are not + supported. */ + noRawOperations, /* raw operations have been requested, but are not + supported. */ + noMixedOperations, + + /* text and raw operations have been requested, but they are not + supported in combination */ + alreadyOpen, + + /* the source/destination is already open for operations not + supported in combination with the requested operations */ + otherProblem /* open failed for some other reason. */ +} openResults; diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2iso/ErrnoCategory.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2iso/ErrnoCategory.cc 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,180 @@ +/* ErrnoCatogory.cc categorizes values of errno maps onto ChanConsts.h. + +Copyright (C) 2008-2022 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. + +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 "config.h" + +#include "ChanConsts.h" + +#if defined(HAVE_ERRNO_H) +#include "errno.h" +#endif + +#if defined(HAVE_SYS_ERRNO_H) +#include "sys/errno.h" +#endif + +#include "m2rts.h" + +#if !defined(FALSE) +#define FALSE (1 == 0) +#endif + +#if !defined(TRUE) +#define TRUE (1 == 1) +#endif + +/* IsErrnoHard - returns TRUE if the value of errno is associated + with a hard device error. */ + +extern "C" int +ErrnoCategory_IsErrnoHard (int e) +{ +#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H) + return ((e == EPERM) || (e == ENOENT) || (e == EIO) || (e == ENXIO) + || (e == EACCES) || (e == ENOTBLK) || (e == ENODEV) || (e == EINVAL) + || (e == ENFILE) || (e == EROFS) || (e == EMLINK)); +#else + return FALSE; +#endif +} + +/* IsErrnoSoft - returns TRUE if the value of errno is associated + with a soft device error. */ + +extern "C" int +ErrnoCategory_IsErrnoSoft (int e) +{ +#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H) + return ((e == ESRCH) || (e == EINTR) || (e == E2BIG) || (e == ENOEXEC) + || (e == EBADF) || (e == ECHILD) || (e == EAGAIN) || (e == ENOMEM) + || (e == EFAULT) || (e == EBUSY) || (e == EEXIST) || (e == EXDEV) + || (e == ENOTDIR) || (e == EISDIR) || (e == EMFILE) || (e == ENOTTY) + || (e == ETXTBSY) || (e == EFBIG) || (e == ENOSPC) || (e == EPIPE)); +#else + return FALSE; +#endif +} + +extern "C" int +ErrnoCategory_UnAvailable (int e) +{ +#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H) + return ((e == ENOENT) || (e == ESRCH) || (e == ENXIO) || (e == ECHILD) + || (e == ENOTBLK) || (e == ENODEV) || (e == ENOTDIR)); +#else + return FALSE; +#endif +} + +/* GetOpenResults - maps errno onto the ISO Modula-2 enumerated type, + OpenResults. */ + +extern "C" openResults +ErrnoCategory_GetOpenResults (int e) +{ + if (e == 0) + return opened; +#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H) + switch (e) + { + case EPERM: + return wrongPermissions; + break; + case ENOENT: + return noSuchFile; + break; + case ENXIO: + return noSuchFile; + break; + case EACCES: + return wrongPermissions; + break; + case ENOTBLK: + return wrongFileType; + break; + case EEXIST: + return fileExists; + break; + case ENODEV: + return noSuchFile; + break; + case ENOTDIR: + return wrongFileType; + break; + case EISDIR: + return wrongFileType; + break; + case EINVAL: + return wrongFlags; + break; + case ENFILE: + return tooManyOpen; + break; + case EMFILE: + return tooManyOpen; + break; + case ENOTTY: + return wrongFileType; + break; + case ENOSPC: + return noRoomOnDevice; + break; + case EROFS: + return wrongPermissions; + break; + + default: + return otherProblem; + } +#else + return otherProblem; +#endif +} + +/* GNU Modula-2 linking fodder. */ + +extern "C" void +_M2_ErrnoCategory_init (int, char *argv[], char *env[]) +{ +} + +extern "C" void +_M2_ErrnoCategory_fini (int, char *argv[], char *env[]) +{ +} + +extern "C" void +_M2_ErrnoCategory_dep (void) +{ +} + +struct _M2_ErrnoCategory_ctor { _M2_ErrnoCategory_ctor (); } _M2_ErrnoCategory_ctor; + +_M2_ErrnoCategory_ctor::_M2_ErrnoCategory_ctor (void) +{ + M2RTS_RegisterModule ("ErrnoCategory", _M2_ErrnoCategory_init, _M2_ErrnoCategory_fini, + _M2_ErrnoCategory_dep); +} diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2iso/Makefile.am --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2iso/Makefile.am 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,244 @@ +# Makefile for libm2iso. +# Copyright 2013-2022 Free Software Foundation, Inc. +# +# 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 +# . + +SUFFIXES = .c .mod .def .o .obj .lo .a .la + +ACLOCAL_AMFLAGS = -I . -I .. -I ../config + +VPATH = . @srcdir@ @srcdir@/../../gcc/m2/gm2-libs-iso + +# Multilib support. +MAKEOVERRIDES= + +version := $(shell $(CC) -dumpversion) + +# Directory in which the compiler finds libraries etc. +libsubdir = $(libdir)/gcc/$(target_alias)/$(version) +# Used to install the shared libgcc. +# was slibdir = @slibdir@ +slibdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)$(MULTISUBDIR) + +toolexeclibdir=@toolexeclibdir@ +toolexecdir=@toolexecdir@ +GM2_FOR_TARGET=@GM2_FOR_TARGET@ + +MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory) +MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory) + +MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi) +inst_libdir = $(libsubdir)$(MULTISUBDIR) +inst_slibdir = $(slibdir)$(MULTIOSSUBDIR) + +# 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)" \ + "GM2_SRC=$(GM2_SRC)" \ + "AR_FLAGS=$(AR_FLAGS)" \ + "CC_FOR_BUILD=$(CC_FOR_BUILD)" \ + "CC_FOR_TARGET=$(CC_FOR_TARGET)" \ + "GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \ + "CFLAGS=$(CFLAGS)" \ + "CXXFLAGS=$(CXXFLAGS)" \ + "CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \ + "CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \ + "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)" \ + "MULTISUBDIR=$(MULTISUBDIR)" \ + "MULTIOSDIR=$(MULTIOSDIR)" \ + "MULTIBUILDTOP=$(MULTIBUILDTOP)" \ + "MULTIFLAGS=$(MULTIFLAGS)" \ + "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_libgm2=$(TARGET_LIB_PATH_libgm2)" + +# Subdir rules rely on $(FLAGS_TO_PASS) +FLAGS_TO_PASS = $(AM_MAKEFLAGS) + + +if BUILD_ISOLIB +M2DEFS = ChanConsts.def CharClass.def \ + ClientSocket.def ComplexMath.def \ + ConvStringLong.def ConvStringReal.def \ + ConvTypes.def COROUTINES.def \ + ErrnoCategory.def EXCEPTIONS.def \ + GeneralUserExceptions.def IOChan.def \ + IOConsts.def IOLink.def \ + IOResult.def LongComplexMath.def \ + LongConv.def LongIO.def \ + LongMath.def LongStr.def \ + LongWholeIO.def LowLong.def \ + LowReal.def LowShort.def \ + M2EXCEPTION.def M2RTS.def \ + MemStream.def \ + Preemptive.def \ + Processes.def ProgramArgs.def \ + RandomNumber.def \ + RawIO.def RealConv.def \ + RealIO.def RealMath.def \ + RealStr.def RndFile.def \ + RTco.def \ + RTdata.def RTentity.def \ + RTfio.def RTgen.def \ + RTgenif.def RTio.def \ + Semaphores.def SeqFile.def \ + ServerSocket.def ShortComplexMath.def \ + ShortIO.def ShortWholeIO.def \ + SimpleCipher.def SIOResult.def \ + SLongIO.def SLongWholeIO.def \ + SRawIO.def SRealIO.def \ + SShortIO.def SShortWholeIO.def \ + StdChans.def STextIO.def \ + Storage.def StreamFile.def \ + StringChan.def Strings.def \ + SWholeIO.def SysClock.def \ + SYSTEM.def TermFile.def \ + TERMINATION.def TextIO.def \ + WholeConv.def WholeIO.def \ + WholeStr.def wrapsock.def \ + wraptime.def + +M2MODS = ChanConsts.mod CharClass.mod \ + ClientSocket.mod ComplexMath.mod \ + ConvStringLong.mod ConvStringReal.mod \ + ConvTypes.mod COROUTINES.mod \ + EXCEPTIONS.mod GeneralUserExceptions.mod \ + IOChan.mod IOConsts.mod \ + IOLink.mod IOResult.mod \ + LongComplexMath.mod LongConv.mod \ + LongIO.mod LongMath.mod \ + LongStr.mod LongWholeIO.mod \ + LowLong.mod LowReal.mod \ + LowShort.mod M2EXCEPTION.mod \ + M2RTS.mod MemStream.mod \ + Preemptive.mod \ + Processes.mod \ + ProgramArgs.mod RandomNumber.mod \ + RawIO.mod RealConv.mod \ + RealIO.mod RealMath.mod \ + RealStr.mod RndFile.mod \ + RTdata.mod RTentity.mod \ + RTfio.mod RTgenif.mod \ + RTgen.mod RTio.mod \ + Semaphores.mod SeqFile.mod \ + ServerSocket.mod ShortComplexMath.mod \ + ShortIO.mod ShortWholeIO.mod \ + SimpleCipher.mod SIOResult.mod \ + SLongIO.mod SLongWholeIO.mod \ + SRawIO.mod SRealIO.mod \ + SShortIO.mod SShortWholeIO.mod \ + StdChans.mod STextIO.mod \ + Storage.mod StreamFile.mod \ + StringChan.mod Strings.mod \ + SWholeIO.mod SysClock.mod \ + SYSTEM.mod TermFile.mod \ + TERMINATION.mod TextIO.mod \ + WholeConv.mod WholeIO.mod \ + WholeStr.mod + +toolexeclib_LTLIBRARIES = libm2iso.la +libm2iso_la_SOURCES = $(M2MODS) \ + ErrnoCategory.cc wrapsock.c \ + wraptime.c RTco.cc + +C_INCLUDES = -I.. -I$(toplevel_srcdir)/libiberty -I$(toplevel_srcdir)/include + +libm2isodir = libm2iso +libm2iso_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2iso_la_SOURCES))) +libm2iso_la_CFLAGS = $(C_INCLUDES) -I. -I.. -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -DBUILD_GM2_LIBS -I@srcdir@/../ -I../../../gcc -I$(GCC_DIR) -I$(GCC_DIR)/../include -I../../libgcc -I$(GCC_DIR)/../libgcc -I$(MULTIBUILDTOP)../../gcc/include +libm2iso_la_M2FLAGS = -I. -Ilibm2iso -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -fiso -fextended-opaque -fm2-g -g +libm2iso_la_LINK = $(LINK) -version-info $(libtool_VERSION) +CLEANFILES = SYSTEM.def +BUILT_SOURCES = SYSTEM.def + +M2LIBDIR = /m2/m2iso/ + +M2HEADER_FILES = m2rts.h + +SYSTEM.def: Makefile + bash $(GM2_SRC)/tools-src/makeSystem -fiso \ + $(GM2_SRC)/gm2-libs-iso/SYSTEM.def \ + $(GM2_SRC)/gm2-libs-iso/SYSTEM.mod \ + -I$(GM2_SRC)/gm2-libs-iso:$(GM2_SRC)/gm2-libs \ + "$(GM2_FOR_TARGET)" $@ + +## add these to the .mod.o rule when optimization is fixed $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) + +.mod.lo: + $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2iso_la_M2FLAGS) $< -o $@ + +.c.lo: + $(LIBTOOL) --tag=CC --mode=compile $(CC) -c $(CFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@ + +.cc.lo: + $(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@ + +install-data-local: force + mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) + $(INSTALL_DATA) .libs/libm2iso.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) + chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2iso.la + $(INSTALL_DATA) .libs/libm2iso.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) + chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)/libm2iso.a + $(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)/libm2iso.a + for i in $(M2DEFS) $(M2MODS) ; do \ + if [ -f $$i ] ; then \ + $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \ + elif [ -f @srcdir@/../../gcc/m2/gm2-libs-iso/$$i ] ; then \ + $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs-iso/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \ + else \ + echo "cannot find $$i" ; exit 1 ; \ + fi ; \ + chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \ + done + for i in $(M2HEADER_FILES) ; do \ + if [ -f @srcdir@/$$i ] ; then \ + $(INSTALL_DATA) @srcdir@/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \ + else \ + echo "cannot find $$i" ; exit 1 ; \ + fi ; \ + chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \ + done + +force: + +endif diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2iso/wraptime.c --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2iso/wraptime.c 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,408 @@ +/* wraptime.c provides access to time related system calls. + +Copyright (C) 2009-2022 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. + +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 "config.h" + +#if defined(HAVE_SYS_TYPES_H) +#include "sys/types.h" +#endif + +#if defined(HAVE_SYS_TIME_H) +#include "sys/time.h" +#endif + +#if defined(HAVE_TIME_H) +#include "time.h" +#endif + +#if defined(HAVE_MALLOC_H) +#include "malloc.h" +#endif + +#if defined(HAVE_LIMITS_H) +#include "limits.h" +#endif + +#if !defined(TRUE) +#define TRUE (1 == 1) +#endif + +#if !defined(FALSE) +#define FALSE (1 == 0) +#endif + +#if !defined(NULL) +#define NULL (void *)0 +#endif + +/* InitTimeval returns a newly created opaque type. */ + +#if defined(HAVE_TIMEVAL) && defined(HAVE_MALLOC_H) +struct timeval * +wraptime_InitTimeval (void) +{ + return (struct timeval *)malloc (sizeof (struct timeval)); +} +#else +void * +wraptime_InitTimeval (void) +{ + return NULL; +} +#endif + +/* KillTimeval deallocates the memory associated with an opaque type. */ + +struct timeval * +wraptime_KillTimeval (void *tv) +{ +#if defined(HAVE_MALLOC_H) + free (tv); +#endif + return NULL; +} + +/* InitTimezone returns a newly created opaque type. */ + +#if defined(HAVE_STRUCT_TIMEZONE) && defined(HAVE_MALLOC_H) +struct timezone * +wraptime_InitTimezone (void) +{ + return (struct timezone *)malloc (sizeof (struct timezone)); +} +#else +void * +wraptime_InitTimezone (void) +{ + return NULL; +} +#endif + +/* KillTimezone - deallocates the memory associated with an opaque + type. */ + +struct timezone * +wraptime_KillTimezone (struct timezone *tv) +{ +#if defined(HAVE_MALLOC_H) + free (tv); +#endif + return NULL; +} + +/* InitTM - returns a newly created opaque type. */ + +#if defined(HAVE_STRUCT_TM) && defined(HAVE_MALLOC_H) +struct tm * +wraptime_InitTM (void) +{ + return (struct tm *)malloc (sizeof (struct tm)); +} +#else +void * +wraptime_InitTM (void) +{ + return NULL; +} +#endif + +/* KillTM - deallocates the memory associated with an opaque type. */ + +struct tm * +wraptime_KillTM (struct tm *tv) +{ +#if defined(HAVE_MALLOC_H) + free (tv); +#endif + return NULL; +} + +/* gettimeofday - calls gettimeofday(2) with the same parameters, tv, + and, tz. It returns 0 on success. */ + +#if defined(HAVE_STRUCT_TIMEZONE) && defined(HAVE_GETTIMEOFDAY) +int +wraptime_gettimeofday (void *tv, struct timezone *tz) +{ + return gettimeofday (tv, tz); +} +#else +int +wraptime_gettimeofday (void *tv, void *tz) +{ + return -1; +} +#endif + +/* settimeofday - calls settimeofday(2) with the same parameters, tv, + and, tz. It returns 0 on success. */ + +#if defined(HAVE_STRUCT_TIMEZONE) && defined(HAVE_SETTIMEOFDAY) +int +wraptime_settimeofday (void *tv, struct timezone *tz) +{ + return settimeofday (tv, tz); +} +#else +int +wraptime_settimeofday (void *tv, void *tz) +{ + return -1; +} +#endif + +/* wraptime_GetFractions - returns the tv_usec field inside the + timeval structure. */ + +#if defined(HAVE_TIMEVAL) +unsigned int +wraptime_GetFractions (struct timeval *tv) +{ + return (unsigned int)tv->tv_usec; +} +#else +unsigned int +wraptime_GetFractions (void *tv) +{ + return (unsigned int)-1; +} +#endif + +/* localtime_r - returns the tm parameter, m, after it has been + assigned with appropriate contents determined by, tv. Notice that + this procedure function expects, timeval, as its first parameter + and not a time_t (as expected by the posix equivalent). */ + +#if defined(HAVE_TIMEVAL) +struct tm * +wraptime_localtime_r (struct timeval *tv, struct tm *m) +{ + return localtime_r (&tv->tv_sec, m); +} +#else +struct tm * +wraptime_localtime_r (void *tv, struct tm *m) +{ + return m; +} +#endif + +/* wraptime_GetYear - returns the year from the structure, m. */ + +#if defined(HAVE_STRUCT_TM) +unsigned int +wraptime_GetYear (struct tm *m) +{ + return m->tm_year; +} +#else +unsigned int +wraptime_GetYear (void *m) +{ + return (unsigned int)-1; +} +#endif + +/* wraptime_GetMonth - returns the month from the structure, m. */ + +#if defined(HAVE_STRUCT_TM) +unsigned int +wraptime_GetMonth (struct tm *m) +{ + return m->tm_mon; +} +#else +unsigned int +wraptime_GetMonth (void *m) +{ + return (unsigned int)-1; +} +#endif + +/* wraptime_GetDay - returns the day of the month from the structure, + m. */ + +#if defined(HAVE_STRUCT_TM) +unsigned int +wraptime_GetDay (struct tm *m) +{ + return m->tm_mday; +} +#else +unsigned int +wraptime_GetDay (void *m) +{ + return (unsigned int)-1; +} +#endif + +/* wraptime_GetHour - returns the hour of the day from the structure, + m. */ + +#if defined(HAVE_STRUCT_TM) +unsigned int +wraptime_GetHour (struct tm *m) +{ + return m->tm_hour; +} +#else +unsigned int +wraptime_GetHour (void *m) +{ + return (unsigned int)-1; +} +#endif + +/* wraptime_GetMinute - returns the minute within the hour from the + structure, m. */ + +#if defined(HAVE_STRUCT_TM) +unsigned int +wraptime_GetMinute (struct tm *m) +{ + return m->tm_min; +} +#else +unsigned int +wraptime_GetMinute (void *m) +{ + return (unsigned int)-1; +} +#endif + +/* wraptime_GetSecond - returns the seconds in the minute from the + structure, m. The return value will always be in the range 0..59. + A leap minute of value 60 will be truncated to 59. */ + +#if defined(HAVE_STRUCT_TM) +unsigned int +wraptime_GetSecond (struct tm *m) +{ + if (m->tm_sec == 60) + return 59; + else + return m->tm_sec; +} +#else +unsigned int +wraptime_GetSecond (void *m) +{ + return (unsigned int)-1; +} +#endif + +/* wraptime_GetSummerTime - returns true if summer time is in effect. */ + +#if defined(HAVE_STRUCT_TIMEZONE) +unsigned int +wraptime_GetSummerTime (struct timezone *tz) +{ + return tz->tz_dsttime != 0; +} +#else +unsigned int +wraptime_GetSummerTime (void *tz) +{ + return FALSE; +} +#endif + +/* wraptime_GetDST - returns the number of minutes west of GMT. */ + +#if defined(HAVE_STRUCT_TIMEZONE) +int +wraptime_GetDST (struct timezone *tz) +{ + return tz->tz_minuteswest; +} +#else +int +wraptime_GetDST (void *tz) +{ +#if defined(INT_MIN) + return INT_MIN; +#else + return (int)((unsigned int)-1); +#endif +} +#endif + +/* SetTimezone - set the timezone field inside timeval, tv. */ + +#if defined(HAVE_STRUCT_TIMEZONE) +void +wraptime_SetTimezone (struct timezone *tz, int zone, int minuteswest) +{ + tz->tz_dsttime = zone; + tz->tz_minuteswest = minuteswest; +} +#else +void +wraptime_SetTimezone (void *tz, int zone, int minuteswest) +{ +} +#endif + +/* SetTimeval - sets the fields in tm, t, with: second, minute, hour, + day, month, year, fractions. */ + +#if defined(HAVE_TIMEVAL) +void +wraptime_SetTimeval (struct tm *t, unsigned int second, unsigned int minute, + unsigned int hour, unsigned int day, unsigned int month, + unsigned int year, unsigned int yday, unsigned int wday, + unsigned int isdst) +{ + t->tm_sec = second; + t->tm_min = minute; + t->tm_hour = hour; + t->tm_mday = day; + t->tm_mon = month; + t->tm_year = year; + t->tm_yday = yday; + t->tm_wday = wday; + t->tm_isdst = isdst; +} +#else +void +wraptime_SetTimeval (void *t, unsigned int second, unsigned int minute, + unsigned int hour, unsigned int day, unsigned int month, + unsigned int year, unsigned int yday, unsigned int wday, + unsigned int isdst) +{ +} +#endif + +/* init - init/finish functions for the module */ + +void +_M2_wraptime_init () +{ +} +void +_M2_wraptime_fini () +{ +} diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2iso/RTco.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2iso/RTco.cc 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,468 @@ +/* RTco.c provides minimal access to thread primitives. + +Copyright (C) 2019-2022 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. + +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 "config.h" +#include +#include +#include +#include +#include + +// #define TRACEON + +#define POOL +#define SEM_POOL 10000 +#define THREAD_POOL 10000 + +#define _GTHREAD_USE_COND_INIT_FUNC +#include "gthr.h" + +/* Ensure that ANSI conform stdio is used. This needs to be set + before any system header file is included. */ +#if defined __MINGW32__ +#define _POSIX 1 +#define gm2_printf gnu_printf +#else +#define gm2_printf __printf__ +#endif + +#if !defined(TRUE) +#define TRUE (1 == 1) +#endif + +#if !defined(FALSE) +#define FALSE (1 == 0) +#endif + +#if defined(TRACEON) +#define tprintf printf +#else +/* sizeof is not evaluated. */ +#define tprintf (void)sizeof +#endif + +typedef struct threadCB_s +{ + void (*proc) (void); + int execution; + pthread_t p; + int tid; + unsigned int interruptLevel; +} threadCB; + + +typedef struct threadSem_s +{ + __gthread_mutex_t mutex; + __gthread_cond_t counter; + int waiting; + int sem_value; +} threadSem; + +static unsigned int nThreads = 0; +static threadCB *threadArray = NULL; +static unsigned int nSemaphores = 0; +static threadSem **semArray = NULL; + +/* These are used to lock the above module data structures. */ +static threadSem lock; +static int initialized = FALSE; + + +extern "C" int RTco_init (void); + + +extern "C" void +_M2_RTco_dep (void) +{ +} + +extern "C" void +_M2_RTco_init (int argc, char *argv[], char *envp[]) +{ +} + +extern "C" void +_M2_RTco_fini (int argc, char *argv[], char *envp[]) +{ +} + +static void +initSem (threadSem *sem, int value) +{ + __GTHREAD_COND_INIT_FUNCTION (&sem->counter); + __GTHREAD_MUTEX_INIT_FUNCTION (&sem->mutex); + sem->waiting = FALSE; + sem->sem_value = value; +} + +static void +waitSem (threadSem *sem) +{ + __gthread_mutex_lock (&sem->mutex); + if (sem->sem_value == 0) + { + sem->waiting = TRUE; + __gthread_cond_wait (&sem->counter, &sem->mutex); + sem->waiting = FALSE; + } + else + sem->sem_value--; + __gthread_mutex_unlock (&sem->mutex); +} + +static void +signalSem (threadSem *sem) +{ + __gthread_mutex_unlock (&sem->mutex); + if (sem->waiting) + __gthread_cond_signal (&sem->counter); + else + sem->sem_value++; + __gthread_mutex_unlock (&sem->mutex); +} + +void stop (void) {} + +extern "C" void +RTco_wait (int sid) +{ + RTco_init (); + tprintf ("wait %d\n", sid); + waitSem (semArray[sid]); +} + +extern "C" void +RTco_signal (int sid) +{ + RTco_init (); + tprintf ("signal %d\n", sid); + signalSem (semArray[sid]); +} + +static int +newSem (void) +{ +#if defined(POOL) + semArray[nSemaphores] + = (threadSem *)malloc (sizeof (threadSem)); + nSemaphores += 1; + if (nSemaphores == SEM_POOL) + M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, + "too many semaphores created"); +#else + threadSem *sem + = (threadSem *)malloc (sizeof (threadSem)); + + /* We need to be careful when using realloc as the lock (semaphore) + operators use the semaphore address. So we keep an array of pointer + to semaphores. */ + if (nSemaphores == 0) + { + semArray = (threadSem **)malloc (sizeof (sem)); + nSemaphores = 1; + } + else + { + nSemaphores += 1; + semArray = (threadSem **)realloc (semArray, + sizeof (sem) * nSemaphores); + } + semArray[nSemaphores - 1] = sem; +#endif + return nSemaphores - 1; +} + +static int +initSemaphore (int value) +{ + int sid = newSem (); + + initSem (semArray[sid], value); + tprintf ("%d = initSemaphore (%d)\n", sid, value); + return sid; +} + +extern "C" int +RTco_initSemaphore (int value) +{ + int sid; + + RTco_init (); + waitSem (&lock); + sid = initSemaphore (value); + signalSem (&lock); + return sid; +} + +/* signalThread signal the semaphore associated with thread tid. */ + +extern "C" void +RTco_signalThread (int tid) +{ + int sem; + RTco_init (); + tprintf ("signalThread %d\n", tid); + waitSem (&lock); + sem = threadArray[tid].execution; + signalSem (&lock); + RTco_signal (sem); +} + +/* waitThread wait on the semaphore associated with thread tid. */ + +extern "C" void +RTco_waitThread (int tid) +{ + RTco_init (); + tprintf ("waitThread %d\n", tid); + RTco_wait (threadArray[tid].execution); +} + +extern "C" int +currentThread (void) +{ + int tid; + + for (tid = 0; tid < nThreads; tid++) + if (pthread_self () == threadArray[tid].p) + return tid; + M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, + "failed to find currentThread"); +} + +extern "C" int +RTco_currentThread (void) +{ + int tid; + + RTco_init (); + waitSem (&lock); + tid = currentThread (); + tprintf ("currentThread %d\n", tid); + signalSem (&lock); + return tid; +} + +/* currentInterruptLevel returns the interrupt level of the current thread. */ + +extern "C" unsigned int +RTco_currentInterruptLevel (void) +{ + RTco_init (); + tprintf ("currentInterruptLevel %d\n", + threadArray[RTco_currentThread ()].interruptLevel); + return threadArray[RTco_currentThread ()].interruptLevel; +} + +/* turninterrupts returns the old interrupt level and assigns the + interrupt level to newLevel. */ + +extern "C" unsigned int +RTco_turnInterrupts (unsigned int newLevel) +{ + int tid = RTco_currentThread (); + unsigned int old = RTco_currentInterruptLevel (); + + tprintf ("turnInterrupts from %d to %d\n", old, newLevel); + waitSem (&lock); + threadArray[tid].interruptLevel = newLevel; + signalSem (&lock); + return old; +} + +static void +never (void) +{ + M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, + "the main thread should never call here"); +} + +static void * +execThread (void *t) +{ + threadCB *tp = (threadCB *)t; + + tprintf ("exec thread tid = %d function = 0x%p arg = 0x%p\n", tp->tid, + tp->proc, t); + RTco_waitThread ( + tp->tid); /* Forcing this thread to block, waiting to be scheduled. */ + tprintf (" exec thread [%d] function = 0x%p arg = 0x%p\n", tp->tid, + tp->proc, t); + tp->proc (); /* Now execute user procedure. */ +#if 0 + M2RTS_CoroutineException ( __FILE__, __LINE__, __COLUMN__, __FUNCTION__, "coroutine finishing"); +#endif + M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, "execThread should never finish"); + return NULL; +} + +static int +newThread (void) +{ +#if defined(POOL) + nThreads += 1; + if (nThreads == THREAD_POOL) + M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, "too many threads created"); + return nThreads - 1; +#else + if (nThreads == 0) + { + threadArray = (threadCB *)malloc (sizeof (threadCB)); + nThreads = 1; + } + else + { + nThreads += 1; + threadArray + = (threadCB *)realloc (threadArray, sizeof (threadCB) * nThreads); + } + return nThreads - 1; +#endif +} + +static int +initThread (void (*proc) (void), unsigned int stackSize, + unsigned int interrupt) +{ + int tid = newThread (); + pthread_attr_t attr; + int result; + + threadArray[tid].proc = proc; + threadArray[tid].tid = tid; + threadArray[tid].execution = initSemaphore (0); + threadArray[tid].interruptLevel = interrupt; + + /* set thread creation attributes. */ + result = pthread_attr_init (&attr); + if (result != 0) + M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, + "failed to create thread attribute"); + + if (stackSize > 0) + { + result = pthread_attr_setstacksize (&attr, stackSize); + if (result != 0) + M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, + "failed to set stack size attribute"); + } + + tprintf ("initThread [%d] function = 0x%p (arg = 0x%p)\n", tid, proc, + (void *)&threadArray[tid]); + result = pthread_create (&threadArray[tid].p, &attr, execThread, + (void *)&threadArray[tid]); + if (result != 0) + M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, "thread_create failed"); + tprintf (" created thread [%d] function = 0x%p 0x%p\n", tid, proc, + (void *)&threadArray[tid]); + return tid; +} + +extern "C" int +RTco_initThread (void (*proc) (void), unsigned int stackSize, + unsigned int interrupt) +{ + int tid; + + RTco_init (); + waitSem (&lock); + tid = initThread (proc, stackSize, interrupt); + signalSem (&lock); + return tid; +} + +/* transfer unlocks thread p2 and locks the current thread. p1 is + updated with the current thread id. */ + +extern "C" void +RTco_transfer (int *p1, int p2) +{ + int tid = currentThread (); + + if (!initialized) + M2RTS_Halt ( + __FILE__, __LINE__, __FUNCTION__, + "cannot transfer to a process before the process has been created"); + if (tid == p2) + { + /* error. */ + M2RTS_Halt (__FILE__, __LINE__, __FUNCTION__, + "attempting to transfer to ourself"); + } + else + { + *p1 = tid; + tprintf ("start, context switching from: %d to %d\n", tid, p2); + RTco_signalThread (p2); + RTco_waitThread (tid); + tprintf ("end, context back to %d\n", tid); + } +} + +extern "C" int +RTco_select (int p1, fd_set *p2, fd_set *p3, fd_set *p4, const timespec *p5) +{ + RTco_init (); + tprintf ("[%x] RTco.select (...)\n", pthread_self ()); + return pselect (p1, p2, p3, p4, p5, NULL); +} + +extern "C" int +RTco_init (void) +{ + if (! initialized) + { + int tid; + + tprintf ("RTco initialized\n"); + initSem (&lock, 0); + /* Create initial thread container. */ +#if defined(POOL) + threadArray = (threadCB *)malloc (sizeof (threadCB) * THREAD_POOL); + semArray = (threadSem **)malloc (sizeof (threadSem *) * SEM_POOL); +#endif + tid = newThread (); /* For the current initial thread. */ + threadArray[tid].tid = tid; + threadArray[tid].execution = initSemaphore (0); + threadArray[tid].p = pthread_self (); + threadArray[tid].interruptLevel = 0; + threadArray[tid].proc + = never; /* This shouldn't happen as we are already running. */ + initialized = TRUE; + tprintf ("RTco initialized completed\n"); + signalSem (&lock); + } + return 0; +} + +struct _M2_RTco_ctor { _M2_RTco_ctor (); } _M2_RTco_ctor; + +_M2_RTco_ctor::_M2_RTco_ctor (void) +{ + M2RTS_RegisterModule ("RTco", _M2_RTco_init, _M2_RTco_fini, + _M2_RTco_dep); +} From patchwork Tue Dec 6 14:47:26 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Gaius Mulley X-Patchwork-Id: 61574 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 32255383FD6B for ; Tue, 6 Dec 2022 14:48:03 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 32255383FD6B DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1670338083; bh=2G0WVJ8hmlqMrQffoECpybWbKht+OgHWWAIpkMv6FwI=; h=Subject:To:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=nbUJzZY2FuFnN8eF1oHiReX8c5JYA9fvboDKtZbZbabA1UBvpxJ6dXlEfps55MBj+ 3uZ2vKHkl0BYpZSQ4BEUzIoNyGK6rwAzgDlbmXTO749vt/yXqKq9fjE7e7wUxxlcBQ ox03FLkmYHasF8udc+ZVATsYQqT9jLMUHbAijfTA= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32a.google.com (mail-wm1-x32a.google.com [IPv6:2a00:1450:4864:20::32a]) by sourceware.org (Postfix) with ESMTPS id ABE9A3864A21 for ; Tue, 6 Dec 2022 14:47:30 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org ABE9A3864A21 Received: by mail-wm1-x32a.google.com with SMTP id ja4-20020a05600c556400b003cf6e77f89cso1227359wmb.0 for ; Tue, 06 Dec 2022 06:47:30 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=date:message-id:to:subject:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=2G0WVJ8hmlqMrQffoECpybWbKht+OgHWWAIpkMv6FwI=; b=kjCvKyCFm2f3eeXGfsm9t2aVgs/FMGYZ2T9Ncvt4XxW+aDIeAoJzgZuhRZuCY7Dkpq HjttghBmD5zD4zOl47yC4XXBK5h1YbUkhDRmUOdpw5OAFRxoIu111amVTTnvBhG7d3M9 JhESSUkSRa3C6LoLagJcxvPL3U4r3MxhN8YmDNZxXCgieF4RT4b02mxeOpPVV+nULVkk CocIiXPnwWQuwOiIaPBfWIeYxP/5JY3Av7en0PJcJNrVffoYLBpsLcNHkvhrdd/Pzj2a TBJ6cYZQ7DG5XEH1hRFhmCa9n2vhP02HH6aWgBOI3xpnZwXM2HoLahKUkf+iHeMAexzW D9Pw== X-Gm-Message-State: ANoB5pk6scG6DakgMuWaAdgX2rzKTa4k+fOw8bEissNzVXQ1yUgrO0E+ cIZ7FaMr0SGkW6gap0JLzMcMgXNUhUw= X-Google-Smtp-Source: AA0mqf5MkNVZMhSnaGAjPHEYKFxkvmmgUx0MT/AmAhJVVkYy2y8jJFcrUNFVmRJ2NvqaNWW3nLfXRA== X-Received: by 2002:a05:600c:4e50:b0:3d0:bda:f2c with SMTP id e16-20020a05600c4e5000b003d00bda0f2cmr50866734wmq.117.1670338049546; Tue, 06 Dec 2022 06:47:29 -0800 (PST) Received: from lancelot ([195.147.220.46]) by smtp.gmail.com with ESMTPSA id bq8-20020a5d5a08000000b002302dc43d77sm6852481wrb.115.2022.12.06.06.47.28 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Dec 2022 06:47:29 -0800 (PST) X-Google-Original-From: Gaius Mulley Received: from gaius by lancelot with local (Exim 4.94.2) (envelope-from ) id 1p2ZEE-004Qf1-Bo for gcc-patches@gcc.gnu.org; Tue, 06 Dec 2022 14:47:26 +0000 Subject: [PATCH v3 6/19] modula2 front end: libgm2/libm2min contents To: X-Mailer: mail (GNU Mailutils 3.10) Message-Id: Date: Tue, 06 Dec 2022 14:47:26 +0000 X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Gaius Mulley via Gcc-patches From: Gaius Mulley Reply-To: Gaius Mulley Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patch set consists of the makefiles, autoconf and a few C sources to build the libgm2/libm2min libraries. ------8<----------8<----------8<----------8<----------8<----------8<---- diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2min/Makefile.am --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2min/Makefile.am 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,147 @@ +# Makefile for libm2min. +# Copyright 2013-2022 Free Software Foundation, Inc. +# +# 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 +# . + +SUFFIXES = .c .mod .def .o .obj .lo .a .la + +ACLOCAL_AMFLAGS = -I . -I .. -I ../config + +VPATH = . @srcdir@/../../gcc/m2/gm2-libs-min + +# Multilib support. +MAKEOVERRIDES= + +version := $(shell $(CC) -dumpversion) + +# Directory in which the compiler finds libraries etc. +libsubdir = $(libdir)/gcc/$(target_alias)/$(version) +# Used to install the shared libgcc. +slibdir = @slibdir@ + +toolexeclibdir=@toolexeclibdir@ +toolexecdir=@toolexecdir@ +GM2_FOR_TARGET=@GM2_FOR_TARGET@ + +MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory) +MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory) + +MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi) +inst_libdir = $(libsubdir)$(MULTISUBDIR) +inst_slibdir = $(slibdir)$(MULTIOSSUBDIR) + + +# 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)" \ + "GM2_SRC=$(GM2_SRC)" \ + "AR_FLAGS=$(AR_FLAGS)" \ + "CC_FOR_BUILD=$(CC_FOR_BUILD)" \ + "CC_FOR_TARGET=$(CC_FOR_TARGET)" \ + "GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \ + "CFLAGS=$(CFLAGS)" \ + "CXXFLAGS=$(CXXFLAGS)" \ + "CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \ + "CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \ + "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)" \ + "MULTISUBDIR=$(MULTISUBDIR)" \ + "MULTIOSDIR=$(MULTIOSDIR)" \ + "MULTIBUILDTOP=$(MULTIBUILDTOP)" \ + "MULTIFLAGS=$(MULTIFLAGS)" \ + "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)" \ + "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_libgm2=$(TARGET_LIB_PATH_libgm2)" + +# Subdir rules rely on $(FLAGS_TO_PASS) +FLAGS_TO_PASS = $(AM_MAKEFLAGS) + +M2DEFS = libc.def M2RTS.def \ + SYSTEM.def + +M2MODS = M2RTS.mod SYSTEM.mod + +libm2mindir = libm2min +toolexeclib_LTLIBRARIES = libm2min.la +libm2min_la_SOURCES = $(M2MODS) libc.c +libm2min_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2min_la_SOURCES))) +libm2min_la_CFLAGS = -I. -I$(GM2_SRC)/gm2-libs-min -I$(GM2_SRC)/gm2-libs +libm2min_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs-min -I$(GM2_SRC)/gm2-libs -fno-exceptions \ + -fno-m2-plugin -fno-scaffold-dynamic -fno-scaffold-main +libm2min_la_LINK = $(LINK) -version-info $(libtool_VERSION) +BUILT_SOURCES = SYSTEM.def +CLEANFILES = SYSTEM.def + +M2LIBDIR = /m2/m2min/ + +.mod.lo: + $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2min_la_M2FLAGS) $< -o $@ + +libc.o: $(GM2_SRC)/gm2-libs-min/libc.c + + +SYSTEM.def: Makefile + echo "CC = $(CC_FOR_BUILD) CC_FOR_TARGET = $(CC_FOR_TARGET) GM2 = $(GM2) GM2_FOR_TARGET = $(GM2_FOR_TARGET) GM2_FOR_BUILD = $(GM2_FOR_BUILD)" + bash $(GM2_SRC)/tools-src/makeSystem -fpim \ + $(GM2_SRC)/gm2-libs-min/SYSTEM.def \ + $(GM2_SRC)/gm2-libs-min/SYSTEM.mod \ + -I$(GM2_SRC)/gm2-libs-min:$(GM2_SRC)/gm2-libs \ + "$(GM2_FOR_TARGET) -fno-exceptions" $@ + +install-data-local: force + mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) + $(INSTALL_DATA) .libs/libm2min.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) + chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2min.la + $(INSTALL_DATA) .libs/libm2min.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) + chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2min.a + $(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2min.a + for i in $(M2DEFS) $(M2MODS) ; do \ + if [ -f $$i ] ; then \ + $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \ + elif [ -f @srcdir@/../../gcc/m2/gm2-libs-min/$$i ] ; then \ + $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs-min/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \ + else \ + echo "cannot find $$i" ; exit 1 ; \ + fi ; \ + chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \ + done + +force: diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2min/libc.c --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2min/libc.c 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,43 @@ +/* libc.c provides minimal stubs for expected symbols used by the rts. + +Copyright (C) 2010-2022 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. + +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 + +#if defined(HAVE_STDLIB_H) +#include +#endif + +void abort (void) +{ + /* you should add your system dependant code here. */ + __builtin_unreachable (); +} + +void exit (int i) +{ + /* you should add your system dependant code here. */ + __builtin_unreachable (); +} From patchwork Tue Dec 6 14:47:26 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Gaius Mulley X-Patchwork-Id: 61573 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id C94523875B6C for ; Tue, 6 Dec 2022 14:48:02 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org C94523875B6C DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1670338082; bh=0pRlOEw0BmqNSg0WUJPZn8JmJ6vQM+JyC4pQgsV1aX8=; h=Subject:To:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=nrccmcI+ySiQu8JC+lvEPbmOQ/JU1Qrw4LN2SbqXb9T1ESU02eJ/P8E1hd8b3VEcr mlqAjHDWZT76fhoD/wai7AEH56XCalUS4Flk4G1CyUIWNXbMatiLE/RLiTR59AcARf 5oQodApvtD21+FCvlMutzgpoJQ4KPTq+tHuqCtXQ= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x336.google.com (mail-wm1-x336.google.com [IPv6:2a00:1450:4864:20::336]) by sourceware.org (Postfix) with ESMTPS id 223EE3846980 for ; Tue, 6 Dec 2022 14:47:30 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 223EE3846980 Received: by mail-wm1-x336.google.com with SMTP id v7so11367352wmn.0 for ; Tue, 06 Dec 2022 06:47:30 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=date:message-id:to:subject:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=0pRlOEw0BmqNSg0WUJPZn8JmJ6vQM+JyC4pQgsV1aX8=; b=Cl2gz9DIAxYeHEedaGZO2xPGko4j47gD/OEyPZ1IMmiNPKukHIAILZJPnYXkvgHncJ 8QaJjwgOGhmtpIjvhPuR1/mEeyZaQ0GEQLUpz6pWU7Ted/6pKAXvOVG0vJaR8UYUfHKp XHkwta4ms732tiEyd1TuFDqqnBEOoh2RqDkeJ2Sht3sbvsIjPLWTvo5qg33eCNMrVYz9 iXGKukqfDCrB/hFl/4q/nk+9b292Y96xE4YhfCUJQBsWM9MSIkMyddOLVFQ+DSz+HJ4k a6Qn4GjmiPk/VRAgRX8R8wO/dew5+umWp9cfqU8ywAIGXtQoZ05YpPhixHpuNz8QlQdS /06Q== X-Gm-Message-State: ANoB5pkdgnoktDu8EipPWT9IQeEpk022V/MOQGLIZZFvmbNeCrrxbrgV RcyrJMIcf4Rp7ZInWr118t0bUocVeLU= X-Google-Smtp-Source: AA0mqf7xURtWdNItSqKEYaPeoODXAKhC2mx7C8KPCxU0MZ5tz3CIpKZ1DU+Ad1gtYuwV7XL6kKCgKQ== X-Received: by 2002:a05:600c:554b:b0:3d0:88b4:9cda with SMTP id iz11-20020a05600c554b00b003d088b49cdamr13183045wmb.114.1670338048855; Tue, 06 Dec 2022 06:47:28 -0800 (PST) Received: from lancelot ([195.147.220.46]) by smtp.gmail.com with ESMTPSA id z16-20020a5d4d10000000b00241c712916fsm20788110wrt.0.2022.12.06.06.47.28 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Dec 2022 06:47:28 -0800 (PST) X-Google-Original-From: Gaius Mulley Received: from gaius by lancelot with local (Exim 4.94.2) (envelope-from ) id 1p2ZEE-004QfF-Gz for gcc-patches@gcc.gnu.org; Tue, 06 Dec 2022 14:47:26 +0000 Subject: [PATCH v3 7/19] modula2 front end: libgm2/libm2log contents To: X-Mailer: mail (GNU Mailutils 3.10) Message-Id: Date: Tue, 06 Dec 2022 14:47:26 +0000 X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Gaius Mulley via Gcc-patches From: Gaius Mulley Reply-To: Gaius Mulley Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patch set consists of the makefiles, autoconf sources necessary to build the various libgm2 libraries. The c/c++/h files are included in the patch set. The modula-2 sources are found in gcc/m2. ------8<----------8<----------8<----------8<----------8<----------8<---- diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2log/Break.c --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2log/Break.c 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,134 @@ +/* Break.c implements an interrupt handler for SIGINT. + +Copyright (C) 2004-2022 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. + +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 + +#if defined(HAVE_STDIO_H) +#include +#endif + +#if defined(HAVE_STDARG_H) +#include +#endif + +#if defined(HAVE_STDLIB_H) +#include +#endif + +#if defined(HAVE_MALLOC_H) +#include +#endif + +typedef void (*PROC) (void); + +#if defined(HAVE_SIGNAL_H) +#include + +struct plist +{ + PROC proc; + struct plist *next; +}; + +static struct plist *head = NULL; + +/* localHandler - dismisses the parameter, p, and invokes the GNU + Modula-2 handler. */ + +static void +localHandler (int p) +{ + if (head != NULL) + head->proc (); +} + +/* EnableBreak - enable the current break handler. */ + +void +Break_EnableBreak (void) +{ + signal (SIGINT, localHandler); +} + +/* DisableBreak - disable the current break handler (and all + installed handlers). */ + +void +Break_DisableBreak (void) +{ + signal (SIGINT, SIG_IGN); +} + +/* InstallBreak - installs a procedure, p, to be invoked when a + ctrl-c is caught. Any number of these procedures may be stacked. + Only the top procedure is run when ctrl-c is caught. */ + +void +Break_InstallBreak (PROC p) +{ + struct plist *q = (struct plist *)malloc (sizeof (struct plist)); + + if (q == NULL) + { + perror ("out of memory error in module Break"); + exit (1); + } + q->next = head; + head = q; + head->proc = p; +} + +/* UnInstallBreak - pops the break handler stack. */ + +void +Break_UnInstallBreak (void) +{ + struct plist *q = head; + + if (head != NULL) + { + head = head->next; + free (q); + } +} +#else +void +Break_EnableBreak (void) +{ +} +void +Break_DisableBreak (void) +{ +} +void +Break_InstallBreak (PROC *p) +{ +} +void +Break_UnInstallBreak (void) +{ +} +#endif diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2log/Makefile.am --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2log/Makefile.am 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,166 @@ +# Makefile for libm2log. +# Copyright 2013-2022 Free Software Foundation, Inc. +# +# 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 +# . + +SUFFIXES = .c .mod .def .o .obj .lo .a .la + +ACLOCAL_AMFLAGS = -I . -I .. -I ../config + +VPATH = . @srcdir@ @srcdir@/../../gcc/m2/gm2-libs-pim + +# Multilib support. +MAKEOVERRIDES= + +version := $(shell $(CC) -dumpversion) + +# Directory in which the compiler finds libraries etc. +libsubdir = $(libdir)/gcc/$(target_alias)/$(version) +# Used to install the shared libgcc. +slibdir = @slibdir@ + +toolexeclibdir=@toolexeclibdir@ +toolexecdir=@toolexecdir@ +GM2_FOR_TARGET=@GM2_FOR_TARGET@ + +MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory) +MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory) + +MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi) +inst_libdir = $(libsubdir)$(MULTISUBDIR) +inst_slibdir = $(slibdir)$(MULTIOSSUBDIR) + + +# 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)" \ + "GM2_SRC=$(GM2_SRC)" \ + "AR_FLAGS=$(AR_FLAGS)" \ + "CC_FOR_BUILD=$(CC_FOR_BUILD)" \ + "CC_FOR_TARGET=$(CC_FOR_TARGET)" \ + "GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \ + "CFLAGS=$(CFLAGS)" \ + "CXXFLAGS=$(CXXFLAGS)" \ + "CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \ + "CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \ + "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)" \ + "MULTISUBDIR=$(MULTISUBDIR)" \ + "MULTIOSDIR=$(MULTIOSDIR)" \ + "MULTIBUILDTOP=$(MULTIBUILDTOP)" \ + "MULTIFLAGS=$(MULTIFLAGS)" \ + "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_libgm2=$(TARGET_LIB_PATH_libgm2)" + +# Subdir rules rely on $(FLAGS_TO_PASS) +FLAGS_TO_PASS = $(AM_MAKEFLAGS) + + +if BUILD_LOGLIB +M2DEFS = BitBlockOps.def BitByteOps.def \ + BitWordOps.def BlockOps.def \ + Break.def CardinalIO.def \ + Conversions.def DebugPMD.def \ + DebugTrace.def Delay.def \ + Display.def ErrorCode.def \ + FileSystem.def FloatingUtilities.def \ + InOut.def Keyboard.def \ + LongIO.def NumberConversion.def \ + Random.def RealConversions.def \ + RealInOut.def Strings.def \ + Termbase.def Terminal.def \ + TimeDate.def + +M2MODS = BitBlockOps.mod BitByteOps.mod \ + BitWordOps.mod BlockOps.mod \ + CardinalIO.mod Conversions.mod \ + DebugPMD.mod DebugTrace.mod \ + Delay.mod Display.mod \ + ErrorCode.mod FileSystem.mod \ + FloatingUtilities.mod InOut.mod \ + Keyboard.mod LongIO.mod \ + NumberConversion.mod Random.mod \ + RealConversions.mod RealInOut.mod \ + Strings.mod Termbase.mod \ + Terminal.mod TimeDate.mod + + +libm2logdir = libm2log +toolexeclib_LTLIBRARIES = libm2log.la +libm2log_la_SOURCES = $(M2MODS) Break.c + +libm2log_la_DEPENDENCIES = ../libm2pim/SYSTEM.def $(addsuffix .lo, $(basename $(libm2log_la_SOURCES))) +libm2log_la_CFLAGS = -I. -DBUILD_GM2_LIBS -I@srcdir@/../ +libm2log_la_M2FLAGS = -I../libm2pim -I$(GM2_SRC)/gm2-libs-pim -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso +libm2log_la_LINK = $(LINK) -version-info $(libtool_VERSION) +BUILT_SOURCES = ../libm2pim/SYSTEM.def + +M2LIBDIR = /m2/m2log/ + +../libm2pim/SYSTEM.def: ../libm2pim/Makefile + cd ../libm2pim ; $(MAKE) $(AM_MAKEFLAGS) SYSTEM.def + +.mod.lo: + $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2log_la_M2FLAGS) $< -o $@ + +install-data-local: force + mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) + $(INSTALL_DATA) .libs/libm2log.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) + chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2log.la + $(INSTALL_DATA) .libs/libm2log.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) + chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2log.a + $(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2log.a + for i in $(M2DEFS) $(M2MODS) ; do \ + if [ -f $$i ] ; then \ + $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \ + elif [ -f @srcdir@/../../gcc/m2/gm2-libs-pim/$$i ] ; then \ + $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs-pim/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \ + else \ + echo "cannot find $$i" ; exit 1 ; \ + fi ; \ + chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \ + done + +force: + +endif From patchwork Tue Dec 6 14:47:26 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Gaius Mulley X-Patchwork-Id: 61579 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id BA9223877227 for ; Tue, 6 Dec 2022 14:49:36 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org BA9223877227 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1670338176; bh=cAiY5Q9YndNSkw24ptYX6D3Mw55yRzmsAh0E7cddNRo=; h=Subject:To:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=NBqo8/fIr4iaZ/laAV8MPnYQde4d7+ULx2lwZAckfiwtJfq3oFUw2kJgcQYpOCVY9 +khDLxWW5mFinIOU1lYqlDvSOHDtUbohPmRFoko+7EYkVNvWD6LH5d3pPOT7OA+B0+ iWOnBgJa8IxN0UrzzObDi0BPUwK8yfEA6W+7PeG8= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x436.google.com (mail-wr1-x436.google.com [IPv6:2a00:1450:4864:20::436]) by sourceware.org (Postfix) with ESMTPS id 1AA6D3864A32 for ; Tue, 6 Dec 2022 14:47:31 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 1AA6D3864A32 Received: by mail-wr1-x436.google.com with SMTP id h12so23746636wrv.10 for ; Tue, 06 Dec 2022 06:47:31 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=date:message-id:to:subject:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=cAiY5Q9YndNSkw24ptYX6D3Mw55yRzmsAh0E7cddNRo=; b=e1VQco6vY0otkOmIKJ4AfhllN0pNV2LxN7tTRFSLkkb0ryi7T+IC8P+dZ8bjE1rG6E vHg465TeoiEEbL7c7SkW2UwQ/gp3ATTsELz39h8z//1SNYsJT79HJBZAKZqiOoUZHCDR xoJBAYyPm8FpMFkC0DRfA5GYZ1OdwcIbVNY1bARxgACYGW16kkpD/iXaM5dXT4CCHRGL xGeXWs7AYMgvD55siYG0FqlfnvJRJblzTp1Z9c8dHvQOMyIxCYsSjamUPlQeY/sjk0A1 2AXoMnK/0Q6UYcaDb5lrFDtHcSMipGY9pMU5uhj8JH8J2mLoLMnHXT6jce/St+kPmi0H fDIg== X-Gm-Message-State: ANoB5pkYOAnoiDOwLtv2ori1/j23EjBOW31OXNnMHlLFQn0Rz4sWMGnV fu+Ico6UU8Rho1FsliIFwUETgV5Kybs= X-Google-Smtp-Source: AA0mqf5q395xt55jKBjpj+9FT8508VrhI9Rs9GmQbLF3fIz8W7lZXf6T3NLLMpKhx5Lc/g/BilZh6g== X-Received: by 2002:adf:bb0b:0:b0:242:61ab:5976 with SMTP id r11-20020adfbb0b000000b0024261ab5976mr6151559wrg.257.1670338049375; Tue, 06 Dec 2022 06:47:29 -0800 (PST) Received: from lancelot ([195.147.220.46]) by smtp.gmail.com with ESMTPSA id dn13-20020a05600c654d00b003c6bd12ac27sm21122793wmb.37.2022.12.06.06.47.28 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Dec 2022 06:47:29 -0800 (PST) X-Google-Original-From: Gaius Mulley Received: from gaius by lancelot with local (Exim 4.94.2) (envelope-from ) id 1p2ZEE-004QfW-Mo for gcc-patches@gcc.gnu.org; Tue, 06 Dec 2022 14:47:26 +0000 Subject: [PATCH v3 8/19] modula2 front end: libgm2 contents To: X-Mailer: mail (GNU Mailutils 3.10) Message-Id: Date: Tue, 06 Dec 2022 14:47:26 +0000 X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Gaius Mulley via Gcc-patches From: Gaius Mulley Reply-To: Gaius Mulley Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patch set consists of the libgm2 makefile, autoconf sources necessary to build the libm2pim, libm2iso, libm2min, libm2cor and libm2log. ------8<----------8<----------8<----------8<----------8<----------8<---- diff -ruw /dev/null gcc-git-devel-modula2/libgm2/ChangeLog --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/ChangeLog 2022-12-06 02:56:51.428775868 +0000 @@ -0,0 +1,506 @@ +2022-05-18 Gaius Mulley + + * Corrected dates on all source files. + * libm2pim/Selective.c: Reformatted comments. + * libm2pim/SysExceptions.c: Reformatted comments. + * libm2pim/dtoa.c: Reformatted comments. + * libm2pim/ldtoa.c: Reformatted comments. + * libm2pim/sckt.c: Reformatted comments. + * libm2pim/termios.c: Reformatted comments. + * libm2pim/wrapc.c: Reformatted comments. + * libm2pim/termios.c: Reformatted comments within enum. + * libm2pim/Selective.c: Correct spelling. + * libm2pim/termios.c: Use GNU comment formatting. + +2022-05-17 Gaius Mulley + + * Corrected dates on all source files. + +2022-03-02 Gaius Mulley + + * libm2pim/sckt.c (tcpServerEstablishPort): Corrected spelling. + (tcpServerEstablish) Corrected spelling. + +2021-06-27 Gaius Mulley + + * Makefile.am: renamed getopt.c to cgetopt.c. + +2021-05-29 Gaius Mulley + + * Makefile.in: (rebuilt). + * aclocal.m4: (rebuilt). + * configure: (rebuilt). + * configure.ac: tidied up messages. Removed android + from the list of supported hosts. Corrected a comment + * libm2pim/Makefile.am: Conditionally build. + * libm2cor/Makefile.am: Conditionally build. + * libm2log/Makefile.am: Conditionally build. + * libm2iso/Makefile.am: Conditionally build. + * libm2cor/Makefile.in: (Rebuilt). + * libm2iso/Makefile.in: (Rebuilt). + * libm2log/Makefile.in: (Rebuilt). + * libm2min/Makefile.in: (Rebuilt). + * libm2pim/Makefile.in: (Rebuilt). + +2021-05-28 Gaius Mulley + + * Makefile.in: (Rebuilt). + * aclocal.m4: (Rebuilt). + * configure: (Rebuilt). + * configure.ac: Introduce checks for supported host + operating system and also known detect target architectures + which are currently restricted to minimal runtime libraries. + * libm2cor/Makefile.in: (Rebuilt). + * libm2iso/Makefile.in: (Rebuilt). + * libm2log/Makefile.in: (Rebuilt). + * libm2min/Makefile.in: (Rebuilt). + * libm2pim/Makefile.in: (Rebuilt). + +2021-02-12 Gaius Mulley + + * libm2iso/RTco.c: (threadSem) new declaration + and implmentation of thread semaphores used internally by + the m2 runtime system. + +2021-01-13 Gaius Mulley + + * Makefile.am: Updated dates. + * aclocal.m4: (Rebuilt). + * autogen.sh: Updated dates. + * configure: (Rebuilt). + * configure.ac: Updated dates. + * libm2cor/KeyBoardLEDs.c: Updated dates. + * libm2cor/Makefile.am: Updated dates. + * libm2iso/ChanConsts.h: Updated dates. + * libm2iso/ErrnoCategory.c: Updated dates. + * libm2iso/Makefile.am: Updated dates. + * libm2iso/RTco.c: Updated dates. + * libm2iso/wrapsock.c: Updated dates. + * libm2iso/wraptime.c: Updated dates. + * libm2log/Break.c: Updated dates. + * libm2log/Makefile.am: Updated dates. + * libm2min/Makefile.am: Updated dates. + * libm2min/libc.c: Updated dates. + * libm2pim/Makefile.am: Updated dates. + * libm2pim/Selective.c: Updated dates. + * libm2pim/SysExceptions.c: Updated dates. + * libm2pim/UnixArgs.c: Updated dates. + * libm2pim/dtoa.c: Updated dates. + * libm2pim/errno.c: Updated dates. + * libm2pim/getopt.c: Updated dates. + * libm2pim/ldtoa.c: Updated dates. + * libm2pim/sckt.c: Updated dates. + * libm2pim/target.c: Updated dates. + * libm2pim/termios.c: Updated dates. + * libm2pim/wrapc.c: Updated dates. + +2020-11-20 Gaius Mulley + + * Makefile.in: (Rebuilt). + * aclocal.m4: (Rebuilt). + * configure: (Rebuilt). + * configure.ac: (libtool_VERSION=17.0.0) + +2020-06-18 Gaius Mulley + + * Makefile.in: (Rebuilt). + * aclocal.m4: (Rebuilt). + * autogen.sh: Execute automake including dependencies. + * configure: (Rebuilt). + * libm2cor/Makefile.in: (Rebuilt). + * libm2iso/Makefile.in: (Rebuilt). + * libm2log/Makefile.am: SYSTEM.def is a dependency using + BUILT_SOURCES. + * libm2log/Makefile.in: (Rebuilt). + * libm2min/Makefile.in: (Rebuilt). + * libm2pim/Makefile.in: (Rebuilt). + +2020-06-15 Gaius Mulley + + * libm2pim/Makefile.am: Added SYSTEM.def as a dependency. + * libm2log/Makefile.am: Added SYSTEM.def as a dependency. + +2020-06-11 Matthias Klose + + * Makefile.am: Reordered libraries. + * Makefile.in: (Rebuilt). + * libm2pim/Makefile.am: (libm2pim_la_LIBADD) Added + definition. + * libm2pim/Makefile.in: (Rebuilt). + +2020-05-01 Gaius Mulley + + * libm2cor/KeyBoardLEDs.c: Include sys/ioctl.h + and stdio.h to fix implicit declarations of ioctl and + perror. + * libm2iso/RTco.c: Include . + * libm2pim/SysExceptions.c: (HAVE_STDIO_H) Checked + and stdio.h included to fix perror implicit declaration. + +2020-04-29 Gaius Mulley + + * libm2pim/wrapc.c: (HAVE_SYS_TYPES_H) checked to include + sys/types.h. (HAVE_TIME_H) checked to include time.h. + Fixes missing prototype errors. (HAVE_UNISTD_H) checked + to include unistd.h to fix getuid missing prototype. + +2020-01-08 Gaius Mulley + + * libm2min/libc.c: (exit) noreturn added. + (abort) noreturn added. + +2019-12-10 Matthias Klose + + * libm2cor/Makefile.am: (libsubdir) Corrected using + target_alias. + * libm2iso/Makefile.am: (libsubdir) Corrected using + target_alias. + * libm2log/Makefile.am: (libsubdir) Corrected using + target_alias. + * libm2min/Makefile.am: (libsubdir) Corrected using + target_alias. + * libm2pim/Makefile.am: (libsubdir) Corrected using + target_alias. + * libm2cor/Makefile.in: Regenerated. + * libm2iso/Makefile.in: Regenerated. + * libm2log/Makefile.in: Regenerated. + * libm2min/Makefile.in: Regenerated. + * libm2pim/Makefile.in: Regenerated. + +2019-12-10 Gaius Mulley + + * libm2iso/RTco.c: Corrected include files + for target building. + +2019-12-09 Gaius Mulley + + * configure.ac: Remove reference to config dir. + (ACX_NONCANONICAL_TARGET) Removed. + * libm2cor/Makefile.in: Regenerated. + * libm2iso/Makefile.in: Regenerated. + * libm2log/Makefile.in: Regenerated. + * libm2min/Makefile.in: Regenerated. + * libm2pim/Makefile.in: Regenerated. + * configure.ac: (LT_INIT) Used instead of AM_PROG_LIBTOOL. + * libm2cor/Makefile.in: Regenerated. + * libm2iso/Makefile.in: Regenerated. + * libm2log/Makefile.in: Regenerated. + * libm2min/Makefile.in: Regenerated. + * libm2pim/Makefile.in: Regenerated. + +2019-12-04 Matthias Klose + + * Makefile.in: Regenerated. + * aclocal.m4: Regenerated from automake-1.15.1. + * libm2cor/Makefile.am: Added -version-info. + * libm2cor/Makefile.in: Regenerated. + * libm2iso/Makefile.am: Added -version-info. + * libm2iso/Makefile.in: Regenerated. + * libm2log/Makefile.am: Added -version-info. + * libm2log/Makefile.in: Regenerated. + * libm2min/Makefile.am: Added -version-info. + * libm2min/Makefile.in: Regenerated. + * libm2pim/Makefile.am: Added -version-info. + * libm2pim/Makefile.in: Regenerated. + +2019-12-03 Gaius Mulley + + * libm2min/Makefile.am: (M2LIBDIR) Corrected + destination directory to m2/m2min. + +2019-11-19 Gaius Mulley + + * multilib fixes + * Makefile.am: (MULTIBUILDTOP) propagate. + * Makefile.in: (Regenerated). + * configure: (Regenerated). + * configure.ac: (ACX_NONCANONICAL_TARGET) Removed. + * libm2cor/Makefile.am: (MULTIBUILDTOP) Propagate. + * libm2cor/Makefile.in: (Regenerated). + * libm2iso/Makefile.am: (MULTIBUILDTOP) Propagate. + * libm2iso/Makefile.in: (Regenerated). + * libm2log/Makefile.am: (MULTIBUILDTOP) Propagate. + * libm2log/Makefile.in: (Regenerated). + * libm2min/Makefile.am: (MULTIBUILDTOP) Propagate. + * libm2min/Makefile.in: (Regenerated). + * libm2pim/Makefile.am: (MULTIBUILDTOP) Propagate. + * libm2pim/Makefile.in: (Regenerated). + +2019-11-18 Gaius Mulley + + * configure: (Regenerated). + * configure.ac: (libtool_VERSION=15.0.0). + Place AM_ENABLE_MULTILIB above GCC_NO_EXECUTABLES. + +2019-11-13 Gaius Mulley + + * libm2pim/Selective.c: Changed to GPL3+ and fixed + formatting. + * libm2pim/SysExceptions.c: Changed to GPL3+ and fixed + formatting. + * libm2pim/UnixArgs.c: Changed to GPL3+ and fixed + formatting. + * libm2pim/dtoa.c: Changed to GPL3+ and fixed + formatting. + * libm2pim/errno.c: Changed to GPL3+ and fixed + formatting. + * libm2pim/getopt.c: Changed to GPL3+ and fixed + formatting. + * libm2pim/ldtoa.c: Changed to GPL3+ and fixed + formatting. + * libm2pim/sckt.c: Changed to GPL3+ and fixed + formatting. + * libm2pim/target.c: Changed to GPL3+ and fixed + formatting. + * libm2pim/termios.c: Changed to GPL3+ and fixed + formatting. + * libm2pim/wrapc.c: Changed to GPL3+ and fixed + formatting. + +2019-11-12 Gaius Mulley + + * libm2cor/KeyBoardLEDs.c: GPLv3 and reformatted. + * libm2iso/ChanConsts.h: GPLv3 and reformatted. + * libm2iso/ErrnoCategory.c: GPLv3 and reformatted. + * libm2iso/RTco.c: GPLv3 and reformatted. + * libm2iso/wrapsock.c: GPLv3 and reformatted. + * libm2iso/wraptime.c: GPLv3 and reformatted. + * libm2cor/Makefile.am: GPLv3. + * libm2iso/Makefile.am: GPLv3. + * libm2log/Makefile.am: GPLv3. + * libm2min/Makefile.am: GPLv3. + * libm2pim/Makefile.am: GPLv3. + * libm2log/Break.c: GPLv3 and reformatted. + * libm2min/libc.c: GPLv3 and reformatted. + +2019-11-04 Gaius Mulley + + * libcor/Makefile.am: (MULTIOSSUBDIR) quote test. + * libiso/Makefile.am: (MULTIOSSUBDIR) quote test. + * libpim/Makefile.am: (MULTIOSSUBDIR) quote test. + * liblog/Makefile.am: (MULTIOSSUBDIR) quote test. + * libmin/Makefile.am: (MULTIOSSUBDIR) quote test. + * libulm/Makefile.am: (MULTIOSSUBDIR) quote test. + * libpth/Makefile.am: (MULTIOSSUBDIR) quote test. + * libcor/Makefile.in: Regenerated. + * libiso/Makefile.in: Regenerated. + * libpim/Makefile.in: Regenerated. + * liblog/Makefile.in: Regenerated. + * libmin/Makefile.in: Regenerated. + * libulm/Makefile.in: Regenerated. + * libpth/Makefile.in: Regenerated. + +2019-10-25 Gaius Mulley + + * libcor/Makefile.am: Added -fm2-g -g. + * libiso/Makefile.am: Added -fm2-g -g and include + path to include ../ + * libiso/RTco.c: Call HALT if the thread fails to + find itself. Place initialized inside critical region. + * libpim/Makefile.am: Added -fm2-g -g. + +2019-09-27 Gaius Mulley + + * libulm: Removed. + * Makefile.am: Removed Ulm libaraies. + * configure.ac: Removed Ulm libaraies. + +2019-08-01 Gaius Mulley + + * libpim/Makefile.am: (M2MODS) added GetOpt.mod + and OptLib.mod. (M2DEFS) added GetOpt.def, + OptLib.def and getopt.def. (libgm2_la_SOURCES) + added wrapc.c and getopt.c. + +2019-07-10 Gaius Mulley + + * libpth/Makefile.am: Use $(MAKE) rather than make. + * libcor/KeyBoardLEDs.c: Reformatted to GNU coding + standards. Also added/corrected empty functions for non + linux targets. Fixed the GPL comment. + +2019-07-09 Rainer Orth + + * Makefile.am: (multilib.am) Included. + +2019-04-03 Gaius Mulley + + * Makefile.in: Regenerated. + * aclocal.m4: Regenerated. + * autogen.sh: Removed version numbers. + * config/libtool.m4: New version of the file + taken from libgo/config. + * configure: Regenerated. + * configure.ac: Updated version numbers. + * libcor/Makefile.in: Regenerated. + * libiso/Makefile.in: Regenerated. + * liblog/Makefile.in: Regenerated. + * libmin/Makefile.in: Regenerated. + * libpim/Makefile.in: Regenerated. + * libulm/Makefile.in: Regenerated. + +2019-03-29 Gaius Mulley + + * configure: Regenerated. + * configure.ac: Implement --enable-libpth-m2 + * libpth/Makefile.am: Pass FLAGS_TO_PASS to make. + move install rules into pth subdirectory. + * libpth/pth/Makefile.am: Added install rules. + +2018-11-27 Gaius Mulley + + * libpim/wrapc.c: Reformatted according to GNU + coding standards. Also defended against macro omissions. + * libiso/wraptime.c: Fixed function declaration + and erroneous return value. + +2018-04-16 Gaius Mulley + + * Makefile.am: Specify the libtool location. + * Makefile.in: Regenerated. + * aclocal.m4: Regenerated. + * autogen.sh: Corrected script to regenerate + using the correct macros and versions of autoconf tools. + * configure: Regenerated. + * configure.ac: Regenerated. + * libcor/Makefile.in: Regenerated. + * libiso/Makefile.in: Regenerated. + * liblog/Makefile.in: Regenerated. + * libmin/Makefile.in: Regenerated. + * libpim/Makefile.in: Regenerated. + * libulm/Makefile.in: Regenerated. + +2018-04-14 Gaius Mulley + + * Makefile.am: Changed to reference the config directory. + * Makefile.in: Regenerated. + * aclocal.m4: Regenerated. + * autogen.sh: Added new script. + * config.h.in: Regenerated. + * configure: Regenerated. + * configure.ac: Minor corrections. + * libcor/Makefile.am: Use $(LIBTOOL). + * libcor/Makefile.in: Regenerated. + * libiso/Makefile.am: Use $(LIBTOOL). + * libiso/Makefile.in: Regenerated. + * liblog/Makefile.am: Use $(LIBTOOL). + * liblog/Makefile.in: Regenerated. + * libmin/Makefile.am: Use $(LIBTOOL). + * libmin/Makefile.in: Regenerated. + * libpim/Makefile.am: Use $(LIBTOOL). + * libpim/Makefile.in: Regenerated. + * libulm/Makefile.am: Use $(LIBTOOL). + * libulm/Makefile.in: Regenerated. + +2018-04-10 Gaius Mulley + + * configure.ac: Added test to AM_ENABLE_MULTILIB. + * Makefile.in: Regenerated. + * aclocal.m4: Regenerated. + * autogen.sh: Updated. + * config.h.in: Regenerated. + * configure: Regenerated. + * libcor/Makefile.in: Regenerated. + * libiso/Makefile.in: Regenerated. + * liblog/Makefile.in: Regenerated. + * libmin/Makefile.am: Added -fno-m2-plugin + * libmin/Makefile.in: Regenerated. + * libpim/Makefile.in: Regenerated. + * libulm/Makefile.in: Regenerated. + +2017-12-27 Gaius Mulley + + * libpim/wrapc.c: (wrapc_isfinite) New function. + +2016-06-09 Gaius Mulley + + * libpim/dtoa.c: Use memmove instead of memcpy. + +2016-03-14 Gaius Mulley + + * libpim/wrapc.c: Corrected spacing. + +2014-12-24 Gaius Mulley + + * sckt.c: Added conditional import of + stdio.h as reported by Christoph Schlegel. + +2014-12-23 Gaius Mulley + + * libulm/Makefile.am: Added pim libs to the + path on the createUlmSys command. + +2014-12-22 Gaius Mulley + + * libulm/Makefile.am: Added rule to build + SYSTEM.def as a built source. + +2014-12-06 Gaius Mulley + + * libcor/Makefile.in: Add .la to list of SUFFIXES. + install .la archive. + * libcor/Makefile.am: Install .la archive. + * libiso/Makefile.in: Install .la archive. + * libiso/Makefile.am: Install .la archive. + * liblog/Makefile.am: Install .la archive. + * liblog/Makefile.in: Install .la archive. + * libmin/Makefile.am: Install .la archive. + * libmin/Makefile.in: Install .la archive. + * libpim/Makefile.am: Install .la archive. + * libpim/Makefile.in: Install .la archive. + * libulm/Makefile.am: Install .la archive. + * libulm/Makefile.in: Install .la archive. + +2014-12-05 Gaius Mulley + + * libmin/Makefile.am: Add .la to the list of SUFFIXES. + * libulm/Makefile.am: Add .la to the list of SUFFIXES. + * libpim/Makefile.am: Add .la to the list of SUFFIXES. + * libcor/Makefile.am: Add .la to the list of SUFFIXES. + * liblog/Makefile.am: Add .la to the list of SUFFIXES. + * libiso/Makefile.am: Add .la to the list of SUFFIXES. + +2014-07-11 Gaius Mulley + + * complete rewrite and restructuring of libgm2. + * gcc-versionno/libgm2/aclocal.m4: (Rebuilt) + * gcc-versionno/libgm2/autogen.sh: (Rebuilt) + * gcc-versionno/libgm2/config.h.in: (New file) + * gcc-versionno/libgm2/configure: (Rebuilt) + * gcc-versionno/libgm2/configure.ac: (New file) + * gcc-versionno/libgm2/libcor: (New directory) + * gcc-versionno/libgm2/libiso: (New directory) + * gcc-versionno/libgm2/liblog: (New directory) + * gcc-versionno/libgm2/libmin: (New directory) + * gcc-versionno/libgm2/libpim: (New directory) + * gcc-versionno/libgm2/libulm: (New directory) + * gcc-versionno/libgm2/Makefile.am: (New file) + * gcc-versionno/libgm2/Makefile.in: (rebuilt) + * gcc-versionno/libgm2/p2c: (New directory) + +2013-12-06 Gaius Mulley + + * gcc-versionno/gcc/gm2/Make-lang.in: Changed flag to -fpim + and changed path appropriately. + +2013-12-05 Gaius Mulley + + * gm2/libgm2/Makefile.in: Build coroutine version of SYSTEM.def. + +2013-10-17 Gaius Mulley + + * gm2/libgm2/Makefile.in: Corrected install of iso SYSTEM.def. + Ensure that we copy form the object directory and avoid the + template version in the source directory. + +2013-09-14 Gaius Mulley + + * gm2/libgm2/Makefile.in: Many changes to allow more libraries + to build and also build SYSTEM.def for the pim, iso and min + libraries. + +2013-07-08 Gaius Mulley + + * gm2/ChangeLog: (New file). + * gm2/libgm2/Makefile.in: Added install rules. Many of which + were adapted from gcc/gm2/Make-file.in. diff -ruw /dev/null gcc-git-devel-modula2/libgm2/config.h.in --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/config.h.in 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,313 @@ +/* config.h.in. Generated from configure.ac by autoheader. */ + +/* function access exists */ +#undef HAVE_ACCESS + +/* function brk exists */ +#undef HAVE_BRK + +/* function cfmakeraw exists */ +#undef HAVE_CFMAKERAW + +/* function close exists */ +#undef HAVE_CLOSE + +/* function creat exists */ +#undef HAVE_CREAT + +/* function ctime exists */ +#undef HAVE_CTIME + +/* Define to 1 if you have the header file. */ +#undef HAVE_DIRECT_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_DIRENT_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_DLFCN_H + +/* function dup exists */ +#undef HAVE_DUP + +/* Define to 1 if you have the header file. */ +#undef HAVE_ERRNO_H + +/* function execve exists */ +#undef HAVE_EXECVE + +/* function exit exists */ +#undef HAVE_EXIT + +/* function fcntl exists */ +#undef HAVE_FCNTL + +/* Define to 1 if you have the header file. */ +#undef HAVE_FCNTL_H + +/* function fstat exists */ +#undef HAVE_FSTAT + +/* function getdents exists */ +#undef HAVE_GETDENTS + +/* function getgid exists */ +#undef HAVE_GETGID + +/* function getpid exists */ +#undef HAVE_GETPID + +/* function gettimeofday exists */ +#undef HAVE_GETTIMEOFD + +/* function getuid exists */ +#undef HAVE_GETUID + +/* Define to 1 if you have the header file. */ +#undef HAVE_INTTYPES_H + +/* function ioctl exists */ +#undef HAVE_IOCTL + +/* function kill exists */ +#undef HAVE_KILL + +/* Define to 1 if you have the header file. */ +#undef HAVE_LANGINFO_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_LIMITS_H + +/* function link exists */ +#undef HAVE_LINK + +/* function lseek exists */ +#undef HAVE_LSEEK + +/* Define to 1 if you have the header file. */ +#undef HAVE_MALLOC_H + +/* have math.h */ +#undef HAVE_MATH_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_NETDB_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_NETINET_IN_H + +/* function open exists */ +#undef HAVE_OPEN + +/* function pause exists */ +#undef HAVE_PAUSE + +/* function pipe exists */ +#undef HAVE_PIPE + +/* Define to 1 if you have the header file. */ +#undef HAVE_PTHREAD_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_PWD_H + +/* function rand exists */ +#undef HAVE_RAND + +/* function read exists */ +#undef HAVE_READ + +/* function select exists */ +#undef HAVE_SELECT + +/* function setgid exists */ +#undef HAVE_SETGID + +/* function setitimer exists */ +#undef HAVE_SETITIMER + +/* function setuid exists */ +#undef HAVE_SETUID + +/* Define to 1 if you have the header file. */ +#undef HAVE_SIGNAL_H + +/* function signbit exists */ +#undef HAVE_SIGNBIT + +/* function signbitf exists */ +#undef HAVE_SIGNBITF + +/* function signbitl exists */ +#undef HAVE_SIGNBITL + +/* function stat exists */ +#undef HAVE_STAT + +/* Define to 1 if you have the header file. */ +#undef HAVE_STDARG_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_STDDEF_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_STDIO_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 + +/* function strsignal exists */ +#undef HAVE_STRSIGNAL + +/* function strtod exists */ +#undef HAVE_STRTOD + +/* function strtold exists */ +#undef HAVE_STRTOLD + +/* Define to 1 if the system has the type `struct stat'. */ +#undef HAVE_STRUCT_STAT + +/* Define to 1 if the system has the type `struct timeval'. */ +#undef HAVE_STRUCT_TIMEVAL + +/* Define to 1 if the system has the type `struct timezone'. */ +#undef HAVE_STRUCT_TIMEZONE + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_ERRNO_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_FILE_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_IOCTL_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_MMAN_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_PARAM_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_RESOURCE_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_SOCKET_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_TIMES_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_TIME_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_SYS_UIO_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_SYS_WAIT_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_TERMIOS_H + +/* function times exists */ +#undef HAVE_TIMES + +/* Define to 1 if you have the header file. */ +#undef HAVE_TIME_H + +/* Define to 1 if you have the header file. */ +#undef HAVE_UNISTD_H + +/* function unlink exists */ +#undef HAVE_UNLINK + +/* function wait exists */ +#undef HAVE_WAIT + +/* Define to 1 if you have the header file. */ +#undef HAVE_WCHAR_H + +/* function write exists */ +#undef HAVE_WRITE + +/* 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 + +/* 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 -ruw /dev/null gcc-git-devel-modula2/libgm2/Makefile.am --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/Makefile.am 2022-12-06 02:56:51.428775868 +0000 @@ -0,0 +1,103 @@ +# Makefile for libgm2. +# Copyright 2013-2022 Free Software Foundation, Inc. +# +# 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.64 +# +# Modula-2 support. +AUTOMAKE_OPTIONS = 1.8 foreign + +SUFFIXES = .c .mod .def .o .obj .lo .a + +ACLOCAL_AMFLAGS = -I . -I .. -I ../config + +# Multilib support. +MAKEOVERRIDES= + +AM_CFLAGS = -I $(srcdir)/../libgcc -I $(MULTIBUILDTOP)../../gcc/include + +gcc_version := $(shell cat $(top_srcdir)/../gcc/BASE-VER) +TOP_GCCDIR := $(shell cd $(top_srcdir) && cd .. && pwd) + +GCC_DIR = $(TOP_GCCDIR)/gcc +GM2_SRC = $(GCC_DIR)/m2 + +toolexeclibdir=@toolexeclibdir@ +toolexecdir=@toolexecdir@ +GM2_FOR_TARGET=@GM2_FOR_TARGET@ + +SUBDIRS = libm2min libm2log libm2cor libm2iso libm2pim +GM2_BUILDDIR := $(shell pwd) +gm2_cdir = $(libdir)/gcc/$(target_alias)/$(gcc_version)/include + +# 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)" \ + "GM2_SRC=$(GM2_SRC)" \ + "AR_FLAGS=$(AR_FLAGS)" \ + "CC_FOR_BUILD=$(CC_FOR_BUILD)" \ + "CC_FOR_TARGET=$(CC_FOR_TARGET)" \ + "GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \ + "CFLAGS=$(CFLAGS)" \ + "CXXFLAGS=$(CXXFLAGS)" \ + "CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \ + "CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \ + "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)" \ + "MULTIBUILDTOP=$(MULTIBUILDTOP)" \ + "MULTISUBDIR=$(MULTISUBDIR)" \ + "MULTIOSDIR=$(MULTIDIR)" \ + "MULTIFLAGS=$(MULTIFLAGS)" \ + "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=$(GM2_BUILDDIR)/libtool" + +# Subdir rules rely on $(FLAGS_TO_PASS) +FLAGS_TO_PASS = $(AM_MAKEFLAGS) + +include $(top_srcdir)/../multilib.am diff -ruw /dev/null gcc-git-devel-modula2/libgm2/configure.ac --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/configure.ac 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,376 @@ +# Configure script for libgm2. +# Copyright (C) 2013-2022 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 +# . + +# Configure looks for the existence of this file to auto-config each language. +# We define several parameters used by configure: + +# Process this file with autoreconf to produce a configure script. + +AC_INIT(package-unused, version-unused,,libgm2) +AC_CONFIG_SRCDIR(Makefile.am) +# AC_CONFIG_MACRO_DIR([config]) +AC_CONFIG_HEADER(config.h) + +libtool_VERSION=17:0:0 +AC_SUBST(libtool_VERSION) + +AM_ENABLE_MULTILIB(, ..) + +GCC_NO_EXECUTABLES + +AC_USE_SYSTEM_EXTENSIONS + +# Do not delete or change the following two lines. For why, see +# http://gcc.gnu.org/ml/libstdc++/2003-07/msg00451.html +AC_CANONICAL_SYSTEM +target_alias=${target_alias-$host_alias} +AC_SUBST(target_alias) + +AM_INIT_AUTOMAKE([1.9.3 no-define foreign no-dist -Wall -Wno-portability]) + +AH_TEMPLATE(PACKAGE, [Name of package]) +AH_TEMPLATE(VERSION, [Version number of package]) + +AC_ARG_WITH(cross-host, +[ --with-cross-host=HOST Configuring with a cross compiler]) + +# Checks for header files. +AC_HEADER_STDC +AC_HEADER_SYS_WAIT +AC_CHECK_HEADER([math.h], + [AC_DEFINE([HAVE_MATH_H], [1], [have math.h])]) + +AC_CHECK_HEADERS(limits.h stddef.h string.h strings.h stdlib.h \ + time.h \ + fcntl.h unistd.h sys/file.h sys/time.h sys/mman.h \ + sys/resource.h sys/param.h sys/times.h sys/stat.h \ + sys/socket.h \ + sys/wait.h sys/ioctl.h errno.h sys/errno.h \ + pwd.h direct.h dirent.h signal.h malloc.h langinfo.h \ + pthread.h stdarg.h stdio.h sys/types.h termios.h \ + netinet/in.h netdb.h sys/uio.h sys/stat.h wchar.h) + + +AC_CANONICAL_HOST +ACX_NONCANONICAL_HOST +ACX_NONCANONICAL_TARGET +GCC_TOPLEV_SUBDIRS + +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) + +# Command-line options. +# Very limited version of AC_MAINTAINER_MODE. +AC_ARG_ENABLE([maintainer-mode], + [AC_HELP_STRING([--enable-maintainer-mode], + [enable make rules and dependencies not useful (and + sometimes confusing) to the casual installer])], + [case ${enable_maintainer_mode} in + yes) MAINT='' ;; + no) MAINT='#' ;; + *) AC_MSG_ERROR([--enable-maintainer-mode must be yes or no]) ;; + esac + maintainer_mode=${enableval}], + [MAINT='#']) +AC_SUBST([MAINT])dnl + +toolexecdir=no +toolexeclibdir=no + +# Calculate toolexeclibdir +# Also toolexecdir, though it's only used in toolexeclibdir +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) + +AH_TEMPLATE(PACKAGE, [Name of package]) +AH_TEMPLATE(VERSION, [Version number of package]) + +AM_MAINTAINER_MODE + +# Check the compiler. +# The same as in boehm-gc and libstdc++. Have to borrow it from there. +# 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 +AC_PROG_CXX +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_PATH_PROG(PERL, perl, perl-not-found-in-path-error) +AC_PROG_MAKE_SET +AC_PROG_INSTALL + +LT_INIT +AC_LIBTOOL_DLOPEN +# AM_PROG_LIBTOOL +AC_SUBST(enable_shared) +AC_SUBST(enable_static) + +AC_CHECK_TYPES([struct timezone, struct stat, struct timeval]) + +AC_LANG_C +# Check the compiler. +# The same as in boehm-gc and libstdc++. Have to borrow it from there. +# 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 +m4_rename_force([real_PRECIOUS],[_AC_ARG_VAR_PRECIOUS]) + +AC_SUBST(CFLAGS) + +AC_DEFUN([GM2_UNDEF],[ + $as_echo "#undef HAVE_$1" >>confdefs.h +]) + +AC_DEFUN([GM2_CHECK_LIB],[ + AC_MSG_CHECKING([m2 front end checking $1 library for $2]) + if test x$gcc_no_link != xyes; then + AC_CHECK_LIB([$1],[$2],[AC_DEFINE([HAVE_$3],[1],[found $2])],[GM2_UNDEF([$3],[$2])]) + else + if test "x$[ac_cv_lib_$1_$2]" = xyes; then + AC_DEFINE([HAVE_$3],[1],[lib$1 includes $2]) + elif test "x$[ac_cv_func_$2]" = xyes; then + AC_DEFINE([HAVE_$3],[1],[function $2 exists]) + else + GM2_UNDEF([$3],[$2]) + fi + fi +]) + +GM2_CHECK_LIB([c],[access],[ACCESS]) +GM2_CHECK_LIB([c],[brk],[BRK]) +GM2_CHECK_LIB([c],[cfmakeraw],[CFMAKERAW]) +GM2_CHECK_LIB([c],[close],[CLOSE]) +GM2_CHECK_LIB([c],[ctime],[CTIME]) +GM2_CHECK_LIB([c],[creat],[CREAT]) +GM2_CHECK_LIB([c],[dup],[DUP]) +GM2_CHECK_LIB([c],[execve],[EXECVE]) +GM2_CHECK_LIB([c],[exit],[EXIT]) +GM2_CHECK_LIB([c],[fcntl],[FCNTL]) +GM2_CHECK_LIB([c],[fstat],[FSTAT]) +GM2_CHECK_LIB([c],[getdents],[GETDENTS]) +GM2_CHECK_LIB([c],[getgid],[GETGID]) +GM2_CHECK_LIB([c],[getpid],[GETPID]) +GM2_CHECK_LIB([c],[gettimeofday],[GETTIMEOFD]) +GM2_CHECK_LIB([c],[getuid],[GETUID]) +GM2_CHECK_LIB([c],[ioctl],[IOCTL]) +GM2_CHECK_LIB([c],[kill],[KILL]) +GM2_CHECK_LIB([c],[link],[LINK]) +GM2_CHECK_LIB([c],[lseek],[LSEEK]) +GM2_CHECK_LIB([c],[open],[OPEN]) +GM2_CHECK_LIB([c],[pause],[PAUSE]) +GM2_CHECK_LIB([c],[pipe],[PIPE]) +GM2_CHECK_LIB([c],[rand],[RAND]) +GM2_CHECK_LIB([c],[read],[READ]) +GM2_CHECK_LIB([c],[select],[SELECT]) +GM2_CHECK_LIB([c],[setitimer],[SETITIMER]) +GM2_CHECK_LIB([c],[setgid],[SETGID]) +GM2_CHECK_LIB([c],[setuid],[SETUID]) +GM2_CHECK_LIB([c],[stat],[STAT]) +GM2_CHECK_LIB([c],[strsignal],[STRSIGNAL]) +GM2_CHECK_LIB([c],[strtod],[STRTOD]) +GM2_CHECK_LIB([c],[strtold],[STRTOLD]) +GM2_CHECK_LIB([c],[times],[TIMES]) +GM2_CHECK_LIB([c],[unlink],[UNLINK]) +GM2_CHECK_LIB([c],[wait],[WAIT]) +GM2_CHECK_LIB([c],[write],[WRITE]) + +GM2_CHECK_LIB([m],[signbit],[SIGNBIT]) +GM2_CHECK_LIB([m],[signbitf],[SIGNBITF]) +GM2_CHECK_LIB([m],[signbitl],[SIGNBITL]) + +AC_MSG_NOTICE([libgm2 has finished checking target libc and libm contents.]) + +# We test the host here and later on check the target. + +# All known M2_HOST_OS values. This is the union of all host operating systems +# supported by gm2. + +M2_SUPPORTED_HOST_OS="aix freebsd hurd linux netbsd openbsd solaris windows" + +M2_HOST_OS=unknown + +case ${host} in + *-*-darwin*) M2_HOST_OS=darwin ;; + *-*-freebsd*) M2_HOST_OS=freebsd ;; + *-*-linux*) M2_HOST_OS=linux ;; + *-*-netbsd*) M2_HOST_OS=netbsd ;; + *-*-openbsd*) M2_HOST_OS=openbsd ;; + *-*-solaris2*) M2_HOST_OS=solaris ;; + *-*-aix*) M2_HOST_OS=aix ;; + *-*-gnu*) M2_HOST_OS=hurd ;; +esac + +# M2_HOST_OS=unknown +if test x${M2_HOST_OS} = xunknown; then + AC_MSG_NOTICE([unsupported host, will build a minimal m2 library]) + BUILD_PIMLIB=false + BUILD_ISOLIB=false + BUILD_CORLIB=false + BUILD_LOGLIB=false +else + AC_MSG_NOTICE([m2 library will be built on ${M2_HOST_OS}]) + BUILD_PIMLIB=true + BUILD_ISOLIB=true + BUILD_CORLIB=true + BUILD_LOGLIB=true +fi + +CC_FOR_BUILD=${CC_FOR_BUILD:-gcc} +AC_SUBST(CC_FOR_BUILD) + +# Propagate GM2_FOR_TARGET into Makefiles +GM2_FOR_TARGET=${GM2_FOR_TARGET:-gcc} +AC_SUBST(GM2_FOR_TARGET) + +# Now we check the target as long as it is a supported host. +# For some embedded targets we choose minimal runtime system which is +# just enough to satisfy the linker targetting raw metal. +if test x${M2_HOST_OS} != xunknown; then +AC_MSG_NOTICE([m2 library building for target ${target}]) +case "$target" in + + avr25*-*-* | avr31*-*-* | avr35*-*-* | avr4*-*-* | avr5*-*-* | avr51*-*-* | avr6*-*-*) + BUILD_PIMLIB=false + BUILD_ISOLIB=false + BUILD_CORLIB=false + BUILD_LOGLIB=false + ;; + + avrxmega2*-*-* | avrxmega4*-*-* | avrxmega5*-*-* | avrxmega6*-*-* | avrxmega7*-*-*) + BUILD_PIMLIB=false + BUILD_ISOLIB=false + BUILD_CORLIB=false + BUILD_LOGLIB=false + ;; + + avr3-*-*) + BUILD_PIMLIB=true + BUILD_ISOLIB=true + BUILD_CORLIB=true + BUILD_LOGLIB=true + ;; + esp32-*-*) + BUILD_PIMLIB=false + BUILD_ISOLIB=false + BUILD_CORLIB=false + BUILD_LOGLIB=false + ;; + +esac +fi + +# GM2_MSG_RESULT issue a query message from the first parameter and a boolean result +# in the second parameter is printed as a "yes" or "no". + +AC_DEFUN([GM2_MSG_RESULT],[ + AC_MSG_CHECKING([$1]) + if test x${$2} = xtrue; then + AC_MSG_RESULT([yes]) + else + AC_MSG_RESULT([no]) + fi +]) + +if test x${M2_HOST_OS} = xunknown; then + AC_MSG_NOTICE([m2 front end will only build minimal Modula-2 runtime library on this host]) +else + GM2_MSG_RESULT([m2 front end will build PIM libraries:],[BUILD_PIMLIB]) + GM2_MSG_RESULT([m2 front end will build ISO libraries:],[BUILD_ISOLIB]) + GM2_MSG_RESULT([m2 front end will build coroutine libraries:],[BUILD_CORLIB]) + GM2_MSG_RESULT([m2 front end will build Logitech compatability libraries:],[BUILD_LOGLIB]) +fi + +AM_CONDITIONAL([BUILD_PIMLIB], [test x$BUILD_PIMLIB = xtrue]) +AM_CONDITIONAL([BUILD_ISOLIB], [test x$BUILD_ISOLIB = xtrue]) +AM_CONDITIONAL([BUILD_CORLIB], [test x$BUILD_CORLIB = xtrue]) +AM_CONDITIONAL([BUILD_LOGLIB], [test x$BUILD_LOGLIB = xtrue]) + +AC_CONFIG_SRCDIR([Makefile.am]) +AC_CONFIG_FILES([Makefile libm2min/Makefile libm2pim/Makefile libm2iso/Makefile + libm2cor/Makefile libm2log/Makefile]) + +AC_MSG_NOTICE([libgm2 has been configured.]) + +AC_OUTPUT diff -ruw /dev/null gcc-git-devel-modula2/libgm2/autogen.sh --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/autogen.sh 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,31 @@ +#!/bin/sh + +# autogen.sh regenerate the autoconf files. +# Copyright 2013-2022 Free Software Foundation, Inc. +# +# 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 +# . + +rm -rf autom4te.cache + +# libtoolize +rm -f aclocal.m4 +# aclocal -I . -I config -I ../config +aclocal -I . -I ../config +autoreconf -I . -I ../config +automake --include-deps + +rm -rf autom4te.cache + +exit 0 diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2cor/Makefile.am --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2cor/Makefile.am 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,156 @@ +# Makefile for libm2cor. +# Copyright 2013-2022 Free Software Foundation, Inc. +# +# 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 +# . + +SUFFIXES = .c .cc .mod .def .o .obj .lo .a .la + +ACLOCAL_AMFLAGS = -I . -I .. -I ../config + +VPATH = . @srcdir@ @srcdir@/../../gcc/m2/gm2-libs-coroutines + +# Multilib support. +MAKEOVERRIDES= + +version := $(shell $(CC) -dumpversion) + +# Directory in which the compiler finds libraries etc. +libsubdir = $(libdir)/gcc/$(target_alias)/$(version) +# Used to install the shared libgcc. +slibdir = @slibdir@ + +toolexeclibdir=@toolexeclibdir@ +toolexecdir=@toolexecdir@ +GM2_FOR_TARGET=@GM2_FOR_TARGET@ + +MULTIDIR := $(shell $(CC) $(CFLAGS) -print-multi-directory) +MULTIOSDIR := $(shell $(CC) $(CFLAGS) -print-multi-os-directory) + +MULTIOSSUBDIR := $(shell if test x$(MULTIOSDIR) != x.; then echo /$(MULTIOSDIR); fi) +inst_libdir = $(libsubdir)$(MULTISUBDIR) +inst_slibdir = $(slibdir)$(MULTIOSSUBDIR) + + +# 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)" \ + "GM2_SRC=$(GM2_SRC)" \ + "AR_FLAGS=$(AR_FLAGS)" \ + "CC_FOR_BUILD=$(CC_FOR_BUILD)" \ + "CC_FOR_TARGET=$(CC_FOR_TARGET)" \ + "GM2_FOR_TARGET=$(GM2_FOR_TARGET)" \ + "CFLAGS=$(CFLAGS)" \ + "CXXFLAGS=$(CXXFLAGS)" \ + "CFLAGS_FOR_BUILD=$(CFLAGS_FOR_BUILD)" \ + "CFLAGS_FOR_TARGET=$(CFLAGS_FOR_TARGET)" \ + "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)" \ + "MULTIBUILDTOP=$(MULTIBUILDTOP)" \ + "MULTISUBDIR=$(MULTISUBDIR)" \ + "MULTIOSDIR=$(MULTIOSDIR)" \ + "MULTIFLAGS=$(MULTIFLAGS)" \ + "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_libgm2=$(TARGET_LIB_PATH_libgm2)" + +# Subdir rules rely on $(FLAGS_TO_PASS) +FLAGS_TO_PASS = $(AM_MAKEFLAGS) + + +if BUILD_CORLIB +M2DEFS = Debug.def Executive.def \ + KeyBoardLEDs.def SYSTEM.def \ + TimerHandler.def + +M2MODS = Debug.mod Executive.mod \ + SYSTEM.mod TimerHandler.mod + +toolexeclib_LTLIBRARIES = libm2cor.la + +libm2cor_la_SOURCES = $(M2MODS) KeyBoardLEDs.cc + +nodist_EXTRA_libm2cor_la_SOURCES = dummy.c ## forces automake to generate the LINK definition + +libm2cordir = libm2cor +libm2cor_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2cor_la_SOURCES))) +libm2cor_la_CFLAGS = -I. -I.. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../ -I@srcdir@/../libm2iso +libm2cor_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs-coroutines -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -fm2-g -g +libm2cor_la_LINK = $(LINK) -version-info $(libtool_VERSION) +BUILT_SOURCES = SYSTEM.def +CLEANFILES = SYSTEM.def + +M2LIBDIR = /m2/m2cor/ + +SYSTEM.def: Makefile + bash $(GM2_SRC)/tools-src/makeSystem -fpim \ + $(GM2_SRC)/gm2-libs-coroutines/SYSTEM.def \ + $(GM2_SRC)/gm2-libs-coroutines/SYSTEM.mod \ + -I$(GM2_SRC)/gm2-libs-coroutines:$(GM2_SRC)/gm2-libs:$(GM2_SRC)/gm2-libs-iso \ + "$(GM2_FOR_TARGET)" $@ + +.mod.lo: + $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2cor_la_M2FLAGS) $< -o $@ + +.cc.lo: + $(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2cor_la_CFLAGS) $< -o $@ + +install-data-local: force + mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) + $(INSTALL_DATA) .libs/libm2cor.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) + chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2cor.la + $(INSTALL_DATA) .libs/libm2cor.a $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) + chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2cor.a + $(RANLIB) $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)libm2cor.a + for i in $(M2DEFS) $(M2MODS) ; do \ + if [ -f $$i ] ; then \ + $(INSTALL_DATA) $$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \ + elif [ -f @srcdir@/../../gcc/m2/gm2-libs-coroutines/$$i ] ; then \ + $(INSTALL_DATA) @srcdir@/../../gcc/m2/gm2-libs-coroutines/$$i '$(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)'; \ + else \ + echo "cannot find $$i" ; exit 1 ; \ + fi ; \ + chmod 644 $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR)$$i ; \ + done + +force: + +endif diff -ruw /dev/null gcc-git-devel-modula2/libgm2/libm2cor/KeyBoardLEDs.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/libgm2/libm2cor/KeyBoardLEDs.cc 2022-12-06 02:56:51.432775922 +0000 @@ -0,0 +1,157 @@ +/* KeyBoardLEDs.c provide access to the keyboard LEDs. + +Copyright (C) 2005-2022 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. + +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 + +#if defined(linux) + +#include +#include +#include +#include +#include +#include + +#if !defined(TRUE) +# define TRUE (1==1) +#endif +#if !defined(FALSE) +# define FALSE (1==0) +#endif + +#include + +static int fd; +static int initialized = FALSE; + + +extern "C" void +KeyBoardLEDs_SwitchScroll (int scrolllock) +{ + unsigned char leds; + int r = ioctl (fd, KDGETLED, &leds); + if (scrolllock) + leds = leds | LED_SCR; + else + leds = leds & (~ LED_SCR); + r = ioctl (fd, KDSETLED, leds); +} + +extern "C" void +KeyBoardLEDs_SwitchNum (int numlock) +{ + unsigned char leds; + int r = ioctl (fd, KDGETLED, &leds); + if (numlock) + leds = leds | LED_NUM; + else + leds = leds & (~ LED_NUM); + r = ioctl (fd, KDSETLED, leds); +} + +extern "C" void +KeyBoardLEDs_SwitchCaps (int capslock) +{ + unsigned char leds; + int r = ioctl (fd, KDGETLED, &leds); + if (capslock) + leds = leds | LED_CAP; + else + leds = leds & (~ LED_CAP); + r = ioctl (fd, KDSETLED, leds); +} + +extern "C" void +KeyBoardLEDs_SwitchLeds (int numlock, int capslock, int scrolllock) +{ + KeyBoardLEDs_SwitchScroll (scrolllock); + KeyBoardLEDs_SwitchNum (numlock); + KeyBoardLEDs_SwitchCaps (capslock); +} + +extern "C" void +_M2_KeyBoardLEDs_init (int, char **, char **) +{ + if (! initialized) + { + initialized = TRUE; + fd = open ("/dev/tty", O_RDONLY); + if (fd == -1) + { + perror ("unable to open /dev/tty"); + exit (1); + } + } +} + +#else +extern "C" void +KeyBoardLEDs_SwitchLeds (int numlock, int capslock, int scrolllock) +{ +} + +extern "C" void +KeyBoardLEDs_SwitchScroll (int scrolllock) +{ +} + +extern "C" void +KeyBoardLEDs_SwitchNum (int numlock) +{ +} + +extern "C" void +KeyBoardLEDs_SwitchCaps (int capslock) +{ +} + +extern "C" void +_M2_KeyBoardLEDs_init (int, char **, char **) +{ +} + +#endif + +/* GNU Modula-2 linking hooks. */ + +extern "C" void +_M2_KeyBoardLEDs_finish (int, char **, char **) +{ +} + +extern "C" void +_M2_KeyBoardLEDs_dep (void) +{ +} + +struct _M2_KeyBoardLEDs_ctor { _M2_KeyBoardLEDs_ctor (); } _M2_KeyBoardLEDs_ctor; + +_M2_KeyBoardLEDs_ctor::_M2_KeyBoardLEDs_ctor (void) +{ + M2RTS_RegisterModule ("KeyBoardLEDs", _M2_KeyBoardLEDs_init, _M2_KeyBoardLEDs_finish, + _M2_KeyBoardLEDs_dep); +} From patchwork Tue Dec 6 14:47:26 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Gaius Mulley X-Patchwork-Id: 61577 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 3248A383B6A6 for ; Tue, 6 Dec 2022 14:49:11 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 3248A383B6A6 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1670338151; bh=7kQSHm06gqjMQjh1u0NimJsAIIGzPV6Yj0CIsgvFuhU=; h=Subject:To:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=WYpc/HhpnWkDANE+eXSa3EiZMamR7Omk9qgGK2BZ2NmLTjANlu50JtciLZ3XNoBxm yOYQhrXeP2I6wOf1Whoc3mrgA+Fl0CXvfB/VeLHON53i/knRbriaw1Z//sUgZijHaJ yzOR/z048sP/sdKkCtW8tPbkhZgbqZlB+oACGiOU= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32b.google.com (mail-wm1-x32b.google.com [IPv6:2a00:1450:4864:20::32b]) by sourceware.org (Postfix) with ESMTPS id 623B4384C915 for ; Tue, 6 Dec 2022 14:47:31 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 623B4384C915 Received: by mail-wm1-x32b.google.com with SMTP id ja4-20020a05600c556400b003cf6e77f89cso1227371wmb.0 for ; Tue, 06 Dec 2022 06:47:31 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=date:message-id:to:subject:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=7kQSHm06gqjMQjh1u0NimJsAIIGzPV6Yj0CIsgvFuhU=; b=3hgGj+YXkNi2MwQyo4pD9DBPMyDhNjQBQ7D/bqzFI0ofZWsmY3bBJMuesPIZSvbKNC NHULXDzqZP3GwdF4pX38H8FkS4Z3KIxvLOwKvho8IVFpTnlDjB1lx8L1oxk0rIL2DqtQ I7b4l/0u29kGKG7qKL9KCzM6SmeA6jixnKlakIlhWPAlNr6Zx0v7bg+j380N9UYw4H3K noakEri+sceaprGkClvG1B6wJ1zpfAsVQWnvnbV8619+Fzs1NCxBj6+MVkvaDJSuXXN4 fcJF5/MZx8fgfaTI5AJ81QTrZ9UvGSsEH+Mh+bw1SqRayimS3u9YtUl5Dqn4yS2IgaNE WRZg== X-Gm-Message-State: ANoB5pm8Cf5nrYycOTA/qbMO31OYXLnaPpYSwIb2I2ti0MxdZBK3K/Me nhSIhC2JAT54yADuNdm2eptMACxw0p0= X-Google-Smtp-Source: AA0mqf5ROWrUJHA0Z2XmwPCym6EJfxIMP29lga/8Bg5y3TJFZAc1FSZm9UKzCKi/if9WoVssPji3Uw== X-Received: by 2002:a05:600c:601a:b0:3d1:e710:9905 with SMTP id az26-20020a05600c601a00b003d1e7109905mr2620442wmb.81.1670338049779; Tue, 06 Dec 2022 06:47:29 -0800 (PST) Received: from lancelot ([195.147.220.46]) by smtp.gmail.com with ESMTPSA id y3-20020adff143000000b0022eafed36ebsm17129401wro.73.2022.12.06.06.47.28 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Dec 2022 06:47:29 -0800 (PST) X-Google-Original-From: Gaius Mulley Received: from gaius by lancelot with local (Exim 4.94.2) (envelope-from ) id 1p2ZEE-004Qfk-S1 for gcc-patches@gcc.gnu.org; Tue, 06 Dec 2022 14:47:26 +0000 Subject: [PATCH v3 9/19] modula2 front end: plugin source files To: X-Mailer: mail (GNU Mailutils 3.10) Message-Id: Date: Tue, 06 Dec 2022 14:47:26 +0000 X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Gaius Mulley via Gcc-patches From: Gaius Mulley Reply-To: Gaius Mulley Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patchset contains the modula2 plugin which detects some runtime errors at compiletime. ------8<----------8<----------8<----------8<----------8<----------8<---- diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/plugin/m2rte.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/plugin/m2rte.cc 2022-12-06 02:56:51.380775219 +0000 @@ -0,0 +1,335 @@ +/* m2rte.cc a plugin to detect runtime exceptions at compiletime. + +Copyright (C) 2017-2022 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 +. */ + + +#include "gcc-plugin.h" +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "options.h" +#include "tree-pass.h" +#include "diagnostic-core.h" +#include "flags.h" +#include "intl.h" +#include "plugin.h" +#include "tree.h" +#include "gimple.h" +#include "gimplify.h" +#include "gimple-iterator.h" +#include "gimplify-me.h" +#include "gimple-pretty-print.h" +#include "plugin-version.h" +#include "diagnostic.h" +#include "context.h" + +#include "rtegraph.h" +extern bool ggc_force_collect; +extern void ggc_collect (void); + +#undef DEBUG_BASICBLOCK + +int plugin_is_GPL_compatible; + +void debug_tree (tree); + +/* All dialects of Modula-2 issue some or all of these runtime error calls. + This plugin detects whether a runtime error will be called in the first + basic block of a reachable function. */ + +static const char *m2_runtime_error_calls[] = { + "M2RTS_AssignmentException", + "M2RTS_ReturnException", + "M2RTS_IncException", + "M2RTS_DecException", + "M2RTS_InclException", + "M2RTS_ExclException", + "M2RTS_ShiftException", + "M2RTS_RotateException", + "M2RTS_StaticArraySubscriptException", + "M2RTS_DynamicArraySubscriptException", + "M2RTS_ForLoopBeginException", + "M2RTS_ForLoopToException", + "M2RTS_ForLoopEndException", + "M2RTS_PointerNilException", + "M2RTS_NoReturnException", + "M2RTS_CaseException", + "M2RTS_WholeNonPosDivException", + "M2RTS_WholeNonPosModException", + "M2RTS_WholeZeroDivException", + "M2RTS_WholeZeroRemException", + "M2RTS_WholeValueException", + "M2RTS_RealValueException", + "M2RTS_ParameterException", + "M2RTS_NoException", + NULL, +}; + + +#if defined(DEBUG_BASICBLOCK) +/* pretty_function display the name of the function. */ + +static void +pretty_function (tree fndecl) +{ + if (fndecl != NULL && (DECL_NAME (fndecl) != NULL)) + { + const char *n = IDENTIFIER_POINTER (DECL_NAME (fndecl)); + fprintf (stderr, "PROCEDURE %s ;\n", n); + } +} +#endif + +void +print_rtl (FILE *outf, const_rtx rtx_first); + +/* strend returns true if string name has ending. */ + +static bool +strend (const char *name, const char *ending) +{ + unsigned int len = strlen (name); + return (len > strlen (ending) + && (strcmp (&name[len-strlen (ending)], ending) == 0)); +} + +/* is_constructor returns true if the function name is that of a module + constructor or deconstructor. */ + +static bool +is_constructor (tree fndecl) +{ + const char *name = IDENTIFIER_POINTER (DECL_NAME (fndecl)); + unsigned int len = strlen (name); + + return ((len > strlen ("_M2_")) + && (strncmp (name, "_M2_", strlen ("_M2_")) == 0) + && (strend (name, "_init") || strend (name, "_finish"))); +} + +/* is_external returns true if the function is extern. */ + +static bool +is_external (tree function) +{ + return (! DECL_EXTERNAL (function)) + && TREE_PUBLIC (function) + && TREE_STATIC (function); +} + +/* is_external returns true if the function is a call to a Modula-2 + runtime exception handler. */ + +static bool +is_rte (tree fndecl) +{ + const char *n = IDENTIFIER_POINTER (DECL_NAME (fndecl)); + + for (int i = 0; m2_runtime_error_calls[i] != NULL; i++) + if (strcmp (m2_runtime_error_calls[i], n) == 0) + return true; + return false; +} + +/* examine_call extract the function tree from the gimple call + statement and check whether it is a call to a runtime exception. */ + +static void +examine_call (gimple *stmt) +{ + tree fndecl = gimple_call_fndecl (stmt); + rtenode *func = rtegraph_lookup (stmt, fndecl, true); + // rtegraph_dump (); + if (fndecl != NULL && (DECL_NAME (fndecl) != NULL)) + { + /* Firstly check if the function is a runtime exception. */ + if (is_rte (fndecl)) + { + /* Remember runtime exception call. */ + rtegraph_include_rtscall (func); + /* Add the callee to the list of candidates to be queried reachable. */ + rtegraph_candidates_include (func); + return; + } + } + /* Add it to the list of calls. */ + rtegraph_include_function_call (func); +} + + +/* examine_function_decl, check if the current function is a module + constructor/deconstructor. Also check if the current function is + declared as external. */ + +static void +examine_function_decl (rtenode *rt) +{ + tree fndecl = rtegraph_get_func (rt); + if (fndecl != NULL && (DECL_NAME (fndecl) != NULL)) + { + /* Check if the function is a module constructor. */ + if (is_constructor (fndecl)) + rtegraph_constructors_include (rt); + /* Can it be called externally? */ + if (is_external (fndecl)) + rtegraph_externs_include (rt); + } +} + + +/* Check and warn if STMT is a self-assign statement. */ + +static void +runtime_exception_inevitable (gimple *stmt) +{ + if (is_gimple_call (stmt)) + examine_call (stmt); +} + + +namespace { + +const pass_data pass_data_exception_detection = +{ + GIMPLE_PASS, /* type */ + "runtime_exception_inevitable", /* name */ + OPTGROUP_NONE, /* optinfo_flags */ + TV_NONE, /* tv_id */ + PROP_gimple_lcf , /* properties_required */ + 0, /* properties_provided */ + 0, /* properties_destroyed */ + 0, /* todo_flags_start */ + 0, /* todo_flags_finish */ +}; + +class pass_warn_exception_inevitable : public gimple_opt_pass +{ +public: + pass_warn_exception_inevitable(gcc::context *ctxt) + : gimple_opt_pass(pass_data_exception_detection, ctxt) + {} + + virtual unsigned int execute (function *); +}; + +/* execute checks the first basic block of function fun to see if it + calls a runtime exception. */ + +unsigned int +pass_warn_exception_inevitable::execute (function *fun) +{ + gimple_stmt_iterator gsi; + basic_block bb; + /* Record a function declaration. */ + rtenode *fn = rtegraph_lookup (fun->gimple_body, fun->decl, false); + + rtegraph_set_current_function (fn); + /* Check if the current function is a module constructor/deconstructor. + Also check if the current function is declared as external. */ + examine_function_decl (fn); + +#if defined(DEBUG_BASICBLOCK) + pretty_function (fun->decl); + int basic_count = 0; +#endif + FOR_EACH_BB_FN (bb, fun) + { +#if defined(DEBUG_BASICBLOCK) + int stmt_count = 0; +#endif + for (gsi = gsi_start_bb (bb); !gsi_end_p (gsi); gsi_next (&gsi)) + { +#if defined(DEBUG_BASICBLOCK) + printf (" [%d][%d] [basic block][statement]\n", + basic_count, stmt_count); + stmt_count++; +#endif + runtime_exception_inevitable (gsi_stmt (gsi)); +#if defined(DEBUG_BASICBLOCK) + debug (gsi_stmt (gsi)); +#endif + } + /* We only care about the first basic block in each function. + We could continue to search if this edge falls though (top + of a loop for example) but for now this is cautiously safe. + --fixme-- */ + return 0; +#if defined(DEBUG_BASICBLOCK) + basic_count++; +#endif + } + return 0; +} + +/* analyse_graph discovers any reachable call to a runtime exception in the + first basic block of a reachable function. It then calls rtegraph_finish + to tidy up and return all dynamic memory used. */ + +void analyse_graph (void *gcc_data, void *user_data) +{ + rtegraph_discover (); + rtegraph_finish (); +} + +} // anon namespace + + +static gimple_opt_pass * +make_pass_warn_exception_inevitable (gcc::context *ctxt) +{ + return new pass_warn_exception_inevitable (ctxt); +} + + +/* plugin_init, check the version and register the plugin. */ + +int +plugin_init (struct plugin_name_args *plugin_info, + struct plugin_gcc_version *version) +{ + struct register_pass_info pass_info; + const char *plugin_name = plugin_info->base_name; + + if (!plugin_default_version_check (version, &gcc_version)) + { + fprintf (stderr, "incorrect GCC version (%s) this plugin was built for GCC version %s\n", + version->basever, gcc_version.basever); + return 1; + } + + /* Runtime exception inevitable detection. This plugin is most effective if + it is run after all optimizations. This is plugged in at the end of + gimple range of optimizations. */ + pass_info.pass = make_pass_warn_exception_inevitable (g); + pass_info.reference_pass_name = "*warn_function_noreturn"; + + pass_info.ref_pass_instance_number = 1; + pass_info.pos_op = PASS_POS_INSERT_AFTER; + + rtegraph_init (); + + register_callback (plugin_name, + PLUGIN_PASS_MANAGER_SETUP, + NULL, + &pass_info); + register_callback (plugin_name, + PLUGIN_FINISH, analyse_graph, NULL); + return 0; +} diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/plugin/README --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/plugin/README 2022-12-06 02:56:51.380775219 +0000 @@ -0,0 +1,2 @@ +This directory contains the Modula-2 plugin which will elevate runtime +warnings into compiler errors if they are known to be reachable. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/rtegraph.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/rtegraph.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,42 @@ +/* rtegraph.h runtime exception graph header. + +Copyright (C) 2019-2022 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 +. */ + +#ifndef RTEGRAPH_H +#define RTEGRAPH_H + +struct rtenode; + +extern rtenode *rtegraph_init_rtenode (gimple *g, tree fndecl, bool is_func_call); +extern rtenode *rtegraph_lookup (gimple *g, tree fndecl, bool is_call); +extern void rtegraph_candidates_include (rtenode *n); +extern void rtegraph_allnodes_include (rtenode *n); +extern void rtegraph_externs_include (rtenode *n); +extern void rtegraph_constructors_include (rtenode *n); +extern void rtegraph_include_rtscall (rtenode *func); +extern void rtegraph_include_function_call (rtenode *func); +extern void rtegraph_set_current_function (rtenode *func); +extern tree rtegraph_get_func (rtenode *func); + +extern void rtegraph_discover (void); +extern void rtegraph_init (void); +extern void rtegraph_finish (void); + +#endif /* RTEGRAPH_H. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/rtegraph.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/rtegraph.cc 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,527 @@ +/* rtegraph.cc graph and nodes used by m2rte. + +Copyright (C) 2019-2022 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 +. */ + +#include "gcc-consolidation.h" + +#include "../gm2-lang.h" +#include "../m2-tree.h" + +#include "langhooks-def.h" /* FIXME: for lhd_set_decl_assembler_name. */ +#include "tree-pass.h" /* FIXME: only for PROP_gimple_any. */ +#include "toplev.h" +#include "debug.h" + +#include "opts.h" +#include "mpfr.h" + +#undef DEBUGGING + +struct GTY (()) rtenode +{ + bool constructor_reachable; /* Is this guarenteed to be reachable by a constructor? */ + bool export_reachable; /* Is this reachable via exported functions? */ + bool exception_routine; /* Is this an exception routine? */ + bool constructor_final; /* Have we walked this rtenode during constructor testing? */ + bool export_final; /* Walked this rtenode during exported testing? */ + bool is_call; /* Is this a function call? */ + gimple *grtenode; + tree func; + rtenode *reachable_src; /* If this is reachable which src function will call us? */ + + vec *function_call; + vec *rts_call; + void dump (void); + void dump_vec (const char *title, vec *list); + + void propagate_constructor_reachable (rtenode *); + void propagate_export_reachable (rtenode *); + void error_message (void); + void warning_message (void); + void note_message (void); + const char *get_func_name (void); + const char *create_message (const char *with_name, const char *without_name); +}; + + +typedef vec rtevec; + +static GTY (()) rtevec *allnodes; +static GTY (()) rtevec *candidates; +static GTY (()) rtevec *externs; +static GTY (()) rtevec *constructors; + + +static void determine_reachable (void); +static void issue_messages (void); +void rtegraph_dump (void); + + +static GTY (()) rtenode *rtegraph_current_function = NULL; + + +/* rtegraph_get_func returns the function associated with the rtenode. */ + +tree +rtegraph_get_func (rtenode *n) +{ + return n->func; +} + +/* rtegraph_set_current_function assigns rtegraph_current_function with func. */ + +void +rtegraph_set_current_function (rtenode *func) +{ + rtegraph_current_function = func; +} + +/* rtegraph_include_rtscall mark func as an exception routine and remember + that it is called from rtegraph_current_function in the rts_call array. */ + +void rtegraph_include_rtscall (rtenode *func) +{ + /* This is a runtime exception, mark it as such. */ + func->exception_routine = true; + /* And remember it. */ + vec_safe_push (rtegraph_current_function->rts_call, func); +} + + +/* rtegraph_include_rtscall remember that rtegraph_current_function calls + func. */ + +void rtegraph_include_function_call (rtenode *func) +{ + vec_safe_push (rtegraph_current_function->function_call, func); +} + + +/* rtegraph_discover performs the main work, called by m2rte.cc analyse_graph. + It determines which function calls a reachable and then issues any warning + message if a reachable function is a call to a runtime exception handler. */ + +void rtegraph_discover (void) +{ + determine_reachable (); +#if defined (DEBUGGING) + rtegraph_dump (); +#endif + issue_messages (); +} + +/* rtegraph_candidates_include include node n in the array of candidates. */ + +void rtegraph_candidates_include (rtenode *n) +{ + unsigned int len = vec_safe_length (candidates); + + for (unsigned int i = 0; i < len; i++) + if ((*candidates)[i] == n) + return; + vec_safe_push (candidates, n); +} + +/* rtegraph_allnodes_include include node n in the array of allnodes. */ + +void rtegraph_allnodes_include (rtenode *n) +{ + unsigned int len = vec_safe_length (allnodes); + + for (unsigned int i = 0; i < len; i++) + if ((*allnodes)[i] == n) + return; + vec_safe_push (allnodes, n); +} + +/* rtegraph_externs_include include node n in the array of externs. */ + +void rtegraph_externs_include (rtenode *n) +{ + unsigned int len = vec_safe_length (externs); + + for (unsigned int i = 0; i < len; i++) + if ((*externs)[i] == n) + return; + vec_safe_push (externs, n); +} + +/* rtegraph_constructors_include include node n in the array of constructors. */ + +void rtegraph_constructors_include (rtenode *n) +{ + unsigned int len = vec_safe_length (constructors); + + for (unsigned int i = 0; i < len; i++) + if ((*constructors)[i] == n) + return; + vec_safe_push (constructors, n); +} + +/* determine_reachable mark modules constructors as reachable and + also mark the exported functions as also reachable. */ + +void determine_reachable (void) +{ + unsigned int len = vec_safe_length (constructors); + for (unsigned int i = 0; i < len; i++) + (*constructors)[i]->propagate_constructor_reachable ((*constructors)[i]); + len = vec_safe_length (externs); + for (unsigned int i = 0; i < len; i++) + (*externs)[i]->propagate_export_reachable ((*externs)[i]); +} + +/* issue_messages for every candidate which is constructor reachable issue + an error. For each candidate which is reachable via an external call + issue a warning, for any other candidate (of a local procedure) issue + a note. */ + +void issue_messages (void) +{ + unsigned int len = vec_safe_length (candidates); + for (unsigned int i = 0; i < len; i++) + { + if ((*candidates)[i]->constructor_reachable) + (*candidates)[i]->error_message (); + else if ((*candidates)[i]->export_reachable) + (*candidates)[i]->warning_message (); + else + (*candidates)[i]->note_message (); + } +} + + +#if defined (DEBUGGING) +/* rtegraph_dump_vec display the contents of a vector array. */ + +void +rtegraph_dump_vec (const char *title, vec *list) +{ + unsigned int len = vec_safe_length (list); + printf ("%s (length = %d)\n", title, len); + for (unsigned int i = 0; i < len; i++) + { + printf ("[%d]: rtenode %p ", i, (*list)[i]); + (*list)[i]->dump (); + } + printf ("end\n"); +} + +/* rtegraph_dump display the contents of each vector array. */ + +void rtegraph_dump (void) +{ + rtegraph_dump_vec ("allnodes", allnodes); + rtegraph_dump_vec ("candidates", candidates); + rtegraph_dump_vec ("externs", externs); + rtegraph_dump_vec ("constructors", constructors); +} +#endif + +/* rtegraph_init_rtenode create and return a new rtenode. */ + +rtenode * +rtegraph_init_rtenode (gimple *g, tree fndecl, bool is_func_call) +{ + rtenode *n = ggc_alloc (); + + n->constructor_reachable = false; + n->export_reachable = false; + n->constructor_final = false; + n->export_final = false; + n->is_call = is_func_call; + n->grtenode = g; + n->func = fndecl; + n->reachable_src = NULL; + + vec_alloc (n->function_call, 0); + // n->function_call = ggc_alloc (); + gcc_assert (vec_safe_length (n->function_call) == 0); + vec_alloc (n->rts_call, 0); + // n->rts_call = ggc_alloc (); + gcc_assert (vec_safe_length (n->rts_call) == 0); + return n; +} + +/* rtegraph_lookup attempts to lookup a rtenode associated with a fndecl + which is a function call from node g. */ + +rtenode * +rtegraph_lookup (gimple *g, tree fndecl, bool is_call) +{ + unsigned int len = vec_safe_length (allnodes); + for (unsigned int i = 0; i < len; i++) + if ((*allnodes)[i]->grtenode == g + && (*allnodes)[i]->func == fndecl + && (*allnodes)[i]->is_call == is_call) + return (*allnodes)[i]; + rtenode *n = rtegraph_init_rtenode (g, fndecl, is_call); + vec_safe_push (allnodes, n); +#if defined (DEBUGGING) + rtegraph_dump (); +#endif + return n; +} + +/* rte_error_at - wraps up an error message. */ + +static void +rte_error_at (location_t location, diagnostic_t kind, const char *message, ...) +{ + diagnostic_info diagnostic; + va_list ap; + rich_location richloc (line_table, location); + + va_start (ap, message); + diagnostic_set_info (&diagnostic, message, &ap, &richloc, kind); + diagnostic_report_diagnostic (global_dc, &diagnostic); + va_end (ap); +} + +/* access_int return true if the tree t contains a constant integer, if so then + its value is assigned to *value. */ + +static bool +access_int (tree t, int *value) +{ + enum tree_code code = TREE_CODE (t); + + if (code == SSA_NAME) + return access_int (SSA_NAME_VAR (t), value); + if (code == INTEGER_CST) + { + *value = TREE_INT_CST_LOW (t); + return true; + } + if ((code == VAR_DECL || code == PARM_DECL) + && DECL_HAS_VALUE_EXPR_P (t)) + return access_int (DECL_VALUE_EXPR (t), value); + return false; +} + +/* access_string return true if the tree t contains a constant string, if so then + its value is assigned to *value. */ + +static bool +access_string (tree t, const char **value) +{ + if (TREE_CODE (t) == ADDR_EXPR) + { + if (TREE_CODE (TREE_OPERAND (t, 0)) == STRING_CST) + { + *value = TREE_STRING_POINTER (TREE_OPERAND (t, 0)); + return true; + } + } + return false; +} + +/* generate an error using the parameters of the M2RTS exception handler to + locate the source code. We dont use location, as the error_at function will + give the function context which might be misleading if this is inlined. */ + +static void +generate_report (gimple *stmt, const char *report, diagnostic_t kind) +{ + if (gimple_call_num_args (stmt) == 5) + { + tree s0 = gimple_call_arg (stmt, 0); + tree i1 = gimple_call_arg (stmt, 1); + tree i2 = gimple_call_arg (stmt, 2); + tree s1 = gimple_call_arg (stmt, 3); + tree s2 = gimple_call_arg (stmt, 4); + const char *file; + int line; + int col; + const char *scope; + const char *message; + + if (access_string (s0, &file) + && access_int (i1, &line) + && access_int (i2, &col) + && access_string (s1, &scope) + && access_string (s2, &message)) + { + /* Continue to use scope as this will survive any + optimization transforms. */ + location_t location = gimple_location (stmt); + rte_error_at (location, kind, "In %s\n%s, %s", + scope, report, message); + } + } +} + +/* get_func_name returns the name of the function associated with rtenode. */ + +const char *rtenode::get_func_name (void) +{ + if (func != NULL && (DECL_NAME (func) != NULL)) + return IDENTIFIER_POINTER (DECL_NAME (func)); + return NULL; +} + +/* create_message if the current rtenode has a named function associated with it then + create a new message using with_name and the function name, otherwise + return without_name. */ + +const char *rtenode::create_message (const char *with_name, const char *without_name) +{ + const char *name = get_func_name (); + if (name == NULL) + return without_name; + + int len = strlen (with_name) + 1 + strlen (name); + char *message = XNEWVEC (char, len); + snprintf (message, len, with_name, name); + return message; +} + +/* error_message issue an DK_ERROR from grtenode. */ + +void rtenode::error_message (void) +{ + if (grtenode != NULL) + generate_report (grtenode, "runtime error will occur", DK_ERROR); +} + +/* warning_message issue an DK_WARNING from grtenode. */ + +void rtenode::warning_message (void) +{ + const char *message = reachable_src->create_message + ("runtime error will occur if an exported procedure is called from %s", + "runtime error will occur if an exported procedure is called"); + if (grtenode != NULL) + generate_report (grtenode, message, DK_WARNING); +} + +/* note_message issue an DK_NOTE from grtenode. */ + +void rtenode::note_message (void) +{ + if (grtenode != NULL) + generate_report (grtenode, "runtime will occur if this procedure is called", DK_NOTE); +} + +/* dump_vec display contents of vector array list. */ +#if defined (DEBUGGING) +void +rtenode::dump_vec (const char *title, vec *list) +{ + printf (" %s (length = %d)\n", title, vec_safe_length (list)); + for (unsigned int i = 0; i < vec_safe_length (list); i++) + printf (" [%d]: rtenode %p\n", i, (*list)[i]); +} +#endif + +/* dump display all vector arrays associated with rtenode. */ + +void +rtenode::dump (void) +{ +#if defined (DEBUGGING) + printf ("rtenode::dump:"); + if (func != NULL && (DECL_NAME (func) != NULL)) + { + const char *n = IDENTIFIER_POINTER (DECL_NAME (func)); + printf ("%s", n); + } + if (constructor_reachable) + printf (", constructor_reachable"); + if (export_reachable) + printf (", export_reachable"); + if (constructor_final) + printf (", constructor_final"); + if (export_final) + printf (", export_final"); + if (is_call) + printf (", is_call"); + else + printf (", decl"); + printf (", grtenode %p, func = %p\n", grtenode, func); + dump_vec ("function_call", function_call); + dump_vec ("rts_call", rts_call); +#endif +} + +/* propagate_constructor_reachable for every function which is reachable from + rtenode call the callee rtenode and mark it as reachable from a + constructor. */ + +void rtenode::propagate_constructor_reachable (rtenode *src) +{ + if (constructor_final) + return; + constructor_final = true; + constructor_reachable = true; + reachable_src = src; + for (unsigned int i = 0; i < vec_safe_length (function_call); i++) + (*function_call)[i]->propagate_constructor_reachable (src); + for (unsigned int i = 0; i < vec_safe_length (rts_call); i++) + (*rts_call)[i]->propagate_constructor_reachable (src); +} + +/* propagate_export_reachable for every function which is reachable + from rtenode call the callee rtenode and mark it as reachable from + an exported function. */ + +void rtenode::propagate_export_reachable (rtenode *src) +{ + if (export_final) + return; + export_final = true; + export_reachable = true; + reachable_src = src; + for (unsigned int i = 0; i < vec_safe_length (function_call); i++) + (*function_call)[i]->propagate_export_reachable (src); + for (unsigned int i = 0; i < vec_safe_length (rts_call); i++) + (*rts_call)[i]->propagate_export_reachable (src); +} + +/* rtegraph_init initialize the data structures (vec arrays) in this + file. */ + +void rtegraph_init (void) +{ + vec_alloc (allnodes, 0); + gcc_assert (vec_safe_length (allnodes) == 0); + vec_alloc (candidates, 0); + gcc_assert (vec_safe_length (candidates) == 0); + vec_alloc (externs, 0); + gcc_assert (vec_safe_length (externs) == 0); + vec_alloc (constructors, 0); + gcc_assert (vec_safe_length (constructors) == 0); +#if defined (DEBUGGING) + rtegraph_dump (); +#endif +} + +/* rtegraph_finish deallocate all vec arrays in this file. */ + +void rtegraph_finish (void) +{ + rtegraph_current_function = NULL; + vec_free (allnodes); + vec_free (candidates); + vec_free (externs); + vec_free (constructors); +} + +#include "gt-m2-rtegraph.h" From patchwork Tue Dec 6 14:47:27 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Gaius Mulley X-Patchwork-Id: 61578 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 90BCB382E47C for ; Tue, 6 Dec 2022 14:49:29 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 90BCB382E47C DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1670338169; bh=Ae0VR8u1hL8M9/C7xc8u9C8rl0f/mo1S3iSdAstSU/A=; h=Subject:To:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=diuVxZGltuBP6cKH3XyzY5DjIIuge+oPUcWGLPMUw2wq1QohMImw+/lu7pH+E6Pko 4PLME71IRuGdFVwkaDHXCk4jTzKJ51U6SNWSrLyUhBvrydehQaFsvJv0n/rWYPGU5M y/sRnXpve3e0EePKvoTaeeDR+tFL05x3pFxisMP0= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x436.google.com (mail-wr1-x436.google.com [IPv6:2a00:1450:4864:20::436]) by sourceware.org (Postfix) with ESMTPS id E26A33875B73 for ; Tue, 6 Dec 2022 14:48:02 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org E26A33875B73 Received: by mail-wr1-x436.google.com with SMTP id o5so23813358wrm.1 for ; Tue, 06 Dec 2022 06:48:02 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=date:message-id:to:subject:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=Ae0VR8u1hL8M9/C7xc8u9C8rl0f/mo1S3iSdAstSU/A=; b=5PFAPLeQo3zlKocpcRu0EbNmdqM3lc8g8P/h3JQ+uxmlB77zQPTWxoF6sjGgnLO0ij LA4a6p1O4wyl1Lgj5eLBAFcoNkbC+tehY6OxJi9DTOhNKwf8KR7l2zbrolgYTwdEQS9Q YPN2fq7uKChi7gMEO51OWXGrU96/KkLV2gi1RmuohhyGH/3hUtWpzqe+OmI9CrecY47s 62IMoKOAlIJdqdywvAXPuiR+6389RfO2pZzTQ4DBuJSvN2TSw82S2OH6TgRr4mMxKrG2 7Yk5R2pfkzUOB279IBGYcbotwPg06rFpUtzE7AaETIrmTUiF7lnsZfH9IYrbL6Eprbd2 lIww== X-Gm-Message-State: ANoB5pn+HLCp88jw3VN/6vjuIvbo7+mILi8Hb5M5JDF0GAB2319xASXq a2ewurWm9Vf2Y5pdxACVFkpU6PMWzYs= X-Google-Smtp-Source: AA0mqf4xXmzeuXl83KjxnZr6GpRNoODu11wT5vU7H9dtCLxnw/7BJfqVUmVVT3rmITIKLswpc/cSSQ== X-Received: by 2002:a05:6000:508:b0:242:34c1:1fd1 with SMTP id a8-20020a056000050800b0024234c11fd1mr14660370wrf.218.1670338079606; Tue, 06 Dec 2022 06:47:59 -0800 (PST) Received: from lancelot ([195.147.220.46]) by smtp.gmail.com with ESMTPSA id u2-20020adfdd42000000b0024242111a27sm13141590wrm.75.2022.12.06.06.47.29 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Dec 2022 06:47:59 -0800 (PST) X-Google-Original-From: Gaius Mulley Received: from gaius by lancelot with local (Exim 4.94.2) (envelope-from ) id 1p2ZEF-004Qfy-3L for gcc-patches@gcc.gnu.org; Tue, 06 Dec 2022 14:47:27 +0000 Subject: [PATCH v3 10/19] modula2 front end: gimple interface header files *.h and *.def To: X-Mailer: mail (GNU Mailutils 3.10) Message-Id: Date: Tue, 06 Dec 2022 14:47:27 +0000 X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Gaius Mulley via Gcc-patches From: Gaius Mulley Reply-To: Gaius Mulley Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patchset contains the gimple interface. The header files {*.h} must match their modula2 counterparts {*.def}. ------8<----------8<----------8<----------8<----------8<----------8<---- diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/init.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/init.def 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,43 @@ +(* init.def provides procedures for initialising the m2 front end. + +Copyright (C) 2012-2022 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" init ; + +FROM SYSTEM IMPORT ADDRESS ; + + +(* + FrontEndInit - initialise the modules, this is a global initialisation. + This is called once. +*) + +PROCEDURE FrontEndInit ; + + +(* + PerCompilationInit - initialise the modules before compiling, filename. + This is to be called every time we compile a new file. +*) + +PROCEDURE PerCompilationInit (filename: ADDRESS) ; + + +END init. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2block.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2block.def 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,225 @@ +(* m2block.def definition module for m2block.cc. + +Copyright (C) 2011-2022 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" m2block ; + + +FROM m2tree IMPORT Tree ; +FROM m2linemap IMPORT location_t ; +FROM SYSTEM IMPORT ADDRESS ; + + +(* + init - initialise the data structures in this module. +*) + +PROCEDURE init ; + + +(* + toplevel - return TRUE if we are in the global scope. +*) + +PROCEDURE toplevel () : BOOLEAN ; + + +(* + global_constant - t is a constant, we keep a chain of all constants + in the global binding level. +*) + +PROCEDURE global_constant (t: Tree) : Tree ; + + +(* + RememberInitModuleFunction - records tree, t, in the global binding level. + So that it will not be garbage collected. + In theory the inner modules could be placed + inside the current_binding_level I suspect. +*) + +PROCEDURE RememberInitModuleFunction (t: Tree) : Tree ; + + +(* + DumpGlobalConstants - displays all global constants and checks none are + poisoned. +*) + +PROCEDURE DumpGlobalConstants () : Tree ; + + +(* + RememberConstant - adds a tree, t, onto the list of constants to be marked + whenever the ggc re-marks all used storage. Constants + live throughout the whole compilation - and they + can be used by many different functions if necessary. +*) + +PROCEDURE RememberConstant (t: Tree) : Tree ; + + +(* + RememberType - remember the type, t, in the ggc marked list. +*) + +PROCEDURE RememberType (t: Tree) : Tree ; + + +(* + pushDecl - pushes a declaration onto the current binding level. +*) + +PROCEDURE pushDecl (decl: Tree) : Tree ; + + +(* + popGlobalScope - pops the current binding level, it expects this binding level + to be the global binding level. +*) + +PROCEDURE popGlobalScope ; + + +(* + pushGlobalScope - push the global scope onto the binding level stack. + There can only ever be one instance of the global binding + level on the stack. +*) + +PROCEDURE pushGlobalScope ; + + +(* + popFunctionScope - pops a binding level, returning the function associated with the + binding level. +*) + +PROCEDURE popFunctionScope () : Tree ; + + +(* + pushFunctionScope - push a binding level. +*) + +PROCEDURE pushFunctionScope (fndecl: Tree) ; + + +(* + finishFunctionCode - adds cur_stmt_list to fndecl. The current binding level + is then able to be destroyed by a call to popFunctionScope. + The cur_stmt_list is appended to the STATEMENT_LIST. +*) + +PROCEDURE finishFunctionCode (fndecl: Tree) ; + + +(* + finishFunctionDecl - removes declarations from the current binding level and places + them inside fndecl. The current binding level is then able to + be destroyed by a call to popFunctionScope. + + The extra tree nodes associated with fndecl will be created + such as BIND_EXPR, BLOCK and the initial STATEMENT_LIST + containing the DECL_EXPR is also created. +*) + +PROCEDURE finishFunctionDecl (location: location_t; fndecl: Tree) ; + + +(* + getLabel - return the label, name, or create a label, name + in the current scope. +*) + +PROCEDURE getLabel (location: location_t; name: ADDRESS) : Tree ; + + +(* + GetErrorNode - returns the gcc error_mark_node. +*) + +PROCEDURE GetErrorNode () : Tree ; + + +(* + includeDecl - pushes a declaration onto the current binding level providing + it is not already present. +*) + +PROCEDURE includeDecl (decl: Tree) ; + + +(* + GetGlobals - returns a list of global variables, functions, constants. +*) + +PROCEDURE GetGlobals () : Tree ; + + +(* + GetGlobalContext - returns the global context tree. +*) + +PROCEDURE GetGlobalContext () : Tree ; + + +(* + begin_statement_list - starts a tree statement. It pushes the + statement list and returns the list node. +*) + +PROCEDURE begin_statement_list () : Tree ; + + +(* + push_statement_list - pushes the statement list, t, onto the + current binding level. +*) + +PROCEDURE push_statement_list (t: Tree) : Tree ; + + +(* + pop_statement_list - pops and returns a statement list from the + current binding level. +*) + +PROCEDURE pop_statement_list () : Tree ; + + +(* + addStmtNote - remember this location represents the start of a Modula-2 + statement. It is flushed if another different location is + generated or another tree is given to add_stmt. +*) + +PROCEDURE addStmtNote (location: location_t) ; + + +(* + removeStmtNote - removes any pending stmt note. +*) + +PROCEDURE removeStmtNote ; + + +END m2block. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2builtins.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2builtins.def 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,121 @@ +(* m2builtins.def definition module for m2builtins.cc. + +Copyright (C) 2003-2022 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" m2builtins ; + +FROM SYSTEM IMPORT ADDRESS ; +FROM m2tree IMPORT Tree ; +FROM m2linemap IMPORT location_t ; + +EXPORT QUALIFIED GetBuiltinConst, GetBuiltinConstType, + GetBuiltinTypeInfoType, GetBuiltinTypeInfo, + BuiltinExists, BuildBuiltinTree, + BuiltInMemCopy, BuiltInAlloca, + BuiltInIsfinite ; + + +(* + GetBuiltinConst - returns the gcc tree of a built in constant, name. + NIL is returned if the constant is unknown. +*) + +PROCEDURE GetBuiltinConst (name: ADDRESS) : Tree ; + + +(* + GetBuiltinConstType - returns the type of a builtin constant, name. + + 0 = unknown constant name + 1 = integer + 2 = real +*) + +PROCEDURE GetBuiltinConstType (name: ADDRESS) : CARDINAL ; + + + +(* + GetBuiltinTypeInfoType - returns value: + 0 is ident is unknown. + 1 if ident is IEC559, LIA1, ISO, IEEE, rounds, underflow, + exception, extend. + 2 if ident is radix, places, exponentmin, exponentmax, + noofmodes. + 3 if ident is large, small. +*) + +PROCEDURE GetBuiltinTypeInfoType (ident: ADDRESS) : CARDINAL ; + + +(* + GetBuiltinTypeInfo - returns a Tree value: + + NULL_TREE if ident is unknown. + boolean Tree if ident is IEC559, LIA1, ISO, IEEE, rounds, underflow, + exception, extend. + ZType Tree if ident is radix, places, exponentmin, exponentmax, + noofmodes. + RType Tree if ident is large, small. +*) + +PROCEDURE GetBuiltinTypeInfo (location: location_t; type: Tree; ident: ADDRESS) : Tree ; + + +(* + BuiltinExists - returns TRUE if the builtin function, name, exists + for this target architecture. +*) + +PROCEDURE BuiltinExists (name: ADDRESS) : BOOLEAN ; + + +(* + BuildBuiltinTree - returns a Tree containing the builtin function, name. +*) + +PROCEDURE BuildBuiltinTree (location: location_t; name: ADDRESS) : Tree ; + + +(* + BuiltinMemCopy and BuiltinAlloca - are called by M2GenGCC to implement open arrays. +*) + +PROCEDURE BuiltInMemCopy (location: location_t; dest, src, n: Tree) : Tree ; + + +(* + BuiltInAlloca - given an expression, n, allocate, n, bytes on the stack for the life + of the current function. +*) + +PROCEDURE BuiltInAlloca (location: location_t; n: Tree) : Tree ; + + +(* + BuiltInIsfinite - given an expression, e, return an integer Tree of 1 if the + value is finite. Return an integer Tree 0 if the value is + not finite. +*) + +PROCEDURE BuiltInIsfinite (location: location_t; e: Tree) : Tree ; + + +END m2builtins. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2color.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2color.def 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,57 @@ +(* m2color.def interface to gcc colorization. + +Copyright (C) 2019-2022 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 m2color ; + +FROM SYSTEM IMPORT ADDRESS ; + +TYPE + PtrToChar = POINTER TO CHAR ; + + +(* colorize_start returns a C string containing the color escape sequences + mapped onto, name. See diagnostic-color.c for the definitive + list of GCC colors. The name list includes: error, warning, + note, range1, range2, quote, locus, fixit-insert, fixit-delete, + diff-filename, diff-hunk, diff-delete, diff-insert, type-diff. *) + +PROCEDURE colorize_start (show_color: BOOLEAN; + name: ARRAY OF CHAR; name_len: CARDINAL) : PtrToChar ; + +(* colorize_stop return a C string containing the escape sequences to + stop text colorization. *) + +PROCEDURE colorize_stop (show_color: BOOLEAN) : PtrToChar ; + + +(* open_quote return a C string containing the open quote character which + might be a UTF-8 character if on a UTF-8 supporting host. *) + +PROCEDURE open_quote () : PtrToChar ; + + +(* close_quote return a C string containing the close quote character which + might be a UTF-8 character if on a UTF-8 supporting host. *) + +PROCEDURE close_quote () : PtrToChar ; + + +END m2color. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2configure.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2configure.def 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,44 @@ +(* m2configure.def exports configuration constants. + +Copyright (C) 2022 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" m2configure ; + +FROM SYSTEM IMPORT ADDRESS ; +EXPORT QUALIFIED UseUnderscoreForC, FullPathCPP ; + + +CONST +(* + UseUnderscoreForC - true if gcc places an underscore in front of global functions. +*) + UseUnderscoreForC = FALSE ; + + +(* + FullPathCPP - return a string to the full path of the C preprocessor cpp. + It checks the -B option (if provided) otherwise it uses + the STANDARD_LIBEXEC_PREFIX. +*) + +PROCEDURE FullPathCPP () : ADDRESS ; + + +END m2configure. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2convert.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2convert.def 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,98 @@ +(* m2convert.def definition module for m2convert.cc. + +Copyright (C) 2011-2022 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" m2convert ; + +FROM m2tree IMPORT Tree ; +FROM m2linemap IMPORT location_t ; + + +(* + ToWord - converts an expression (Integer or Ordinal type) into + a WORD. +*) + +PROCEDURE ToWord (location: location_t; expr: Tree) : Tree ; + + +(* + ToCardinal - convert an expression, expr, to a CARDINAL. +*) + +PROCEDURE ToCardinal (location: location_t; expr: Tree) : Tree ; + + +(* + ToInteger - convert an expression, expr, to an INTEGER. +*) + +PROCEDURE ToInteger (location: location_t; expr: Tree) : Tree ; + + +(* + ToBitset - convert an expression, expr, to a BITSET. +*) + +PROCEDURE ToBitset (location: location_t; expr: Tree) : Tree ; + + +(* + ConvertToPtr - convert an expression to a void *. +*) + +PROCEDURE ConvertToPtr (p: Tree) : Tree ; + + +(* + BuildConvert - build and return tree VAL(type, value) + checkOverflow determines whether we + should suppress overflow checking. +*) + +PROCEDURE BuildConvert (location: location_t; type: Tree; value: Tree; checkOverflow: BOOLEAN) : Tree ; + + +(* + ConvertConstantAndCheck - in Modula-2 sementics: return( VAL(type, expr) ) + Only to be used for a constant expr, + overflow checking is performed. +*) + +PROCEDURE ConvertConstantAndCheck (location: location_t; type: Tree; expr: Tree) : Tree ; + + +(* + ConvertString - converts string, expr, into a string of type, type. +*) + +PROCEDURE ConvertString (type, expr: Tree) : Tree ; + + +(* + GenericToType - converts, expr, into, type, providing that expr is + a generic system type (byte, word etc). Otherwise + expr is returned unaltered. +*) + +PROCEDURE GenericToType (location: location_t; type, expr: Tree) : Tree ; + + +END m2convert. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2decl.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2decl.def 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,203 @@ +(* m2decl.def definition module for m2decl.cc. + +Copyright (C) 2011-2022 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 m2decl ; + +FROM SYSTEM IMPORT ADDRESS ; +FROM m2tree IMPORT Tree ; +FROM m2linemap IMPORT location_t ; + + +(* + BuildModuleCtor creates the per module constructor used as part of + the dynamic linking scaffold. +*) + +PROCEDURE BuildModuleCtor (moduleCtor: Tree) ; + + +(* + DeclareModuleCtor configures the function to be used as a ctor. +*) + +PROCEDURE DeclareModuleCtor (decl: Tree) : Tree ; + + + +(* + +*) + +PROCEDURE DeclareM2linkForcedModuleInitOrder (location: location_t; + RuntimeOverride: ADDRESS) : Tree ; + + +PROCEDURE DeclareM2linkStaticInitialization (location: location_t; + ScaffoldStatic: INTEGER) : Tree ; + +PROCEDURE BuildPtrToTypeString (location: location_t; string: ADDRESS; type: Tree) : Tree ; + + +(* + GetBitsPerBitset - returns the number of bits in a BITSET. +*) + +PROCEDURE GetBitsPerBitset () : INTEGER ; + + +(* + GetBitsPerInt - returns the number of bits in a INTEGER. +*) + +PROCEDURE GetBitsPerInt () : INTEGER ; + + +(* + GetBitsPerUnit - returns the number of bits in a UNIT. +*) + +PROCEDURE GetBitsPerUnit () : INTEGER ; + + +(* + GetBitsPerWord - returns the number of bits in a WORD. +*) + +PROCEDURE GetBitsPerWord () : INTEGER ; + + +(* + BuildIntegerConstant - return a tree containing the integer value. +*) + +PROCEDURE BuildIntegerConstant (value: INTEGER) : Tree ; + + +(* + BuildStringConstantType - builds a string constant with a type. +*) + +PROCEDURE BuildStringConstantType (length: INTEGER; string: ADDRESS; type: Tree) : Tree ; + + +(* + DeclareKnownVariable - declares a variable in scope, + funcscope. Note that the global variable, + current_function_decl, is altered if + isglobal is TRUE. +*) + +PROCEDURE DeclareKnownVariable (location: location_t; name: ADDRESS; type: Tree; + exported, imported, istemporary, isglobal: BOOLEAN; + scope, initial: Tree) : Tree ; + + +(* + DeclareKnownConstant - given a constant, value, of, type, create a constant in the GCC + symbol table. Note that the name of the constant is not used + as _all_ constants are declared in the global scope. The front end + deals with scoping rules - here we declare all constants with no names + in the global scope. This allows M2SubExp and constant folding routines + the liberty of operating with quadruples which all assume constants can + always be referenced. +*) + +PROCEDURE DeclareKnownConstant (location: location_t; type: Tree; value: Tree) : Tree ; + + +(* + BuildParameterDeclaration - creates and returns one parameter from, name, and, type. + It appends this parameter to the internal param_type_list. + If name is nul then we assume we are creating a function + type declaration and we ignore names. +*) + +PROCEDURE BuildParameterDeclaration (location: location_t; name: ADDRESS; type: Tree; + isreference: BOOLEAN) : Tree ; + + +(* + BuildStartFunctionDeclaration - initializes global variables ready + for building a function. +*) + +PROCEDURE BuildStartFunctionDeclaration (uses_varargs: BOOLEAN) ; + + +(* + BuildEndFunctionDeclaration - build a function which will return a value of returntype. + The arguments have been created by BuildParameterDeclaration. +*) + +PROCEDURE BuildEndFunctionDeclaration (location_begin, location_end: location_t; + name: ADDRESS; returntype: Tree; + isexternal, isnested, ispublic: BOOLEAN) : Tree ; + + +(* + RememberVariables - +*) + +PROCEDURE RememberVariables (l: Tree) ; + + +(* + DetermineSizeOfConstant - given, str, and, base, fill in + needsLong and needsUnsigned appropriately. +*) + +PROCEDURE DetermineSizeOfConstant (location: location_t; + str: ADDRESS; base: CARDINAL; + VAR needsLong, needsUnsigned: BOOLEAN) ; + + +(* + BuildConstLiteralNumber - returns a GCC TREE built from the string, str. + It assumes that, str, represents a legal + number in Modula-2. It always returns a + positive value. +*) + +PROCEDURE BuildConstLiteralNumber (location: location_t; + str: ADDRESS; base: CARDINAL) : Tree ; + + +(* + BuildStringConstant - creates a string constant given a, string, + and, length. +*) + +PROCEDURE BuildStringConstant (string: ADDRESS; length: INTEGER) : Tree ; + + +(* + BuildCStringConstant - creates a string constant given a, string, + and, length. +*) + +PROCEDURE BuildCStringConstant (string: ADDRESS; length: INTEGER) : Tree ; + + + +PROCEDURE GetDeclContext (t: Tree) : Tree ; + + +END m2decl. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2except.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2except.def 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,79 @@ +(* m2except.def provides an interface to build exception trees. + +Copyright (C) 2008-2022 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" m2except ; + +FROM m2tree IMPORT Tree ; +FROM m2linemap IMPORT location_t ; + + +(* + InitExceptions - initialize this module, it declares the + external functions and assigns them to + the appropriate global tree variables. +*) + +PROCEDURE InitExceptions (location: location_t) ; + + +(* + BuildThrow - builds a throw statement and return the tree. +*) + +PROCEDURE BuildThrow (location: location_t; t: Tree) : Tree ; + + +(* + BuildTryBegin - returns a tree representing the 'try' block. +*) + +PROCEDURE BuildTryBegin (location: location_t) : Tree ; + + +(* + BuildTryEnd - builds the end of the Try block and prepares + for the catch handlers. +*) + +PROCEDURE BuildTryEnd (tryBlock: Tree) ; + + +(* + BuildCatchBegin - creates a handler tree for the C++ + statement 'catch (...) {'. + It returns the handler tree. +*) + +PROCEDURE BuildCatchBegin (location: location_t) : Tree ; + + +(* + BuildCatchEnd - completes a try catch block. + It returns the, try_block, tree. + It creates the C++ statement + + '}' which matches the catch above. +*) + +PROCEDURE BuildCatchEnd (location: location_t; handler, tryBlock: Tree) : Tree ; + + +END m2except. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2expr.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2expr.def 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,700 @@ +(* m2expr.def definition module for m2expr.cc. + +Copyright (C) 2011-2022 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" m2expr ; + +FROM SYSTEM IMPORT ADDRESS ; +FROM m2tree IMPORT Tree ; +FROM m2linemap IMPORT location_t ; + + +TYPE + BuildBinCheckProcedure = PROCEDURE (location_t, Tree, Tree, Tree, Tree, Tree) : Tree ; + BuildBinProcedure = PROCEDURE (location_t, Tree, Tree, BOOLEAN) : Tree ; + BuildUnaryProcedure = PROCEDURE (location_t, Tree, BOOLEAN) : Tree ; + BuildUnaryCheckProcedure = PROCEDURE (location_t, Tree, Tree, Tree, Tree) : Tree ; + BuildExprProcedure = PROCEDURE (location_t, Tree, Tree) : Tree ; + BuildSetProcedure = PROCEDURE (location_t, Tree, Tree, Tree, Tree, BOOLEAN) ; + BuildUnarySetProcedure = PROCEDURE (location_t, Tree, BOOLEAN) ; + BuildUnarySetFunction = PROCEDURE (location_t, Tree, BOOLEAN) : Tree ; + + +(* + init - initialise this module. +*) + +PROCEDURE init (location: location_t) ; + + +(* + CompareTrees - returns -1 if e1 < e2, 0 if e1 == e2, and 1 if e1 > e2. +*) + +PROCEDURE CompareTrees (e1: Tree; e2: Tree) : INTEGER ; + + +PROCEDURE GetPointerOne (location: location_t) : Tree ; + + +PROCEDURE GetPointerZero (location: location_t) : Tree ; + + +PROCEDURE GetWordOne (location: location_t) : Tree ; + + +PROCEDURE GetWordZero (location: location_t) : Tree ; + + +PROCEDURE GetIntegerOne (location: location_t) : Tree ; + + +PROCEDURE GetIntegerZero (location: location_t) : Tree ; + + +PROCEDURE GetCardinalOne (location: location_t) : Tree ; + + +PROCEDURE GetCardinalZero (location: location_t) : Tree ; + + +PROCEDURE GetSizeOfInBits (type: Tree) : Tree ; + + +PROCEDURE GetSizeOf (location: location_t; type: Tree) : Tree ; + + +(* + BuildLogicalRotate - builds the ISO Modula-2 ROTATE operator + for a fundamental data type. +*) + +PROCEDURE BuildLogicalRotate (location: location_t; op1: Tree; op2: Tree; op3: Tree; nBits: Tree; needconvert: BOOLEAN) ; + + +(* + BuildLRRn - builds and returns tree (op1 rotate right by op2 bits) + it rotates a set of size, nBits. +*) + +PROCEDURE BuildLRRn (location: location_t; op1: Tree; op2: Tree; nBits: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildLRLn - builds and returns tree (op1 rotate left by op2 bits) + it rotates a set of size, nBits. +*) + +PROCEDURE BuildLRLn (location: location_t; op1: Tree; op2: Tree; nBits: Tree; needconvert: BOOLEAN) : Tree ; + + + +PROCEDURE BuildMask (location: location_t; nBits: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildMult - builds a multiplication tree. +*) + +PROCEDURE BuildMult (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildMultCheck - builds a multiplication tree after checking for overflow. +*) + +PROCEDURE BuildMultCheck (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ; + + +(* + BuildLRR - builds and returns tree (op1 rotate right by op2 bits) +*) + +PROCEDURE BuildLRR (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildLRL - builds and returns tree (op1 rotate left by op2 bits) +*) + +PROCEDURE BuildLRL (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildLogicalShift - builds the ISO Modula-2 SHIFT operator + for a fundamental data type. +*) + +PROCEDURE BuildLogicalShift (location: location_t; op1: Tree; op2: Tree; op3: Tree; nBits: Tree; needconvert: BOOLEAN) ; + + +(* + BuildLSR - builds and returns tree (op1 >> op2) +*) + +PROCEDURE BuildLSR (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildLSL - builds and returns tree (op1 << op2) +*) + +PROCEDURE BuildLSL (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildDivM2 - build and return ((op2 < 0) : (op1 divtrunc op2) ? (op1 divfloor op2)) + when -fiso, -fpim4 or -fpositive-mod-floor-div is present else + return op1 div trunc op2 +*) + +PROCEDURE BuildDivM2 (location: location_t; op1, op2: Tree; needsconvert: BOOLEAN) : Tree ; + + +(* + BuildDivM2Check - build and return ((op2 < 0) : (op1 divtrunc op2) ? (op1 divfloor op2)) + when -fiso, -fpim4 or -fpositive-mod-floor-div is present else + return op1 div trunc op2. Use the checking div equivalents. +*) + +PROCEDURE BuildDivM2Check (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ; + + +(* + BuildModM2 - build and return ((op2 < 0) : (op1 divtrunc op2) ? (op1 divfloor op2)) + when -fiso, -fpim4 or -fpositive-mod-floor-div is present else + return op1 div trunc op2 +*) + +PROCEDURE BuildModM2 (location: location_t; op1, op2: Tree; needsconvert: BOOLEAN) : Tree ; + + +(* + BuildModM2Check - if iso or pim4 then build and return ((op2 < 0) : (op1 + modceil op2) ? (op1 modfloor op2)) otherwise use modtrunc. + Use the checking mod equivalents. + build and return ((op2 < 0) : (op1 divtrunc op2) ? (op1 divfloor op2)) + when -fiso, -fpim4 or -fpositive-mod-floor-div is present else + return op1 div trunc op2. Use the checking div equivalents. +*) + +PROCEDURE BuildModM2Check (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ; + + +(* + BuildModFloor - builds a modulus tree. +*) + +PROCEDURE BuildModFloor (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildDivCeil - builds a division tree. +*) + +PROCEDURE BuildDivCeil (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildModCeil - builds a modulus tree. +*) + +PROCEDURE BuildModCeil (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildDivFloor - builds a division tree. +*) + +PROCEDURE BuildDivFloor (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildModTrunc - builds a modulus tree. +*) + +PROCEDURE BuildModTrunc (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildDivTrunc - builds a division tree. +*) + +PROCEDURE BuildDivTrunc (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildDivTruncCheck - builds a division tree after checking for overflow. +*) + +PROCEDURE BuildDivTruncCheck (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ; + + +(* + BuildRDiv - builds a division tree (this should only be used for REAL and COMPLEX + types and NEVER for integer based types). +*) + +PROCEDURE BuildRDiv (location: location_t; op1, op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildSubCheck - builds a subtraction tree after checking for overflow. +*) + +PROCEDURE BuildSubCheck (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ; + + +(* + BuildAddCheck - builds an addition tree after checking for overflow. +*) + +PROCEDURE BuildAddCheck (location: location_t; op1, op2, lowest, min, max: Tree) : Tree ; + + +(* + BuildSub - builds a subtraction tree. +*) + +PROCEDURE BuildSub (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildAdd - builds an addition tree. +*) + +PROCEDURE BuildAdd (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + FoldAndStrip - return expression, t, after it has been folded (if possible). +*) + +PROCEDURE FoldAndStrip (t: Tree) : Tree ; + + +(* + StringLength - returns an unsigned int which is the length + of, string. +*) + +PROCEDURE StringLength (string: Tree) : CARDINAL ; + + +(* + TreeOverflow - returns TRUE if the contant expression, t, has + caused an overflow. No error message or warning + is emitted and no modification is made to, t. +*) + +PROCEDURE TreeOverflow (t: Tree) : BOOLEAN ; + + +(* + RemoveOverflow - if tree, t, is a constant expression it removes + any overflow flag and returns, t. +*) + +PROCEDURE RemoveOverflow (t: Tree) : Tree ; + + +(* + BuildCoerce - returns a tree containing the expression, expr, after + it has been coersed to, type. +*) + +PROCEDURE BuildCoerce (location: location_t; des: Tree; type: Tree; expr: Tree) : Tree ; + + +(* + BuildTrunc - returns an integer expression from a REAL or LONGREAL op1. +*) + +PROCEDURE BuildTrunc (op1: Tree) : Tree ; + + +(* + BuildNegate - builds a negate expression and returns the tree. +*) + +PROCEDURE BuildNegate (location: location_t; op1: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildNegateCheck - builds a negate expression and returns the tree. +*) + +PROCEDURE BuildNegateCheck (location: location_t; arg, lowest, min, max: Tree) : Tree ; + + +(* + BuildSetNegate - builds a set negate expression and returns the tree. +*) + +PROCEDURE BuildSetNegate (location: location_t; op1: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildTBitSize - returns the minimum number of bits to represent, type. +*) + +PROCEDURE BuildTBitSize (location: location_t; type: Tree) : Tree ; + + +(* + BuildSize - builds a SIZE function expression and returns the tree. +*) + +PROCEDURE BuildSize (location: location_t; op1: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildAddr - builds an expression which calculates the address of + op1 and returns the tree. +*) + +PROCEDURE BuildAddr (location: location_t; op1: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildOffset1 - builds an expression containing the number of bytes the field + is offset from the start of the record structure. + This function is the same as the above, except that it + derives the record from the field and then calls BuildOffset. + The expression is returned. +*) + +PROCEDURE BuildOffset1 (location: location_t; field: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildOffset - builds an expression containing the number of bytes the field + is offset from the start of the record structure. + The expression is returned. +*) + +PROCEDURE BuildOffset (location: location_t; record: Tree; field: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildLogicalOrAddress - build a logical or expressions and return the tree. +*) + +PROCEDURE BuildLogicalOrAddress (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildLogicalOr - build a logical or expressions and return the tree. +*) + +PROCEDURE BuildLogicalOr (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildLogicalAnd - build a logical and expression and return the tree. +*) + +PROCEDURE BuildLogicalAnd (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + + +PROCEDURE BuildSymmetricDifference (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildLogicalDifference - build a logical difference expression and + return the tree. + (op1 and (not op2)) +*) + +PROCEDURE BuildLogicalDifference (location: location_t; op1: Tree; op2: Tree; needconvert: BOOLEAN) : Tree ; + + +(* + BuildLessThan - return a tree which computes < +*) + +PROCEDURE BuildLessThan (location: location_t; op1: Tree; op2: Tree) : Tree ; + + +(* + BuildGreaterThan - return a tree which computes > +*) + +PROCEDURE BuildGreaterThan (location: location_t; op1: Tree; op2: Tree) : Tree ; + + +(* + BuildLessThanOrEqual - return a tree which computes < +*) + +PROCEDURE BuildLessThanOrEqual (location: location_t; op1: Tree; op2: Tree) : Tree ; + + +(* + BuildGreaterThanOrEqual - return a tree which computes >= +*) + +PROCEDURE BuildGreaterThanOrEqual (location: location_t; op1: Tree; op2: Tree) : Tree ; + + +(* + BuildEqualTo - return a tree which computes = +*) + +PROCEDURE BuildEqualTo (location: location_t; op1: Tree; op2: Tree) : Tree ; + + + +PROCEDURE BuildNotEqualTo (location: location_t; op1: Tree; op2: Tree) : Tree ; + + +(* + BuildIsSuperset - return a tree which computes: op1 & op2 == op2 +*) + +PROCEDURE BuildIsSuperset (location: location_t; op1: Tree; op2: Tree) : Tree ; + + +(* + BuildIsNotSuperset - return a tree which computes: op1 & op2 != op2 +*) + +PROCEDURE BuildIsNotSuperset (location: location_t; op1: Tree; op2: Tree) : Tree ; + + +(* + BuildIsSubset - return a tree which computes: op1 & op2 == op1 +*) + +PROCEDURE BuildIsSubset (location: location_t; op1: Tree; op2: Tree) : Tree ; + + +(* + BuildIsNotSubset - return a tree which computes: op1 & op2 != op1 +*) + +PROCEDURE BuildIsNotSubset (location: location_t; op1: Tree; op2: Tree) : Tree ; + + +(* + BuildIfConstInVar - generates: if constel in varset then goto label. +*) + +PROCEDURE BuildIfConstInVar (location: location_t; type: Tree; varset: Tree; constel: Tree; is_lvalue: BOOLEAN; fieldno: INTEGER; label: ADDRESS) ; + + + +PROCEDURE BuildIfNotConstInVar (location: location_t; type: Tree; varset: Tree; constel: Tree; is_lvalue: BOOLEAN; fieldno: INTEGER; label: ADDRESS) ; + + +(* + BuildIfVarInVar - generates: if varel in varset then goto label +*) + +PROCEDURE BuildIfVarInVar (location: location_t; type: Tree; varset: Tree; varel: Tree; is_lvalue: BOOLEAN; low: Tree; high: Tree; label: ADDRESS) ; + + +(* + BuildIfNotVarInVar - generates: if not (varel in varset) then goto label +*) + +PROCEDURE BuildIfNotVarInVar (location: location_t; type: Tree; varset: Tree; varel: Tree; is_lvalue: BOOLEAN; low: Tree; high: Tree; label: ADDRESS) ; + + +(* + BuildForeachWordInSetDoIfExpr - foreach word in set, type, compute the expression, expr, and if true + goto label. +*) + +PROCEDURE BuildForeachWordInSetDoIfExpr (location: location_t; + type, op1, op2: Tree; + is_op1lvalue, is_op2lvalue, + is_op1const, isop2const: BOOLEAN; + expr: BuildExprProcedure; label: ADDRESS) ; + + +(* + BuildIfInRangeGoto - if var is in the range low..high then goto label +*) + +PROCEDURE BuildIfInRangeGoto (location: location_t; var: Tree; low: Tree; high: Tree; label: ADDRESS) ; + + +(* + BuildIfNotInRangeGoto - if var is not in the range low..high then goto label +*) + +PROCEDURE BuildIfNotInRangeGoto (location: location_t; var: Tree; low: Tree; high: Tree; label: ADDRESS) ; + + +(* + BuildArray - returns a tree which accesses array[index] + given, lowIndice. +*) + +PROCEDURE BuildArray (location: location_t; type: Tree; array: Tree; index: Tree; lowIndice: Tree) : Tree ; + + +(* + BuildComponentRef - build a component reference tree which accesses record.field. + If field does not belong to record it calls + BuildComponentRef on the penultimate field. +*) + +PROCEDURE BuildComponentRef (location: location_t; record: Tree; field: Tree) : Tree ; + + +(* + BuildIndirect - build: ( *target) given that the object to be copied is of, type. +*) + +PROCEDURE BuildIndirect (location: location_t; target: Tree; type: Tree) : Tree ; + + +(* + IsTrue - returns TRUE if, t, is known to be TRUE. +*) + +PROCEDURE IsTrue (t: Tree) : BOOLEAN ; + + +(* + IsFalse - returns FALSE if, t, is known to be FALSE. +*) + +PROCEDURE IsFalse (t: Tree) : BOOLEAN ; + + +(* + AreConstantsEqual - maps onto tree.c (tree_int_cst_equal). It returns + TRUE if the value of e1 is the same as e2. +*) + +PROCEDURE AreConstantsEqual (e1: Tree; e2: Tree) : BOOLEAN ; + + +(* + AreRealOrComplexConstantsEqual - returns TRUE if constants, + e1 and e2 are equal according + to IEEE rules. This does not + perform bit equivalence for + example IEEE states that + -0 == 0 and NaN != NaN. +*) + +PROCEDURE AreRealOrComplexConstantsEqual (e1: Tree; e2: Tree) : BOOLEAN ; + + +(* + DetermineSign - returns -1 if e<0 + 0 if e==0 + 1 if e>0 + + an unsigned constant will never return -1 +*) + +PROCEDURE DetermineSign (e: Tree) : INTEGER ; + + +(* + BuildCap - builds the Modula-2 function CAP(t) and returns + the result in a gcc Tree. +*) + +PROCEDURE BuildCap (location: location_t; t: Tree) : Tree ; + + +(* + BuildAbs - builds the Modula-2 function ABS(t) and returns + the result in a gcc Tree. +*) + +PROCEDURE BuildAbs (location: location_t; t: Tree) : Tree ; + + +(* + BuildRe - builds an expression for the function RE. +*) + +PROCEDURE BuildRe (op1: Tree) : Tree ; + + +(* + BuildIm - builds an expression for the function IM. +*) + +PROCEDURE BuildIm (op1: Tree) : Tree ; + + +(* + BuildCmplx - builds an expression for the function CMPLX. +*) + +PROCEDURE BuildCmplx (location: location_t; type: Tree; real: Tree; imag: Tree) : Tree ; + + +(* + BuildBinaryForeachWordDo - provides the large set operators. Each word + (or less) of the set can be calculated by binop. + This procedure runs along each word of the + large set invoking the binop. +*) + +PROCEDURE BuildBinaryForeachWordDo (location: location_t; + type, op1, op2, op3: Tree; + binop: BuildBinProcedure; + is_op1lvalue, + is_op2lvalue, + is_op3lvalue, + is_op1_const, + is_op2_const, + is_op3_const: BOOLEAN) ; + +(* + BuildBinarySetDo - if the size of the set is <= TSIZE(WORD) then + op1 := binop(op2, op3) + else + call m2rtsprocedure(op1, op2, op3) +*) + +PROCEDURE BuildBinarySetDo (location: location_t; + settype, op1, op2, op3: Tree; + binop: BuildSetProcedure; + is_op1lvalue, is_op2lvalue, is_op3lvalue: BOOLEAN; + nBits, unbounded: Tree; + varproc, leftproc, rightproc: Tree) ; + +(* + ConstantExpressionWarning - issue a warning if the constant has overflowed. +*) + +PROCEDURE ConstantExpressionWarning (value: Tree) ; + + +(* + BuildAddAddress - returns an expression op1+op2 where op1 is a pointer type + and op2 is not a pointer type. +*) + +PROCEDURE BuildAddAddress (location: location_t; op1, op2: Tree) : Tree ; + + +END m2expr. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2linemap.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2linemap.def 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,61 @@ +(* m2linemap.def provides access to GCC location_t. + +Copyright (C) 2011-2022 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" m2linemap ; + +FROM SYSTEM IMPORT ADDRESS ; + +EXPORT QUALIFIED StartFile, EndFile, StartLine, GetLocationColumn, GetLocationRange, + GetLocationBinary, UnknownLocation, BuiltinsLocation, + GetLineNoFromLocation, GetColumnNoFromLocation, + GetFilenameFromLocation, ErrorAt, ErrorAtf, + WarningAtf, NoteAtf, internal_error, location_t ; + +TYPE + location_t = INTEGER ; + + +PROCEDURE StartFile (filename: ADDRESS; linebegin: CARDINAL) ; +PROCEDURE EndFile ; +PROCEDURE StartLine (linenumber: CARDINAL; linesize: CARDINAL) ; +PROCEDURE GetLocationColumn (column: CARDINAL) : location_t ; +PROCEDURE GetLocationRange (start, end: CARDINAL) : location_t ; +PROCEDURE GetLocationBinary (caret, left, right: location_t) : location_t ; + +PROCEDURE UnknownLocation () : location_t ; +PROCEDURE BuiltinsLocation () : location_t ; + +PROCEDURE GetLineNoFromLocation (location: location_t) : INTEGER ; +PROCEDURE GetColumnNoFromLocation (location: location_t) : INTEGER ; +PROCEDURE GetFilenameFromLocation (location: location_t) : ADDRESS ; +PROCEDURE ErrorAt (location: location_t; message: ADDRESS) ; +(* +PROCEDURE ErrorAtf (location: location_t; message: ADDRESS; ...) ; +PROCEDURE WarningAtf (location: location_t; message: ADDRESS; ...) ; +PROCEDURE NoteAtf (location: location_t; message: ADDRESS; ...) ; +*) +PROCEDURE ErrorAtf (location: location_t; message: ADDRESS) ; +PROCEDURE WarningAtf (location: location_t; message: ADDRESS) ; +PROCEDURE NoteAtf (location: location_t; message: ADDRESS) ; +PROCEDURE internal_error (message: ADDRESS) ; + + +END m2linemap. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2misc.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2misc.def 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,29 @@ +(* m2misc.def definition module for m2misc.cc. + +Copyright (C) 2011-2022 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" m2misc ; + +FROM m2tree IMPORT Tree ; + +PROCEDURE DebugTree (t: Tree) ; + + +END m2misc. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2statement.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2statement.def 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,312 @@ +(* m2statement.def definition module for m2statement.cc. + +Copyright (C) 2011-2022 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" m2statement ; + + +FROM SYSTEM IMPORT ADDRESS ; +FROM m2tree IMPORT Tree ; +FROM m2linemap IMPORT location_t ; +FROM m2expr IMPORT BuildUnarySetFunction ; + + +(* + DoJump - jump to the appropriate label depending whether + result of the expression is TRUE or FALSE. +*) + +PROCEDURE DoJump (location: location_t; exp: Tree; falselabel: ADDRESS; truelabel: ADDRESS) ; + + +(* + BuildStartFunctionCode - generate function entry code. +*) + +PROCEDURE BuildStartFunctionCode (location: location_t; fndecl: Tree; isexported: BOOLEAN; isinline: BOOLEAN) ; + + +(* + BuildEndFunctionCode - generates the function epilogue. +*) + +PROCEDURE BuildEndFunctionCode (location: location_t; fndecl: Tree; nested: BOOLEAN) ; + + +(* + BuildReturnValueCode - generates the code associated with: RETURN( value ) +*) + +PROCEDURE BuildReturnValueCode (location: location_t; fndecl: Tree; value: Tree) ; + + +(* + BuildPushFunctionContext - pushes the current function context. + Maps onto push_function_context in ../function.c +*) + +PROCEDURE BuildPushFunctionContext ; + + +(* + BuildPopFunctionContext - pops the current function context. + Maps onto pop_function_context in ../function.c +*) + +PROCEDURE BuildPopFunctionContext ; + + +(* + BuildAssignmentTree - builds the assignment of, des, and, expr. + It returns, des. +*) + +PROCEDURE BuildAssignmentTree (location: location_t; des, expr: Tree) : Tree ; + + +(* + BuildAssignmentStatement builds the assignment of, des, and, expr. +*) + +PROCEDURE BuildAssignmentStatement (location: location_t; des, expr: Tree) ; + + +(* + BuildGoto - builds a goto operation. +*) + +PROCEDURE BuildGoto (location: location_t; name: ADDRESS) ; + + +(* + DeclareLabel - create a label, name. +*) + +PROCEDURE DeclareLabel (location: location_t; name: ADDRESS) ; + + +(* + BuildIfThenDoEnd - returns a tree which will only execute + statement, s, if, condition, is true. +*) + +PROCEDURE BuildIfThenDoEnd (condition: Tree; then_block: Tree) : Tree ; + + +(* + BuildIfThenElseEnd - returns a tree which will execute + then_block or else_block depending upon, + condition. +*) + +PROCEDURE BuildIfThenElseEnd (condition: Tree; then_block: Tree; else_block: Tree) : Tree ; + + +(* + BuildParam - build a list of parameters, ready for a subsequent procedure call. +*) + +PROCEDURE BuildParam (location: location_t; param: Tree) ; + + +(* + BuildFunctionCallTree - creates a procedure function call from + a procedure and parameter list and the + return type, rettype. No tree is returned + as the tree is held in the last_function + global variable. It is expected the + BuildFunctValue is to be called after + a call to BuildFunctionCallTree. +*) + +PROCEDURE BuildFunctionCallTree (location: location_t; procedure: Tree; rettype: Tree) ; + + +(* + BuildProcedureCallTree - creates a procedure call from a procedure and + parameter list and the return type, rettype. +*) + +PROCEDURE BuildProcedureCallTree (location: location_t; procedure: Tree; rettype: Tree) : Tree ; + + +(* + BuildIndirectProcedureCallTree - creates a procedure call from a procedure and + parameter list and the return type, rettype. +*) + +PROCEDURE BuildIndirectProcedureCallTree (location: location_t; procedure: Tree; rettype: Tree) : Tree ; + + +(* + BuildFunctValue - generates code for value := last_function(foobar); +*) + +PROCEDURE BuildFunctValue (location: location_t; value: Tree) : Tree ; + + +(* + BuildCall2 - builds a tree representing: function(arg1, arg2). +*) + +PROCEDURE BuildCall2 (location: location_t; + function, rettype, arg1, arg2: Tree) : Tree ; + + +(* + BuildCall3 - builds a tree representing: function(arg1, arg2, arg3). +*) + +PROCEDURE BuildCall3 (location: location_t; + function, rettype, arg1, arg2, arg3: Tree) : Tree ; + + +(* + SetLastFunction - set the last_function to, t. +*) + +PROCEDURE SetLastFunction (t: Tree) ; + + +(* + GetLastFunction - returns, last_function. +*) + +PROCEDURE GetLastFunction () : Tree ; + + +(* + GetParamTree - return parameter, i. +*) + +PROCEDURE GetParamTree (call: Tree; i: CARDINAL) : Tree ; + + +(* + BuildTryFinally - returns a TRY_FINALL_EXPR with the call and cleanups + attached. +*) + +PROCEDURE BuildTryFinally (location: location_t; call: Tree; cleanups: Tree) : Tree ; + + +(* + BuildCleanUp - return a CLEANUP_POINT_EXPR which will clobber, param. +*) + +PROCEDURE BuildCleanUp (param: Tree) : Tree ; + + +(* + BuildAsm - generates an inline assembler instruction. +*) + +PROCEDURE BuildAsm (location: location_t; instr: Tree; + isVolatile: BOOLEAN; isSimple: BOOLEAN; + inputs: Tree; outputs: Tree; trash: Tree; labels: Tree) ; + + +(* + BuildUnaryForeachWordDo - provides the large set operators. + Each word (or less) of the set can be + calculated by unop. + This procedure iterates over each word + of the large set invoking the unop. +*) + +PROCEDURE BuildUnaryForeachWordDo (location: location_t; type: Tree; op1: Tree; op2: Tree; + unop: BuildUnarySetFunction; + is_op1lvalue, is_op2lvalue, is_op1const, is_op2const: BOOLEAN) ; + + +(* + BuildExcludeVarConst - builds the EXCL(op1, 1<. + +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" m2top ; + + +(* + SetFlagUnitAtATime - sets GCC flag_unit_at_a_time to b. +*) + +PROCEDURE SetFlagUnitAtATime (b: BOOLEAN) ; + + +(* + StartGlobalContext - initializes a dummy function for the global scope. +*) + +PROCEDURE StartGlobalContext ; + + +(* + EndGlobalContext - ends the dummy function for the global scope. +*) + +PROCEDURE EndGlobalContext ; + + +END m2top. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2tree.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2tree.def 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,41 @@ +(* m2tree.def definition module for m2tree.cc. + +Copyright (C) 2011-2022 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" m2tree ; + +FROM SYSTEM IMPORT ADDRESS ; + +TYPE + Tree = ADDRESS ; + + +PROCEDURE IsAConstant (t: Tree) : BOOLEAN ; +PROCEDURE IsOrdinal (type: Tree) : BOOLEAN ; +PROCEDURE IsTreeOverflow (value: Tree) : BOOLEAN ; +PROCEDURE skip_const_decl (exp: Tree) : Tree ; +PROCEDURE skip_type_decl (type: Tree) : Tree ; +PROCEDURE is_type (type: Tree) : BOOLEAN ; +PROCEDURE is_array (array: Tree) : BOOLEAN ; +PROCEDURE is_var (var: Tree) : BOOLEAN ; +PROCEDURE debug_tree (t: Tree) ; + + +END m2tree. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2treelib.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2treelib.def 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,109 @@ +(* m2treelib.def definition module for m2treelib.cc. + +Copyright (C) 2011-2022 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" m2treelib ; + +FROM m2tree IMPORT Tree ; +FROM m2linemap IMPORT location_t ; +FROM SYSTEM IMPORT ADDRESS ; + +TYPE + tree_code = INTEGER ; + + +(* + get_set_address_if_var - returns the address of, op, providing + it is not a constant. + NULL is returned if, op, is a constant. +*) + +PROCEDURE get_set_address_if_var (location: location_t; op: Tree; is_lvalue: INTEGER; is_const: INTEGER) : Tree ; + + +(* + get_set_field_rhs - returns the value of p->field. +*) + +PROCEDURE get_set_field_rhs (location: location_t; p: Tree; field: Tree) : Tree ; + + +(* + get_set_field_lhs - returns the address of p->field. +*) + +PROCEDURE get_set_field_lhs (location: location_t; p: Tree; field: Tree) : Tree ; + + +(* + get_set_address - returns the address of op1. +*) + +PROCEDURE get_set_address (location: location_t; op1: Tree; is_lvalue: INTEGER) : Tree ; + + +(* + get_set_value - returns the value indicated by, field, in the set. + Either p->field or the constant(op.fieldNo) is returned. +*) + +PROCEDURE get_set_value (location: location_t; p: Tree; field: Tree; is_const: INTEGER; op: Tree; fieldNo: CARDINAL) : Tree ; + + +(* + get_field_no - returns the field no for, op. The, op, is either + a constructor or a variable of type record. + If, op, is a constructor (a set constant in GNU Modula-2) + then this function is essentially a no-op and it returns op. + Else we iterate over the field list and return the + appropriate field number. +*) + +PROCEDURE get_field_no (type: Tree; op: Tree; is_const: INTEGER; fieldNo: CARDINAL) : Tree ; + + +(* + get_rvalue - returns the rvalue of t. The, type, is the object type to be + copied upon indirection. +*) + +PROCEDURE get_rvalue (location: location_t; t: Tree; type: Tree; is_lvalue: INTEGER) : Tree ; + + +(* + DoCall - build a call tree arranging the parameter list as a vector. +*) + +PROCEDURE DoCall (location: location_t; rettype: Tree; funcptr: Tree; param_list: Tree) : Tree ; + + + +PROCEDURE build_modify_expr (location: location_t; des: Tree; modifycode: tree_code; copy: Tree) : Tree ; + + +(* + do_jump_if_bit - tests bit in word against integer zero using operator, code. + If the result is true then jump to label. +*) + +PROCEDURE do_jump_if_bit (location: location_t; code: tree_code; word: Tree; bit: Tree; label: ADDRESS) ; + + +END m2treelib. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2type.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2type.def 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,986 @@ +(* m2type.def definition module for m2type.cc. + +Copyright (C) 2011-2022 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" m2type ; + +FROM SYSTEM IMPORT ADDRESS ; +FROM m2tree IMPORT Tree ; +FROM m2linemap IMPORT location_t ; + + +TYPE + Constructor = ADDRESS ; + + +(* + ValueInTypeRange - returns TRUE if the constant, value, lies in the range + of, type. +*) + +PROCEDURE ValueInTypeRange (type: Tree; value: Tree) : BOOLEAN ; + + +(* + ValueOutOfTypeRange - returns TRUE if the constant, value, exceed the range + of, type. +*) + +PROCEDURE ValueOutOfTypeRange (type: Tree; value: Tree) : BOOLEAN ; + + +(* + ExceedsTypeRange - return TRUE if low or high exceed the range of, type. +*) + +PROCEDURE ExceedsTypeRange (type: Tree; low, high: Tree) : BOOLEAN ; + + +(* + WithinTypeRange - return TRUE if low and high are within the range of, type. +*) + +PROCEDURE WithinTypeRange (type: Tree; low, high: Tree) : BOOLEAN ; + + +(* + BuildSubrangeType - creates a subrange of, type, with, lowval, highval. +*) + +PROCEDURE BuildSubrangeType (location: location_t; name: ADDRESS; type: Tree; lowval: Tree; highval: Tree) : Tree ; + + +(* + BuildCharConstant - creates a character constant given a, string. +*) + +PROCEDURE BuildCharConstant (location: location_t; string: ADDRESS) : Tree ; + + +(* + BuildCharConstantChar - creates a character constant given a character, ch. +*) + +PROCEDURE BuildCharConstantChar (location: location_t; ch: CHAR) : Tree ; + + +(* + BuildArrayConstructorElement - adds, value, to the constructor_element_list. +*) + +PROCEDURE BuildArrayConstructorElement (p: ADDRESS; value: Tree; indice: Tree) ; + + +(* + BuildEndArrayConstructor - returns a tree containing the array + compound literal. +*) + +PROCEDURE BuildEndArrayConstructor (p: Constructor) : Tree ; + + +(* + BuildEndArrayConstructor - returns a tree containing the array + compound literal. +*) + +PROCEDURE BuildStartArrayConstructor (type: Tree) : Constructor ; + + +(* + BuildRecordConstructorElement - adds, value, to the constructor_element_list. +*) + +PROCEDURE BuildRecordConstructorElement (p: Constructor; value: Tree) ; + + +(* + BuildEndRecordConstructor - returns a tree containing the record compound literal. +*) + +PROCEDURE BuildEndRecordConstructor (p: Constructor) : Tree ; + + +(* + BuildStartRecordConstructor - initializes a record compound + constructor frame. +*) + +PROCEDURE BuildStartRecordConstructor (type: Tree) : Constructor ; + + +(* + BuildEndSetConstructor - finishes building a set constant. +*) + +PROCEDURE BuildEndSetConstructor (p: Constructor) : Tree ; + + +(* + BuildSetConstructorElement - adds, value, to the constructor_element_list. +*) + +PROCEDURE BuildSetConstructorElement (p: Constructor; value: Tree) ; + + +(* + BuildStartSetConstructor - starts to create a set constant. + Remember that type is really a record type. +*) + +PROCEDURE BuildStartSetConstructor (type: Tree) : Constructor ; + + +(* + BuildSetType - creates a SET OF [lowval..highval] +*) + +PROCEDURE BuildSetType (location: location_t; name: ADDRESS; type: Tree; lowval: Tree; highval: Tree; ispacked: BOOLEAN) : Tree ; + + +(* + BuildConstPointerType - returns a type which is a const pointer to, totype. +*) + +PROCEDURE BuildConstPointerType (totype: Tree) : Tree ; + + +(* + BuildPointerType - returns a type which is a pointer to, totype. +*) + +PROCEDURE BuildPointerType (totype: Tree) : Tree ; + + +(* + BuildEnumerator - build an enumerator and add it to the, enumvalues, list. + It returns a copy of the value. --fixme-- why do this? +*) + +PROCEDURE BuildEnumerator (location: location_t; name: ADDRESS; value: Tree; + VAR enumvalues: Tree) : Tree ; + + +(* + BuildEndEnumeration - finish building the enumeration, it uses the enum + list, enumvalues, and returns a enumeration type tree. +*) + +PROCEDURE BuildEndEnumeration (location: location_t; type: Tree; enumvalues: Tree) : Tree ; + + +(* + BuildStartEnumeration - create an enumerated type in gcc. +*) + +PROCEDURE BuildStartEnumeration (location: location_t; name: ADDRESS; ispacked: BOOLEAN) : Tree ; + + +(* + BuildTypeDeclaration - adds the, type, to the current statement list. +*) + +PROCEDURE BuildTypeDeclaration (location: location_t; type: Tree) ; + + +(* + GetMaxFrom - given a, type, return a constant representing the maximum + legal value. +*) + +PROCEDURE GetMaxFrom (location: location_t; type: Tree) : Tree ; + + +(* + GetMinFrom - given a, type, return a constant representing the minimum + legal value. +*) + +PROCEDURE GetMinFrom (location: location_t; type: Tree) : Tree ; + + +(* + GetDefaultType - given a, type, with a, name, return a GCC declaration of this type. + Checks to see whether the type name has already been declared as a + default type and if so it returns this declaration. Otherwise it + declares the type. In Modula-2 this is equivalent to: + + TYPE + name = type ; + + We need this function as the initialization to gccgm2.c will + declare C default types and _some_ M2 default types. +*) + +PROCEDURE GetDefaultType (location: location_t; name: ADDRESS; type: Tree) : Tree ; + + +(* + BuildEndType - finish declaring, type, and return, type. +*) + +PROCEDURE BuildEndType (location: location_t; type: Tree) : Tree ; + + +(* + BuildStartType - given a, type, with a, name, return a GCC declaration of this type. + TYPE + name = foo ; + + the type, foo, maybe a partially created type (which has + yet to be 'gm2_finish_decl'ed. +*) + +PROCEDURE BuildStartType (location: location_t; name: ADDRESS; type: Tree) : Tree ; + + +(* + InitSystemTypes - +*) + +PROCEDURE InitSystemTypes (location: location_t; loc: INTEGER) ; + + +(* + InitBaseTypes - +*) + +PROCEDURE InitBaseTypes (location: location_t) ; + + +(* + BuildVariableArrayAndDeclare - creates a variable length array. + high is the maximum legal elements (which is a runtime variable). + This creates and array index, array type and local variable. +*) + +PROCEDURE BuildVariableArrayAndDeclare (location: location_t; elementtype: Tree; high: Tree; name: ADDRESS; scope: Tree) : Tree ; + + +(* + InitFunctionTypeParameters - resets the current function type parameter list. +*) + +PROCEDURE InitFunctionTypeParameters ; + + +(* + BuildProcTypeParameterDeclaration - creates and returns one parameter from, name, and, type. + It appends this parameter to the internal param_type_list. +*) + +PROCEDURE BuildProcTypeParameterDeclaration (location: location_t; type: Tree; isreference: BOOLEAN) : Tree ; + + +(* + BuildStartFunctionType - creates a pointer type, necessary to + create a function type. +*) + +PROCEDURE BuildStartFunctionType (location: location_t; name: ADDRESS) : Tree ; + + +(* + BuildEndFunctionType - build a function type which would return a, value. + The arguments have been created by BuildParameterDeclaration. +*) + +PROCEDURE BuildEndFunctionType (func: Tree; type: Tree; usesvarags: BOOLEAN) : Tree ; + + +(* + GetTreeType - returns TREE_TYPE (t). +*) + +PROCEDURE GetTreeType (type: Tree) : Tree ; + + +(* + DeclareKnownType - given a, type, with a, name, return a GCC declaration of this type. + TYPE + name = foo ; +*) + +PROCEDURE DeclareKnownType (location: location_t; name: ADDRESS; type: Tree) : Tree ; + + +(* + GetM2ZType - return the ISO Z data type, the longest int datatype. +*) + +PROCEDURE GetM2ZType () : Tree ; + + +(* + GetM2RType - return the ISO R data type, the longest real datatype. +*) + +PROCEDURE GetM2RType () : Tree ; + + +(* + BuildSetTypeFromSubrange - constructs a set type from a subrangeType. +*) + +PROCEDURE BuildSetTypeFromSubrange (location: location_t; name: ADDRESS; + subrangeType: Tree; + lowval: Tree; highval: Tree; + ispacked: BOOLEAN) : Tree ; + + +(* + BuildSmallestTypeRange - returns the smallest INTEGER_TYPE which is + sufficient to contain values: low..high. +*) + +PROCEDURE BuildSmallestTypeRange (location: location_t; low: Tree; high: Tree) : Tree ; + + +(* + GetBooleanType - +*) + +PROCEDURE GetBooleanType () : Tree ; + + +(* + GetBooleanFalse - +*) + +PROCEDURE GetBooleanFalse () : Tree ; + + +(* + GetBooleanTrue - +*) + +PROCEDURE GetBooleanTrue () : Tree ; + + +(* + GetPackedBooleanType - return the packed boolean data type node. +*) + +PROCEDURE GetPackedBooleanType () : Tree ; + + +(* + GetCharType - return the char type node. +*) + +PROCEDURE GetCharType () : Tree ; + + +(* + GetByteType - return the byte type node. +*) + +PROCEDURE GetByteType () : Tree ; + + +(* + GetVoidType - return the C void type. +*) + +PROCEDURE GetVoidType () : Tree ; + + +(* + GetBitnumType - return the ISO bitnum type. +*) + +PROCEDURE GetBitnumType () : Tree ; + + +(* + GetRealType - +*) + +PROCEDURE GetRealType () : Tree ; + + +(* + GetLongRealType - return the C long double data type. +*) + +PROCEDURE GetLongRealType () : Tree ; + + +(* + GetShortRealType - return the C float data type. +*) + +PROCEDURE GetShortRealType () : Tree ; + + +(* + GetLongIntType - return the C long int data type. +*) + +PROCEDURE GetLongIntType () : Tree ; + + +(* + GetPointerType - return the GCC ptr type node. Equivalent to (void * ). +*) + +PROCEDURE GetPointerType () : Tree ; + + +(* + GetCardinalType - return the cardinal type. +*) + +PROCEDURE GetCardinalType () : Tree ; + + +(* + GetIntegerType - return the integer type node. +*) + +PROCEDURE GetIntegerType () : Tree ; + + +(* + GetWordType - return the C unsigned data type. +*) + +PROCEDURE GetWordType () : Tree ; + + +(* + GetM2CardinalType - return the m2 cardinal data type. +*) + +PROCEDURE GetM2CardinalType () : Tree ; + + +(* + GetBitsetType - return the bitset type. +*) + +PROCEDURE GetBitsetType () : Tree ; + + +(* + GetM2CType - a test function. +*) + +PROCEDURE GetM2CType () : Tree ; + + +(* + GetProcType - return the m2 proc data type. +*) + +PROCEDURE GetProcType () : Tree ; + + +(* + GetM2ComplexType - return the complex type. +*) + +PROCEDURE GetM2ComplexType () : Tree ; + + +(* + GetM2LongComplexType - return the long complex type. +*) + +PROCEDURE GetM2LongComplexType () : Tree ; + + +(* + GetM2ShortComplexType - return the short complex type. +*) + +PROCEDURE GetM2ShortComplexType () : Tree ; + + +(* + GetM2Complex128Type - return the fixed size complex type. +*) + +PROCEDURE GetM2Complex128 () : Tree ; + + +(* + GetM2Complex96 - return the fixed size complex type. +*) + +PROCEDURE GetM2Complex96 () : Tree ; + + +(* + GetM2Complex64 - return the fixed size complex type. +*) + +PROCEDURE GetM2Complex64 () : Tree ; + + +(* + GetM2Complex32 - return the fixed size complex type. +*) + +PROCEDURE GetM2Complex32 () : Tree ; + + +(* + GetM2Real128 - return the real 128 bit type. +*) + +PROCEDURE GetM2Real128 () : Tree ; + + +(* + GetM2Real96 - return the real 96 bit type. +*) + +PROCEDURE GetM2Real96 () : Tree ; + + +(* + GetM2Real64 - return the real 64 bit type. +*) + +PROCEDURE GetM2Real64 () : Tree ; + + +(* + GetM2Real32 - return the real 32 bit type. +*) + +PROCEDURE GetM2Real32 () : Tree ; + + +(* + GetM2Bitset32 - return the bitset 32 bit type. +*) + +PROCEDURE GetM2Bitset32 () : Tree ; + + +(* + GetM2Bitset16 - return the bitset 16 bit type. +*) + +PROCEDURE GetM2Bitset16 () : Tree ; + + +(* + GetM2Bitset8 - return the bitset 8 bit type. +*) + +PROCEDURE GetM2Bitset8 () : Tree ; + + +(* + GetM2Word64 - return the word 64 bit type. +*) + +PROCEDURE GetM2Word64 () : Tree ; + + +(* + GetM2Word32 - return the word 32 bit type. +*) + +PROCEDURE GetM2Word32 () : Tree ; + + +(* + GetM2Word16 - return the word 16 bit type. +*) + +PROCEDURE GetM2Word16 () : Tree ; + + +(* + GetM2Cardinal64 - return the cardinal 64 bit type. +*) + +PROCEDURE GetM2Cardinal64 () : Tree ; + + +(* + GetM2Cardinal32 - return the cardinal 32 bit type. +*) + +PROCEDURE GetM2Cardinal32 () : Tree ; + + +(* + GetM2Cardinal16 - return the cardinal 16 bit type. +*) + +PROCEDURE GetM2Cardinal16 () : Tree ; + + +(* + GetM2Cardinal8 - return the cardinal 8 bit type. +*) + +PROCEDURE GetM2Cardinal8 () : Tree ; + + +(* + GetM2Integer64 - return the integer 64 bit type. +*) + +PROCEDURE GetM2Integer64 () : Tree ; + + +(* + GetM2Integer32 - return the integer 32 bit type. +*) + +PROCEDURE GetM2Integer32 () : Tree ; + + +(* + GetM2Integer16 - return the integer 16 bit type. +*) + +PROCEDURE GetM2Integer16 () : Tree ; + + +(* + GetM2Integer8 - return the integer 8 bit type. +*) + +PROCEDURE GetM2Integer8 () : Tree ; + + +(* + GetISOLocType - return the m2 loc word data type. +*) + +PROCEDURE GetISOLocType () : Tree ; + + +(* + GetISOByteType - return the m2 iso byte data type. +*) + +PROCEDURE GetISOByteType () : Tree ; + + +(* + GetISOWordType - return the m2 iso word data type. +*) + +PROCEDURE GetISOWordType () : Tree ; + + +(* + GetShortCardType - return the C short unsigned data type. +*) + +PROCEDURE GetShortCardType () : Tree ; + + +(* + GetM2ShortCardType - return the m2 short cardinal data type. +*) + +PROCEDURE GetM2ShortCardType () : Tree ; + + +(* + GetShortIntType - return the C short int data type. +*) + +PROCEDURE GetShortIntType () : Tree ; + + +(* + GetM2ShortIntType - return the m2 short integer data type. +*) + +PROCEDURE GetM2ShortIntType () : Tree ; + + +(* + GetM2LongCardType - return the m2 long cardinal data type. +*) + +PROCEDURE GetM2LongCardType () : Tree ; + + +(* + GetM2LongIntType - return the m2 long integer data type. +*) + +PROCEDURE GetM2LongIntType () : Tree ; + + +(* + GetM2LongRealType - return the m2 long real data type. +*) + +PROCEDURE GetM2LongRealType () : Tree ; + + +(* + GetM2RealType - return the m2 real data type. +*) + +PROCEDURE GetM2RealType () : Tree ; + + +(* + GetM2ShortRealType - return the m2 short real data type. +*) + +PROCEDURE GetM2ShortRealType () : Tree ; + + +(* + GetM2IntegerType - return the m2 integer data type. +*) + +PROCEDURE GetM2IntegerType () : Tree ; + + +(* + GetM2CharType - return the m2 char data type. +*) + +PROCEDURE GetM2CharType () : Tree ; + + +(* + GetCSizeTType - return a type representing, size_t on this system. +*) + +PROCEDURE GetCSizeTType () : Tree ; + + +(* + GetCSSizeTType - return a type representing, ssize_t on this system. +*) + +PROCEDURE GetCSSizeTType () : Tree ; + + +(* + BuildArrayStringConstructor - creates an array constructor for, arrayType, + consisting of the character elements + defined by, str, of, length, characters. +*) + +PROCEDURE BuildArrayStringConstructor (location: location_t; arrayType: Tree; str: Tree; length: Tree) : Tree ; + + +(* + RealToTree - convert a real number into a Tree. +*) + +PROCEDURE RealToTree (name: ADDRESS) : Tree ; + + +(* + BuildStartRecord - return a RECORD tree. +*) + +PROCEDURE BuildStartRecord (location: location_t; name: ADDRESS) : Tree ; + + +(* + BuildStartUnion - return a union tree. +*) + +PROCEDURE BuildStartUnion (location: location_t; name: ADDRESS) : Tree ; + + + +PROCEDURE BuildStartVarient (location: location_t; name: ADDRESS) : Tree ; + + + +PROCEDURE BuildEndVarient (location: location_t; varientField: Tree; varientList: Tree; isPacked: BOOLEAN) : Tree ; + + + +PROCEDURE BuildStartFieldVarient (location: location_t; name: ADDRESS) : Tree ; + + + +PROCEDURE BuildEndFieldVarient (location: location_t; varientField: Tree; varientList: Tree; isPacked: BOOLEAN) : Tree ; + + + +PROCEDURE BuildStartFieldRecord (location: location_t; name: ADDRESS; type: Tree) : Tree ; + + + +PROCEDURE BuildFieldRecord (location: location_t; name: ADDRESS; type: Tree) : Tree ; + + +(* + ChainOn - interface so that Modula-2 can also create chains of + declarations. +*) + +PROCEDURE ChainOn (t1: Tree; t2: Tree) : Tree ; + + +(* + ChainOnParamValue - adds a list node {{name, str}, value} into the tree list. +*) + +PROCEDURE ChainOnParamValue (list: Tree; name: Tree; str: Tree; value: Tree) : Tree ; + + +(* + AddStringToTreeList - adds, string, to list. +*) + +PROCEDURE AddStringToTreeList (list: Tree; string: Tree) : Tree ; + + +(* + BuildEndRecord - a heavily pruned finish_struct from c-decl.c. + It sets the context for each field to, t, + propagates isPacked throughout the fields in + the structure. +*) + +PROCEDURE BuildEndRecord (location: location_t; record: Tree; fieldlist: Tree; isPacked: BOOLEAN) : Tree ; + + +(* + SetAlignment - sets the alignment of a, node, to, align. + It duplicates the, node, and sets the alignment + to prevent alignment effecting behaviour elsewhere. +*) + +PROCEDURE SetAlignment (node: Tree; align: Tree) : Tree ; + + +(* + SetDeclPacked - sets the packed bit in decl TREE, node. + It returns the node. +*) + +PROCEDURE SetDeclPacked (node: Tree) : Tree ; + + +(* + SetTypePacked - sets the packed bit in type TREE, node. + It returns the node. +*) + +PROCEDURE SetTypePacked (node: Tree) : Tree ; + + +(* + SetRecordFieldOffset - returns field after the byteOffset and bitOffset + has been applied to it. +*) + +PROCEDURE SetRecordFieldOffset (field: Tree; byteOffset: Tree; bitOffset: Tree; fieldtype: Tree; nbits: Tree) : Tree ; + + +(* + BuildPackedFieldRecord - builds a packed field record of, + name, and, fieldtype. +*) + +PROCEDURE BuildPackedFieldRecord (location: location_t; name: ADDRESS; fieldtype: Tree) : Tree ; + + +(* + BuildNumberOfArrayElements - returns the number of elements in an + arrayType. +*) + +PROCEDURE BuildNumberOfArrayElements (location: location_t; arrayType: Tree) : Tree ; + + +(* + AddStatement - maps onto add_stmt. +*) + +PROCEDURE AddStatement (location: location_t; t: Tree) ; + + +(* + MarkFunctionReferenced - marks a function as referenced. +*) + +PROCEDURE MarkFunctionReferenced (f: Tree) ; + + +(* + GarbageCollect - force gcc to garbage collect. +*) + +PROCEDURE GarbageCollect ; + + +(* + BuildArrayIndexType - creates an integer index which accesses an array. + low and high are the min, max elements of the array. +*) + +PROCEDURE BuildArrayIndexType (low: Tree; high: Tree) : Tree ; + + +(* + GetArrayNoOfElements - returns the number of elements in, arraytype. +*) + +PROCEDURE GetArrayNoOfElements (location: location_t; arraytype: Tree) : Tree ; + + +(* + BuildEndArrayType - returns a type which is an array indexed by IndexType + and which has ElementType elements. +*) + +PROCEDURE BuildEndArrayType (arraytype: Tree; elementtype: Tree; indextype: Tree; type: INTEGER) : Tree ; + + +(* + PutArrayType - +*) + +PROCEDURE PutArrayType (array: Tree; type: Tree) ; + + +(* + BuildStartArrayType - creates an array with an indextype and elttype. The front end + symbol, type, is also passed to allow the gccgm2 to return the + canonical edition of the array type even if the GCC elttype is + NULL_TREE. +*) + +PROCEDURE BuildStartArrayType (index_type: Tree; elt_type: Tree; type: INTEGER) : Tree ; + + +(* + IsAddress - return TRUE if the type is an ADDRESS. +*) + +PROCEDURE IsAddress (type: Tree) : BOOLEAN ; + + +END m2type. diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/dynamicstrings.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/dynamicstrings.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,38 @@ +/* dynamicstrings.h provides a minimal interface to a string library. + +Copyright (C) 2012-2022 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(dynamicstrings_h) + +#define dynamicstrings_h +#if defined(dynamicstrings_c) +#define EXTERN +#else /* !dynamicstrings_c. */ +#define EXTERN extern +#endif /* !dynamicstrings_c. */ + +typedef void *dynamicstrings_string; + +EXTERN dynamicstrings_string DynamicStrings_Mark (dynamicstrings_string s); +EXTERN dynamicstrings_string +DynamicStrings_InitStringCharStar (dynamicstrings_string s); + +#undef EXTERN +#endif /* !dynamicstrings_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/gcc-consolidation.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/gcc-consolidation.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,92 @@ +/* gcc-consolidation.h provides a single header for required gcc headers. + +Copyright (C) 2012-2022 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 +. */ + +#include "config.h" +#include "system.h" +#include "coretypes.h" +#include "realmpfr.h" +#include "backend.h" +#include "stringpool.h" +#include "rtl.h" +#include "tree.h" +#include "predict.h" +#include "df.h" +#include "tm.h" +#include "hash-set.h" +#include "machmode.h" +#include "vec.h" +#include "double-int.h" +#include "input.h" +#include "alias.h" +#include "symtab.h" +#include "options.h" +#include "wide-int.h" +#include "inchash.h" +#include "stor-layout.h" +#include "attribs.h" +#include "intl.h" +#include "tree-iterator.h" +#include "diagnostic.h" +#include "wide-int-print.h" +#include "real.h" +#include "float.h" +#include "spellcheck.h" +#include "opt-suggestions.h" + +/* Utilize some of the C build routines. */ + +#include "fold-const.h" +#include "varasm.h" +#include "hashtab.h" +#include "hard-reg-set.h" +#include "function.h" + +#include "hash-map.h" +#include "langhooks.h" +#include "timevar.h" +#include "dumpfile.h" +#include "target.h" +#include "dominance.h" +#include "cfg.h" +#include "cfganal.h" +#include "predict.h" +#include "basic-block.h" +#include "df.h" +#include "tree-ssa-alias.h" +#include "internal-fn.h" +#include "gimple-expr.h" +#include "is-a.h" +#include "gimple.h" +#include "gimple-ssa.h" +#include "gimplify.h" +#include "stringpool.h" +#include "tree-nested.h" +#include "print-tree.h" +#include "except.h" +#include "toplev.h" +#include "convert.h" +#include "tree-dump.h" +#include "plugin-api.h" +#include "hard-reg-set.h" +#include "function.h" +#include "ipa-ref.h" +#include "cgraph.h" +#include "stmt.h" diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/init.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/init.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,35 @@ +/* init.h header file for init.cc. + +Copyright (C) 2012-2022 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(init_h) +#define init_h + +#if defined(init_cpp) +extern "C" { +void init_FrontEndInit (void); +void init_PerCompilationInit (const char *filename); +} +#else /* !init_cpp. */ +void init_FrontEndInit (void); +void init_PerCompilationInit (const char *filename); +#endif /* !init_cpp. */ + +#endif /*! init_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2assert.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2assert.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,68 @@ +/* m2assert.h header file for m2assert.cc and assertion macros. + +Copyright (C) 2012-2022 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(m2assert_h) +#define m2assert_h +#if defined(m2assert_c) +#define EXTERN +#else /* !m2assert_c. */ +#define EXTERN extern +#endif /* !m2assert_c. */ + +#if !defined(ASSERT) +#define ASSERT(X, Y) \ + { \ + if (!(X)) \ + { \ + debug_tree (Y); \ + internal_error ("%s:%d:condition %s failed", __FILE__, __LINE__, \ + #X); \ + } \ + } +#endif + +#if !defined(ASSERT_BOOL) +#define ASSERT_BOOL(X) \ + { \ + if ((X != 0) && (X != 1)) \ + { \ + internal_error ( \ + "%s:%d:the value %s is not a BOOLEAN as the value is %d", \ + __FILE__, __LINE__, #X, X); \ + } \ + } +#endif + +#if !defined(ASSERT_CONDITION) +#define ASSERT_CONDITION(X) \ + { \ + if (!(X)) \ + { \ + internal_error ("%s:%d:condition %s failed", __FILE__, __LINE__, \ + #X); \ + } \ + } +#endif + +EXTERN void m2assert_AssertLocation (location_t location); + +#undef EXTERN +#endif /* m2assert_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2block.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2block.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,77 @@ +/* m2block.h header file for m2block.cc. + +Copyright (C) 2012-2022 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(m2block_h) +#define m2block_h +#if defined(m2block_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else /* !m2block_c. */ +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !m2block_h. */ +#define EXTERN extern +#endif /* !m2block_c. */ +#endif /* !m2block_h. */ + +EXTERN tree m2block_getLabel (location_t location, char *name); +EXTERN void m2block_pushFunctionScope (tree fndecl); +EXTERN tree m2block_popFunctionScope (void); +EXTERN void m2block_pushGlobalScope (void); +EXTERN void m2block_popGlobalScope (void); +EXTERN tree m2block_pushDecl (tree decl); +EXTERN void m2block_addDeclExpr (tree t); + +EXTERN tree m2block_begin_statement_list (void); +EXTERN tree m2block_push_statement_list (tree t); +EXTERN tree m2block_pop_statement_list (void); + +EXTERN void m2block_finishFunctionDecl (location_t location, tree fndecl); +EXTERN void m2block_finishFunctionCode (tree fndecl); + +EXTERN tree m2block_RememberType (tree t); +EXTERN tree m2block_RememberConstant (tree t); +EXTERN tree m2block_DumpGlobalConstants (void); +EXTERN tree m2block_RememberInitModuleFunction (tree t); +EXTERN tree m2block_global_constant (tree t); +EXTERN int m2block_toplevel (void); +EXTERN tree m2block_GetErrorNode (void); + +EXTERN void m2block_addStmtNote (location_t location); + +EXTERN tree m2block_cur_stmt_list (void); +EXTERN tree *m2block_cur_stmt_list_addr (void); +EXTERN int m2block_is_building_stmt_list (void); +EXTERN tree m2block_GetGlobals (void); +EXTERN tree m2block_GetGlobalContext (void); +EXTERN void m2block_finishGlobals (void); +EXTERN void m2block_includeDecl (tree); +EXTERN tree m2block_add_stmt (location_t location, tree t); +EXTERN void m2block_addStmtNote (location_t location); +EXTERN void m2block_removeStmtNote (void); + +EXTERN void m2block_init (void); + +#undef EXTERN +#endif /* m2block_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2builtins.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2builtins.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,56 @@ +/* m2builtins.h header file for m2builtins.cc. + +Copyright (C) 2012-2022 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(m2builtins_h) + +#define m2builtins_h +#if defined(m2builtins_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else /* !m2builtins_c. */ +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ +#endif /* !m2builtins_c. */ + +EXTERN tree m2builtins_GetBuiltinConst (char *name); +EXTERN unsigned int m2builtins_GetBuiltinConstType (char *name); +EXTERN unsigned int m2builtins_GetBuiltinTypeInfoType (const char *ident); +EXTERN tree m2builtins_GetBuiltinTypeInfo (location_t location, tree type, + const char *ident); +EXTERN tree m2builtins_BuiltInMemCopy (location_t location, tree dest, + tree src, tree n); +EXTERN tree m2builtins_BuiltInAlloca (location_t location, tree n); +EXTERN tree m2builtins_BuiltInIsfinite (location_t location, tree e); +EXTERN int m2builtins_BuiltinExists (char *name); +EXTERN tree m2builtins_BuildBuiltinTree (location_t location, char *name); +EXTERN tree m2builtins_BuiltInHugeVal (location_t location); +EXTERN tree m2builtins_BuiltInHugeValShort (location_t location); +EXTERN tree m2builtins_BuiltInHugeValLong (location_t location); +EXTERN void m2builtins_init (location_t location); + +#undef EXTERN +#endif /* m2builtins_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2color.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2color.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,52 @@ +/* m2color.h interface to gcc colorization. + +Copyright (C) 2019-2022 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(m2color_h) +#define m2color_h +#if defined(m2color_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else /* !m2color_c. */ +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ +#endif /* !m2color_c. */ + + +EXTERN char * +m2color_colorize_start (bool show_color, char *name, unsigned int name_len); + +EXTERN char *m2color_colorize_stop (bool show_color); + +EXTERN char *m2color_open_quote (void); + +EXTERN char *m2color_close_quote (void); + +EXTERN void _M2_m2color_init (); +EXTERN void _M2_m2color_finish (); + + +#endif diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2configure.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2configure.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,44 @@ +/* m2configure.h header file for m2configure.cc. + +Copyright (C) 2022 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(m2configure_h) + +#define m2configure_h +#if defined(m2configure_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else /* !m2configure_c. */ +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ +#endif /* !m2configure_c. */ + +#include "input.h" + +EXTERN char *m2configure_FullPathCPP (void); + +#undef EXTERN +#endif /* m2configure_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2convert.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2convert.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,54 @@ +/* m2convert.h header file for m2convert.cc. + +Copyright (C) 2012-2022 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(m2convert_h) +#define m2convert_h +#if defined(m2convert_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else /* m2convert_c. */ +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ +#endif /* m2convert_c. */ + +EXTERN tree m2convert_BuildConvert (location_t location, tree type, tree value, + int checkOverflow); +EXTERN tree m2convert_ConvertToPtr (location_t location_t, tree p); +EXTERN tree m2convert_ConvertString (tree type, tree expr); +EXTERN tree m2convert_ConvertConstantAndCheck (location_t location, tree type, + tree expr); +EXTERN tree m2convert_convertToPtr (location_t location, tree type); +EXTERN tree m2convert_ToCardinal (location_t location, tree expr); +EXTERN tree m2convert_ToInteger (location_t location, tree expr); +EXTERN tree m2convert_ToWord (location_t location, tree expr); +EXTERN tree m2convert_ToBitset (location_t location, tree expr); +EXTERN tree m2convert_ToLoc (location_t location, tree expr); +EXTERN tree m2convert_GenericToType (location_t location, tree type, + tree expr); + +#undef EXTERN +#endif /* m2convert_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2decl.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2decl.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,82 @@ +/* m2decl.h header file for m2decl.cc. + +Copyright (C) 2012-2022 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(m2decl_h) + +#define m2decl_h +#if defined(m2decl_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else /* !m2decl_c. */ +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ +#endif /* !m2decl_c. */ + + +EXTERN tree m2decl_DeclareM2linkStaticInitialization (location_t location, + int ScaffoldStatic); +EXTERN tree m2decl_DeclareM2linkForcedModuleInitOrder (location_t location, + const char *RuntimeOverride); +EXTERN tree m2decl_BuildPtrToTypeString (location_t location, const char *string, tree type); +EXTERN void m2decl_BuildModuleCtor (tree module_ctor); +EXTERN tree m2decl_DeclareModuleCtor (tree decl); +EXTERN tree m2decl_GetDeclContext (tree t); +EXTERN tree m2decl_BuildStringConstant (const char *string, int length); +EXTERN tree m2decl_BuildCStringConstant (const char *string, int length); +EXTERN tree m2decl_BuildConstLiteralNumber (location_t location, + const char *str, + unsigned int base); +EXTERN void m2decl_DetermineSizeOfConstant (location_t location, + const char *str, unsigned int base, + int *needsLong, + int *needsUnsigned); +EXTERN void m2decl_RememberVariables (tree l); + +EXTERN tree m2decl_BuildEndFunctionDeclaration ( + location_t location_begin, location_t location_end, const char *name, + tree returntype, int isexternal, int isnested, int ispublic); +EXTERN void m2decl_BuildStartFunctionDeclaration (int uses_varargs); +EXTERN tree m2decl_BuildParameterDeclaration (location_t location, char *name, + tree type, int isreference); +EXTERN tree m2decl_DeclareKnownConstant (location_t location, tree type, + tree value); +EXTERN tree m2decl_DeclareKnownVariable (location_t location, const char *name, + tree type, int exported, int imported, + int istemporary, int isglobal, + tree scope, tree initial); + +EXTERN tree m2decl_BuildStringConstantType (int length, const char *string, + tree type); +EXTERN tree m2decl_BuildIntegerConstant (int value); + +EXTERN int m2decl_GetBitsPerWord (void); +EXTERN int m2decl_GetBitsPerUnit (void); +EXTERN int m2decl_GetBitsPerInt (void); +EXTERN int m2decl_GetBitsPerBitset (void); + +#undef EXTERN +#endif /* m2decl_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2except.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2except.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,70 @@ +/* m2except.h header file for m2except.cc. + +Copyright (C) 2012-2022 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(m2except_h) +#define m2except_h +#if defined(m2except_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else /* !m2except_c. */ +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ +#endif /* !m2except_c. */ + +/* InitExceptions - initialize this module, it declares the external + functions and assigns them to the appropriate global tree + variables. */ + +EXTERN void m2except_InitExceptions (location_t location); + +/* BuildThrow - builds a throw statement and return the tree. */ + +EXTERN tree m2except_BuildThrow (location_t location, tree exp); + +/* BuildTryBegin - returns a tree representing the 'try' block. */ + +EXTERN tree m2except_BuildTryBegin (location_t location); + +/* BuildTryEnd - builds the end of the Try block and prepares for the + catch handlers. */ + +EXTERN void m2except_BuildTryEnd (tree tryBlock); + +/* BuildCatchBegin - creates a handler tree for the C++ statement + 'catch (...) {'. It returns the handler tree. */ + +EXTERN tree m2except_BuildCatchBegin (location_t location); + +/* BuildCatchEnd - completes a try catch block. It returns the, + try_block, tree. It creates the C++ statement + +'}' which matches the catch above. */ + +EXTERN tree m2except_BuildCatchEnd (location_t location, tree handler, + tree tryBlock); + +#endif /* m2except_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2expr.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2expr.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,244 @@ +/* m2expr.h header file for m2expr.cc. + +Copyright (C) 2012-2022 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(m2expr_h) +#define m2expr_h +#if defined(m2expr_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else /* !m2expr_c. */ +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ +#endif /* !m2expr_c. */ + +EXTERN void m2expr_BuildBinaryForeachWordDo ( + location_t location, tree type, tree op1, tree op2, tree op3, + tree (*binop) (location_t, tree, tree, int), int is_op1lvalue, + int is_op2lvalue, int is_op3lvalue, int is_op1const, int is_op2const, + int is_op3const); +EXTERN tree m2expr_BuildCmplx (location_t location, tree type, tree real, + tree imag); +EXTERN tree m2expr_BuildIm (tree op1); +EXTERN tree m2expr_BuildRe (tree op1); +EXTERN tree m2expr_BuildAbs (location_t location, tree t); +EXTERN tree m2expr_BuildCap (location_t location, tree t); +EXTERN int m2expr_DetermineSign (tree e); +EXTERN int m2expr_AreRealOrComplexConstantsEqual (tree e1, tree e2); +EXTERN int m2expr_AreConstantsEqual (tree e1, tree e2); +EXTERN int m2expr_IsFalse (tree t); +EXTERN int m2expr_IsTrue (tree t); +EXTERN tree m2expr_BuildIndirect (location_t location, tree target, tree type); +EXTERN tree m2expr_BuildComponentRef (location_t location, tree record, + tree field); +EXTERN tree m2expr_BuildArray (location_t location, tree type, tree array, + tree index, tree lowIndice); +EXTERN void m2expr_BuildIfNotInRangeGoto (location_t location, tree var, + tree low, tree high, char *label); +EXTERN void m2expr_BuildIfInRangeGoto (location_t location, tree var, tree low, + tree high, char *label); +EXTERN void m2expr_BuildForeachWordInSetDoIfExpr ( + location_t location, tree type, tree op1, tree op2, int is_op1lvalue, + int is_op2lvalue, int is_op1const, int is_op2const, + tree (*expr) (location_t, tree, tree), char *label); +EXTERN void m2expr_BuildIfNotVarInVar (location_t location, tree type, + tree varset, tree varel, int is_lvalue, + tree low, tree high ATTRIBUTE_UNUSED, + char *label); +EXTERN void m2expr_BuildIfVarInVar (location_t location, tree type, + tree varset, tree varel, int is_lvalue, + tree low, tree high ATTRIBUTE_UNUSED, + char *label); +EXTERN void m2expr_BuildIfNotConstInVar (location_t location, tree type, + tree varset, tree constel, + int is_lvalue, int fieldno, + char *label); +EXTERN void m2expr_BuildIfConstInVar (location_t location, tree type, + tree varset, tree constel, int is_lvalue, + int fieldno, char *label); +EXTERN tree m2expr_BuildIsNotSubset (location_t location, tree op1, tree op2); +EXTERN tree m2expr_BuildIsSubset (location_t location, tree op1, tree op2); +EXTERN tree m2expr_BuildIsNotSuperset (location_t location, tree op1, + tree op2); +EXTERN tree m2expr_BuildIsSuperset (location_t location, tree op1, tree op2); +EXTERN tree m2expr_BuildNotEqualTo (location_t location, tree op1, tree op2); +EXTERN tree m2expr_BuildEqualTo (location_t location, tree op1, tree op2); +EXTERN tree m2expr_BuildGreaterThanOrEqual (location_t location, tree op1, + tree op2); +EXTERN tree m2expr_BuildLessThanOrEqual (location_t location, tree op1, + tree op2); +EXTERN tree m2expr_BuildGreaterThan (location_t location, tree op1, tree op2); +EXTERN tree m2expr_BuildLessThan (location_t location, tree op1, tree op2); +EXTERN tree m2expr_BuildLogicalDifference (location_t location, tree op1, + tree op2, int needconvert); +EXTERN tree m2expr_BuildSymmetricDifference (location_t location, tree op1, + tree op2, int needconvert); +EXTERN tree m2expr_BuildLogicalAnd (location_t location, tree op1, tree op2, + int needconvert); +EXTERN tree m2expr_BuildLogicalOr (location_t location, tree op1, tree op2, + int needconvert); +EXTERN tree m2expr_BuildLogicalOrAddress (location_t location, tree op1, + tree op2, int needconvert); +EXTERN tree m2expr_BuildOffset (location_t location, tree record, tree field, + int needconvert ATTRIBUTE_UNUSED); +EXTERN tree m2expr_BuildOffset1 (location_t location, tree field, + int needconvert ATTRIBUTE_UNUSED); +EXTERN tree m2expr_BuildAddr (location_t location, tree op1, int needconvert); +EXTERN tree m2expr_BuildSize (location_t location, tree op1, + int needconvert ATTRIBUTE_UNUSED); +EXTERN tree m2expr_BuildTBitSize (location_t location, tree type); +EXTERN tree m2expr_BuildSetNegate (location_t location, tree op1, + int needconvert); +EXTERN tree m2expr_BuildNegate (location_t location, tree op1, + int needconvert); +EXTERN tree m2expr_BuildNegateCheck (location_t location, tree arg, + tree lowest, tree min, tree max); +EXTERN tree m2expr_BuildTrunc (tree op1); +EXTERN tree m2expr_BuildCoerce (location_t location, tree des, tree type, + tree expr); +EXTERN tree m2expr_RemoveOverflow (tree t); +EXTERN int m2expr_TreeOverflow (tree t); + +EXTERN unsigned int m2expr_StringLength (tree string); +EXTERN tree m2expr_FoldAndStrip (tree t); +EXTERN int m2expr_interpret_integer (const char *str, unsigned int base, + unsigned HOST_WIDE_INT *low, + HOST_WIDE_INT *high); +EXTERN int m2expr_interpret_m2_integer (const char *str, unsigned int base, + unsigned int *low, int *high, + int *needsLong, int *needsUnsigned); + +EXTERN tree m2expr_BuildAddCheck (location_t location, tree op1, tree op2, + tree lowest, tree min, tree max); +EXTERN tree m2expr_BuildSubCheck (location_t location, tree op1, tree op2, + tree lowest, tree min, tree max); +EXTERN tree m2expr_BuildMultCheck (location_t location, tree op1, tree op2, + tree lowest, tree min, tree max); + +EXTERN tree m2expr_BuildAdd (location_t location, tree op1, tree op2, + int needconvert); +EXTERN tree m2expr_BuildSub (location_t location, tree op1, tree op2, + int needconvert); +EXTERN tree m2expr_BuildDivTrunc (location_t location, tree op1, tree op2, + int needconvert); +EXTERN tree m2expr_BuildDivTruncCheck (location_t location, tree op1, tree op2, + tree lowest, tree min, tree max); +EXTERN tree m2expr_BuildModTrunc (location_t location, tree op1, tree op2, + int needconvert); + +EXTERN tree m2expr_BuildDivCeil (location_t location, tree op1, tree op2, + int needconvert); +EXTERN tree m2expr_BuildModCeil (location_t location, tree op1, tree op2, + int needconvert); + +EXTERN tree m2expr_BuildDivFloor (location_t location, tree op1, tree op2, + int needconvert); +EXTERN tree m2expr_BuildModFloor (location_t location, tree op1, tree op2, + int needconvert); + +EXTERN tree m2expr_BuildDivM2 (location_t location, tree op1, tree op2, + unsigned int needsconvert); +EXTERN tree m2expr_BuildModM2 (location_t location, tree op1, tree op2, + unsigned int needsconvert); +EXTERN tree m2expr_BuildDivM2Check (location_t location, tree op1, tree op2, + tree lowest, tree min, tree max); + +EXTERN tree m2expr_BuildModM2Check (location_t location, tree op1, tree op2, + tree lowest, tree min, tree max); + +EXTERN tree m2expr_BuildLSL (location_t location, tree op1, tree op2, + int needconvert); + +EXTERN tree m2expr_BuildLSR (location_t location, tree op1, tree op2, + int needconvert); + +EXTERN void m2expr_BuildLogicalShift (location_t location, tree op1, tree op2, + tree op3, tree nBits ATTRIBUTE_UNUSED, + int needconvert); + +EXTERN tree m2expr_BuildLRL (location_t location, tree op1, tree op2, + int needconvert); + +EXTERN tree m2expr_BuildLRR (location_t location, tree op1, tree op2, + int needconvert); +EXTERN tree m2expr_BuildMult (location_t location, tree op1, tree op2, + int needconvert); + +EXTERN tree m2expr_BuildRRotate (location_t location, tree op1, tree nBits, + int needconvert); +EXTERN tree m2expr_BuildLRotate (location_t location, tree op1, tree nBits, + int needconvert); + +EXTERN tree m2expr_BuildMask (location_t location, tree nBits, + int needconvert); +EXTERN tree m2expr_BuildLRLn (location_t location, tree op1, tree op2, + tree nBits, int needconvert); +EXTERN tree m2expr_BuildLRRn (location_t location, tree op1, tree op2, + tree nBits, int needconvert); +EXTERN void m2expr_BuildLogicalRotate (location_t location, tree op1, tree op2, + tree op3, tree nBits, int needconvert); +EXTERN void m2expr_BuildBinarySetDo ( + location_t location, tree settype, tree op1, tree op2, tree op3, + void (*binop) (location_t, tree, tree, tree, tree, int), int is_op1lvalue, + int is_op2lvalue, int is_op3lvalue, tree nBits, tree unbounded, + tree varproc, tree leftproc, tree rightproc); + +EXTERN tree m2expr_GetSizeOf (location_t location, tree type); +EXTERN tree m2expr_GetSizeOfInBits (tree type); + +EXTERN tree m2expr_GetCardinalZero (location_t location); +EXTERN tree m2expr_GetCardinalOne (location_t location); +EXTERN tree m2expr_GetIntegerZero (location_t location); +EXTERN tree m2expr_GetIntegerOne (location_t location); +EXTERN tree m2expr_GetWordZero (location_t location); +EXTERN tree m2expr_GetWordOne (location_t location); +EXTERN tree m2expr_GetPointerZero (location_t location); +EXTERN tree m2expr_GetPointerOne (location_t location); + +#if 0 +EXTERN tree m2expr_GetBooleanTrue (void); +EXTERN tree m2expr_GetBooleanFalse (void); +#endif + +EXTERN int m2expr_CompareTrees (tree e1, tree e2); +EXTERN tree m2expr_build_unary_op (location_t location ATTRIBUTE_UNUSED, + enum tree_code code, tree arg, + int flag ATTRIBUTE_UNUSED); +EXTERN tree m2expr_build_binary_op (location_t location, enum tree_code code, + tree op1, tree op2, int convert); +EXTERN tree m2expr_build_binary_op_check (location_t location, + enum tree_code code, tree op1, + tree op2, int needconvert, + tree lowest, tree min, tree max); +EXTERN void m2expr_ConstantExpressionWarning (tree value); +EXTERN tree m2expr_BuildAddAddress (location_t location, tree op1, tree op2); +EXTERN tree m2expr_BuildRDiv (location_t location, tree op1, tree op2, + int needconvert); + +EXTERN void m2expr_init (location_t location); + +#undef EXTERN +#endif /* m2expr_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2linemap.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2linemap.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,72 @@ +/* m2linemap.h header file for m2linemap.cc. + +Copyright (C) 2012-2022 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(m2linemap_h) + +#include "input.h" + +#define m2linemap_h +#if defined(m2linemap_c) +#if (__cplusplus) +#define EXTERN extern "C" +#else /* !__cplusplus. */ +#define EXTERN +#endif /*!__cplusplus. */ +#else /* !m2linemap_c. */ +#if (__cplusplus) +#define EXTERN extern "C" +#else /* !__cplusplus. */ +#define EXTERN extern +#endif /* !__cplusplus. */ +#endif /* !m2linemap_c. */ + +EXTERN void m2linemap_StartFile (void *filename, unsigned int linebegin); +EXTERN void m2linemap_EndFile (void); +EXTERN void m2linemap_StartLine (unsigned int linenumber, + unsigned int linesize); +EXTERN location_t m2linemap_GetLocationColumn (unsigned int column); +EXTERN location_t m2linemap_GetLocationRange (unsigned int start, unsigned int end); +EXTERN location_t m2linemap_GetLocationBinary (location_t caret, + location_t start, location_t finish); + +EXTERN location_t m2linemap_UnknownLocation (void); +EXTERN location_t m2linemap_BuiltinsLocation (void); + +EXTERN location_t m2linemap_GetLocationColumn (unsigned int column); +EXTERN int m2linemap_GetLineNoFromLocation (location_t location); +EXTERN int m2linemap_GetColumnNoFromLocation (location_t location); +EXTERN const char *m2linemap_GetFilenameFromLocation (location_t location); +EXTERN void m2linemap_ErrorAt (location_t location, char *message); +EXTERN void m2linemap_ErrorAtf (location_t location, const char *message, ...); +EXTERN void m2linemap_WarningAtf (location_t location, const char *message, ...); +EXTERN void m2linemap_NoteAtf (location_t location, const char *message, ...); +EXTERN void m2linemap_internal_error (const char *message); + + +EXTERN location_t UnknownLocation (void); +EXTERN location_t BuiltinsLocation (void); +EXTERN void ErrorAt (location_t location, char *message); +EXTERN void ErrorAtf (location_t location, const char *message, ...); +EXTERN void WarningAtf (location_t location, const char *message, ...); +EXTERN void NoteAtf (location_t location, const char *message, ...); + +#undef EXTERN +#endif /* m2linemap_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2misc.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2misc.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,44 @@ +/* m2misc.h header file for m2misc.cc. + +Copyright (C) 2012-2022 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(m2misc_h) + +#define m2misc_h +#if defined(m2misc_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else /* !m2misc_c. */ +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ +#endif /* !m2misc_c. */ + +EXTERN void m2misc_DebugTree (tree t); +EXTERN void m2misc_printStmt (void); +EXTERN void m2misc_DebugTreeChain (tree t); + +#undef EXTERN +#endif /* m2misc_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2options.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2options.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,126 @@ +/* m2options.h header file for M2Options.mod. + +Copyright (C) 2012-2022 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(m2options_h) + +#define m2options_h +#if defined(m2options_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else /* !m2options_c. */ +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ +#endif /* !m2options_c. */ + +#include "input.h" + +EXTERN void M2Options_SetMakeIncludePath (const char *arg); +EXTERN void M2Options_SetSearchPath (const char *arg); +EXTERN void M2Options_setdefextension (const char *arg); +EXTERN void M2Options_setmodextension (const char *arg); + +EXTERN void M2Options_SetISO (int value); +EXTERN void M2Options_SetPIM (int value); +EXTERN void M2Options_SetPIM2 (int value); +EXTERN void M2Options_SetPIM3 (int value); +EXTERN void M2Options_SetPIM4 (int value); +EXTERN void M2Options_SetFloatValueCheck (int value); +EXTERN void M2Options_SetWholeValueCheck (int value); + +EXTERN int M2Options_GetISO (void); +EXTERN int M2Options_GetPIM (void); +EXTERN int M2Options_GetPIM2 (void); +EXTERN int M2Options_GetPIM3 (void); +EXTERN int M2Options_GetPIM4 (void); +EXTERN int M2Options_GetPositiveModFloor (void); +EXTERN int M2Options_GetFloatValueCheck (void); +EXTERN int M2Options_GetWholeValueCheck (void); + +EXTERN void M2Options_Setc (int value); +EXTERN int M2Options_Getc (void); + +EXTERN void M2Options_SetUselist (int value, const char *filename); +EXTERN void M2Options_SetAutoInit (int value); +EXTERN void M2Options_SetPositiveModFloor (int value); +EXTERN void M2Options_SetNilCheck (int value); +EXTERN void M2Options_SetWholeDiv (int value); +EXTERN void M2Options_SetIndex (int value); +EXTERN void M2Options_SetRange (int value); +EXTERN void M2Options_SetReturnCheck (int value); +EXTERN void M2Options_SetCaseCheck (int value); +EXTERN void M2Options_SetCheckAll (int value); +EXTERN void M2Options_SetExceptions (int value); +EXTERN void M2Options_SetStyle (int value); +EXTERN void M2Options_SetPedantic (int value); +EXTERN void M2Options_SetPedanticParamNames (int value); +EXTERN void M2Options_SetPedanticCast (int value); +EXTERN void M2Options_SetExtendedOpaque (int value); +EXTERN void M2Options_SetVerboseUnbounded (int value); +EXTERN void M2Options_SetXCode (int value); +EXTERN void M2Options_SetCompilerDebugging (int value); +EXTERN void M2Options_SetQuadDebugging (int value); +EXTERN void M2Options_SetDebugTraceQuad (int value); +EXTERN void M2Options_SetDebugTraceAPI (int value); +EXTERN void M2Options_SetSources (int value); +EXTERN void M2Options_SetUnboundedByReference (int value); +EXTERN void M2Options_SetDumpSystemExports (int value); +EXTERN void M2Options_SetOptimizing (int value); +EXTERN void M2Options_SetQuiet (int value); +EXTERN void M2Options_SetCC1Quiet (int value); +EXTERN void M2Options_SetCpp (int value); +EXTERN void M2Options_SetSwig (int value); +EXTERN void M2Options_SetForcedLocation (location_t location); +EXTERN location_t M2Options_OverrideLocation (location_t location); +EXTERN void M2Options_SetStatistics (int on); +EXTERN void M2Options_CppProg (const char *program); +EXTERN void M2Options_CppArg (const char *opt, const char *arg, int joined); +EXTERN void M2Options_SetWholeProgram (int value); +EXTERN void M2Options_FinaliseOptions (void); +EXTERN void M2Options_SetDebugFunctionLineNumbers (int value); +EXTERN void M2Options_SetGenerateStatementNote (int value); +EXTERN int M2Options_GetCpp (void); +EXTERN int M2Options_GetM2g (void); +EXTERN void M2Options_SetM2g (int value); +EXTERN void M2Options_SetLowerCaseKeywords (int value); +EXTERN void M2Options_SetUnusedVariableChecking (int value); +EXTERN void M2Options_SetUnusedParameterChecking (int value); +EXTERN void M2Options_SetStrictTypeChecking (int value); +EXTERN void M2Options_SetWall (int value); +EXTERN void M2Options_SetSaveTemps (int value); +EXTERN void M2Options_SetSaveTempsDir (const char *arg); +EXTERN int M2Options_GetSaveTemps (void); +EXTERN void M2Options_SetScaffoldStatic (int value); +EXTERN void M2Options_SetScaffoldDynamic (int value); +EXTERN void M2Options_SetScaffoldMain (int value); +EXTERN void M2Options_SetRuntimeModuleOverride (const char *override); +EXTERN void M2Options_SetGenModuleList (int value, const char *filename); +EXTERN void M2Options_SetShared (int value); +EXTERN void M2Options_SetB (const char *arg); +EXTERN char *M2Options_GetB (void); + +#undef EXTERN +#endif /* m2options_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2range.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2range.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,40 @@ +/* m2range.h header file for M2Range.mod. + +Copyright (C) 2012-2022 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(m2range_h) +#define m2range_h +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ + +EXTERN tree M2Range_BuildIfCallWholeHandlerLoc (location_t location, + tree condition, + const char *scope, + const char *message); +EXTERN tree M2Range_BuildIfCallRealHandlerLoc (location_t location, + tree condition, + const char *scope, + const char *message); + +#undef EXTERN +#endif /* m2range_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2search.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2search.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,35 @@ +/* m2search.h header file for m2search.c. + +Copyright (C) 2012-2022 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(m2search_h) + +#define m2search_h +#if defined(m2search_h) +#define EXTERN +#else /* !m2search_h. */ +#define EXTERN extern +#endif /* !m2search_h. */ + +#include "dynamicstrings.h" + +EXTERN void M2Search_PrependSearchPath (dynamicstrings_string *s); + +#endif /* m2search_c. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2statement.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2statement.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,111 @@ +/* m2statement.h header file for m2statement.cc. + +Copyright (C) 2012-2022 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(m2statement_h) +#define m2statement_h +#if defined(m2statement_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else /* !m2statement_c. */ +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ +#endif /* !m2statement_c. */ + +EXTERN void m2statement_BuildCallInner (location_t location, tree fndecl); +EXTERN void m2statement_BuildEnd (location_t location, tree fndecl, + int nested); +EXTERN tree m2statement_BuildStart (location_t location, char *name, + int inner_module); +EXTERN void m2statement_BuildIncludeVarVar (location_t location, tree type, + tree varset, tree varel, + int is_lvalue, tree low); +EXTERN void m2statement_BuildIncludeVarConst (location_t location, tree type, + tree op1, tree op2, + int is_lvalue, int fieldno); +EXTERN void m2statement_BuildExcludeVarVar (location_t location, tree type, + tree varset, tree varel, + int is_lvalue, tree low); +EXTERN void m2statement_BuildExcludeVarConst (location_t location, tree type, + tree op1, tree op2, + int is_lvalue, int fieldno); +EXTERN void m2statement_BuildUnaryForeachWordDo ( + location_t location, tree type, tree op1, tree op2, + tree (*unop) (location_t, tree, int), int is_op1lvalue, int is_op2lvalue, + int is_op1const, int is_op2const); +EXTERN void m2statement_BuildAsm (location_t location, tree instr, + int isVolatile, int isSimple, tree inputs, + tree outputs, tree trash, tree labels); +EXTERN tree m2statement_BuildFunctValue (location_t location, tree value); +EXTERN tree m2statement_BuildIndirectProcedureCallTree (location_t location, + tree procedure, + tree rettype); +EXTERN tree m2statement_BuildProcedureCallTree (location_t location, + tree procedure, tree rettype); +EXTERN void m2statement_BuildFunctionCallTree (location_t location, + tree procedure, tree rettype); +EXTERN void m2statement_BuildParam (location_t location, tree param); + +EXTERN tree m2statement_BuildIfThenElseEnd (tree condition, tree then_block, + tree else_block); +EXTERN tree m2statement_BuildIfThenDoEnd (tree condition, tree then_block); + +EXTERN void m2statement_DeclareLabel (location_t location, char *name); +EXTERN void m2statement_BuildGoto (location_t location, char *name); +EXTERN tree m2statement_BuildAssignmentTree (location_t location, tree des, + tree expr); +EXTERN void m2statement_BuildAssignmentStatement (location_t location, tree des, + tree expr); +EXTERN void m2statement_BuildPopFunctionContext (void); +EXTERN void m2statement_BuildPushFunctionContext (void); +EXTERN void m2statement_BuildReturnValueCode (location_t location, tree fndecl, + tree value); +EXTERN void m2statement_BuildEndFunctionCode (location_t location, tree fndecl, + int nested); +EXTERN void m2statement_BuildStartFunctionCode (location_t location, + tree fndecl, int isexported, + int isinline); +EXTERN void m2statement_DoJump (location_t location, tree exp, + char *falselabel, char *truelabel); +EXTERN tree m2statement_BuildCall2 (location_t location, tree function, + tree rettype, tree arg1, tree arg2); +EXTERN tree m2statement_BuildCall3 (location_t location, tree function, + tree rettype, tree arg1, tree arg2, + tree arg3); +EXTERN void m2statement_SetLastFunction (tree t); +EXTERN tree m2statement_GetLastFunction (void); +EXTERN void m2statement_SetParamList (tree t); +EXTERN tree m2statement_GetParamList (void); +EXTERN tree m2statement_GetCurrentFunction (void); +EXTERN void m2statement_SetBeginLocation (location_t location); +EXTERN void m2statement_SetEndLocation (location_t location); +EXTERN tree m2statement_GetParamTree (tree call, unsigned int i); +EXTERN tree m2statement_BuildTryFinally (location_t location, tree call, + tree cleanups); +EXTERN tree m2statement_BuildCleanUp (tree param); + +#undef EXTERN +#endif /* m2statement_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2top.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2top.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,44 @@ +/* m2top.h header file for m2top.cc. + +Copyright (C) 2012-2022 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(m2top_h) + +#define m2top_h +#if defined(m2top_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ +#endif /* !m2top_c. */ + +EXTERN void m2top_StartGlobalContext (void); +EXTERN void m2top_EndGlobalContext (void); +EXTERN void m2top_SetFlagUnitAtATime (int b); + +#undef EXTERN +#endif /* m2top_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2tree.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2tree.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,58 @@ +/* m2tree.h header file for m2tree.cc. + +Copyright (C) 2012-2022 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(m2tree_h) +#define m2tree_h +#if defined(m2tree_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else /* m2tree_c. */ +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ +#endif /* m2tree_c. */ + +#include "input.h" + +EXTERN int m2tree_is_var (tree var); +EXTERN int m2tree_is_array (tree array); +EXTERN int m2tree_is_type (tree type); +EXTERN tree m2tree_skip_type_decl (tree type); +EXTERN tree m2tree_skip_const_decl (tree exp); +EXTERN int m2tree_IsTreeOverflow (tree value); +EXTERN int m2tree_IsOrdinal (tree type); +EXTERN int m2tree_IsAConstant (tree t); +EXTERN void m2tree_debug_tree (tree t); +EXTERN tree m2tree_skip_reference_type (tree exp); + + +#ifndef SET_WORD_SIZE +/* gross hack. */ +#define SET_WORD_SIZE INT_TYPE_SIZE +#endif /* SET_WORD_SIZE. */ + +#undef EXTERN +#endif /* m2tree_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2treelib.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2treelib.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,66 @@ +/* m2treelib.h header file for m2treelib.cc. + +Copyright (C) 2012-2022 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(m2treelib_h) +#define m2treelib_h +#if defined(m2treelib_c) +#define EXTERN +#else /* !m2treelib_c. */ +#define EXTERN extern +#endif /* !m2treelib_c. */ + +EXTERN void m2treelib_do_jump_if_bit (location_t location, enum tree_code code, + tree word, tree bit, char *label); +EXTERN tree m2treelib_build_modify_expr (location_t location, tree des, + enum tree_code modifycode, tree copy); +EXTERN tree m2treelib_DoCall (location_t location, tree rettype, tree funcptr, + tree param_list); +EXTERN tree m2treelib_DoCall0 (location_t location, tree rettype, + tree funcptr); +EXTERN tree m2treelib_DoCall1 (location_t location, tree rettype, tree funcptr, + tree arg0); +EXTERN tree m2treelib_DoCall2 (location_t location, tree rettype, tree funcptr, + tree arg0, tree arg1); +EXTERN tree m2treelib_DoCall3 (location_t location, tree rettype, tree funcptr, + tree arg0, tree arg1, tree arg2); +EXTERN tree m2treelib_get_rvalue (location_t location, tree t, tree type, + int is_lvalue); +EXTERN tree m2treelib_get_field_no (tree type, tree op, int is_const, + unsigned int fieldNo); +EXTERN tree m2treelib_get_set_value (location_t location, tree p, tree field, + int is_const, int is_lvalue, tree op, + unsigned int fieldNo); +EXTERN tree m2treelib_get_set_address (location_t location, tree op1, + int is_lvalue); +EXTERN tree m2treelib_get_set_field_lhs (location_t location, tree p, + tree field); +EXTERN tree m2treelib_get_set_field_rhs (location_t location, tree p, + tree field); +EXTERN tree m2treelib_get_set_address_if_var (location_t location, tree op, + int is_lvalue, int is_const); +EXTERN tree m2treelib_get_set_field_des (location_t location, tree p, + tree field); + +EXTERN tree add_stmt (location_t location, tree t); +EXTERN tree build_stmt (location_t loc, enum tree_code code, ...); + +#undef EXTERN +#endif /* m2treelib_h. */ diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2type.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2type.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,222 @@ +/* m2type.h header file for m2type.cc. + +Copyright (C) 2012-2022 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(m2type_h) +#define m2type_h +#if defined(m2type_c) +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN +#endif /* !__GNUG__. */ +#else /* !m2type_c. */ +#if defined(__GNUG__) +#define EXTERN extern "C" +#else /* !__GNUG__. */ +#define EXTERN extern +#endif /* !__GNUG__. */ +#endif /* !m2type_c. */ + +typedef void *m2type_Constructor; + +EXTERN int m2type_ValueInTypeRange (tree type, tree value); +EXTERN int m2type_ExceedsTypeRange (tree type, tree low, tree high); +EXTERN int m2type_ValueOutOfTypeRange (tree type, tree value); +EXTERN int m2type_WithinTypeRange (tree type, tree low, tree high); +EXTERN tree m2type_BuildStartArrayType (tree index_type, tree elt_type, + int type); +EXTERN void m2type_PutArrayType (tree array, tree type); +EXTERN tree m2type_BuildEndArrayType (tree arraytype, tree elementtype, + tree indextype, int type); +EXTERN tree m2type_GetArrayNoOfElements (location_t location, tree arraytype); +EXTERN tree m2type_BuildArrayIndexType (tree low, tree high); +EXTERN void m2type_GarbageCollect (void); +EXTERN void m2type_MarkFunctionReferenced (tree f); +EXTERN void m2type_AddStatement (location_t location, tree t); +EXTERN tree m2type_BuildNumberOfArrayElements (location_t location, + tree arrayType); +EXTERN tree m2type_BuildPackedFieldRecord (location_t location, char *name, + tree fieldtype); +EXTERN tree m2type_SetRecordFieldOffset (tree field, tree byteOffset, + tree bitOffset, tree fieldtype, + tree nbits); +EXTERN tree m2type_SetTypePacked (tree node); +EXTERN tree m2type_SetDeclPacked (tree node); +EXTERN tree m2type_SetAlignment (tree node, tree align); +EXTERN tree m2type_BuildEndRecord (location_t location, tree record, + tree fieldlist, int isPacked); +EXTERN tree m2type_AddStringToTreeList (tree list, tree string); +EXTERN tree m2type_ChainOnParamValue (tree list, tree name, tree str, + tree value); +EXTERN tree m2type_ChainOn (tree t1, tree t2); +EXTERN tree m2type_BuildFieldRecord (location_t location, char *name, + tree type); +EXTERN tree m2type_BuildStartFieldRecord (location_t location, char *name, + tree type); +EXTERN tree m2type_BuildEndFieldVarient (location_t location, + tree varientField, tree varientList, + int isPacked); +EXTERN tree m2type_BuildStartFieldVarient (location_t location, char *name); +EXTERN tree m2type_BuildEndVarient (location_t location, tree varientField, + tree varientList, int isPacked); +EXTERN tree m2type_BuildStartVarient (location_t location, char *name); +EXTERN tree m2type_BuildStartUnion (location_t location, char *name); +EXTERN tree m2type_BuildStartRecord (location_t location, char *name); +EXTERN tree m2type_RealToTree (char *name); +EXTERN tree m2type_BuildArrayStringConstructor (location_t location, + tree arrayType, tree str, + tree length); + +#if 0 +EXTERN tree m2type_GetPointerOne (void); +EXTERN tree m2type_GetPointerZero (void); +EXTERN tree m2type_GetWordOne (void); +EXTERN tree m2type_GetWordZero (void); +#endif + +EXTERN tree m2type_GetM2CharType (void); +EXTERN tree m2type_GetM2IntegerType (void); +EXTERN tree m2type_GetM2ShortRealType (void); +EXTERN tree m2type_GetM2RealType (void); +EXTERN tree m2type_GetM2LongRealType (void); +EXTERN tree m2type_GetM2LongIntType (void); +EXTERN tree m2type_GetM2LongCardType (void); +EXTERN tree m2type_GetM2ShortIntType (void); +EXTERN tree m2type_GetShortIntType (void); +EXTERN tree m2type_GetM2ShortCardType (void); +EXTERN tree m2type_GetShortCardType (void); +EXTERN tree m2type_GetISOWordType (void); +EXTERN tree m2type_GetISOByteType (void); +EXTERN tree m2type_GetISOLocType (void); +EXTERN tree m2type_GetM2Integer8 (void); +EXTERN tree m2type_GetM2Integer16 (void); +EXTERN tree m2type_GetM2Integer32 (void); +EXTERN tree m2type_GetM2Integer64 (void); +EXTERN tree m2type_GetM2Cardinal8 (void); +EXTERN tree m2type_GetM2Cardinal16 (void); +EXTERN tree m2type_GetM2Cardinal32 (void); +EXTERN tree m2type_GetM2Cardinal64 (void); +EXTERN tree m2type_GetM2Word16 (void); +EXTERN tree m2type_GetM2Word32 (void); +EXTERN tree m2type_GetM2Word64 (void); +EXTERN tree m2type_GetM2Bitset8 (void); +EXTERN tree m2type_GetM2Bitset16 (void); +EXTERN tree m2type_GetM2Bitset32 (void); +EXTERN tree m2type_GetM2Real32 (void); +EXTERN tree m2type_GetM2Real64 (void); +EXTERN tree m2type_GetM2Real96 (void); +EXTERN tree m2type_GetM2Real128 (void); +EXTERN tree m2type_GetM2Complex32 (void); +EXTERN tree m2type_GetM2Complex64 (void); +EXTERN tree m2type_GetM2Complex96 (void); +EXTERN tree m2type_GetM2Complex128 (void); +EXTERN tree m2type_GetM2ShortComplexType (void); +EXTERN tree m2type_GetM2LongComplexType (void); +EXTERN tree m2type_GetM2ComplexType (void); +EXTERN tree m2type_GetShortCardType (void); +EXTERN tree m2type_GetProcType (void); +EXTERN tree m2type_GetCSizeTType (void); +EXTERN tree m2type_GetCSSizeTType (void); + +EXTERN tree m2type_GetM2CType (void); + +EXTERN tree m2type_GetBitsetType (void); +EXTERN tree m2type_GetM2CardinalType (void); +EXTERN tree m2type_GetWordType (void); +EXTERN tree m2type_GetIntegerType (void); +EXTERN tree m2type_GetCardinalType (void); +EXTERN tree m2type_GetPointerType (void); +EXTERN tree m2type_GetLongIntType (void); +EXTERN tree m2type_GetShortRealType (void); +EXTERN tree m2type_GetLongRealType (void); +EXTERN tree m2type_GetRealType (void); +EXTERN tree m2type_GetBitnumType (void); +EXTERN tree m2type_GetVoidType (void); +EXTERN tree m2type_GetByteType (void); +EXTERN tree m2type_GetCharType (void); +EXTERN tree m2type_GetPackedBooleanType (void); +EXTERN tree m2type_GetBooleanTrue (void); +EXTERN tree m2type_GetBooleanFalse (void); +EXTERN tree m2type_GetBooleanType (void); +EXTERN tree m2type_BuildSmallestTypeRange (location_t location, tree low, + tree high); +EXTERN tree m2type_BuildSetTypeFromSubrange (location_t location, char *name, + tree subrangeType, tree lowval, + tree highval, int ispacked); +EXTERN int m2type_GetBitsPerBitset (void); +EXTERN tree m2type_GetM2RType (void); +EXTERN tree m2type_GetM2ZType (void); + +EXTERN tree m2type_DeclareKnownType (location_t location, char *name, + tree type); +EXTERN tree m2type_GetTreeType (tree type); +EXTERN tree m2type_BuildEndFunctionType (tree func, tree type, + int uses_varargs); +EXTERN tree m2type_BuildStartFunctionType ( + location_t location ATTRIBUTE_UNUSED, char *name ATTRIBUTE_UNUSED); +EXTERN void m2type_InitFunctionTypeParameters (void); +EXTERN tree m2type_BuildVariableArrayAndDeclare (location_t location, + tree elementtype, tree high, + char *name, tree scope); +EXTERN void m2type_InitSystemTypes (location_t location, int loc); +EXTERN void m2type_InitBaseTypes (location_t location); +EXTERN tree m2type_BuildStartType (location_t location, char *name, tree type); +EXTERN tree m2type_BuildEndType (location_t location, tree type); +EXTERN tree m2type_GetDefaultType (location_t location, char *name, tree type); +EXTERN tree m2type_GetMinFrom (location_t location, tree type); +EXTERN tree m2type_GetMaxFrom (location_t location, tree type); +EXTERN void m2type_BuildTypeDeclaration (location_t location, tree type); +EXTERN tree m2type_BuildStartEnumeration (location_t location, char *name, + int ispacked); +EXTERN tree m2type_BuildEndEnumeration (location_t location, tree enumtype, + tree enumvalues); +EXTERN tree m2type_BuildEnumerator (location_t location, char *name, + tree value, tree *enumvalues); +EXTERN tree m2type_BuildPointerType (tree totype); +EXTERN tree m2type_BuildConstPointerType (tree totype); +EXTERN tree m2type_BuildSetType (location_t location, char *name, tree type, + tree lowval, tree highval, int ispacked); +EXTERN void *m2type_BuildStartSetConstructor (tree type); +EXTERN void m2type_BuildSetConstructorElement (void *p, tree value); +EXTERN tree m2type_BuildEndSetConstructor (void *p); +EXTERN void *m2type_BuildStartRecordConstructor (tree type); +EXTERN tree m2type_BuildEndRecordConstructor (void *p); +EXTERN void m2type_BuildRecordConstructorElement (void *p, tree value); +EXTERN void *m2type_BuildStartArrayConstructor (tree type); +EXTERN tree m2type_BuildEndArrayConstructor (void *p); +EXTERN void m2type_BuildArrayConstructorElement (void *p, tree value, + tree indice); +EXTERN tree m2type_BuildCharConstant (location_t location, const char *string); +EXTERN tree m2type_BuildCharConstantChar (location_t location, char ch); +EXTERN tree m2type_BuildSubrangeType (location_t location, char *name, + tree type, tree lowval, tree highval); +EXTERN tree m2type_gm2_unsigned_type (tree type); +EXTERN tree m2type_gm2_signed_type (tree type); +EXTERN tree m2type_gm2_signed_or_unsigned_type (int unsignedp, tree type); +EXTERN tree m2type_gm2_type_for_size (unsigned int bits, int unsignedp); +EXTERN tree m2type_BuildProcTypeParameterDeclaration (location_t location, + tree type, + int isreference); +EXTERN int m2type_IsAddress (tree type); +EXTERN tree m2type_GetCardinalAddressType (void); + +#undef EXTERN +#endif /* m2type_h */ From patchwork Tue Dec 6 14:47:27 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Gaius Mulley X-Patchwork-Id: 61586 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id DA5293875B6A for ; Tue, 6 Dec 2022 14:52:12 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org DA5293875B6A DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1670338332; bh=jd6T5PCvwIqpV4ByEXZ6Ve7LzEBSxBGP10vVjXbS5qw=; h=Subject:To:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=sO8EgYb2uvyVWQKV81uahxJzM6cYoxkSfm9p1rEGQcg1LraT2fQG/uMIv7f5EAbFH tJWGm5j/g3Cg/j74FSHHxqZRD4mtYxuGG4ZrzUBEhPAlxHmDuGEx0rSG1YJhU3Yb7P QsFknjrMwsdm7zgaM4whxUT9dMxR32gjb/cRjYTk= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42b.google.com (mail-wr1-x42b.google.com [IPv6:2a00:1450:4864:20::42b]) by sourceware.org (Postfix) with ESMTPS id C8441384699B for ; Tue, 6 Dec 2022 14:47:33 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org C8441384699B Received: by mail-wr1-x42b.google.com with SMTP id w15so23774360wrl.9 for ; Tue, 06 Dec 2022 06:47:33 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=date:message-id:to:subject:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=jd6T5PCvwIqpV4ByEXZ6Ve7LzEBSxBGP10vVjXbS5qw=; b=2sT4tDGtB5IJeRhqV0q5BLRuTtvfAlpa0rnhXUboD1Mx+ZgrYMGXsNuIv3JiiGc/+6 9sGo6oJucAMdssV0nFNJJVZ5p9hFvOY+VzPdfPB5LaruIjmDVXETzKPHYtrOovyxhuLh DUFg4stvme0KLbpDyMgdwCCJMhaS6xyEYQ1fp19feNV7Q+QOIdJRCVu+DQLYQFzgJpQp as8QRjtgDIV6RL7jKKgOMQENHX8qQVsqp1FS4aMbAlFR1t6e2gsWY++4iRoidePzdGKM WofM0WrFtOZlu4RcsqasSUOdxniVUFBQLl/dGiJjI+pKtAHvP4Yzm/J83a1Eaes50IGf v4fg== X-Gm-Message-State: ANoB5pmZUWsjRsGOOG3AxsKlhg8RwJIA8HEXDS2JRh22CvLtmhxZ2e6W v9s7/e1qpIzvTFUQAMMxs5OcRLlbrro= X-Google-Smtp-Source: AA0mqf6/e5CGGB2C0QBrtxUU1wdsh3owBRsimbV/E16HX7jp+bJEpAXw6c2kVwgTWR3BmhrFpvTtOA== X-Received: by 2002:a5d:4244:0:b0:242:5add:4d76 with SMTP id s4-20020a5d4244000000b002425add4d76mr7049432wrr.632.1670338052466; Tue, 06 Dec 2022 06:47:32 -0800 (PST) Received: from lancelot ([195.147.220.46]) by smtp.gmail.com with ESMTPSA id f18-20020a05600c4e9200b003c6c182bef9sm34943210wmq.36.2022.12.06.06.47.31 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Dec 2022 06:47:32 -0800 (PST) X-Google-Original-From: Gaius Mulley Received: from gaius by lancelot with local (Exim 4.94.2) (envelope-from ) id 1p2ZEF-004Qgl-Sj for gcc-patches@gcc.gnu.org; Tue, 06 Dec 2022 14:47:27 +0000 Subject: [PATCH v3 13/19] modula2 front end: gimple interface *[g-m]*.cc To: X-Mailer: mail (GNU Mailutils 3.10) Message-Id: Date: Tue, 06 Dec 2022 14:47:27 +0000 X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Gaius Mulley via Gcc-patches From: Gaius Mulley Reply-To: Gaius Mulley Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patchset contains the gimple interface. ------8<----------8<----------8<----------8<----------8<----------8<---- diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2linemap.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2linemap.cc 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,254 @@ +/* m2linemap.cc provides an interface to GCC linemaps. + +Copyright (C) 2012-2022 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 +. */ + +#include "gcc-consolidation.h" + +/* Utilize some of the C build routines */ + +#include "../gm2-lang.h" +#include "../m2-tree.h" + +#include "m2assert.h" +#include "m2block.h" +#include "m2decl.h" +#include "m2expr.h" +#include "m2options.h" +#include "m2tree.h" +#include "m2type.h" +#define m2linemap_c +#include "m2linemap.h" + +static int inFile = FALSE; + +#if defined(__cplusplus) +#define EXTERN extern "C" +#else +#define EXTERN +#endif + +/* Start getting locations from a new file. */ + +EXTERN +void +m2linemap_StartFile (void *filename, unsigned int linebegin) +{ + if (inFile) + m2linemap_EndFile (); + linemap_add (line_table, LC_ENTER, false, + xstrdup (reinterpret_cast (filename)), linebegin); + inFile = TRUE; +} + +/* Tell the line table the file has ended. */ + +EXTERN +void +m2linemap_EndFile (void) +{ + linemap_add (line_table, LC_LEAVE, 0, NULL, 0); + inFile = FALSE; +} + +/* Indicate that there is a new source file line number with a + maximum width. */ + +EXTERN +void +m2linemap_StartLine (unsigned int linenumber, unsigned int linesize) +{ + linemap_line_start (line_table, linenumber, linesize); +} + +/* GetLocationColumn, returns a location_t based on the current line + number and column. */ + +EXTERN +location_t +m2linemap_GetLocationColumn (unsigned int column) +{ + return linemap_position_for_column (line_table, column); +} + +/* GetLocationRange, returns a location based on the start column + and end column. */ + +EXTERN +location_t +m2linemap_GetLocationRange (unsigned int start, unsigned int end) +{ + location_t caret = m2linemap_GetLocationColumn (start); + + source_range where; + where.m_start = linemap_position_for_column (line_table, start); + where.m_finish = linemap_position_for_column (line_table, end); + return make_location (caret, where); +} + + +static +int +isSrcLocation (location_t location) +{ + return (location != BUILTINS_LOCATION) && (location != UNKNOWN_LOCATION); +} + + +/* GetLocationBinary, returns a location based on the expression + start caret finish locations. */ + +EXTERN +location_t +m2linemap_GetLocationBinary (location_t caret, location_t start, location_t finish) +{ + if (isSrcLocation (start) && isSrcLocation (finish) && isSrcLocation (caret) + && (m2linemap_GetFilenameFromLocation (start) != NULL)) + { + linemap_add (line_table, LC_ENTER, false, xstrdup (m2linemap_GetFilenameFromLocation (start)), 1); + gcc_assert (inFile); + location_t location = make_location (caret, start, finish); + return location; + } + return caret; +} + +/* GetLineNoFromLocation - returns the lineno given a location. */ + +EXTERN +int +m2linemap_GetLineNoFromLocation (location_t location) +{ + if (isSrcLocation (location) && (!M2Options_GetCpp ())) + { + expanded_location xl = expand_location (location); + return xl.line; + } + return 0; +} + +/* GetColumnNoFromLocation - returns the columnno given a location. */ + +EXTERN +int +m2linemap_GetColumnNoFromLocation (location_t location) +{ + if (isSrcLocation (location) && (!M2Options_GetCpp ())) + { + expanded_location xl = expand_location (location); + return xl.column; + } + return 0; +} + +/* GetFilenameFromLocation - returns the filename given a location. */ + +EXTERN +const char * +m2linemap_GetFilenameFromLocation (location_t location) +{ + if (isSrcLocation (location) && (!M2Options_GetCpp ())) + { + expanded_location xl = expand_location (location); + return xl.file; + } + return NULL; +} + +/* ErrorAt - issue an error message. */ + +EXTERN +void +m2linemap_ErrorAt (location_t location, char *message) +{ + error_at (location, message); +} + +/* m2linemap_ErrorAtf - wraps up an error message. */ + +void +m2linemap_ErrorAtf (location_t location, const char *message, ...) +{ + diagnostic_info diagnostic; + va_list ap; + rich_location richloc (line_table, location); + + va_start (ap, message); + diagnostic_set_info (&diagnostic, message, &ap, &richloc, DK_ERROR); + diagnostic_report_diagnostic (global_dc, &diagnostic); + va_end (ap); +} + +/* m2linemap_WarningAtf - wraps up a warning message. */ + +void +m2linemap_WarningAtf (location_t location, const char *message, ...) +{ + diagnostic_info diagnostic; + va_list ap; + rich_location richloc (line_table, location); + + va_start (ap, message); + diagnostic_set_info (&diagnostic, message, &ap, &richloc, DK_WARNING); + diagnostic_report_diagnostic (global_dc, &diagnostic); + va_end (ap); +} + +/* m2linemap_NoteAtf - wraps up a note message. */ + +void +m2linemap_NoteAtf (location_t location, const char *message, ...) +{ + diagnostic_info diagnostic; + va_list ap; + rich_location richloc (line_table, location); + + va_start (ap, message); + diagnostic_set_info (&diagnostic, message, &ap, &richloc, DK_NOTE); + diagnostic_report_diagnostic (global_dc, &diagnostic); + va_end (ap); +} + +/* m2linemap_internal_error - allow Modula-2 to use the GCC internal error. */ + +void +m2linemap_internal_error (const char *message) +{ + internal_error (message); +} + +/* UnknownLocation - return the predefined location representing an + unknown location. */ + +EXTERN +location_t +m2linemap_UnknownLocation (void) +{ + return UNKNOWN_LOCATION; +} + +/* BuiltinsLocation - return the predefined location representing a + builtin. */ + +EXTERN +location_t +m2linemap_BuiltinsLocation (void) +{ + return BUILTINS_LOCATION; +} diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2misc.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-gcc/m2misc.cc 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,56 @@ +/* m2misc.cc miscellaneous tree debugging functions. + +Copyright (C) 2012-2022 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 +. */ + +#include "gcc-consolidation.h" + +#include "../m2-tree.h" +#include "tree-iterator.h" + +#define m2misc_c +#include "m2block.h" +#include "m2misc.h" +#include "m2tree.h" + +/* DebugTree - display the tree, t. */ + +void +m2misc_DebugTree (tree t) +{ + debug_tree (t); +} + +/* DebugTree - display the tree, t. */ + +void +m2misc_DebugTreeChain (tree t) +{ + for (; (t != NULL); t = TREE_CHAIN (t)) + debug_tree (t); +} + +/* DebugTree - display the tree, t. */ + +void +m2misc_printStmt (void) +{ + if (m2block_cur_stmt_list () != NULL) + debug_tree (m2block_cur_stmt_list ()); +} From patchwork Tue Dec 6 14:47:28 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Gaius Mulley X-Patchwork-Id: 61584 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 7EA76383B6D5 for ; Tue, 6 Dec 2022 14:51:16 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 7EA76383B6D5 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1670338276; bh=GlMrJaRBg5NjOp3monaIX+CsLHgABSXjCm3YYgKR48s=; h=Subject:To:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=d132AhhnzhNrB8vb9wdinaw2DSLzAJn5A6LxBbmwvxmkdzsvQr8U1O2jUu86u5/n2 yEj/suOrzGTAeq4azrLAIOplvCgR/KB/6gWFG/AubgDeq6ehRmNz0Swztt8tBDBn3V sGrDDanwDRKwm4FaWBSXa4rlfj1aTVV/IRIo+91A= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x32f.google.com (mail-wm1-x32f.google.com [IPv6:2a00:1450:4864:20::32f]) by sourceware.org (Postfix) with ESMTPS id 63FCB3871FB9 for ; Tue, 6 Dec 2022 14:48:13 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 63FCB3871FB9 Received: by mail-wm1-x32f.google.com with SMTP id r65-20020a1c4444000000b003d1e906ca23so396243wma.3 for ; Tue, 06 Dec 2022 06:48:13 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=date:message-id:to:subject:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=GlMrJaRBg5NjOp3monaIX+CsLHgABSXjCm3YYgKR48s=; b=jS4cgMOVjZhxpsavN6di/rK1t0K0fSUZ+GbWVfCD4B9f9RZ5tOy7ekzExaCFMCWLV2 NwwJExG27afgsBQ1yrl+/4SE5FBXsORud+b0dr5giNMpqNJZc/cpsWaj6mlqnHkboDiO jby83CxuQk+z3U0z3euFWDly8HXyiEJCe215vCzlqtchBoCIDmneI+Tayz9FnhwNgpjO d3MJ+vwtFGTVwFM3ibwzT4N0xapuwZnysSxwZSGufno/3TdSPS5yk04EJho+YC1Ndwqi 6fSxU3oN9QEFfTc/QQDnivFVicDqtButEx5FwjREs9ti10dkZzKJwdE8QYvESaE660Lb FpOw== X-Gm-Message-State: ANoB5pl6/Pf20h+yxR/OBZBu7flHZAj6q5GoCo0Gjun35saf31z7imtW 1SR3uko2Kww1koZ4GVGIrVdmV/KmsjI= X-Google-Smtp-Source: AA0mqf6msE7OOtqnNnPuYjc8rYG9Rs5eNHKqNImaqKykhdbbItAGtAxb6oQx/dHrLCe/uictUxLfMg== X-Received: by 2002:a05:600c:414d:b0:3d0:878e:6fed with SMTP id h13-20020a05600c414d00b003d0878e6fedmr13636531wmm.150.1670338090656; Tue, 06 Dec 2022 06:48:10 -0800 (PST) Received: from lancelot ([195.147.220.46]) by smtp.gmail.com with ESMTPSA id b18-20020a05600010d200b002423a5d7cb1sm13980031wrx.113.2022.12.06.06.47.32 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Dec 2022 06:48:10 -0800 (PST) X-Google-Original-From: Gaius Mulley Received: from gaius by lancelot with local (Exim 4.94.2) (envelope-from ) id 1p2ZEG-004QhG-Bj for gcc-patches@gcc.gnu.org; Tue, 06 Dec 2022 14:47:28 +0000 Subject: [PATCH v3 15/19] modula2 front end: cc1gm2 additional non modula2 source files To: X-Mailer: mail (GNU Mailutils 3.10) Message-Id: Date: Tue, 06 Dec 2022 14:47:28 +0000 X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Gaius Mulley via Gcc-patches From: Gaius Mulley Reply-To: Gaius Mulley Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This patch set contains the .h, .cc and .flex files found in gcc/m2. The files are tightly coupled with the gimple interface (see 04-gimple-interface) and built using the rules found in (01-03-make). ------8<----------8<----------8<----------8<----------8<----------8<---- diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-lang.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-lang.cc 2022-12-06 02:57:10.909039217 +0000 @@ -0,0 +1,887 @@ +/* gm2-lang.cc language-dependent hooks for GNU Modula-2. + +Copyright (C) 2002-2022 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 COPYING. If not, write to the +Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301, USA. */ + +#include "gm2-gcc/gcc-consolidation.h" + +#include "langhooks-def.h" /* FIXME: for lhd_set_decl_assembler_name. */ +#include "tree-pass.h" /* FIXME: only for PROP_gimple_any. */ +#include "toplev.h" +#include "debug.h" + +#include "opts.h" + +#define GM2_LANG_C +#include "gm2-lang.h" +#include "m2block.h" +#include "dynamicstrings.h" +#include "m2options.h" +#include "m2convert.h" +#include "m2linemap.h" +#include "init.h" +#include "m2-tree.h" +#include "convert.h" +#include "rtegraph.h" + +static void write_globals (void); + +static int insideCppArgs = FALSE; + +#define EXPR_STMT_EXPR(NODE) TREE_OPERAND (EXPR_STMT_CHECK (NODE), 0) + +/* start of new stuff. */ + +/* Language-dependent contents of a type. */ + +struct GTY (()) lang_type +{ + char dummy; +}; + +/* Language-dependent contents of a decl. */ + +struct GTY (()) lang_decl +{ + char dummy; +}; + +/* Language-dependent contents of an identifier. This must include a + tree_identifier. */ + +struct GTY (()) lang_identifier +{ + struct tree_identifier common; +}; + +/* 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; +}; + +struct GTY (()) language_function +{ + + /* While we are parsing the function, this contains information about + the statement-tree that we are building. */ + /* struct stmt_tree_s stmt_tree; */ + tree stmt_tree; +}; + +/* Language hooks. */ + +bool +gm2_langhook_init (void) +{ + build_common_tree_nodes (false); + build_common_builtin_nodes (); + + /* The default precision for floating point numbers. This is used + for floating point constants with abstract type. This may eventually + be controllable by a command line option. */ + mpfr_set_default_prec (256); + + /* GNU Modula-2 uses exceptions. */ + using_eh_for_cleanups (); + return true; +} + +/* The option mask. */ + +static unsigned int +gm2_langhook_option_lang_mask (void) +{ + return CL_ModulaX2; +} + +/* Initialize the options structure. */ + +static void +gm2_langhook_init_options_struct (struct gcc_options *opts) +{ + /* Default to avoiding range issues for complex multiply and divide. */ + opts->x_flag_complex_method = 2; + + /* The builtin math functions should not set errno. */ + opts->x_flag_errno_math = 0; + opts->frontend_set_flag_errno_math = true; + + /* Exceptions are used. */ + opts->x_flag_exceptions = 1; + init_FrontEndInit (); +} + +/* Infrastructure for a VEC of bool values. */ + +/* This array determines whether the filename is associated with the + C preprocessor. */ + +static vec filename_cpp; + +void +gm2_langhook_init_options (unsigned int decoded_options_count, + struct cl_decoded_option *decoded_options) +{ + unsigned int i; + bool in_cpp_args = false; + + for (i = 1; i < decoded_options_count; i++) + { + switch (decoded_options[i].opt_index) + { + case OPT_fcpp_begin: + in_cpp_args = true; + break; + case OPT_fcpp_end: + in_cpp_args = false; + break; + case OPT_SPECIAL_input_file: + case OPT_SPECIAL_program_name: + filename_cpp.safe_push (in_cpp_args); + } + } + filename_cpp.safe_push (false); +} + +static bool +is_cpp_filename (unsigned int i) +{ + gcc_assert (i < filename_cpp.length ()); + return filename_cpp[i]; +} + +/* Handle gm2 specific options. Return 0 if we didn't do anything. */ + +bool +gm2_langhook_handle_option ( + size_t scode, const char *arg, HOST_WIDE_INT value, int kind ATTRIBUTE_UNUSED, + location_t loc ATTRIBUTE_UNUSED, + const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED) +{ + enum opt_code code = (enum opt_code)scode; + + /* ignore file names. */ + if (code == N_OPTS) + return 1; + + switch (code) + { + case OPT_B: + M2Options_SetB (arg); + return 1; + case OPT_c: + M2Options_Setc (value); + return 1; + case OPT_I: + if (insideCppArgs) + { + const struct cl_option *option = &cl_options[scode]; + const char *opt = (const char *)option->opt_text; + M2Options_CppArg (opt, arg, TRUE); + } + else + M2Options_SetSearchPath (arg); + return 1; + case OPT_fiso: + M2Options_SetISO (value); + return 1; + case OPT_fpim: + M2Options_SetPIM (value); + return 1; + case OPT_fpim2: + M2Options_SetPIM2 (value); + return 1; + case OPT_fpim3: + M2Options_SetPIM3 (value); + return 1; + case OPT_fpim4: + M2Options_SetPIM4 (value); + return 1; + case OPT_fpositive_mod_floor_div: + M2Options_SetPositiveModFloor (value); + return 1; + case OPT_flibs_: + /* handled in the gm2 driver. */ + return 1; + case OPT_fgen_module_list_: + M2Options_SetGenModuleList (value, arg); + return 1; + case OPT_fnil: + M2Options_SetNilCheck (value); + return 1; + case OPT_fwholediv: + M2Options_SetWholeDiv (value); + return 1; + case OPT_findex: + M2Options_SetIndex (value); + return 1; + case OPT_frange: + M2Options_SetRange (value); + return 1; + case OPT_ffloatvalue: + M2Options_SetFloatValueCheck (value); + return 1; + case OPT_fwholevalue: + M2Options_SetWholeValueCheck (value); + return 1; + case OPT_freturn: + M2Options_SetReturnCheck (value); + return 1; + case OPT_fcase: + M2Options_SetCaseCheck (value); + return 1; + case OPT_fd: + M2Options_SetCompilerDebugging (value); + return 1; + case OPT_fdebug_trace_quad: + M2Options_SetDebugTraceQuad (value); + return 1; + case OPT_fdebug_trace_api: + M2Options_SetDebugTraceAPI (value); + return 1; + case OPT_fdebug_function_line_numbers: + M2Options_SetDebugFunctionLineNumbers (value); + return 1; + case OPT_fauto_init: + M2Options_SetAutoInit (value); + return 1; + case OPT_fsoft_check_all: + M2Options_SetCheckAll (value); + return 1; + case OPT_fexceptions: + M2Options_SetExceptions (value); + return 1; + case OPT_Wstyle: + M2Options_SetStyle (value); + return 1; + case OPT_Wpedantic: + M2Options_SetPedantic (value); + return 1; + case OPT_Wpedantic_param_names: + M2Options_SetPedanticParamNames (value); + return 1; + case OPT_Wpedantic_cast: + M2Options_SetPedanticCast (value); + return 1; + case OPT_fextended_opaque: + M2Options_SetExtendedOpaque (value); + return 1; + case OPT_Wverbose_unbounded: + M2Options_SetVerboseUnbounded (value); + return 1; + case OPT_Wunused_variable: + M2Options_SetUnusedVariableChecking (value); + return 1; + case OPT_Wunused_parameter: + M2Options_SetUnusedParameterChecking (value); + return 1; + case OPT_fm2_strict_type: + M2Options_SetStrictTypeChecking (value); + return 1; + case OPT_Wall: + M2Options_SetWall (value); + return 1; + case OPT_fxcode: + M2Options_SetXCode (value); + return 1; + case OPT_fm2_lower_case: + M2Options_SetLowerCaseKeywords (value); + return 1; + case OPT_fuse_list_: + M2Options_SetUselist (value, arg); + return 1; + case OPT_fruntime_modules_: + M2Options_SetRuntimeModuleOverride (arg); + return 1; + case OPT_fpthread: + /* handled in the driver. */ + return 1; + case OPT_fm2_plugin: + /* handled in the driver. */ + return 1; + case OPT_fscaffold_dynamic: + M2Options_SetScaffoldDynamic (value); + return 1; + case OPT_fscaffold_static: + M2Options_SetScaffoldStatic (value); + return 1; + case OPT_fscaffold_main: + M2Options_SetScaffoldMain (value); + return 1; + case OPT_fcpp: + M2Options_SetCpp (value); + return 1; + case OPT_fcpp_begin: + insideCppArgs = TRUE; + return 1; + case OPT_fcpp_end: + insideCppArgs = FALSE; + return 1; + case OPT_fq: + M2Options_SetQuadDebugging (value); + return 1; + case OPT_fsources: + M2Options_SetSources (value); + return 1; + case OPT_funbounded_by_reference: + M2Options_SetUnboundedByReference (value); + return 1; + case OPT_fdef_: + M2Options_setdefextension (arg); + return 1; + case OPT_fmod_: + M2Options_setmodextension (arg); + return 1; + case OPT_fdump_system_exports: + M2Options_SetDumpSystemExports (value); + return 1; + case OPT_fswig: + M2Options_SetSwig (value); + return 1; + case OPT_fshared: + M2Options_SetShared (value); + return 1; + case OPT_fm2_statistics: + M2Options_SetStatistics (value); + return 1; + case OPT_fm2_g: + M2Options_SetM2g (value); + return 1; + case OPT_O: + M2Options_SetOptimizing (value); + return 1; + case OPT_quiet: + M2Options_SetQuiet (value); + return 1; + case OPT_fm2_whole_program: + M2Options_SetWholeProgram (value); + return 1; + case OPT_flocation_: + if (strcmp (arg, "builtins") == 0) + { + M2Options_SetForcedLocation (BUILTINS_LOCATION); + return 1; + } + else if (strcmp (arg, "unknown") == 0) + { + M2Options_SetForcedLocation (UNKNOWN_LOCATION); + return 1; + } + else if ((arg != NULL) && (ISDIGIT (arg[0]))) + { + M2Options_SetForcedLocation (atoi (arg)); + return 1; + } + else + return 0; + case OPT_save_temps: + M2Options_SetSaveTemps (value); + return 1; + case OPT_save_temps_: + M2Options_SetSaveTempsDir (arg); + return 1; + default: + if (insideCppArgs) + { + const struct cl_option *option = &cl_options[scode]; + const char *opt = (const char *)option->opt_text; + + M2Options_CppArg (opt, arg, TRUE); + return 1; + } + return 0; + } + return 0; +} + +/* Run after parsing options. */ + +static bool +gm2_langhook_post_options (const char **pfilename) +{ + const char *filename = *pfilename; + flag_excess_precision = EXCESS_PRECISION_FAST; + M2Options_SetCC1Quiet (quiet_flag); + M2Options_FinaliseOptions (); + main_input_filename = filename; + + /* Returning false means that the backend should be used. */ + return false; +} + +/* Call the compiler for every source filename on the command line. */ + +static void +gm2_parse_input_files (const char **filenames, unsigned int filename_count) +{ + unsigned int i; + gcc_assert (filename_count > 0); + + for (i = 0; i < filename_count; i++) + if (!is_cpp_filename (i)) + { + main_input_filename = filenames[i]; + init_PerCompilationInit (filenames[i]); + } +} + +static void +gm2_langhook_parse_file (void) +{ + gm2_parse_input_files (in_fnames, num_in_fnames); + write_globals (); +} + +static tree +gm2_langhook_type_for_size (unsigned int bits, int unsignedp) +{ + return gm2_type_for_size (bits, unsignedp); +} + +static tree +gm2_langhook_type_for_mode (machine_mode mode, int unsignedp) +{ + tree type; + + for (int i = 0; i < NUM_INT_N_ENTS; i ++) + if (int_n_enabled_p[i] + && mode == int_n_data[i].m) + return (unsignedp ? int_n_trees[i].unsigned_type + : int_n_trees[i].signed_type); + + if (VECTOR_MODE_P (mode)) + { + tree inner; + + inner = gm2_langhook_type_for_mode (GET_MODE_INNER (mode), unsignedp); + if (inner != NULL_TREE) + return build_vector_type_for_mode (inner, mode); + return NULL_TREE; + } + + scalar_int_mode imode; + if (is_int_mode (mode, &imode)) + return gm2_langhook_type_for_size (GET_MODE_BITSIZE (imode), unsignedp); + + if (mode == TYPE_MODE (float_type_node)) + return float_type_node; + + if (mode == TYPE_MODE (double_type_node)) + return double_type_node; + + if (mode == TYPE_MODE (long_double_type_node)) + return long_double_type_node; + + if (COMPLEX_MODE_P (mode)) + { + if (mode == TYPE_MODE (complex_float_type_node)) + return complex_float_type_node; + if (mode == TYPE_MODE (complex_double_type_node)) + return complex_double_type_node; + if (mode == TYPE_MODE (complex_long_double_type_node)) + return complex_long_double_type_node; + } + +#if HOST_BITS_PER_WIDE_INT >= 64 + /* The middle-end and some backends rely on TImode being supported + for 64-bit HWI. */ + if (mode == TImode) + { + type = build_nonstandard_integer_type (GET_MODE_BITSIZE (TImode), + unsignedp); + if (type && TYPE_MODE (type) == TImode) + return type; + } +#endif + return NULL_TREE; +} + +/* Record a builtin function. We just ignore builtin functions. */ + +static tree +gm2_langhook_builtin_function (tree decl) +{ + return decl; +} + +/* Return true if we are in the global binding level. */ + +static bool +gm2_langhook_global_bindings_p (void) +{ + return current_function_decl == NULL_TREE; +} + +/* Unused langhook. */ + +static tree +gm2_langhook_pushdecl (tree decl ATTRIBUTE_UNUSED) +{ + gcc_unreachable (); +} + +/* This hook is used to get the current list of declarations as trees. + We don't support that; instead we use write_globals. This can't + simply crash because it is called by -gstabs. */ + +static tree +gm2_langhook_getdecls (void) +{ + return NULL; +} + +/* m2_write_global_declarations writes out globals creating an array + of the declarations and calling wrapup_global_declarations. */ + +static void +m2_write_global_declarations (tree globals) +{ + auto_vec global_decls; + tree decl = globals; + int n = 0; + + while (decl != NULL) + { + global_decls.safe_push (decl); + decl = TREE_CHAIN (decl); + n++; + } + wrapup_global_declarations (global_decls.address (), n); +} + +/* Write out globals. */ + +static void +write_globals (void) +{ + tree t; + unsigned i; + + m2block_finishGlobals (); + + /* Process all file scopes in this compilation, and the + external_scope, through wrapup_global_declarations and + check_global_declarations. */ + FOR_EACH_VEC_ELT (*all_translation_units, i, t) + m2_write_global_declarations (BLOCK_VARS (DECL_INITIAL (t))); +} + + +/* Gimplify an EXPR_STMT node. */ + +static void +gimplify_expr_stmt (tree *stmt_p) +{ + gcc_assert (EXPR_STMT_EXPR (*stmt_p) != NULL_TREE); + *stmt_p = EXPR_STMT_EXPR (*stmt_p); +} + +/* Genericize a TRY_BLOCK. */ + +static void +genericize_try_block (tree *stmt_p) +{ + tree body = TRY_STMTS (*stmt_p); + tree cleanup = TRY_HANDLERS (*stmt_p); + + *stmt_p = build2 (TRY_CATCH_EXPR, void_type_node, body, cleanup); +} + +/* Genericize a HANDLER by converting to a CATCH_EXPR. */ + +static void +genericize_catch_block (tree *stmt_p) +{ + tree type = HANDLER_TYPE (*stmt_p); + tree body = HANDLER_BODY (*stmt_p); + + /* FIXME should the caught type go in TREE_TYPE? */ + *stmt_p = build2 (CATCH_EXPR, void_type_node, type, body); +} + +/* Convert the tree representation of FNDECL from m2 frontend trees + to GENERIC. */ + +extern void pf (tree); + +void +gm2_genericize (tree fndecl) +{ + tree t; + struct cgraph_node *cgn; + +#if 0 + pf (fndecl); +#endif + /* Fix up the types of parms passed by invisible reference. */ + for (t = DECL_ARGUMENTS (fndecl); t; t = DECL_CHAIN (t)) + if (TREE_ADDRESSABLE (TREE_TYPE (t))) + { + + /* If a function's arguments are copied to create a thunk, then + DECL_BY_REFERENCE will be set -- but the type of the argument will be + a pointer type, so we will never get here. */ + gcc_assert (!DECL_BY_REFERENCE (t)); + gcc_assert (DECL_ARG_TYPE (t) != TREE_TYPE (t)); + TREE_TYPE (t) = DECL_ARG_TYPE (t); + DECL_BY_REFERENCE (t) = 1; + TREE_ADDRESSABLE (t) = 0; + relayout_decl (t); + } + + /* Dump all nested functions now. */ + cgn = cgraph_node::get_create (fndecl); + for (cgn = first_nested_function (cgn); + cgn != NULL; cgn = next_nested_function (cgn)) + gm2_genericize (cgn->decl); +} + +/* gm2 gimplify expression, currently just change THROW in the same + way as C++ */ + +static int +gm2_langhook_gimplify_expr (tree *expr_p, gimple_seq *pre_p ATTRIBUTE_UNUSED, + gimple_seq *post_p ATTRIBUTE_UNUSED) +{ + enum tree_code code = TREE_CODE (*expr_p); + + switch (code) + { + case THROW_EXPR: + + /* FIXME communicate throw type to back end, probably by moving + THROW_EXPR into ../tree.def. */ + *expr_p = TREE_OPERAND (*expr_p, 0); + return GS_OK; + + case EXPR_STMT: + gimplify_expr_stmt (expr_p); + return GS_OK; + + case TRY_BLOCK: + genericize_try_block (expr_p); + return GS_OK; + + case HANDLER: + genericize_catch_block (expr_p); + return GS_OK; + + default: + return GS_UNHANDLED; + } +} + +static GTY(()) tree gm2_eh_personality_decl; + +static tree +gm2_langhook_eh_personality (void) +{ + if (!gm2_eh_personality_decl) + gm2_eh_personality_decl = build_personality_function ("gxx"); + + return gm2_eh_personality_decl; +} + +/* Functions called directly by the generic backend. */ + +tree +convert_loc (location_t location, tree type, tree expr) +{ + if (type == error_mark_node || expr == error_mark_node + || TREE_TYPE (expr) == error_mark_node) + return error_mark_node; + + if (type == TREE_TYPE (expr)) + return expr; + + gcc_assert (TYPE_MAIN_VARIANT (type) != NULL); + if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (expr))) + return fold_convert (type, expr); + + expr = m2convert_GenericToType (location, type, expr); + switch (TREE_CODE (type)) + { + case VOID_TYPE: + case BOOLEAN_TYPE: + return fold_convert (type, expr); + case INTEGER_TYPE: + return fold (convert_to_integer (type, expr)); + case POINTER_TYPE: + return fold (convert_to_pointer (type, expr)); + case REAL_TYPE: + return fold (convert_to_real (type, expr)); + case COMPLEX_TYPE: + return fold (convert_to_complex (type, expr)); + case ENUMERAL_TYPE: + return fold (convert_to_integer (type, expr)); + default: + error_at (location, "cannot convert expression, only base types can be converted"); + break; + } + return error_mark_node; +} + +/* Functions called directly by the generic backend. */ + +tree +convert (tree type, tree expr) +{ + return convert_loc (m2linemap_UnknownLocation (), type, expr); +} + +/* Mark EXP saying that we need to be able to take the address of it; + it should not be allocated in a register. Returns true if + successful. */ + +bool +gm2_mark_addressable (tree exp) +{ + tree x = exp; + + while (TRUE) + switch (TREE_CODE (x)) + { + case COMPONENT_REF: + if (DECL_PACKED (TREE_OPERAND (x, 1))) + return false; + x = TREE_OPERAND (x, 0); + break; + + case ADDR_EXPR: + case ARRAY_REF: + case REALPART_EXPR: + case IMAGPART_EXPR: + x = TREE_OPERAND (x, 0); + break; + + case COMPOUND_LITERAL_EXPR: + case CONSTRUCTOR: + case STRING_CST: + case VAR_DECL: + case CONST_DECL: + case PARM_DECL: + case RESULT_DECL: + case FUNCTION_DECL: + TREE_ADDRESSABLE (x) = 1; + return true; + default: + return true; + } + /* Never reach here. */ + gcc_unreachable (); +} + +/* Return an integer type with BITS bits of precision, that is + unsigned if UNSIGNEDP is nonzero, otherwise signed. */ + +tree +gm2_type_for_size (unsigned int bits, int unsignedp) +{ + tree type; + + if (unsignedp) + { + if (bits == INT_TYPE_SIZE) + type = unsigned_type_node; + else if (bits == CHAR_TYPE_SIZE) + type = unsigned_char_type_node; + else if (bits == SHORT_TYPE_SIZE) + type = short_unsigned_type_node; + else if (bits == LONG_TYPE_SIZE) + type = long_unsigned_type_node; + else if (bits == LONG_LONG_TYPE_SIZE) + type = long_long_unsigned_type_node; + else + type = make_unsigned_type (bits); + } + else + { + if (bits == INT_TYPE_SIZE) + type = integer_type_node; + else if (bits == CHAR_TYPE_SIZE) + type = signed_char_type_node; + else if (bits == SHORT_TYPE_SIZE) + type = short_integer_type_node; + else if (bits == LONG_TYPE_SIZE) + type = long_integer_type_node; + else if (bits == LONG_LONG_TYPE_SIZE) + type = long_long_integer_type_node; + else + type = make_signed_type (bits); + } + return type; +} + +/* Allow the analyzer to understand Storage ALLOCATE/DEALLOCATE. */ + +bool +gm2_langhook_new_dispose_storage_substitution (void) +{ + return true; +} + +#undef LANG_HOOKS_NAME +#undef LANG_HOOKS_INIT +#undef LANG_HOOKS_INIT_OPTIONS +#undef LANG_HOOKS_OPTION_LANG_MASK +#undef LANG_HOOKS_INIT_OPTIONS_STRUCT +#undef LANG_HOOKS_HANDLE_OPTION +#undef LANG_HOOKS_POST_OPTIONS +#undef LANG_HOOKS_PARSE_FILE +#undef LANG_HOOKS_TYPE_FOR_MODE +#undef LANG_HOOKS_TYPE_FOR_SIZE +#undef LANG_HOOKS_BUILTIN_FUNCTION +#undef LANG_HOOKS_GLOBAL_BINDINGS_P +#undef LANG_HOOKS_PUSHDECL +#undef LANG_HOOKS_GETDECLS +#undef LANG_HOOKS_GIMPLIFY_EXPR +#undef LANG_HOOKS_EH_PERSONALITY +#undef LANG_HOOKS_NEW_DISPOSE_STORAGE_SUBSTITUTION + +#define LANG_HOOKS_NAME "GNU Modula-2" +#define LANG_HOOKS_INIT gm2_langhook_init +#define LANG_HOOKS_INIT_OPTIONS gm2_langhook_init_options +#define LANG_HOOKS_OPTION_LANG_MASK gm2_langhook_option_lang_mask +#define LANG_HOOKS_INIT_OPTIONS_STRUCT gm2_langhook_init_options_struct +#define LANG_HOOKS_HANDLE_OPTION gm2_langhook_handle_option +#define LANG_HOOKS_POST_OPTIONS gm2_langhook_post_options +#define LANG_HOOKS_PARSE_FILE gm2_langhook_parse_file +#define LANG_HOOKS_TYPE_FOR_MODE gm2_langhook_type_for_mode +#define LANG_HOOKS_TYPE_FOR_SIZE gm2_langhook_type_for_size +#define LANG_HOOKS_BUILTIN_FUNCTION gm2_langhook_builtin_function +#define LANG_HOOKS_GLOBAL_BINDINGS_P gm2_langhook_global_bindings_p +#define LANG_HOOKS_PUSHDECL gm2_langhook_pushdecl +#define LANG_HOOKS_GETDECLS gm2_langhook_getdecls +#define LANG_HOOKS_GIMPLIFY_EXPR gm2_langhook_gimplify_expr +#define LANG_HOOKS_EH_PERSONALITY gm2_langhook_eh_personality +#define LANG_HOOKS_NEW_DISPOSE_STORAGE_SUBSTITUTION \ + gm2_langhook_new_dispose_storage_substitution + +struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER; + +#include "gt-m2-gm2-lang.h" +#include "gtype-m2.h" diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2-lang.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2-lang.h 2022-12-06 02:56:51.344774733 +0000 @@ -0,0 +1,56 @@ +/* Language-dependent hooks for GNU Modula-2. + Copyright (C) 2003-2022 Free Software Foundation, Inc. + Contributed by Gaius Mulley + +This file is part of GNU CC. + +GNU CC 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 CC 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 CC; see the file COPYING. If not, write to +the Free Software Foundation, 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ + +#if !defined(GM2_LANG_H) +# define GM2_LANG_H + +#if defined(GM2_LANG_C) +# define EXTERN +#else +# define EXTERN extern +#endif +#include "config.h" +#include "system.h" +#include "ansidecl.h" +#include "coretypes.h" +#include "opts.h" +#include "tree.h" +#include "gimple.h" + + +EXTERN enum gimplify_status gm2_gimplify_expr (tree *, tree *, tree *); +EXTERN bool gm2_mark_addressable (tree); +EXTERN tree gm2_type_for_size (unsigned int bits, int unsignedp); +EXTERN tree gm2_type_for_mode (enum machine_mode mode, int unsignedp); +EXTERN bool gm2_langhook_init (void); +EXTERN bool gm2_langhook_handle_option (size_t scode, const char *arg, + int value, + int kind ATTRIBUTE_UNUSED, + location_t loc ATTRIBUTE_UNUSED, + const struct cl_option_handlers *handlers ATTRIBUTE_UNUSED); +EXTERN void gm2_langhook_init_options (unsigned int decoded_options_count, + struct cl_decoded_option *decoded_options); +EXTERN void gm2_genericize (tree fndecl); +EXTERN tree convert_loc (location_t location, tree type, tree expr); + + +#undef EXTERN +#endif diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/gm2version.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/gm2version.h 2022-12-06 02:56:51.360774949 +0000 @@ -0,0 +1,22 @@ +/* gm2version provides access to the gm2 front end version number. + +Copyright (C) 2008-2022 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 +. */ + +extern void gm2_version (int need_to_exit); diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/m2.flex --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/m2.flex 2022-12-06 02:56:51.360774949 +0000 @@ -0,0 +1,760 @@ +%{ +/* m2.flex implements lexical analysis for Modula-2. + +Copyright (C) 2004-2022 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 +. */ + +#include "gm2-gcc/gcc-consolidation.h" + +#include "GM2Reserved.h" +#include "GM2LexBuf.h" +#include "input.h" +#include "m2options.h" + + +#if defined(GM2USEGGC) +# include "ggc.h" +#endif + +#include "timevar.h" + +#define START_FILE(F,L) m2linemap_StartFile(F,L) +#define END_FILE() m2linemap_EndFile() +#define START_LINE(N,S) m2linemap_StartLine(N,S) +#define GET_LOCATION(COLUMN_START,COLUMN_END) \ + m2linemap_GetLocationRange(COLUMN_START,COLUMN_END) +#define TIMEVAR_PUSH_LEX timevar_push (TV_LEX) +#define TIMEVAR_POP_LEX timevar_pop (TV_LEX) + +#ifdef __cplusplus +#define EXTERN extern "C" +#endif + + /* m2.flex provides a lexical analyser for GNU Modula-2. */ + + struct lineInfo { + char *linebuf; /* line contents */ + int linelen; /* length */ + int tokenpos; /* start position of token within line */ + int toklen; /* a copy of yylen (length of token) */ + int nextpos; /* position after token */ + int lineno; /* line number of this line */ + int column; /* first column number of token on this line */ + int inuse; /* do we need to keep this line info? */ + location_t location; /* the corresponding gcc location_t */ + struct lineInfo *next; + }; + + struct functionInfo { + char *name; /* function name */ + int module; /* is it really a module? */ + struct functionInfo *next; /* list of nested functions */ + }; + + static int lineno =1; /* a running count of the file line number */ + static char *filename =NULL; + static int commentLevel=0; + static struct lineInfo *currentLine=NULL; + static struct functionInfo *currentFunction=NULL; + static int seenFunctionStart=FALSE; + static int seenEnd=FALSE; + static int seenModuleStart=FALSE; + static int isDefinitionModule=FALSE; + static int totalLines=0; + +static void pushLine (void); +static void popLine (void); +static void finishedLine (void); +static void resetpos (void); +static void consumeLine (void); +static void updatepos (void); +static void skippos (void); +static void poperrorskip (const char *); +static void endOfComment (void); +static void handleDate (void); +static void handleLine (void); +static void handleFile (void); +static void handleFunction (void); +static void handleColumn (void); +static void pushFunction (char *function, int module); +static void popFunction (void); +static void checkFunction (void); +EXTERN void m2flex_M2Error (const char *); +EXTERN location_t m2flex_GetLocation (void); +EXTERN int m2flex_GetColumnNo (void); +EXTERN int m2flex_OpenSource (char *s); +EXTERN int m2flex_GetLineNo (void); +EXTERN void m2flex_CloseSource (void); +EXTERN char *m2flex_GetToken (void); +EXTERN void _M2_m2flex_init (void); +EXTERN int m2flex_GetTotalLines (void); +extern void yylex (void); + +#if !defined(TRUE) +# define TRUE (1==1) +#endif +#if !defined(FALSE) +# define FALSE (1==0) +#endif + +#define YY_DECL void yylex (void) +%} + +%option nounput +%x COMMENT COMMENT1 LINE0 LINE1 LINE2 + +%% + +"(*" { updatepos(); + commentLevel=1; pushLine(); skippos(); + BEGIN COMMENT; } +"*)" { endOfComment(); } +"(*" { commentLevel++; pushLine(); updatepos(); skippos(); } +"<*" { if (commentLevel == 1) { + updatepos(); + pushLine(); + skippos(); + BEGIN COMMENT1; + } else + updatepos(); skippos(); + } +\n.* { consumeLine(); } +. { updatepos(); skippos(); } +. { updatepos(); skippos(); } +"*>" { updatepos(); skippos(); finishedLine(); BEGIN COMMENT; } +\n.* { consumeLine(); } +"*)" { poperrorskip("unterminated source code directive, missing *>"); + endOfComment(); } +<> { poperrorskip("unterminated source code directive, missing *>"); BEGIN COMMENT; } +<> { poperrorskip("unterminated comment found at the end of the file, missing *)"); BEGIN INITIAL; } + +^\#.* { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ BEGIN LINE0; } +\n\#.* { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ BEGIN LINE0; } +\#[ \t]* { updatepos(); } +[0-9]+[ \t]*\" { updatepos(); lineno=atoi(yytext)-1; BEGIN LINE1; } +\n { m2flex_M2Error("missing initial quote after #line directive"); resetpos(); BEGIN INITIAL; } +[^\n] +[^\"\n]+ { m2flex_M2Error("missing final quote after #line directive"); resetpos(); BEGIN INITIAL; } +.*\" { updatepos(); + filename = (char *)xrealloc(filename, yyleng+1); + strcpy(filename, yytext); + filename[yyleng-1] = (char)0; /* remove trailing quote */ + START_FILE (filename, lineno); + BEGIN LINE2; + } +[ \t]* { updatepos(); } +\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; } +2[ \t]*\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; } +1[ \t]*\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; } +1[ \t]*.*\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; } +2[ \t]*.*\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; } +3[ \t]*.*\n { M2LexBuf_SetFile(filename); updatepos(); BEGIN INITIAL; } + +\n[^\#].* { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ } +\n { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ } + +\"[^\"\n]*\" { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_stringtok, yytext); return; } +\"[^\"\n]*$ { updatepos(); + m2flex_M2Error("missing terminating quote, \""); + resetpos(); return; + } + +'[^'\n]*' { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_stringtok, yytext); return; } +'[^'\n]*$ { updatepos(); + m2flex_M2Error("missing terminating quote, '"); + resetpos(); return; + } + +<> { updatepos(); M2LexBuf_AddTok(M2Reserved_eoftok); return; } +\+ { updatepos(); M2LexBuf_AddTok(M2Reserved_plustok); return; } +- { updatepos(); M2LexBuf_AddTok(M2Reserved_minustok); return; } +"*" { updatepos(); M2LexBuf_AddTok(M2Reserved_timestok); return; } +\/ { updatepos(); M2LexBuf_AddTok(M2Reserved_dividetok); return; } +:= { updatepos(); M2LexBuf_AddTok(M2Reserved_becomestok); return; } +\& { updatepos(); M2LexBuf_AddTok(M2Reserved_ambersandtok); return; } +\. { updatepos(); M2LexBuf_AddTok(M2Reserved_periodtok); return; } +\, { updatepos(); M2LexBuf_AddTok(M2Reserved_commatok); return; } +\; { updatepos(); M2LexBuf_AddTok(M2Reserved_semicolontok); return; } +\( { updatepos(); M2LexBuf_AddTok(M2Reserved_lparatok); return; } +\) { updatepos(); M2LexBuf_AddTok(M2Reserved_rparatok); return; } +\[ { updatepos(); M2LexBuf_AddTok(M2Reserved_lsbratok); return; } +\] { updatepos(); M2LexBuf_AddTok(M2Reserved_rsbratok); return; } +\(\! { updatepos(); M2LexBuf_AddTok(M2Reserved_lsbratok); return; } +\!\) { updatepos(); M2LexBuf_AddTok(M2Reserved_rsbratok); return; } +\^ { updatepos(); M2LexBuf_AddTok(M2Reserved_uparrowtok); return; } +\@ { updatepos(); M2LexBuf_AddTok(M2Reserved_uparrowtok); return; } +\{ { updatepos(); M2LexBuf_AddTok(M2Reserved_lcbratok); return; } +\} { updatepos(); M2LexBuf_AddTok(M2Reserved_rcbratok); return; } +\(\: { updatepos(); M2LexBuf_AddTok(M2Reserved_lcbratok); return; } +\:\) { updatepos(); M2LexBuf_AddTok(M2Reserved_rcbratok); return; } +\' { updatepos(); M2LexBuf_AddTok(M2Reserved_singlequotetok); return; } +\= { updatepos(); M2LexBuf_AddTok(M2Reserved_equaltok); return; } +\# { updatepos(); M2LexBuf_AddTok(M2Reserved_hashtok); return; } +\< { updatepos(); M2LexBuf_AddTok(M2Reserved_lesstok); return; } +\> { updatepos(); M2LexBuf_AddTok(M2Reserved_greatertok); return; } +\<\> { updatepos(); M2LexBuf_AddTok(M2Reserved_lessgreatertok); return; } +\<\= { updatepos(); M2LexBuf_AddTok(M2Reserved_lessequaltok); return; } +\>\= { updatepos(); M2LexBuf_AddTok(M2Reserved_greaterequaltok); return; } +"<*" { updatepos(); M2LexBuf_AddTok(M2Reserved_ldirectivetok); return; } +"*>" { updatepos(); M2LexBuf_AddTok(M2Reserved_rdirectivetok); return; } +\.\. { updatepos(); M2LexBuf_AddTok(M2Reserved_periodperiodtok); return; } +\.\.\. { updatepos(); M2LexBuf_AddTok(M2Reserved_periodperiodperiodtok); return; } +\: { updatepos(); M2LexBuf_AddTok(M2Reserved_colontok); return; } +\" { updatepos(); M2LexBuf_AddTok(M2Reserved_doublequotestok); return; } +\| { updatepos(); M2LexBuf_AddTok(M2Reserved_bartok); return; } +\! { updatepos(); M2LexBuf_AddTok(M2Reserved_bartok); return; } +\~ { updatepos(); M2LexBuf_AddTok(M2Reserved_nottok); return; } +AND { updatepos(); M2LexBuf_AddTok(M2Reserved_andtok); return; } +ARRAY { updatepos(); M2LexBuf_AddTok(M2Reserved_arraytok); return; } +BEGIN { updatepos(); M2LexBuf_AddTok(M2Reserved_begintok); return; } +BY { updatepos(); M2LexBuf_AddTok(M2Reserved_bytok); return; } +CASE { updatepos(); M2LexBuf_AddTok(M2Reserved_casetok); return; } +CONST { updatepos(); M2LexBuf_AddTok(M2Reserved_consttok); return; } +DEFINITION { updatepos(); isDefinitionModule = TRUE; + M2LexBuf_AddTok(M2Reserved_definitiontok); return; } +DIV { updatepos(); M2LexBuf_AddTok(M2Reserved_divtok); return; } +DO { updatepos(); M2LexBuf_AddTok(M2Reserved_dotok); return; } +ELSE { updatepos(); M2LexBuf_AddTok(M2Reserved_elsetok); return; } +ELSIF { updatepos(); M2LexBuf_AddTok(M2Reserved_elsiftok); return; } +END { updatepos(); seenEnd=TRUE; + M2LexBuf_AddTok(M2Reserved_endtok); return; } +EXCEPT { updatepos(); M2LexBuf_AddTok(M2Reserved_excepttok); return; } +EXIT { updatepos(); M2LexBuf_AddTok(M2Reserved_exittok); return; } +EXPORT { updatepos(); M2LexBuf_AddTok(M2Reserved_exporttok); return; } +FINALLY { updatepos(); M2LexBuf_AddTok(M2Reserved_finallytok); return; } +FOR { updatepos(); M2LexBuf_AddTok(M2Reserved_fortok); return; } +FROM { updatepos(); M2LexBuf_AddTok(M2Reserved_fromtok); return; } +IF { updatepos(); M2LexBuf_AddTok(M2Reserved_iftok); return; } +IMPLEMENTATION { updatepos(); M2LexBuf_AddTok(M2Reserved_implementationtok); return; } +IMPORT { updatepos(); M2LexBuf_AddTok(M2Reserved_importtok); return; } +IN { updatepos(); M2LexBuf_AddTok(M2Reserved_intok); return; } +LOOP { updatepos(); M2LexBuf_AddTok(M2Reserved_looptok); return; } +MOD { updatepos(); M2LexBuf_AddTok(M2Reserved_modtok); return; } +MODULE { updatepos(); seenModuleStart=TRUE; + M2LexBuf_AddTok(M2Reserved_moduletok); return; } +NOT { updatepos(); M2LexBuf_AddTok(M2Reserved_nottok); return; } +OF { updatepos(); M2LexBuf_AddTok(M2Reserved_oftok); return; } +OR { updatepos(); M2LexBuf_AddTok(M2Reserved_ortok); return; } +PACKEDSET { updatepos(); M2LexBuf_AddTok(M2Reserved_packedsettok); return; } +POINTER { updatepos(); M2LexBuf_AddTok(M2Reserved_pointertok); return; } +PROCEDURE { updatepos(); seenFunctionStart=TRUE; + M2LexBuf_AddTok(M2Reserved_proceduretok); return; } +QUALIFIED { updatepos(); M2LexBuf_AddTok(M2Reserved_qualifiedtok); return; } +UNQUALIFIED { updatepos(); M2LexBuf_AddTok(M2Reserved_unqualifiedtok); return; } +RECORD { updatepos(); M2LexBuf_AddTok(M2Reserved_recordtok); return; } +REM { updatepos(); M2LexBuf_AddTok(M2Reserved_remtok); return; } +REPEAT { updatepos(); M2LexBuf_AddTok(M2Reserved_repeattok); return; } +RETRY { updatepos(); M2LexBuf_AddTok(M2Reserved_retrytok); return; } +RETURN { updatepos(); M2LexBuf_AddTok(M2Reserved_returntok); return; } +SET { updatepos(); M2LexBuf_AddTok(M2Reserved_settok); return; } +THEN { updatepos(); M2LexBuf_AddTok(M2Reserved_thentok); return; } +TO { updatepos(); M2LexBuf_AddTok(M2Reserved_totok); return; } +TYPE { updatepos(); M2LexBuf_AddTok(M2Reserved_typetok); return; } +UNTIL { updatepos(); M2LexBuf_AddTok(M2Reserved_untiltok); return; } +VAR { updatepos(); M2LexBuf_AddTok(M2Reserved_vartok); return; } +WHILE { updatepos(); M2LexBuf_AddTok(M2Reserved_whiletok); return; } +WITH { updatepos(); M2LexBuf_AddTok(M2Reserved_withtok); return; } +ASM { updatepos(); M2LexBuf_AddTok(M2Reserved_asmtok); return; } +VOLATILE { updatepos(); M2LexBuf_AddTok(M2Reserved_volatiletok); return; } +\_\_DATE\_\_ { updatepos(); handleDate(); return; } +\_\_LINE\_\_ { updatepos(); handleLine(); return; } +\_\_FILE\_\_ { updatepos(); handleFile(); return; } +\_\_FUNCTION\_\_ { updatepos(); handleFunction(); return; } +\_\_COLUMN\_\_ { updatepos(); handleColumn(); return; } +\_\_ATTRIBUTE\_\_ { updatepos(); M2LexBuf_AddTok(M2Reserved_attributetok); return; } +\_\_BUILTIN\_\_ { updatepos(); M2LexBuf_AddTok(M2Reserved_builtintok); return; } +\_\_INLINE\_\_ { updatepos(); M2LexBuf_AddTok(M2Reserved_inlinetok); return; } + + +(([0-9]*\.[0-9]+)(E[+-]?[0-9]+)?) { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_realtok, yytext); return; } +[0-9]*\.E[+-]?[0-9]+ { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_realtok, yytext); return; } +[a-zA-Z_][a-zA-Z0-9_]* { checkFunction(); updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_identtok, yytext); return; } +[0-9]+ { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; } +[0-9]+B { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; } +[0-9]+C { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; } +[0-9A-F]+H { updatepos(); M2LexBuf_AddTokCharStar(M2Reserved_integertok, yytext); return; } +[\t\r ]+ { currentLine->tokenpos += yyleng; /* Ignore space. */; } +. { updatepos(); m2flex_M2Error("unrecognised symbol"); skippos(); } + +%% + +/* have removed the -? from the beginning of the real/integer constant literal rules */ + +/* + * hand built routines + */ + +/* + * handleFile - handles the __FILE__ construct by wraping it in double quotes and putting + * it into the token buffer as a string. + */ + +static void handleFile (void) +{ + char *s = (char *)alloca(strlen(filename)+2+1); + + strcpy(s, "\""); + strcat(s, filename); + strcat(s, "\""); + M2LexBuf_AddTokCharStar(M2Reserved_stringtok, s); +} + +/* + * handleLine - handles the __LINE__ construct by passing an integer to + * the token buffer. + */ + +static void handleLine (void) +{ + M2LexBuf_AddTokInteger(M2Reserved_integertok, lineno); +} + +/* + * handleColumn - handles the __COLUMN__ construct by passing an integer to + * the token buffer. + */ + +static void handleColumn (void) +{ + M2LexBuf_AddTokInteger(M2Reserved_integertok, m2flex_GetColumnNo()); +} + +/* + * handleDate - handles the __DATE__ construct by passing the date + * as a string to the token buffer. + */ + +static void handleDate (void) +{ + time_t clock = time ((time_t *)0); + char *sdate = ctime (&clock); + char *s = (char *) alloca (strlen (sdate) + 2 + 1); + char *p = index (sdate, '\n'); + + if (p != NULL) { + *p = (char) 0; + } + strcpy(s, "\""); + strcat(s, sdate); + strcat(s, "\""); + M2LexBuf_AddTokCharStar (M2Reserved_stringtok, s); +} + +/* + * handleFunction - handles the __FUNCTION__ construct by wrapping + * it in double quotes and putting it into the token + * buffer as a string. + */ + +static void handleFunction (void) +{ + if (currentFunction == NULL) + M2LexBuf_AddTokCharStar(M2Reserved_stringtok, const_cast("\"\"")); + else if (currentFunction->module) { + char *s = (char *) alloca(strlen(yytext) + + strlen("\"module initialization\"") + 1); + strcpy(s, "\"module "); + strcat(s, currentFunction->name); + strcat(s, " initialization\""); + M2LexBuf_AddTokCharStar(M2Reserved_stringtok, s); + } else { + char *function = currentFunction->name; + char *s = (char *)alloca(strlen(function)+2+1); + strcpy(s, "\""); + strcat(s, function); + strcat(s, "\""); + M2LexBuf_AddTokCharStar(M2Reserved_stringtok, s); + } +} + +/* + * pushFunction - pushes the function name onto the stack. + */ + +static void pushFunction (char *function, int module) +{ + if (currentFunction == NULL) { + currentFunction = (struct functionInfo *)xmalloc (sizeof (struct functionInfo)); + currentFunction->name = xstrdup(function); + currentFunction->next = NULL; + currentFunction->module = module; + } else { + struct functionInfo *f = (struct functionInfo *)xmalloc (sizeof (struct functionInfo)); + f->name = xstrdup(function); + f->next = currentFunction; + f->module = module; + currentFunction = f; + } +} + +/* + * popFunction - pops the current function. + */ + +static void popFunction (void) +{ + if (currentFunction != NULL && currentFunction->next != NULL) { + struct functionInfo *f = currentFunction; + + currentFunction = currentFunction->next; + if (f->name != NULL) + free(f->name); + free(f); + } +} + +/* + * endOfComment - handles the end of comment + */ + +static void endOfComment (void) +{ + commentLevel--; + updatepos(); + skippos(); + if (commentLevel==0) { + BEGIN INITIAL; + finishedLine(); + } else + popLine(); +} + +/* + * m2flex_M2Error - displays the error message, s, after the code line and pointer + * to the erroneous token. + */ + +EXTERN void m2flex_M2Error (const char *s) +{ + if (currentLine->linebuf != NULL) { + int i=1; + + printf("%s:%d:%s\n", filename, currentLine->lineno, currentLine->linebuf); + printf("%s:%d:%*s", filename, currentLine->lineno, 1+currentLine->tokenpos, "^"); + while (itoklen) { + putchar('^'); + i++; + } + putchar('\n'); + } + printf("%s:%d:%s\n", filename, currentLine->lineno, s); +} + +static void poperrorskip (const char *s) +{ + int nextpos =currentLine->nextpos; + int tokenpos=currentLine->tokenpos; + + popLine(); + m2flex_M2Error(s); + if (currentLine != NULL) { + currentLine->nextpos = nextpos; + currentLine->tokenpos = tokenpos; + } +} + +/* + * consumeLine - reads a line into a buffer, it then pushes back the whole + * line except the initial \n. + */ + +static void consumeLine (void) +{ + if (currentLine->linelenlinebuf = (char *)xrealloc (currentLine->linebuf, yyleng); + currentLine->linelen = yyleng; + } + strcpy(currentLine->linebuf, yytext+1); /* copy all except the initial \n */ + lineno++; + totalLines++; + currentLine->lineno = lineno; + currentLine->tokenpos=0; + currentLine->nextpos=0; + currentLine->column=0; + START_LINE (lineno, yyleng); + yyless(1); /* push back all but the \n */ +} + +static void assert_location (location_t location ATTRIBUTE_UNUSED) +{ +#if 0 + if ((location != BUILTINS_LOCATION) && (location != UNKNOWN_LOCATION) && (! M2Options_GetCpp ())) { + expanded_location xl = expand_location (location); + if (xl.line != currentLine->lineno) { + m2flex_M2Error ("mismatched gcc location and front end token number"); + } + } +#endif +} + +/* + * updatepos - updates the current token position. + * Should be used when a rule matches a token. + */ + +static void updatepos (void) +{ + seenFunctionStart = FALSE; + seenEnd = FALSE; + seenModuleStart = FALSE; + currentLine->nextpos = currentLine->tokenpos+yyleng; + currentLine->toklen = yyleng; + /* if (currentLine->column == 0) */ + currentLine->column = currentLine->tokenpos+1; + currentLine->location = + M2Options_OverrideLocation (GET_LOCATION (currentLine->column, + currentLine->column+currentLine->toklen-1)); + assert_location (GET_LOCATION (currentLine->column, + currentLine->column+currentLine->toklen-1)); +} + +/* + * checkFunction - checks to see whether we have seen the start + * or end of a function. + */ + +static void checkFunction (void) +{ + if (! isDefinitionModule) { + if (seenModuleStart) + pushFunction(yytext, 1); + if (seenFunctionStart) + pushFunction(yytext, 0); + if (seenEnd && currentFunction != NULL && + (strcmp(currentFunction->name, yytext) == 0)) + popFunction(); + } + seenFunctionStart = FALSE; + seenEnd = FALSE; + seenModuleStart = FALSE; +} + +/* + * skippos - skips over this token. This function should be called + * if we are not returning and thus not calling getToken. + */ + +static void skippos (void) +{ + currentLine->tokenpos = currentLine->nextpos; +} + +/* + * initLine - initializes a currentLine + */ + +static void initLine (void) +{ + currentLine = (struct lineInfo *)xmalloc (sizeof(struct lineInfo)); + + if (currentLine == NULL) + perror("xmalloc"); + currentLine->linebuf = NULL; + currentLine->linelen = 0; + currentLine->tokenpos = 0; + currentLine->toklen = 0; + currentLine->nextpos = 0; + currentLine->lineno = lineno; + currentLine->column = 0; + currentLine->inuse = TRUE; + currentLine->next = NULL; +} + +/* + * pushLine - pushes a new line structure. + */ + +static void pushLine (void) +{ + if (currentLine == NULL) + initLine(); + else if (currentLine->inuse) { + struct lineInfo *l = (struct lineInfo *)xmalloc (sizeof(struct lineInfo)); + + if (currentLine->linebuf == NULL) { + l->linebuf = NULL; + l->linelen = 0; + } else { + l->linebuf = (char *)xstrdup (currentLine->linebuf); + l->linelen = strlen (l->linebuf)+1; + } + l->tokenpos = currentLine->tokenpos; + l->toklen = currentLine->toklen; + l->nextpos = currentLine->nextpos; + l->lineno = currentLine->lineno; + l->column = currentLine->column; + l->next = currentLine; + currentLine = l; + } + currentLine->inuse = TRUE; +} + +/* + * popLine - pops a line structure. + */ + +static void popLine (void) +{ + if (currentLine != NULL) { + struct lineInfo *l = currentLine; + + if (currentLine->linebuf != NULL) + free(currentLine->linebuf); + currentLine = l->next; + free(l); + } +} + +/* + * resetpos - resets the position of the next token to the start of the line. + */ + +static void resetpos (void) +{ + if (currentLine != NULL) + currentLine->nextpos = 0; +} + +/* + * finishedLine - indicates that the current line does not need to be preserved when a pushLine + * occurs. + */ + +static void finishedLine (void) +{ + currentLine->inuse = FALSE; +} + +/* + * m2flex_GetToken - returns a new token. + */ + +EXTERN char *m2flex_GetToken (void) +{ + TIMEVAR_PUSH_LEX; + if (currentLine == NULL) + initLine(); + currentLine->tokenpos = currentLine->nextpos; + yylex(); + TIMEVAR_POP_LEX; + return yytext; +} + +/* + * CloseSource - provided for semantic sugar + */ + +EXTERN void m2flex_CloseSource (void) +{ + END_FILE (); +} + +/* + * OpenSource - returns TRUE if file s can be opened and + * all tokens are taken from this file. + */ + +EXTERN int m2flex_OpenSource (char *s) +{ + FILE *f = fopen(s, "r"); + + if (f == NULL) + return( FALSE ); + else { + isDefinitionModule = FALSE; + while (currentFunction != NULL) + { + struct functionInfo *f = currentFunction; + currentFunction = f->next; + if (f->name != NULL) + free(f->name); + free(f); + } + yy_delete_buffer (YY_CURRENT_BUFFER); + yy_switch_to_buffer (yy_create_buffer(f, YY_BUF_SIZE)); + filename = xstrdup (s); + lineno = 1; + if (currentLine == NULL) + pushLine (); + else + currentLine->lineno = lineno; + START_FILE (filename, lineno); + BEGIN INITIAL; resetpos (); + return TRUE; + } +} + +/* + * m2flex_GetLineNo - returns the current line number. + */ + +EXTERN int m2flex_GetLineNo (void) +{ + if (currentLine != NULL) + return currentLine->lineno; + else + return 0; +} + +/* + * m2flex_GetColumnNo - returns the column where the current + * token starts. + */ + +EXTERN int m2flex_GetColumnNo (void) +{ + if (currentLine != NULL) + return currentLine->column; + else + return 0; +} + +/* + * m2flex_GetLocation - returns the gcc location_t of the current token. + */ + +EXTERN location_t m2flex_GetLocation (void) +{ + if (currentLine != NULL) + return currentLine->location; + else + return 0; +} + +/* + * GetTotalLines - returns the total number of lines parsed. + */ + +EXTERN int m2flex_GetTotalLines (void) +{ + return totalLines; +} + +/* + * yywrap is called when end of file is seen. We push an eof token + * and tell the lexical analysis to stop. + */ + +int yywrap (void) +{ + updatepos(); M2LexBuf_AddTok(M2Reserved_eoftok); return 1; +} + +EXTERN void _M2_m2flex_init (void) {} +EXTERN void _M2_m2flex_finish (void) {} diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/m2pp.cc --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/m2pp.cc 2022-12-06 02:56:51.360774949 +0000 @@ -0,0 +1,2643 @@ +/* m2pp.c pretty print trees, output in Modula-2 where possible. + +Copyright (C) 2007-2022 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(GM2) +#include "gm2-gcc/gcc-consolidation.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 + +#define M2PP_C +#include "m2/m2pp.h" + +#undef DEBUGGING + +typedef struct pretty_t +{ + int needs_space; + int needs_indent; + int curpos; + int indent; + int issued_begin; + int in_vars; + int in_types; + tree block; + int bits; +} pretty; + +typedef struct m2stack_t +{ + tree value; + struct m2stack_t *next; +} stack; + +/* Prototypes. */ + +static pretty *initPretty (int bits); +static pretty *dupPretty (pretty *s); +static int getindent (pretty *s); +static void setindent (pretty *s, int n); +static int getcurpos (pretty *s); +static void m2pp_identifier (pretty *s, tree t); +static void m2pp_needspace (pretty *s); +static void m2pp_function (pretty *s, tree t); +static void m2pp_function_header (pretty *s, tree t); +static void m2pp_function_vars (pretty *s, tree t); +static void m2pp_statement_sequence (pretty *s, tree t); +static void m2pp_print (pretty *s, const char *p); +static void m2pp_print_char (pretty *s, char ch); +static void m2pp_parameter (pretty *s, tree t); +static void m2pp_type (pretty *s, tree t); +static void m2pp_ident_pointer (pretty *s, tree t); +static void m2pp_set_type (pretty *s, tree t); +static void m2pp_enum (pretty *s, tree t); +static void m2pp_array (pretty *s, tree t); +static void m2pp_subrange (pretty *s, tree t); +static void m2pp_gimpified (pretty *s, tree t); +static void m2pp_pointer_type (pretty *s, tree t); +static void m2pp_record_type (pretty *s, tree t); +static void m2pp_union_type (pretty *s, tree t); +static void m2pp_simple_type (pretty *s, tree t); +static void m2pp_expression (pretty *s, tree t); +static void m2pp_relop (pretty *s, tree t, const char *p); +static void m2pp_simple_expression (pretty *s, tree t); +static void m2pp_statement_sequence (pretty *s, tree t); +static void m2pp_unknown (pretty *s, const char *s1, const char *s2); +static void m2pp_statement (pretty *s, tree t); +static void m2pp_assignment (pretty *s, tree t); +static void m2pp_designator (pretty *s, tree t); +static void m2pp_conditional (pretty *s, tree t); +static void m2pp_label_expr (pretty *s, tree t); +static void m2pp_label_decl (pretty *s, tree t); +static void m2pp_goto (pretty *s, tree t); +static void m2pp_list (pretty *s, tree t); +static void m2pp_offset (pretty *s, tree t); +static void m2pp_indirect_ref (pretty *s, tree t); +static void m2pp_integer_cst (pretty *s, tree t); +static void m2pp_real_cst (pretty *s, tree t); +static void m2pp_string_cst (pretty *s, tree t); +static void m2pp_integer (pretty *s, tree t); +static void m2pp_addr_expr (pretty *s, tree t); +static void m2pp_nop (pretty *s, tree t); +static void m2pp_convert (pretty *s, tree t); +static void m2pp_var_decl (pretty *s, tree t); +static void m2pp_binary (pretty *s, tree t, const char *p); +static void m2pp_unary (pretty *s, tree t, const char *p); +static void m2pp_call_expr (pretty *s, tree t); +static void m2pp_procedure_call (pretty *s, tree t); +static void m2pp_ssa (pretty *s, tree t); +static void m2pp_block (pretty *s, tree t); +static void m2pp_block_list (pretty *s, tree t); +static void m2pp_var_list (pretty *s, tree t); +static void m2pp_bind_expr (pretty *s, tree t); +static void m2pp_return_expr (pretty *s, tree t); +static void m2pp_result_decl (pretty *s, tree t); +static void m2pp_try_block (pretty *s, tree t); +static void m2pp_cleanup_point_expr (pretty *s, tree t); +static void m2pp_handler (pretty *s, tree t); +static void m2pp_component_ref (pretty *s, tree t); +static void m2pp_array_ref (pretty *s, tree t); +static void m2pp_begin (pretty *s); +static void m2pp_var (pretty *s); +static void m2pp_types (pretty *s); +static void m2pp_decl_expr (pretty *s, tree t); +static void m2pp_var_type_decl (pretty *s, tree t); +static void m2pp_non_lvalue_expr (pretty *s, tree t); +static void m2pp_procedure_type (pretty *s, tree t); +static void m2pp_param_type (pretty *s, tree t); +static void m2pp_type_lowlevel (pretty *s, tree t); +static void m2pp_try_catch_expr (pretty *s, tree t); +static void m2pp_throw (pretty *s, tree t); +static void m2pp_catch_expr (pretty *s, tree t); +static void m2pp_try_finally_expr (pretty *s, tree t); +static void m2pp_complex (pretty *s, tree t); +static void killPretty (pretty *s); +static void m2pp_compound_expression (pretty *s, tree t); +static void m2pp_target_expression (pretty *s, tree t); +static void m2pp_constructor (pretty *s, tree t); +static void m2pp_translation (pretty *s, tree t); +static void m2pp_module_block (pretty *s, tree t); +static void push (tree t); +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); + +void pet (tree t); +void m2pp_integer (pretty *s, tree t); + +extern void stop (void); + +static stack *stackPtr = NULL; + +/* do_pf helper function for pf. */ + +void +do_pf (tree t, int bits) +{ + pretty *state = initPretty (bits); + + if (TREE_CODE (t) == TRANSLATION_UNIT_DECL) + m2pp_translation (state, t); + else if (TREE_CODE (t) == BLOCK) + m2pp_module_block (state, t); + else if (TREE_CODE (t) == FUNCTION_DECL) + m2pp_function (state, t); + else + m2pp_statement_sequence (state, t); + killPretty (state); +} + +/* pf print function. Expected to be printed interactively from + the debugger: print pf(func), or to be called from code. */ + +void +pf (tree t) +{ + do_pf (t, FALSE); +} + +/* pe print expression. Expected to be printed interactively from + the debugger: print pe(expr), or to be called from code. */ + +void +pe (tree t) +{ + pretty *state = initPretty (FALSE); + + m2pp_expression (state, t); + m2pp_needspace (state); + m2pp_print (state, ";\n"); + killPretty (state); +} + +/* pet print expression and its type. Expected to be printed + interactively from the debugger: print pet(expr), or to be called + from code. */ + +void +pet (tree t) +{ + pretty *state = initPretty (FALSE); + + m2pp_expression (state, t); + m2pp_needspace (state); + m2pp_print (state, ":"); + m2pp_type (state, TREE_TYPE (t)); + m2pp_print (state, ";\n"); + killPretty (state); +} + +/* pt print type. Expected to be printed interactively from the + debugger: print pt(expr), or to be called from code. */ + +void +pt (tree t) +{ + pretty *state = initPretty (FALSE); + m2pp_type (state, t); + m2pp_needspace (state); + m2pp_print (state, ";\n"); + killPretty (state); +} + +/* ptl print type low level. Expected to be printed interactively + from the debugger: print ptl(type), or to be called from code. */ + +void +ptl (tree t) +{ + pretty *state = initPretty (FALSE); + m2pp_type_lowlevel (state, t); + m2pp_needspace (state); + m2pp_print (state, ";\n"); + killPretty (state); +} + +/* ptcl print TREE_CHAINed list. */ + +void +ptcl (tree t) +{ + pretty *state = initPretty (FALSE); + + m2pp_decl_list (state, t); + m2pp_print (state, "\n"); + killPretty (state); +} + +/* loc if tree has a location then display it within a comment. */ + +static void +m2pp_loc (pretty *s, tree t) +{ + if (CAN_HAVE_LOCATION_P (t)) + { + if (EXPR_HAS_LOCATION (t)) + { + if (EXPR_LOCATION (t) == UNKNOWN_LOCATION) + m2pp_print (s, "(* missing location1 *)\n"); + else + { + expanded_location l = expand_location (EXPR_LOCATION (t)); + + m2pp_print (s, "(* "); + m2pp_print (s, l.file); + m2pp_print (s, ":"); + printf ("%d", l.line); + m2pp_print (s, " *)"); + m2pp_print (s, "\n"); + } + } + else + { + m2pp_print (s, "(* missing location2 *)\n"); + } + } +} + +/* m2pp_decl_list prints a TREE_CHAINed list for a decl node. */ + +static void +m2pp_decl_list (pretty *s, tree t) +{ + tree u = t; + + m2pp_print (s, "("); + m2pp_needspace (s); + while (t != NULL_TREE) + { + m2pp_identifier (s, t); + t = TREE_CHAIN (t); + if (t == u || t == NULL_TREE) + break; + m2pp_print (s, ","); + m2pp_needspace (s); + } + m2pp_needspace (s); + m2pp_print (s, ")"); +} + +static void +m2pp_decl_bool (pretty *s, tree t) +{ + if (TREE_STATIC (t)) + m2pp_print (s, "static, "); + if (DECL_EXTERNAL (t)) + m2pp_print (s, "external, "); + if (DECL_SEEN_IN_BIND_EXPR_P (t)) + m2pp_print (s, "in bind expr, "); +} + +void +pv (tree t) +{ + if (t) + { + enum tree_code code = TREE_CODE (t); + + if (code == PARM_DECL) + { + pretty *state = initPretty (FALSE); + m2pp_identifier (state, t); + m2pp_needspace (state); + m2pp_print (state, "\n"); + else + { + m2pp_print (state, ", abstract origin = "); + m2pp_identifier (state, DECL_ABSTRACT_ORIGIN (t)); + m2pp_print (state, ">\n"); + pv (DECL_ABSTRACT_ORIGIN (t)); + } + killPretty (state); + } + if (code == VAR_DECL) + { + pretty *state = initPretty (FALSE); + m2pp_identifier (state, t); + m2pp_needspace (state); + m2pp_print (state, "(* *)\n"); + else + { + m2pp_print (state, ", abstract origin = "); + m2pp_identifier (state, DECL_ABSTRACT_ORIGIN (t)); + m2pp_print (state, "> *)\n"); + pv (DECL_ABSTRACT_ORIGIN (t)); + } + killPretty (state); + } + } +} + +#if defined(GM2_MAINTAINER) + +/* remember an internal debugging hook. */ +static tree rememberF = NULL; + +static void +remember (tree t) +{ + rememberF = t; + printf ("type: watch *((tree *) %p) != %p\n", (void *)&DECL_SAVED_TREE (t), + (void *)DECL_SAVED_TREE (t)); +} +#endif + +/* push pushes tree t onto stack. */ + +static void +push (tree t) +{ + stack *s = (stack *)xmalloc (sizeof (stack)); + + s->value = t; + s->next = stackPtr; + stackPtr = s; +} + +/* pop pops a tree, from the stack. */ + +static void +pop (void) +{ + stack *s = stackPtr; + + stackPtr = stackPtr->next; + free (s); +} + +/* being_printed returns TRUE if t is held on the stack. */ + +static int +begin_printed (tree t) +{ + stack *s = stackPtr; + + while (s != NULL) + { + if (s->value == t) + return TRUE; + else + s = s->next; + } + return FALSE; +} + +/* dupPretty duplicate and return a copy of state s. */ + +static pretty * +dupPretty (pretty *s) +{ + pretty *p = initPretty (s->bits); + *p = *s; + return p; +} + +/* initPretty initialise the state of the pretty printer. */ + +static pretty * +initPretty (int bits) +{ + pretty *state = (pretty *)xmalloc (sizeof (pretty)); + state->needs_space = FALSE; + state->needs_indent = FALSE; + state->curpos = 0; + state->indent = 0; + state->issued_begin = FALSE; + state->in_vars = FALSE; + state->in_types = FALSE; + state->block = NULL_TREE; + state->bits = bits; + return state; +} + +/* killPretty cleans up the state. */ + +static void +killPretty (pretty *s) +{ + free (s); + fflush (stdout); +} + +/* getindent returns the current indent value. */ + +static int +getindent (pretty *s) +{ + return s->indent; +} + +/* setindent sets the current indent to, n. */ + +static void +setindent (pretty *s, int n) +{ + s->indent = n; +} + +/* getcurpos returns the current cursor position. */ + +static int +getcurpos (pretty *s) +{ + if (s->needs_space) + return s->curpos + 1; + else + return s->curpos; +} + +/* m2pp_type_lowlevel prints out the low level details of a + fundamental type. */ + +static void +m2pp_type_lowlevel (pretty *s, tree t) +{ + if (TREE_CODE (t) == INTEGER_TYPE) + { + m2pp_print (s, "min"); + m2pp_needspace (s); + m2pp_integer_cst (s, TYPE_MIN_VALUE (t)); + m2pp_print (s, ", max"); + m2pp_needspace (s); + m2pp_integer_cst (s, TYPE_MAX_VALUE (t)); + m2pp_print (s, ", type size unit"); + m2pp_needspace (s); + m2pp_integer_cst (s, TYPE_SIZE_UNIT (t)); + m2pp_print (s, ", type size"); + m2pp_needspace (s); + m2pp_integer_cst (s, TYPE_SIZE (t)); + + printf (", precision %d, mode %d, align %d, user align %d", + TYPE_PRECISION (t), TYPE_MODE (t), TYPE_ALIGN (t), + TYPE_USER_ALIGN (t)); + + m2pp_needspace (s); + if (TYPE_UNSIGNED (t)) + m2pp_print (s, "unsigned\n"); + else + m2pp_print (s, "signed\n"); + } +} + +/* m2pp_var emit a VAR if necessary. */ + +static void +m2pp_var (pretty *s) +{ + if (!s->in_vars) + { + s->in_vars = TRUE; + m2pp_print (s, "VAR\n"); + setindent (s, getindent (s) + 3); + } +} + +/* m2pp_types emit a TYPE if necessary. */ + +static void +m2pp_types (pretty *s) +{ + if (!s->in_types) + { + s->in_types = TRUE; + m2pp_print (s, "TYPE\n"); + setindent (s, getindent (s) + 3); + } +} + +/* hextree displays the critical fields for function, block and + bind_expr trees in raw hex. */ + +static void +hextree (tree t) +{ + if (t == NULL_TREE) + return; + + if (TREE_CODE (t) == BLOCK) + { + printf ("(* BLOCK %p *)\n", (void *)t); + printf ("BLOCK_VARS (t) = %p\n", (void *)BLOCK_VARS (t)); + printf ("BLOCK_SUPERCONTEXT (t) = %p\n", + (void *)BLOCK_SUPERCONTEXT (t)); + } + if (TREE_CODE (t) == BIND_EXPR) + { + printf ("(* BIND_EXPR %p *)\n", (void *)t); + printf ("BIND_EXPR_VARS (t) = %p\n", (void *)BIND_EXPR_VARS (t)); + printf ("BIND_EXPR_BLOCK (t) = %p\n", (void *)BIND_EXPR_BLOCK (t)); + printf ("BIND_EXPR_BODY (t) = %p\n", (void *)BIND_EXPR_BODY (t)); + } + if (TREE_CODE (t) == FUNCTION_DECL) + { + printf ("(* FUNCTION_DECL %p *)\n", (void *)t); + printf ("DECL_INITIAL (t) = %p\n", (void *)DECL_INITIAL (t)); + printf ("DECL_SAVED_TREE (t) = %p\n", (void *)DECL_SAVED_TREE (t)); + hextree (DECL_INITIAL (t)); + hextree (DECL_SAVED_TREE (t)); + } + if (TREE_CODE (t) == VAR_DECL) + { + pretty *state = initPretty (FALSE); + + printf ("(* VAR_DECL %p <", (void *)t); + if (DECL_SEEN_IN_BIND_EXPR_P (t)) + printf ("b"); + if (DECL_EXTERNAL (t)) + printf ("e"); + if (TREE_STATIC (t)) + printf ("s"); + printf ("> context = %p*)\n", (void *)decl_function_context (t)); + m2pp_type (state, TREE_TYPE (t)); + m2pp_needspace (state); + m2pp_print (state, ";\n"); + killPretty (state); + } + if (TREE_CODE (t) == PARM_DECL) + { + pretty *state = initPretty (FALSE); + + printf ("(* PARM_DECL %p <", (void *)t); + printf ("> context = %p*)\n", (void *)decl_function_context (t)); + m2pp_type (state, TREE_TYPE (t)); + m2pp_needspace (state); + m2pp_print (state, ";\n"); + killPretty (state); + } +} + +/* translation produce a pseudo implementation module from the tree t. */ + +static void +m2pp_translation (pretty *s, tree t) +{ + tree block = DECL_INITIAL (t); + + m2pp_print (s, "IMPLEMENTATION MODULE "); + m2pp_identifier (s, t); + m2pp_print (s, "\n\n"); + + if (block != NULL) + { + m2pp_module_block (s, block); + m2pp_print (s, "\n"); + } + + m2pp_print (s, "\n"); + m2pp_print (s, "END "); + m2pp_identifier (s, t); + m2pp_print (s, ".\n"); +} + +static void +m2pp_module_block (pretty *s, tree t) +{ + t = BLOCK_VARS (t); + + if (t != NULL_TREE) + for (; t != NULL_TREE; t = TREE_CHAIN (t)) + { + switch (TREE_CODE (t)) + { + case FUNCTION_DECL: + if (!DECL_EXTERNAL (t)) + { + pretty *p = dupPretty (s); + printf ("\n"); + p->in_vars = FALSE; + p->in_types = FALSE; + m2pp_function (p, t); + killPretty (p); + printf ("\n"); + s->in_vars = FALSE; + s->in_types = FALSE; + } + break; + + case TYPE_DECL: + { + int o = getindent (s); + int p; + + m2pp_print (s, "\n"); + m2pp_types (s); + setindent (s, o + 3); + m2pp_identifier (s, t); + m2pp_print (s, " = "); + p = getcurpos (s); + setindent (s, p); + m2pp_type (s, TREE_TYPE (t)); + setindent (s, o); + m2pp_needspace (s); + m2pp_print (s, ";\n"); + s->in_vars = FALSE; + } + break; + + case VAR_DECL: + m2pp_var (s); + m2pp_identifier (s, t); + m2pp_needspace (s); + m2pp_print (s, ":"); + m2pp_needspace (s); + m2pp_type (s, TREE_TYPE (t)); + m2pp_needspace (s); + m2pp_print (s, ";\n"); + s->in_types = FALSE; + break; + + case DECL_EXPR: + printf ("is this node legal here? \n"); + m2pp_decl_expr (s, t); + break; + + default: + m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t))); + } + } +} + +/* m2pp_begin emit a BEGIN if necessary. */ + +static void +m2pp_begin (pretty *s) +{ + if (!s->issued_begin) + { + if (s->in_vars || s->in_types) + { + setindent (s, getindent (s) - 3); + m2pp_print (s, "BEGIN\n"); + setindent (s, getindent (s) + 3); + } + else + { + m2pp_print (s, "BEGIN\n"); + setindent (s, getindent (s) + 3); + } + s->issued_begin = TRUE; + s->in_vars = FALSE; + s->in_types = FALSE; + } +} + +/* m2pp_function walk over the function. */ + +static void +m2pp_function (pretty *s, tree t) +{ + m2pp_function_header (s, t); + m2pp_function_vars (s, t); + m2pp_statement_sequence (s, DECL_SAVED_TREE (t)); + if (TREE_CODE (t) == FUNCTION_DECL) + { + m2pp_begin (s); + setindent (s, getindent (s) - 3); + m2pp_print (s, "END"); + m2pp_needspace (s); + m2pp_identifier (s, t); + m2pp_needspace (s); + m2pp_print (s, ";\n"); + } +} + +/* m2pp_bind_expr displays the bind expr tree node. */ + +static void +m2pp_bind_expr (pretty *s, tree t) +{ + if (TREE_CODE (t) == BIND_EXPR) + { + if (BIND_EXPR_VARS (t)) + { + m2pp_print (s, "(* variables in bind_expr *)\n"); + m2pp_var (s); + m2pp_var_list (s, BIND_EXPR_VARS (t)); + } + if (BIND_EXPR_BLOCK (t)) + { + m2pp_print (s, "(* bind_expr_block *)\n"); + m2pp_statement_sequence (s, BIND_EXPR_BLOCK (t)); + m2pp_needspace (s); + m2pp_print (s, "; \n"); + } + m2pp_statement_sequence (s, BIND_EXPR_BODY (t)); + } +} + +/* m2pp_block_list iterates over the list of blocks. */ + +static void +m2pp_block_list (pretty *s, tree t) +{ + for (; t; t = BLOCK_CHAIN (t)) + m2pp_block (s, t); +} + +/* m2pp_block prints the VARiables and the TYPEs inside a block. */ + +static void +m2pp_block (pretty *s, tree t) +{ + if ((BLOCK_VARS (t) != NULL_TREE) && (s->block != BLOCK_VARS (t))) + { + s->block = BLOCK_VARS (t); + m2pp_print (s, "(* block variables *)\n"); + m2pp_var (s); + m2pp_var_list (s, BLOCK_VARS (t)); + } +} + +/* m2pp_var_type_decl displays the variable and type declaration. */ + +static void +m2pp_var_type_decl (pretty *s, tree t) +{ + m2pp_identifier (s, t); + m2pp_needspace (s); + m2pp_print (s, ":"); + m2pp_needspace (s); + m2pp_type (s, TREE_TYPE (t)); + m2pp_needspace (s); + m2pp_print (s, ";\n"); +} + +/* m2pp_var_list print a variable list. */ + +static void +m2pp_var_list (pretty *s, tree t) +{ + if (t != NULL_TREE) + for (; t; t = TREE_CHAIN (t)) + { + if (TREE_CODE (t) == FUNCTION_DECL) + { + pretty *p = dupPretty (s); + printf ("\n"); + p->in_vars = FALSE; + p->in_types = FALSE; + m2pp_function (p, t); + killPretty (p); + printf ("\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"); + // is it legal to have a DECL_EXPR here ? + m2pp_var_type_decl (s, DECL_EXPR_DECL (t)); + } + else + m2pp_var_type_decl (s, t); + } +} + +#if 0 +/* m2pp_type_list print a variable list. */ + +static void +m2pp_type_list (pretty *s, tree t) +{ + if (t != NULL_TREE) + for (; t; t = TREE_CHAIN (t)) + { + m2pp_identifier (s, t); + m2pp_needspace (s); + m2pp_print (s, "="); + m2pp_needspace (s); + m2pp_type (s, TREE_TYPE (t)); + m2pp_needspace (s); + m2pp_print (s, ";\n"); + } +} +#endif + +/* m2pp_needspace sets appropriate flag to TRUE. */ + +static void +m2pp_needspace (pretty *s) +{ + s->needs_space = TRUE; +} + +/* m2pp_identifer prints an identifier. */ + +static void +m2pp_identifier (pretty *s, tree t) +{ + if (t) + { + if (TREE_CODE (t) == COMPONENT_REF) + m2pp_component_ref (s, t); + else if (DECL_NAME (t) && IDENTIFIER_POINTER (DECL_NAME (t))) + m2pp_ident_pointer (s, DECL_NAME (t)); + else + { + char name[100]; + + if (TREE_CODE (t) == CONST_DECL) + snprintf (name, 100, "C_%u", DECL_UID (t)); + else + snprintf (name, 100, "D_%u", DECL_UID (t)); + m2pp_print (s, name); + } + } +} + +/* m2pp_ident_pointer displays an ident pointer. */ + +static void +m2pp_ident_pointer (pretty *s, tree t) +{ + if (t) + m2pp_print (s, IDENTIFIER_POINTER (t)); +} + +/* m2pp_parameter prints out a param decl tree. */ + +static void +m2pp_parameter (pretty *s, tree t) +{ + if (TREE_CODE (t) == PARM_DECL) + { + if (TREE_TYPE (t) && (TREE_CODE (TREE_TYPE (t)) == REFERENCE_TYPE)) + { + m2pp_print (s, "VAR"); + m2pp_needspace (s); + m2pp_identifier (s, t); + m2pp_print (s, ":"); + m2pp_needspace (s); + m2pp_simple_type (s, TREE_TYPE (TREE_TYPE (t))); + } + else + { + m2pp_identifier (s, t); + m2pp_print (s, ":"); + m2pp_needspace (s); + m2pp_simple_type (s, TREE_TYPE (t)); + } + } +} + +/* m2pp_param_type prints out the type of parameter. */ + +static void +m2pp_param_type (pretty *s, tree t) +{ + if (t && (TREE_CODE (t) == REFERENCE_TYPE)) + { + m2pp_print (s, "VAR"); + m2pp_needspace (s); + m2pp_simple_type (s, TREE_TYPE (t)); + } + else + m2pp_simple_type (s, t); +} + +/* m2pp_procedure_type displays a procedure type. */ + +static void +m2pp_procedure_type (pretty *s, tree t) +{ + push (t); + if (TREE_CODE (t) == FUNCTION_TYPE) + { + tree i = TYPE_ARG_TYPES (t); + tree returnType = TREE_TYPE (TREE_TYPE (t)); + + m2pp_needspace (s); + m2pp_print (s, "PROCEDURE"); + m2pp_needspace (s); + if (i != NULL_TREE) + { + int o = getindent (s); + int p; + int first = TRUE; + + m2pp_print (s, "("); + p = getcurpos (s); + setindent (s, p); + while (i != NULL_TREE) + { + if (TREE_CHAIN (i) == NULL_TREE) + { + if (TREE_VALUE (i) == void_type_node) + /* Ignore void_type_node at the end. */ + ; + else + { + m2pp_param_type (s, TREE_VALUE (i)); + m2pp_print (s, ", ..."); + } + break; + } + else + { + if (!first) + { + m2pp_print (s, ","); + m2pp_needspace (s); + } + m2pp_param_type (s, TREE_VALUE (i)); + } + i = TREE_CHAIN (i); + first = FALSE; + } + m2pp_print (s, ")"); + setindent (s, o); + } + else if (returnType != NULL_TREE) + { + m2pp_needspace (s); + m2pp_print (s, "()"); + } + if (returnType != NULL_TREE) + { + m2pp_needspace (s); + m2pp_print (s, ": "); + m2pp_simple_type (s, returnType); + } + } + pop (); +} + +/* m2pp_comment_header displays a simple header with some critical + tree info. */ + +static void +m2pp_comment_header (pretty *s, tree t) +{ + int o = getindent (s); + + m2pp_print (s, "(*\n"); + setindent (s, o + 3); + m2pp_identifier (s, t); + m2pp_needspace (s); + m2pp_print (s, "-"); + m2pp_needspace (s); + if (TREE_PUBLIC (t)) + { + m2pp_needspace (s); + m2pp_print (s, "public,"); + } + if (TREE_STATIC (t)) + { + m2pp_needspace (s); + m2pp_print (s, "static,"); + } + if (DECL_EXTERNAL (t)) + { + m2pp_needspace (s); + m2pp_print (s, "extern"); + } + m2pp_print (s, "\n"); + setindent (s, o); + m2pp_print (s, "*)\n\n"); +} + +/* m2pp_function_header displays the function header. */ + +static void +m2pp_function_header (pretty *s, tree t) +{ + push (t); + if (TREE_CODE (t) == FUNCTION_DECL) + { + tree i = DECL_ARGUMENTS (t); + tree returnType = TREE_TYPE (TREE_TYPE (t)); + + m2pp_comment_header (s, t); + m2pp_print (s, "PROCEDURE "); + m2pp_identifier (s, t); + m2pp_needspace (s); + if (i != NULL_TREE) + { + int o = getindent (s); + int p; + + m2pp_print (s, "("); + p = getcurpos (s); + setindent (s, p); + while (i != NULL_TREE) + { + m2pp_parameter (s, i); + i = TREE_CHAIN (i); + if (i != NULL_TREE) + m2pp_print (s, ";\n"); + } + m2pp_print (s, ")"); + m2pp_needspace (s); + setindent (s, o); + } + else if (returnType != void_type_node) + { + m2pp_print (s, "()"); + m2pp_needspace (s); + } + if (returnType != void_type_node) + { + m2pp_print (s, ": "); + m2pp_simple_type (s, returnType); + m2pp_needspace (s); + } + m2pp_print (s, "; "); + m2pp_loc (s, t); + m2pp_print (s, "\n"); + } + pop (); +} + +/* m2pp_add_var adds a variable into a list as defined by, data. */ + +static tree +m2pp_add_var (tree *tp, int *walk_subtrees, void *data) +{ + tree t = *tp; + pretty *s = (pretty *)data; + enum tree_code code = TREE_CODE (t); + + if (code == VAR_DECL) + { + m2pp_var (s); + m2pp_identifier (s, t); + m2pp_needspace (s); + m2pp_print (s, ":"); + m2pp_needspace (s); + m2pp_type (s, TREE_TYPE (t)); + m2pp_needspace (s); + m2pp_print (s, ";\n"); + } + if (code == SSA_NAME) + { + m2pp_var (s); + m2pp_ssa (s, t); + m2pp_identifier (s, SSA_NAME_VAR (t)); + m2pp_needspace (s); + m2pp_print (s, ":"); + m2pp_needspace (s); + m2pp_type (s, TREE_TYPE (t)); + m2pp_needspace (s); + m2pp_print (s, ";\n"); + } + + *walk_subtrees = 1; + return NULL_TREE; +} + +/* m2pp_function_vars displays variables as defined by the function + tree. */ + +static void +m2pp_function_vars (pretty *s, tree t) +{ + walk_tree_without_duplicates (&t, m2pp_add_var, s); + + if (TREE_CODE (t) == FUNCTION_DECL && DECL_INITIAL (t)) + { + m2pp_print (s, "(* variables in function_decl (decl_initial) *)\n"); + m2pp_var (s); + m2pp_statement_sequence (s, DECL_INITIAL (t)); + } +} + +/* m2pp_print print out a string p interpreting '\n' and + adjusting the fields within state s. */ + +static void +m2pp_print (pretty *s, const char *p) +{ + if (p) + { + int l = strlen (p); + int i = 0; + + if (s->needs_space) + { + printf (" "); + s->needs_space = FALSE; + s->curpos++; + } + + while (i < l) + { + if (p[i] == '\n') + { + s->needs_indent = TRUE; + s->curpos = 0; + printf ("\n"); + } + else + { + if (s->needs_indent) + { + if (s->indent > 0) + printf ("%*c", s->indent, ' '); + s->needs_indent = FALSE; + s->curpos += s->indent; + } + s->curpos++; + putchar (p[i]); + } + i++; + } + } +} + +/* m2pp_print_char prints out a character ch obeying needs_space + and needs_indent. */ + +static void +m2pp_print_char (pretty *s, char ch) +{ + if (s->needs_space) + { + printf (" "); + s->needs_space = FALSE; + s->curpos++; + } + if (s->needs_indent) + { + if (s->indent > 0) + printf ("%*c", s->indent, ' '); + s->needs_indent = FALSE; + s->curpos += s->indent; + } + if (ch == '\n') + { + s->curpos++; + putchar ('\\'); + putchar ('n'); + } + else + putchar (ch); + s->curpos++; +} + +/* m2pp_integer display the appropriate integer type. */ + +#if defined(GM2) +void +m2pp_integer (pretty *s, tree t) +{ + if (t == m2type_GetM2ZType ()) + m2pp_print (s, "M2ZTYPE"); + else if (t == m2type_GetM2LongIntType ()) + m2pp_print (s, "LONGINT"); + else if (t == m2type_GetM2IntegerType ()) + m2pp_print (s, "INTEGER"); + else if (t == m2type_GetM2ShortIntType ()) + m2pp_print (s, "SHORTINT"); + else if (t == m2type_GetLongIntType ()) + m2pp_print (s, "long int"); + else if (t == m2type_GetIntegerType ()) + m2pp_print (s, "int"); + else if (t == m2type_GetShortIntType ()) + m2pp_print (s, "short"); + else if (t == m2type_GetM2LongCardType ()) + m2pp_print (s, "LONGCARD"); + else if (t == m2type_GetM2CardinalType ()) + m2pp_print (s, "CARDINAL"); + else if (t == m2type_GetM2ShortCardType ()) + m2pp_print (s, "SHORTCARD"); + else if (t == m2type_GetCardinalType ()) + m2pp_print (s, "CARDINAL"); + else if (t == m2type_GetPointerType ()) + m2pp_print (s, "ADDRESS"); + else if (t == m2type_GetByteType ()) + m2pp_print (s, "BYTE"); + else if (t == m2type_GetCharType ()) + m2pp_print (s, "CHAR"); + else if (t == m2type_GetBitsetType ()) + m2pp_print (s, "BITSET"); + else if (t == m2type_GetBitnumType ()) + m2pp_print (s, "BITNUM"); + else + { + if (TYPE_UNSIGNED (t)) + m2pp_print (s, "CARDINAL"); + else + m2pp_print (s, "INTEGER"); + m2pp_integer_cst (s, TYPE_SIZE (t)); + } +} +#else +void +m2pp_integer (pretty *s, tree t ATTRIBUTE_UNUSED) +{ + m2pp_print (s, "INTEGER"); +} +#endif + +/* m2pp_complex display the actual complex type. */ + +#if defined(GM2) +static void +m2pp_complex (pretty *s, tree t) +{ + if (t == m2type_GetM2ComplexType ()) + m2pp_print (s, "COMPLEX"); + else if (t == m2type_GetM2LongComplexType ()) + m2pp_print (s, "LONGCOMPLEX"); + else if (t == m2type_GetM2ShortComplexType ()) + m2pp_print (s, "SHORTCOMPLEX"); + else if (t == m2type_GetM2CType ()) + m2pp_print (s, "C'omplex' type"); + else if (t == m2type_GetM2Complex32 ()) + m2pp_print (s, "COMPLEX32"); + else if (t == m2type_GetM2Complex64 ()) + m2pp_print (s, "COMPLEX64"); + else if (t == m2type_GetM2Complex96 ()) + m2pp_print (s, "COMPLEX96"); + else if (t == m2type_GetM2Complex128 ()) + m2pp_print (s, "COMPLEX128"); + else + m2pp_print (s, "unknown COMPLEX type"); +} + +#else + +static void +m2pp_complex (pretty *s, tree t ATTRIBUTE_UNUSED) +{ + m2pp_print (s, "a COMPLEX type"); +} +#endif + +/* m2pp_type prints a full type. */ + +void +m2pp_type (pretty *s, tree t) +{ + if (begin_printed (t)) + { + m2pp_print (s, "<...>"); + return; + } + if ((TREE_CODE (t) != FIELD_DECL) && (TREE_CODE (t) != TYPE_DECL)) + m2pp_gimpified (s, t); + switch (TREE_CODE (t)) + { + case INTEGER_TYPE: + m2pp_integer (s, t); + break; + case REAL_TYPE: + m2pp_print (s, "REAL"); + break; + case ENUMERAL_TYPE: + m2pp_enum (s, t); + break; + case UNION_TYPE: + m2pp_union_type (s, t); + break; + case RECORD_TYPE: + m2pp_record_type (s, t); + break; + case ARRAY_TYPE: + m2pp_array (s, t); + break; +#if 0 + case FUNCTION_TYPE: + m2pp_function_type (s, t); + break; +#endif + case TYPE_DECL: + m2pp_identifier (s, t); + break; + case POINTER_TYPE: + m2pp_pointer_type (s, t); + break; +#if defined(GM2) + case SET_TYPE: + m2pp_set_type (s, t); + break; +#endif + case VOID_TYPE: + m2pp_print (s, "ADDRESS"); + break; + case COMPLEX_TYPE: + m2pp_complex (s, t); + break; + default: + m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t))); + } +} + +/* m2pp_set_type prints out the set type. */ + +static void +m2pp_set_type (pretty *s, tree t) +{ + push (t); + m2pp_print (s, "SET OF"); + m2pp_needspace (s); + m2pp_type (s, TREE_TYPE (t)); + pop (); +} + +/* m2pp_enum print out the enumeration type. */ + +static void +m2pp_enum (pretty *s, tree t) +{ + tree chain_p = TYPE_VALUES (t); + + push (t); + m2pp_print (s, "("); + while (chain_p) + { + m2pp_ident_pointer (s, TREE_PURPOSE (chain_p)); + chain_p = TREE_CHAIN (chain_p); + if (chain_p) + m2pp_print (s, ", "); + } + m2pp_print (s, ")"); + pop (); +} + +/* m2pp_array prints out the array type. */ + +static void +m2pp_array (pretty *s, tree t) +{ + push (t); + m2pp_print (s, "ARRAY"); + m2pp_needspace (s); + m2pp_subrange (s, TYPE_DOMAIN (t)); + m2pp_needspace (s); + m2pp_print (s, "OF"); + m2pp_needspace (s); + m2pp_type (s, TREE_TYPE (t)); + pop (); +} + +/* m2pp_subrange prints out the subrange, but probably the lower + bound will always be zero. */ + +static void +m2pp_subrange (pretty *s, tree t) +{ + tree min = TYPE_MIN_VALUE (t); + tree max = TYPE_MAX_VALUE (t); + + m2pp_print (s, "["); + m2pp_expression (s, min); + m2pp_print (s, ".."); + m2pp_expression (s, max); + m2pp_print (s, "]"); +} + +/* m2pp_gimplified print out a gimplified comment. */ + +static void +m2pp_gimpified (pretty *s, tree t) +{ + if (!TYPE_SIZES_GIMPLIFIED (t)) + { + m2pp_print (s, "(* *)"); + m2pp_needspace (s); + } +} + +/* m2pp_printer_type display the pointer type. */ + +static void +m2pp_pointer_type (pretty *s, tree t) +{ + push (t); + if (TREE_CODE (t) == POINTER_TYPE) + { + if (TREE_CODE (TREE_TYPE (t)) == FUNCTION_TYPE) + m2pp_procedure_type (s, TREE_TYPE (t)); + else if (t == ptr_type_node) + m2pp_print (s, "ADDRESS"); + else + { + m2pp_print (s, "POINTER TO"); + m2pp_needspace (s); + m2pp_type (s, TREE_TYPE (t)); + } + } + pop (); +} + +/* m2pp_record_alignment prints out whether this record is aligned + (packed). */ + +static void +m2pp_record_alignment (pretty *s, tree t) +{ + if (TYPE_PACKED (t)) + m2pp_print (s, "<* bytealignment (0) *>\n"); +} + +static unsigned int +m2pp_getaligned (tree t) +{ + if (DECL_P (t)) + { + if (DECL_USER_ALIGN (t)) + return DECL_ALIGN (t); + } + else if (TYPE_P (t)) + { + if (TYPE_USER_ALIGN (t)) + return TYPE_ALIGN (t); + } + return 0; +} + +static void +m2pp_recordfield_alignment (pretty *s, tree t) +{ + unsigned int aligned = m2pp_getaligned (t); + + if (aligned != 0) + { + int o = getindent (s); + int p = getcurpos (s); + m2pp_needspace (s); + m2pp_print (s, "<* bytealignment ("); + setindent (s, p + 18); + + printf ("%d", aligned / BITS_PER_UNIT); + + m2pp_print (s, ")"); + m2pp_needspace (s); + setindent (s, p); + m2pp_print (s, "*>"); + setindent (s, o); + } +} + +static void +m2pp_recordfield_bitfield (pretty *s, tree t) +{ + if ((TREE_CODE (t) == FIELD_DECL) && DECL_PACKED (t)) + { + m2pp_print (s, " (* packed"); + if (DECL_NONADDRESSABLE_P (t)) + m2pp_print (s, ", non-addressible"); + if (DECL_BIT_FIELD (t)) + m2pp_print (s, ", bit-field"); + m2pp_print (s, ", offset: "); + m2pp_expression (s, DECL_FIELD_OFFSET (t)); + m2pp_print (s, ", bit offset:"); + m2pp_expression (s, DECL_FIELD_BIT_OFFSET (t)); + m2pp_print (s, " *) "); + } +} + +/* m2pp_record_type displays the record type. */ + +static void +m2pp_record_type (pretty *s, tree t) +{ + push (t); + if (TREE_CODE (t) == RECORD_TYPE) + { + tree i; + int o = getindent (s); + int p = getcurpos (s); + + m2pp_print (s, "RECORD\n"); + setindent (s, p + 3); + m2pp_record_alignment (s, t); + for (i = TYPE_FIELDS (t); i != NULL_TREE; i = TREE_CHAIN (i)) + { + m2pp_identifier (s, i); + m2pp_print (s, " : "); + m2pp_type (s, TREE_TYPE (i)); + m2pp_recordfield_bitfield (s, i); + m2pp_recordfield_alignment (s, i); + m2pp_print (s, ";\n"); + } + setindent (s, p); + m2pp_print (s, "END"); + setindent (s, o); + } + pop (); +} + +/* m2pp_record_type displays the record type. */ + +static void +m2pp_union_type (pretty *s, tree t) +{ + push (t); + if (TREE_CODE (t) == UNION_TYPE) + { + tree i; + int o = getindent (s); + int p = getcurpos (s); + + m2pp_print (s, "CASE .. OF\n"); + setindent (s, p + 3); + m2pp_record_alignment (s, t); + for (i = TYPE_FIELDS (t); i != NULL_TREE; i = TREE_CHAIN (i)) + { + m2pp_identifier (s, i); + m2pp_print (s, " : "); + m2pp_type (s, TREE_TYPE (i)); + m2pp_recordfield_bitfield (s, i); + m2pp_print (s, ";\n"); + } + setindent (s, p); + m2pp_print (s, "END"); + setindent (s, o); + } + pop (); +} + +/* m2pp_simple_type. */ + +static void +m2pp_simple_type (pretty *s, tree t) +{ + if (begin_printed (t)) + { + m2pp_print (s, "<...>"); + return; + } + + m2pp_gimpified (s, t); + switch (TREE_CODE (t)) + { + case INTEGER_TYPE: + m2pp_integer (s, t); + break; + case REAL_TYPE: + m2pp_print (s, "REAL"); + break; + case BOOLEAN_TYPE: + m2pp_print (s, "BOOLEAN"); + break; + case VOID_TYPE: + m2pp_print (s, "ADDRESS"); + break; + case TYPE_DECL: + m2pp_identifier (s, t); + break; + case POINTER_TYPE: + m2pp_pointer_type (s, t); + break; + case RECORD_TYPE: + m2pp_record_type (s, t); + break; + case UNION_TYPE: + m2pp_union_type (s, t); + break; + case ENUMERAL_TYPE: + m2pp_enum (s, t); + break; + case COMPLEX_TYPE: + m2pp_complex (s, t); + break; + default: + m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t))); + } +} + +/* m2pp_expression display an expression. */ + +static void +m2pp_expression (pretty *s, tree t) +{ + enum tree_code code = TREE_CODE (t); + + switch (code) + { + case EQ_EXPR: + m2pp_relop (s, t, "="); + break; + case NE_EXPR: + m2pp_relop (s, t, "#"); + break; + case LE_EXPR: + m2pp_relop (s, t, "<="); + break; + case GE_EXPR: + m2pp_relop (s, t, ">="); + break; + case LT_EXPR: + m2pp_relop (s, t, "<"); + break; + case GT_EXPR: + m2pp_relop (s, t, ">"); + break; + default: + m2pp_simple_expression (s, t); + } +} + +/* m2pp_relop displays the lhs relop rhs. */ + +static void +m2pp_relop (pretty *s, tree t, const char *p) +{ + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_needspace (s); + m2pp_print (s, p); + m2pp_needspace (s); + m2pp_expression (s, TREE_OPERAND (t, 1)); +} + +/* m2pp_compound_expression handle compound expression tree. */ + +static void +m2pp_compound_expression (pretty *s, tree t) +{ + m2pp_print (s, "compound expression {"); + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_print (s, " (* result ignored *), "); + m2pp_expression (s, TREE_OPERAND (t, 1)); + m2pp_print (s, "}"); + m2pp_needspace (s); +} + +/* m2pp_target_expression handle target expression tree. */ + +static void +m2pp_target_expression (pretty *s, tree t) +{ + m2pp_print (s, "{"); + m2pp_needspace (s); + if (TREE_OPERAND (t, 0) != NULL_TREE) + { + m2pp_print (s, "(* target *) "); + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_print (s, ","); + m2pp_needspace (s); + } + if (TREE_OPERAND (t, 1) != NULL_TREE) + { + m2pp_print (s, "(* initializer *) "); + m2pp_expression (s, TREE_OPERAND (t, 1)); + m2pp_print (s, ","); + m2pp_needspace (s); + } + if (TREE_OPERAND (t, 2) != NULL_TREE) + { + m2pp_print (s, "(* cleanup *) "); + m2pp_expression (s, TREE_OPERAND (t, 2)); + m2pp_print (s, ","); + m2pp_needspace (s); + } + if (TREE_OPERAND (t, 3) != NULL_TREE) + { + m2pp_print (s, "(* saved initializer *) "); + m2pp_expression (s, TREE_OPERAND (t, 3)); + m2pp_print (s, ","); + m2pp_needspace (s); + } + m2pp_print (s, "}"); + m2pp_needspace (s); +} + +/* m2pp_constructor print out a constructor. */ + +static void +m2pp_constructor (pretty *s, tree t) +{ + tree purpose, value; + unsigned HOST_WIDE_INT ix; + + m2pp_print (s, "{ "); + FOR_EACH_CONSTRUCTOR_ELT (CONSTRUCTOR_ELTS (t), ix, purpose, value) + { + m2pp_print (s, "(index: "); + m2pp_simple_expression (s, purpose); + m2pp_print (s, ") "); + m2pp_simple_expression (s, value); + m2pp_print (s, ", "); + } + m2pp_print (s, "}"); + m2pp_print (s, "(* type: "); + setindent (s, getindent (s) + 8); + m2pp_type (s, TREE_TYPE (t)); + setindent (s, getindent (s) - 8); + m2pp_print (s, " *)\n"); +} + +/* m2pp_complex_expr handle GCC complex_expr tree. */ + +static void +m2pp_complex_expr (pretty *s, tree t) +{ + if (TREE_CODE (t) == COMPLEX_CST) + { + m2pp_print (s, "CMPLX("); + m2pp_needspace (s); + m2pp_expression (s, TREE_REALPART (t)); + m2pp_print (s, ","); + m2pp_needspace (s); + m2pp_expression (s, TREE_IMAGPART (t)); + m2pp_print (s, ")"); + } + else + { + m2pp_print (s, "CMPLX("); + m2pp_needspace (s); + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_print (s, ","); + m2pp_needspace (s); + m2pp_expression (s, TREE_OPERAND (t, 1)); + m2pp_print (s, ")"); + } +} + +/* m2pp_imagpart_expr handle imagpart_expr tree. */ + +static void +m2pp_imagpart_expr (pretty *s, tree t) +{ + m2pp_print (s, "IM("); + m2pp_needspace (s); + if (TREE_CODE (t) == IMAGPART_EXPR) + m2pp_expression (s, TREE_OPERAND (t, 0)); + else if (TREE_CODE (t) == COMPLEX_CST) + m2pp_expression (s, TREE_IMAGPART (t)); + m2pp_needspace (s); + m2pp_print (s, ")"); +} + +/* m2pp_realpart_expr handle imagpart_expr tree. */ + +static void +m2pp_realpart_expr (pretty *s, tree t) +{ + m2pp_print (s, "RE("); + m2pp_needspace (s); + if (TREE_CODE (t) == REALPART_EXPR) + m2pp_expression (s, TREE_OPERAND (t, 0)); + else if (TREE_CODE (t) == COMPLEX_CST) + m2pp_expression (s, TREE_REALPART (t)); + m2pp_needspace (s); + m2pp_print (s, ")"); +} + +/* m2pp_bit_ior_expr generate a C style bit or. */ + +static void +m2pp_bit_ior_expr (pretty *s, tree t) +{ + m2pp_binary (s, t, "|"); +} + +/* m2pp_truth_expr. */ + +static void +m2pp_truth_expr (pretty *s, tree t, const char *op) +{ + m2pp_print (s, "("); + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_print (s, ")"); + m2pp_needspace (s); + m2pp_print (s, op); + m2pp_needspace (s); + m2pp_print (s, "("); + m2pp_expression (s, TREE_OPERAND (t, 1)); + m2pp_print (s, ")"); +} + +/* m2pp_simple_expression handle GCC expression tree. */ + +static void +m2pp_simple_expression (pretty *s, tree t) +{ + enum tree_code code = TREE_CODE (t); + + switch (code) + { + case ERROR_MARK: + m2pp_print (s, "(* !!! ERROR NODE !!! *)"); + break; + case CONSTRUCTOR: + m2pp_constructor (s, t); + break; + case IDENTIFIER_NODE: + m2pp_ident_pointer (s, t); + break; + case PARM_DECL: + m2pp_identifier (s, t); + break; + case FIELD_DECL: + m2pp_identifier (s, t); + break; + case TREE_LIST: + m2pp_list (s, t); + break; + case BLOCK: + m2pp_print (s, "(* BLOCK NODE *)"); + break; + case OFFSET_TYPE: + m2pp_offset (s, t); + break; + case INTEGER_CST: + m2pp_integer_cst (s, t); + break; + case REAL_CST: + m2pp_real_cst (s, t); + break; + case STRING_CST: + m2pp_string_cst (s, t); + break; + case INDIRECT_REF: + m2pp_indirect_ref (s, t); + break; + case ADDR_EXPR: + m2pp_addr_expr (s, t); + break; + case NOP_EXPR: + m2pp_nop (s, t); + break; + case CONVERT_EXPR: + m2pp_convert (s, t); + break; + case VAR_DECL: + m2pp_var_decl (s, t); + break; + case RESULT_DECL: + m2pp_result_decl (s, t); + break; + case PLUS_EXPR: + m2pp_binary (s, t, "+"); + break; + case MINUS_EXPR: + m2pp_binary (s, t, "-"); + break; + case MULT_EXPR: + m2pp_binary (s, t, "*"); + break; + case FLOOR_DIV_EXPR: + case CEIL_DIV_EXPR: + case TRUNC_DIV_EXPR: + case ROUND_DIV_EXPR: + m2pp_binary (s, t, "DIV"); + break; + case FLOOR_MOD_EXPR: + case CEIL_MOD_EXPR: + case TRUNC_MOD_EXPR: + case ROUND_MOD_EXPR: + m2pp_binary (s, t, "MOD"); + break; + case NEGATE_EXPR: + m2pp_unary (s, t, "-"); + break; + case CALL_EXPR: + m2pp_call_expr (s, t); + break; + case SSA_NAME: + m2pp_ssa (s, t); + break; + case COMPONENT_REF: + m2pp_component_ref (s, t); + break; + case RETURN_EXPR: + m2pp_return_expr (s, t); + break; + case ARRAY_REF: + m2pp_array_ref (s, t); + break; + case NON_LVALUE_EXPR: + m2pp_non_lvalue_expr (s, t); + break; + case EXPR_STMT: + m2pp_expression (s, EXPR_STMT_EXPR (t)); + break; +#if 0 + case EXC_PTR_EXPR: + m2pp_print (s, "GCC_EXCEPTION_OBJECT"); + break; +#endif + case INIT_EXPR: + case MODIFY_EXPR: + m2pp_assignment (s, t); + break; + case COMPOUND_EXPR: + m2pp_compound_expression (s, t); + break; + case TARGET_EXPR: + m2pp_target_expression (s, t); + break; + case THROW_EXPR: + m2pp_throw (s, t); + break; + case FUNCTION_DECL: + m2pp_identifier (s, t); + break; + case COMPLEX_EXPR: + m2pp_complex_expr (s, t); + break; + case REALPART_EXPR: + m2pp_realpart_expr (s, t); + break; + case IMAGPART_EXPR: + m2pp_imagpart_expr (s, t); + break; + case CONST_DECL: + m2pp_identifier (s, t); + break; + case POINTER_PLUS_EXPR: + m2pp_binary (s, t, "+"); + break; + case CLEANUP_POINT_EXPR: + m2pp_cleanup_point_expr (s, t); + break; + case BIT_IOR_EXPR: + m2pp_bit_ior_expr (s, t); + break; + case TRUTH_ANDIF_EXPR: + m2pp_truth_expr (s, t, "AND"); + break; + case TRUTH_ORIF_EXPR: + m2pp_truth_expr (s, t, "OR"); + break; + default: + m2pp_unknown (s, __FUNCTION__, get_tree_code_name (code)); + } +} + +/* non_lvalue_expr indicates that operand 0 is not an lvalue. */ + +static void +m2pp_non_lvalue_expr (pretty *s, tree t) +{ + m2pp_needspace (s); + m2pp_print (s, "assert_non_lvalue("); + m2pp_needspace (s); + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_needspace (s); + m2pp_print (s, ")"); +} + +/* m2pp_array_ref prints out the array reference. */ + +static void +m2pp_array_ref (pretty *s, tree t) +{ + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_print (s, "["); + m2pp_expression (s, TREE_OPERAND (t, 1)); + m2pp_print (s, "]"); +} + +/* m2pp_ssa prints out the ssa variable name. */ + +static void +m2pp_ssa (pretty *s, tree t) +{ + m2pp_identifier (s, SSA_NAME_VAR (t)); +} + +/* m2pp_binary print the binary operator, p, and lhs, rhs. */ + +static void +m2pp_binary (pretty *s, tree t, const char *p) +{ + tree left = TREE_OPERAND (t, 0); + tree right = TREE_OPERAND (t, 1); + + m2pp_expression (s, left); + m2pp_needspace (s); + m2pp_print (s, p); + m2pp_needspace (s); + m2pp_expression (s, right); +} + +/* m2pp_unary print the unary operator, p, and expression. */ + +static void +m2pp_unary (pretty *s, tree t, const char *p) +{ + tree expr = TREE_OPERAND (t, 0); + + m2pp_needspace (s); + m2pp_print (s, p); + m2pp_expression (s, expr); +} + +/* m2pp_integer_cst displays the integer constant. */ + +static void +m2pp_integer_cst (pretty *s, tree t) +{ + char val[100]; + + snprintf (val, 100, "%lud", TREE_INT_CST_LOW (t)); + m2pp_print (s, val); +} + +/* m2pp_real_cst displays the real constant. */ + +static void +m2pp_real_cst (pretty *s, tree t ATTRIBUTE_UNUSED) +{ + m2pp_print (s, ""); +} + +/* m2pp_string_cst displays the real constant. */ + +static void +m2pp_string_cst (pretty *s, tree t) +{ + const char *p = TREE_STRING_POINTER (t); + int i = 0; + + m2pp_print (s, "\""); + while (p[i] != '\0') + { + m2pp_print_char (s, p[i]); + i++; + } + m2pp_print (s, "\""); +} + +/* m2pp_statement_sequence iterates over a statement list + displaying each statement in turn. */ + +static void +m2pp_statement_sequence (pretty *s, tree t) +{ + if (t != NULL_TREE) + { + if (TREE_CODE (t) == STATEMENT_LIST) + { + tree_stmt_iterator i; + m2pp_print (s, "(* statement list *)\n"); + + for (i = tsi_start (t); !tsi_end_p (i); tsi_next (&i)) + m2pp_statement (s, *tsi_stmt_ptr (i)); + } + else + m2pp_statement (s, t); + } +} + +/* m2pp_unknown displays an error message. */ + +static void +m2pp_unknown (pretty *s, const char *s1, const char *s2) +{ + m2pp_begin (s); + m2pp_print (s, s1); + m2pp_needspace (s); + m2pp_print (s, s2); + m2pp_needspace (s); +} + +/* m2pp_throw displays a throw statement. */ + +static void +m2pp_throw (pretty *s, tree t) +{ + tree expr = TREE_OPERAND (t, 0); + + m2pp_begin (s); + if (expr == NULL_TREE) + m2pp_print (s, "THROW ;\n"); + else + { + m2pp_print (s, "THROW ("); + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_print (s, ")\n"); + } +} + +/* m2pp_catch_expr attempts to reconstruct a catch expr. */ + +static void +m2pp_catch_expr (pretty *s, tree t) +{ + tree types = CATCH_TYPES (t); + tree body = CATCH_BODY (t); + + m2pp_print (s, "(* CATCH expression "); + if (types != NULL_TREE) + { + m2pp_print (s, "("); + m2pp_expression (s, types); + m2pp_print (s, ")"); + } + m2pp_print (s, "*)\n"); + m2pp_print (s, "(* catch body *)\n"); + m2pp_statement_sequence (s, body); + m2pp_print (s, "(* end catch body *)\n"); +} + +/* m2pp_try_finally_expr attemts to reconstruct a try finally expr. */ + +static void +m2pp_try_finally_expr (pretty *s, tree t) +{ + m2pp_begin (s); + m2pp_print (s, "(* try_finally_expr *)\n"); + setindent (s, getindent (s) + 3); + m2pp_statement_sequence (s, TREE_OPERAND (t, 0)); + setindent (s, getindent (s) - 3); + m2pp_print (s, + "(* finally (cleanup which is executed after the above) *)\n"); + setindent (s, getindent (s) + 3); + m2pp_statement_sequence (s, TREE_OPERAND (t, 1)); + setindent (s, getindent (s) - 3); + m2pp_print (s, "(* end try_finally_expr *)\n"); +} + +#if !defined(GM2) +/* m2pp_if_stmt pretty print a C++ if_stmt. */ + +static void +m2pp_if_stmt (pretty *s, tree t) +{ + m2pp_print (s, "(* only C++ uses if_stmt nodes *)\n"); + m2pp_print (s, "IF "); + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_print (s, "\n"); + m2pp_print (s, "THEN\n"); + setindent (s, getindent (s) + 3); + m2pp_statement_sequence (s, TREE_OPERAND (t, 1)); + setindent (s, getindent (s) - 3); + m2pp_print (s, "ELSE\n"); + setindent (s, getindent (s) + 3); + m2pp_statement_sequence (s, TREE_OPERAND (t, 2)); + setindent (s, getindent (s) - 3); + m2pp_print (s, "END\n"); +} +#endif + +/* m2pp_statement attempts to reconstruct a statement. */ + +static void +m2pp_statement (pretty *s, tree t) +{ + enum tree_code code = TREE_CODE (t); + + m2pp_loc (s, t); + switch (code) + { + case COND_EXPR: + m2pp_conditional (s, t); + break; + case LABEL_EXPR: + m2pp_label_expr (s, t); + break; + case LABEL_DECL: + m2pp_label_decl (s, t); + break; + case GOTO_EXPR: + m2pp_goto (s, t); + break; + case INIT_EXPR: + case MODIFY_EXPR: + m2pp_assignment (s, t); + break; + case CALL_EXPR: + m2pp_procedure_call (s, t); + break; + case BLOCK: + m2pp_block_list (s, t); + break; + case BIND_EXPR: + m2pp_bind_expr (s, t); + break; + case RETURN_EXPR: + m2pp_return_expr (s, t); + break; + case DECL_EXPR: + m2pp_decl_expr (s, t); + break; + case TRY_BLOCK: + m2pp_try_block (s, t); + break; + case HANDLER: + m2pp_handler (s, t); + break; + case CLEANUP_POINT_EXPR: + m2pp_cleanup_point_expr (s, t); + break; + case THROW_EXPR: + m2pp_throw (s, t); + break; + case TRY_CATCH_EXPR: + m2pp_try_catch_expr (s, t); + break; + case TRY_FINALLY_EXPR: + m2pp_try_finally_expr (s, t); + break; + case CATCH_EXPR: + m2pp_catch_expr (s, t); + break; +#if defined(CPP) + case IF_STMT: + m2pp_if_stmt (s, t); + break; +#endif + case ERROR_MARK: + m2pp_print (s, "\n"); + break; + default: + m2pp_unknown (s, __FUNCTION__, get_tree_code_name (TREE_CODE (t))); + } +} + +/* m2pp_try_catch_expr is used after gimplification. */ + +static void +m2pp_try_catch_expr (pretty *s, tree t) +{ + m2pp_print (s, "(* try_catch_expr begins *)\n"); + m2pp_statement_sequence (s, TREE_OPERAND (t, 0)); + setindent (s, 0); + m2pp_print (s, "EXCEPT\n"); + setindent (s, 3); + m2pp_statement_sequence (s, TREE_OPERAND (t, 1)); + m2pp_print (s, "(* try_catch_expr ends *)\n"); +} + +/* m2pp_cleanup_point_expr emits a comment indicating a GCC + cleanup_point_expr is present. */ + +static void +m2pp_cleanup_point_expr (pretty *s, tree t) +{ + m2pp_begin (s); + m2pp_print (s, "(* cleanup point begins *)\n"); + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_print (s, "(* cleanup point ends *)\n"); +} + +/* m2pp_decl_expr displays a local declaration. */ + +static void +m2pp_decl_expr (pretty *s, tree t) +{ + m2pp_var (s); + m2pp_print (s, "(* variable in decl_expr *)\n"); + m2pp_var_type_decl (s, DECL_EXPR_DECL (t)); +} + +/* m2pp_procedure_call print a call to a procedure. */ + +static void +m2pp_procedure_call (pretty *s, tree t) +{ + m2pp_begin (s); + m2pp_call_expr (s, t); + m2pp_needspace (s); + m2pp_print (s, ";\n"); +} + +/* args displays each argument in an iter list by calling expression. */ + +static void +m2pp_args (pretty *s, tree e) +{ + call_expr_arg_iterator iter; + tree arg; + + m2pp_print (s, "("); + m2pp_needspace (s); + FOR_EACH_CALL_EXPR_ARG (arg, iter, e) + { + m2pp_expression (s, arg); + if (more_call_expr_args_p (&iter)) + { + m2pp_print (s, ","); + m2pp_needspace (s); + } + } + m2pp_print (s, ")"); +} + +/* m2pp_call_expr print a call to a procedure or function. */ + +static void +m2pp_call_expr (pretty *s, tree t) +{ + tree call = CALL_EXPR_FN (t); + tree args = TREE_OPERAND (t, 1); + tree type = TREE_TYPE (t); + int has_return_type = TRUE; + tree proc; + + if (type && (TREE_CODE (type) == VOID_TYPE)) + has_return_type = FALSE; + + if (TREE_CODE (call) == ADDR_EXPR || TREE_CODE (call) == NON_LVALUE_EXPR) + proc = TREE_OPERAND (call, 0); + else + proc = call; + + m2pp_expression (s, proc); + if (args || has_return_type) + m2pp_args (s, t); +} + +/* m2pp_return_expr displays the return statement. */ + +static void +m2pp_return_expr (pretty *s, tree t) +{ + tree e = TREE_OPERAND (t, 0); + + m2pp_begin (s); + if (e == NULL_TREE) + { + m2pp_print (s, "RETURN"); + } + else if (TREE_CODE (e) == MODIFY_EXPR || (TREE_CODE (e) == INIT_EXPR)) + { + m2pp_assignment (s, e); + m2pp_print (s, "RETURN"); + m2pp_needspace (s); + m2pp_expression (s, TREE_OPERAND (e, 0)); + } + else + { + m2pp_print (s, "RETURN"); + m2pp_needspace (s); + m2pp_expression (s, e); + } + m2pp_needspace (s); + m2pp_print (s, ";\n"); +} + +/* m2pp_try_block displays the try block. */ + +static void +m2pp_try_block (pretty *s, tree t) +{ + tree stmts = TRY_STMTS (t); + tree handlers = TRY_HANDLERS (t); + + m2pp_begin (s); + m2pp_print (s, "(* TRY *)\n"); + m2pp_statement_sequence (s, stmts); + setindent (s, 0); + m2pp_print (s, "EXCEPT\n"); + setindent (s, 3); + m2pp_statement_sequence (s, handlers); + m2pp_print (s, "(* END TRY *)\n"); +} + +/* m2pp_try_block displays the handler block. */ + +static void +m2pp_handler (pretty *s, tree t) +{ + tree parms = HANDLER_PARMS (t); + tree body = HANDLER_BODY (t); + tree type = HANDLER_TYPE (t); + + m2pp_print (s, "(* handler *)\n"); + if (parms != NULL_TREE) + { + m2pp_print (s, "(* handler parameter has a type (should be NULL_TREE) " + "in Modula-2 *)\n"); + m2pp_print (s, "CATCH ("); + m2pp_expression (s, parms); + m2pp_print (s, ")\n"); + } + if (type != NULL_TREE) + m2pp_print (s, "(* handler type (should be NULL_TREE) in Modula-2 *)\n"); + m2pp_statement_sequence (s, body); +} + +/* m2pp_assignment prints out the assignment statement. */ + +static void +m2pp_assignment (pretty *s, tree t) +{ + int o; + + m2pp_begin (s); + m2pp_designator (s, TREE_OPERAND (t, 0)); + m2pp_needspace (s); + m2pp_print (s, ":="); + m2pp_needspace (s); + o = getindent (s); + setindent (s, getcurpos (s) + 1); + m2pp_expression (s, TREE_OPERAND (t, 1)); + m2pp_needspace (s); + m2pp_print (s, ";\n"); + setindent (s, o); +} + +/* m2pp_designator displays the lhs of an assignment. */ + +static void +m2pp_designator (pretty *s, tree t) +{ + m2pp_expression (s, t); +} + +/* m2pp_indirect_ref displays the indirect operator. */ + +static void +m2pp_indirect_ref (pretty *s, tree t) +{ + m2pp_print (s, "("); + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_print (s, ")^"); +} + +/* m2pp_conditional builds an IF THEN ELSE END. With more work + this should be moved into statement sequence which could look for + repeat and while loops. */ + +static void +m2pp_conditional (pretty *s, tree t) +{ + int o; + + m2pp_begin (s); + m2pp_print (s, "IF"); + m2pp_needspace (s); + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_print (s, "\nTHEN\n"); + o = getindent (s); + setindent (s, o + 3); + m2pp_statement_sequence (s, TREE_OPERAND (t, 1)); + setindent (s, o); + if (TREE_OPERAND (t, 2) != NULL_TREE) + { + m2pp_print (s, "ELSE\n"); + setindent (s, o + 3); + m2pp_statement_sequence (s, TREE_OPERAND (t, 2)); + setindent (s, o); + } + m2pp_print (s, "END ;\n"); +} + +/* m2pp_label_decl displays a label. Again should be moved into + statement sequence to determine proper loop constructs. */ + +static void +m2pp_label_decl (pretty *s, tree t) +{ + m2pp_begin (s); + m2pp_print (s, "(* label "); + m2pp_identifier (s, t); + m2pp_print (s, ": *)\n"); +} + +/* m2pp_label_expr skips the LABEL_EXPR to find the LABEL_DECL. */ + +static void +m2pp_label_expr (pretty *s, tree t) +{ + m2pp_begin (s); + m2pp_statement (s, TREE_OPERAND (t, 0)); +} + +/* m2pp_goto displays a goto statement. Again should be moved into + statement sequence to determine proper loop constructs. */ + +static void +m2pp_goto (pretty *s, tree t) +{ + m2pp_begin (s); + m2pp_print (s, "(* goto "); + m2pp_identifier (s, TREE_OPERAND (t, 0)); + m2pp_print (s, " *)\n"); +} + +/* m2pp_list prints a TREE_CHAINed list. */ + +static void +m2pp_list (pretty *s, tree t) +{ + tree u = t; + + m2pp_print (s, "("); + m2pp_needspace (s); + while (t != NULL_TREE) + { + m2pp_expression (s, TREE_VALUE (t)); + t = TREE_CHAIN (t); + if (t == u || t == NULL_TREE) + break; + m2pp_print (s, ","); + m2pp_needspace (s); + } + m2pp_needspace (s); + m2pp_print (s, ")"); +} + +/* m2pp_offset displays the offset operator. */ + +static void +m2pp_offset (pretty *s, tree t) +{ + tree type = TREE_TYPE (t); + tree base = TYPE_OFFSET_BASETYPE (t); + + m2pp_print (s, "OFFSET ("); + m2pp_type (s, base); + m2pp_print (s, "."); + m2pp_type (s, type); + m2pp_print (s, ")"); +} + +/* m2pp_addr_expr create an ADR expression. */ + +static void +m2pp_addr_expr (pretty *s, tree t) +{ + m2pp_needspace (s); + m2pp_print (s, "ADR ("); + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_print (s, ")"); +} + +/* m2pp_nop generate a CAST expression. */ + +static void +m2pp_nop (pretty *s, tree t) +{ + m2pp_needspace (s); + m2pp_print (s, "CAST ("); + m2pp_simple_type (s, TREE_TYPE (t)); + m2pp_print (s, ", "); + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_print (s, ")"); +} + +/* m2pp_convert generate a CONVERT expression. */ + +static void +m2pp_convert (pretty *s, tree t) +{ + m2pp_needspace (s); + m2pp_print (s, "CONVERT ("); + m2pp_simple_type (s, TREE_TYPE (t)); + m2pp_print (s, ", "); + m2pp_expression (s, TREE_OPERAND (t, 0)); + m2pp_print (s, ")"); +} + +/* m2pp_var_decl generate a variable. */ + +static void +m2pp_var_decl (pretty *s, tree t) +{ + m2pp_identifier (s, t); +} + +/* m2pp_result_decl generate a result declaration (variable). */ + +static void +m2pp_result_decl (pretty *s, tree t) +{ + m2pp_identifier (s, t); +} + +/* m2pp_component_ref generate a record field access. */ + +static void +m2pp_component_ref (pretty *s, tree t) +{ + m2pp_simple_expression (s, TREE_OPERAND (t, 0)); + m2pp_print (s, "."); + m2pp_simple_expression (s, TREE_OPERAND (t, 1)); +} diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/m2pp.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/m2pp.h 2022-12-06 02:56:51.360774949 +0000 @@ -0,0 +1,42 @@ +/* m2pp.h pretty print trees, output in Modula-2 where possible. + +Copyright (C) 2007-2022 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(M2PP_H) +# define M2PP_H + +# if defined(M2PP_C) +# define EXTERN +# else +# define EXTERN extern +# endif + +/* These functions allow a maintainer to dump the trees in Modula-2. */ + +EXTERN void pf (tree t); +EXTERN void pe (tree t); +EXTERN void pt (tree t); +EXTERN void ptl (tree t); +EXTERN void pv (tree t); +EXTERN void ptcl (tree t); + + +# undef EXTERN +#endif diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/m2-tree.def --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/m2-tree.def 2022-12-06 02:56:51.360774949 +0000 @@ -0,0 +1,24 @@ +/* gm2-tree.def a component of a C header file used to define a SET type. + +Copyright (C) 2006-2022 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 COPYING. If not, write to the +Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA +02110-1301, USA. */ + +/* A SET_TYPE type. */ +DEFTREECODE (SET_TYPE, "set_type", tcc_type, 0) diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/m2-tree.h --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/m2-tree.h 2022-12-06 02:56:51.360774949 +0000 @@ -0,0 +1,48 @@ +/* m2-tree.h create language specific tree nodes for Modula-2. + +Copyright (C) 2001-2022 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 +. */ + +#ifndef GCC_GM2_TREE_H +#define GCC_GM2_TREE_H + +#include "ggc.h" +#include "function.h" +#include "hashtab.h" +#include "vec.h" + +/* These macros provide convenient access to the various statement nodes. */ + +#define TRY_STMTS(NODE) TREE_OPERAND (TRY_BLOCK_CHECK (NODE), 0) +#define TRY_HANDLERS(NODE) TREE_OPERAND (TRY_BLOCK_CHECK (NODE), 1) + +/* Nonzero if this try block is a function try block. */ +#define FN_TRY_BLOCK_P(NODE) TREE_LANG_FLAG_3 (TRY_BLOCK_CHECK (NODE)) +#define HANDLER_PARMS(NODE) TREE_OPERAND (HANDLER_CHECK (NODE), 0) +#define HANDLER_BODY(NODE) TREE_OPERAND (HANDLER_CHECK (NODE), 1) +#define HANDLER_TYPE(NODE) TREE_TYPE (HANDLER_CHECK (NODE)) + +/* STMT_EXPR accessor. */ +#define STMT_EXPR_STMT(NODE) TREE_OPERAND (STMT_EXPR_CHECK (NODE), 0) + +/* EXPR_STMT accessor. This gives the expression associated with an + expression statement. */ +#define EXPR_STMT_EXPR(NODE) TREE_OPERAND (EXPR_STMT_CHECK (NODE), 0) + +#endif diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/version.c --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/version.c 2022-12-06 02:56:51.380775219 +0000 @@ -0,0 +1 @@ +#define version_string "1.9.5" From patchwork Tue Dec 6 14:47:28 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Gaius Mulley X-Patchwork-Id: 61585 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 1FE62395B06C for ; Tue, 6 Dec 2022 14:51:38 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 1FE62395B06C DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1670338298; bh=iz62N+HiYeXt0pyJ4dqkJIb7tNYhI1/yDZv1z+p8ZwY=; h=Subject:To:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=nvDTEcF/dm7Qn3yBC0S8q61qs8YCqGdvA3AMpkEUca8AV18ws8XX01CtZC+6p/lWY VdEq+l8y0ZgoPP1xlabrkzR1d7yd8V02Gjp9TXCt0T8XQ5Vp5BbzfdjPPdk1h0EJh3 LbrSU9RanQAlhRpa57xPEjtjP4F+1dlFFdxtfD3E= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x333.google.com (mail-wm1-x333.google.com [IPv6:2a00:1450:4864:20::333]) by sourceware.org (Postfix) with ESMTPS id 4C4CD3871FB6 for ; Tue, 6 Dec 2022 14:47:50 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 4C4CD3871FB6 Received: by mail-wm1-x333.google.com with SMTP id m19so11343315wms.5 for ; Tue, 06 Dec 2022 06:47:50 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=date:message-id:to:subject:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=iz62N+HiYeXt0pyJ4dqkJIb7tNYhI1/yDZv1z+p8ZwY=; b=WCDGlbqirO7l7zloCoifiyif7jTk21+eri0IBGONuEPqzschWTFLNZwv3s0vV/5KZe s3t/PlpGr+SDT/RaQKQNBov/iqS9HBkxf5n3zXo51Iw04jK9YjfZQqtb/91rPYLPQAoT qVJocmiocjpniqKuOQr3zskmx+i+4ixtMVJ3mh5c/curbs/lqmtOWtGYIUUDkjskG2lO hzkhGLlRt0HK+KCxh6+q9+usu0tlHj62sdf0w2cK92AEUvODO4I/d6vi2cjidD5iZghJ VizOtL+teRo0HBCrQi6GsyUXYggqCvKgamwWOkcHB1e2K3L1MThWsDXNqPgOhhbYT9RQ UeLQ== X-Gm-Message-State: ANoB5pkS4i6gNj0j+zRfI2VW0yB7/mo6JmkQ8rIS8mpBklcuunpBfaee qcdMfhkxib98yaKM2Sm6lG0= X-Google-Smtp-Source: AA0mqf7Dc7Uq8+leIPoqpnz4St30wnOC+w6O3tde6UFVdDnNv8Zusw0P7QU4V9+PxnpkfjXJPd7nJw== X-Received: by 2002:a05:600c:5113:b0:3cf:77c0:48ea with SMTP id o19-20020a05600c511300b003cf77c048eamr66140224wms.130.1670338068055; Tue, 06 Dec 2022 06:47:48 -0800 (PST) Received: from lancelot ([195.147.220.46]) by smtp.gmail.com with ESMTPSA id l5-20020a5d5605000000b002367ad808a9sm16842639wrv.30.2022.12.06.06.47.32 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Dec 2022 06:47:47 -0800 (PST) X-Google-Original-From: Gaius Mulley Received: from gaius by lancelot with local (Exim 4.94.2) (envelope-from ) id 1p2ZEG-004QhV-Lh; Tue, 06 Dec 2022 14:47:28 +0000 Subject: [PATCH v3 16/19] modula2 front end: bootstrap and documentation tools To: , X-Mailer: mail (GNU Mailutils 3.10) Message-Id: Date: Tue, 06 Dec 2022 14:47:28 +0000 X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_FILL_THIS_FORM_SHORT 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Gaius Mulley via Gcc-patches From: Gaius Mulley Reply-To: Gaius Mulley Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Hi Martin, here is the revised patch having applied all previous recommendations: https://gcc.gnu.org/pipermail/gcc-patches/2022-October/603436.html. Is this ok now? Thanks for the improvement suggestions. ------8<----------8<----------8<----------8<----------8<----------8<---- diff -ruw /dev/null gcc-git-devel-modula2/mliska@suse.cz diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/tools-src/tidydates.py --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/tools-src/tidydates.py 2022-12-06 02:56:51.380775219 +0000 @@ -0,0 +1,166 @@ +#!/usr/bin/env python3 + +# utility to tidy dates and detect lack of copyright. + +# Copyright (C) 2016-2022 Free Software Foundation, Inc. +# +# 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 COPYING. If not, write to the +# Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301, USA. + +import os +import sys +import pathlib +import shutil + +max_line_length = 60 + +COPYRIGHT = 'Copyright (C)' + + +def visit_dir(directory, ext, func): + # visit_dir - call func for each file below, dir, matching extension, ext. + list_of_files = os.listdir(directory) + list_of_files.sort() + for filename in list_of_files: + path = pathlib.PurePath(filename) + full = os.path.join(directory, filename) + if path.is_file(full): + if path.suffix == ext: + func(full) + elif path.is_dir(full): + visit_dir(full, ext, func) + + +def is_year(year): + # is_year - returns True if, year, is legal. + if len(year) == 5: + year = year[:-1] + for c in year: + if not c.isdigit(): + return False + return True + + +def handle_copyright(outfile, lines, n, leader1, leader2): + # handle_copyright look for Copyright in the comment. + global max_line_length + i = lines[n] + c = i.find(COPYRIGHT)+len(COPYRIGHT) + outfile.write(i[:c]) + d = i[c:].split() + start = c + seen_date = True + years = [] + while seen_date: + if d == []: + n += 1 + i = lines[n] + d = i[2:].split() + else: + e = d[0] + punctuation = '' + if len(d) == 1: + d = [] + else: + d = d[1:] + if c > max_line_length: + outfile.write('\n') + outfile.write(leader1) + outfile.write(leader2) + outfile.write(' '*(start-2)) + c = start + if is_year(e): + if (e[-1] == '.') or (e[-1] == ','): + punctuation = e[-1] + e = e[:-1] + else: + punctuation = '' + else: + seen_date = False + if seen_date: + if not (e in years): + c += len(e) + len(punctuation) + outfile.write(' ') + outfile.write(e) + outfile.write(punctuation) + years += [e] + else: + if start < c: + outfile.write('\n') + outfile.write(leader1) + outfile.write(leader2) + outfile.write(' '*(start-2)) + + outfile.write(' ') + outfile.write(e) + outfile.write(punctuation) + for w in d: + outfile.write(' ') + outfile.write(w) + outfile.write('\n') + return outfile, n+1 + + +def handle_header(filename, leader1, leader2): + # handle_header reads in the header of a file and inserts + # a line break around the Copyright dates. + print('------------------------------') + lines = open(filename).readlines() + if len(lines) > 20: + with open('tmptidy', 'w') as outfile: + n = 0 + for i in lines: + if i.find('Copyright (C)') >= 0: + outfile, n = handle_copyright(outfile, lines, + n, leader1, leader2) + outfile.writelines(lines[n:]) + outfile.close() + print('-> mv tmptidy', filename) + shutil.move('tmptidy', filename) + return + else: + outfile.write(lines[n]) + n += 1 + sys.stdout.write('%s:1:1 needs a Copyright notice..\n' % filename) + + +def bash_tidy(filename): + # bash_tidy - tidy up dates using '#' comment + handle_header(filename, '#', ' ') + + +def c_tidy(filename): + # c_tidy - tidy up dates using '/* */' comments + handle_header(filename, ' ', '*') + + +def m2_tidy(filename): + # m2_tidy - tidy up dates using '(* *)' comments + handle_header(filename, ' ', ' ') + + +def main(): + # main - for each file extension call the appropriate tidy routine. + visit_dir('.', '.in', bash_tidy) + visit_dir('.', '.py', bash_tidy) + visit_dir('.', '.c', c_tidy) + visit_dir('.', '.h', c_tidy) + visit_dir('.', '.def', m2_tidy) + visit_dir('.', '.mod', m2_tidy) + + +main() diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/tools-src/boilerplate.py --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/tools-src/boilerplate.py 2022-12-06 02:56:51.380775219 +0000 @@ -0,0 +1,548 @@ +#!/usr/bin/env python3 +# +# boilerplate.py utility to rewrite the boilerplate with new dates. +# +# Copyright (C) 2018-2022 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 +# . +# + +import argparse +import datetime +import os +import sys + + +error_count = 0 +seen_files = [] +output_name = None + +ISO_COPYRIGHT = 'Copyright ISO/IEC' +COPYRIGHT = 'Copyright (C)' +GNU_PUBLIC_LICENSE = 'GNU General Public License' +GNU_LESSER_GENERAL = 'GNU Lesser General' +GCC_RUNTIME_LIB_EXC = 'GCC Runtime Library Exception' +VERSION_2_1 = 'version 2.1' +VERSION_2 = 'version 2' +VERSION_3 = 'version 3' +Licenses = {VERSION_2_1: 'v2.1', VERSION_2: 'v2', VERSION_3: 'v3'} +CONTRIBUTED_BY = 'ontributed by' + + +def printf(fmt, *args): + # printf - keeps C programmers happy :-) + print(str(fmt) % args, end=' ') + + +def error(fmt, *args): + # error - issue an error message. + global error_count + + print(str(fmt) % args, end=' ') + error_count += 1 + + +def halt_on_error(): + if error_count > 0: + os.sys.exit(1) + + +def basename(f): + b = f.split('/') + return b[-1] + + +def analyse_comment(text, f): + # analyse_comment determine the license from the top comment. + start_date, end_date = None, None + contribution, summary, lic = None, None, None + if text.find(ISO_COPYRIGHT) > 0: + lic = 'BSISO' + now = datetime.datetime.now() + for d in range(1984, now.year+1): + if text.find(str(d)) > 0: + if start_date is None: + start_date = str(d) + end_date = str(d) + return start_date, end_date, '', '', lic + elif text.find(COPYRIGHT) > 0: + if text.find(GNU_PUBLIC_LICENSE) > 0: + lic = 'GPL' + elif text.find(GNU_LESSER_GENERAL) > 0: + lic = 'LGPL' + for license in Licenses.keys(): + if text.find(license) > 0: + lic += Licenses[license] + if text.find(GCC_RUNTIME_LIB_EXC) > 0: + lic += 'x' + now = datetime.datetime.now() + for d in range(1984, now.year+1): + if text.find(str(d)) > 0: + if start_date is None: + start_date = str(d) + end_date = str(d) + if text.find(CONTRIBUTED_BY) > 0: + i = text.find(CONTRIBUTED_BY) + i += len(CONTRIBUTED_BY) + j = text.index('. ', i) + contribution = text[i:j] + if text.find(basename(f)) > 0: + i = text.find(basename(f)) + j = text.find('. ', i) + if j < 0: + error('summary of the file does not finish with a '.'') + summary = text[i:] + else: + summary = text[i:j] + return start_date, end_date, contribution, summary, lic + + +def analyse_header_without_terminator(f, start): + text = '' + for count, l in enumerate(open(f).readlines()): + parts = l.split(start) + if len(parts) > 1: + line = start.join(parts[1:]) + line = line.strip() + text += ' ' + text += line + elif (l.rstrip() != '') and (len(parts[0]) > 0): + return analyse_comment(text, f), count + return [None, None, None, None, None], 0 + + +def analyse_header_with_terminator(f, start, end): + inComment = False + text = '' + for count, line in enumerate(open(f).readlines()): + while line != '': + line = line.strip() + if inComment: + text += ' ' + pos = line.find(end) + if pos >= 0: + text += line[:pos] + line = line[pos:] + inComment = False + else: + text += line + line = '' + else: + pos = line.find(start) + if (pos >= 0) and (len(line) > len(start)): + before = line[:pos].strip() + if before != '': + return analyse_comment(text, f), count + line = line[pos + len(start):] + inComment = True + elif (line != '') and (line == end): + line = '' + else: + return analyse_comment(text, f), count + return [None, None, None, None, None], 0 + + +def analyse_header(f, start, end): + # analyse_header - + if end is None: + return analyse_header_without_terminator(f, start) + else: + return analyse_header_with_terminator(f, start, end) + + +def add_stop(sentence): + # add_stop - add a full stop to a sentance. + if sentence is None: + return None + sentence = sentence.rstrip() + if (len(sentence) > 0) and (sentence[-1] != '.'): + return sentence + '.' + return sentence + + +GPLv3 = ''' +%s + +Copyright (C) %s Free Software Foundation, Inc. +Contributed by %s + +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 +. +''' + +GPLv3x = ''' +%s + +Copyright (C) %s Free Software Foundation, Inc. +Contributed by %s + +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. + +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 +. +''' + +LGPLv3 = ''' +%s + +Copyright (C) %s Free Software Foundation, Inc. +Contributed by %s + +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 Lesser General Public License as +published by the Free Software Foundation, either version 3 of the +License, 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 +Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public License +along with GNU Modula-2. If not, see . +''' + +BSISO = ''' +Library module defined by the International Standard + Information technology - programming languages + BS ISO/IEC 10514-1:1996E Part 1: Modula-2, Base Language. + + Copyright ISO/IEC (International Organization for Standardization + and International Electrotechnical Commission) %s. + + It may be freely copied for the purpose of implementation (see page + 707 of the Information technology - Programming languages Part 1: + Modula-2, Base Language. BS ISO/IEC 10514-1:1996). +''' + +templates = {} +templates['GPLv3'] = GPLv3 +templates['GPLv3x'] = GPLv3x +templates['LGPLv3'] = LGPLv3 +templates['LGPLv2.1'] = LGPLv3 +templates['BSISO'] = BSISO + + +def write_template(fo, magic, start, end, dates, contribution, summary, lic): + if lic in templates: + if lic == 'BSISO': + # non gpl but freely distributed for the implementation of a + # compiler + text = templates[lic] % (dates) + text = text.rstrip() + else: + summary = summary.lstrip() + contribution = contribution.lstrip() + summary = add_stop(summary) + contribution = add_stop(contribution) + if magic is not None: + fo.write(magic) + fo.write('\n') + text = templates[lic] % (summary, dates, contribution) + text = text.rstrip() + if end is None: + text = text.split('\n') + for line in text: + fo.write(start) + fo.write(' ') + fo.write(line) + fo.write('\n') + else: + text = text.lstrip() + fo.write(start) + fo.write(' ') + fo.write(text) + fo.write(' ') + fo.write(end) + fo.write('\n') + # add a blank comment line for a script for eye candy. + if start == '#' and end is None: + fo.write(start) + fo.write('\n') + else: + error('no template found for: %s\n', lic) + os.sys.exit(1) + return fo + + +def write_boiler_plate(fo, magic, start, end, + start_date, end_date, contribution, summary, gpl): + if start_date == end_date: + dates = start_date + else: + dates = '%s-%s' % (start_date, end_date) + return write_template(fo, magic, start, end, + dates, contribution, summary, gpl) + + +def rewrite_file(f, magic, start, end, start_date, end_date, + contribution, summary, gpl, lines): + text = ''.join(open(f).readlines()[lines:]) + if output_name == '-': + fo = sys.stdout + else: + fo = open(f, 'w') + fo = write_boiler_plate(fo, magic, start, end, + start_date, end_date, contribution, summary, gpl) + fo.write(text) + fo.flush() + if output_name != '-': + fo.close() + + +def handle_header(f, magic, start, end): + # handle_header keep reading lines of file, f, looking for start, end + # sequences and comments inside. The comments are checked for: + # date, contribution, summary + global error_count + + error_count = 0 + [start_date, end_date, + contribution, summary, lic], lines = analyse_header(f, start, end) + if lic is None: + error('%s:1:no GPL found at the top of the file\n', f) + else: + if args.verbose: + printf('copyright: %s\n', lic) + if (start_date is not None) and (end_date is not None): + if start_date == end_date: + printf('dates = %s\n', start_date) + else: + printf('dates = %s-%s\n', start_date, end_date) + if summary is not None: + printf('summary: %s\n', summary) + if contribution is not None: + printf('contribution: %s\n', contribution) + if start_date is None: + error('%s:1:no date found in the GPL at the top of the file\n', f) + if args.contribution is None: + if contribution == '': + error('%s:1:no contribution found in the ' + + 'GPL at the top of the file\n', f) + else: + contribution = args.contribution + if summary is None: + if args.summary == '': + error('%s:1:no single line summary found in the ' + + 'GPL at the top of the file\n', f) + else: + summary = args.summary + if error_count == 0: + now = datetime.datetime.now() + if args.no: + print(f, 'suppressing change as requested: %s-%s %s' + % (start_date, end_date, lic)) + else: + if lic == 'BSISO': + # don't change the BS ISO license! + pass + elif args.extensions: + lic = 'GPLv3x' + elif args.gpl3: + lic = 'GPLv3' + rewrite_file(f, magic, start, end, start_date, + str(now.year), contribution, summary, lic, lines) + else: + printf('too many errors, no modifications will occur\n') + + +def bash_tidy(f): + # bash_tidy tidy up dates using '#' comment + handle_header(f, '#!/bin/bash', '#', None) + + +def python_tidy(f): + # python_tidy tidy up dates using '#' comment + handle_header(f, '#!/usr/bin/env python3', '#', None) + + +def bnf_tidy(f): + # bnf_tidy tidy up dates using '--' comment + handle_header(f, None, '--', None) + + +def c_tidy(f): + # c_tidy tidy up dates using '/* */' comments + handle_header(f, None, '/*', '*/') + + +def m2_tidy(f): + # m2_tidy tidy up dates using '(* *)' comments + handle_header(f, None, '(*', '*)') + + +def in_tidy(f): + # in_tidy tidy up dates using '#' as a comment and check + # the first line for magic number. + first = open(f).readlines()[0] + if (len(first) > 0) and (first[:2] == '#!'): + # magic number found, use this + handle_header(f, first, '#', None) + else: + handle_header(f, None, '#', None) + + +def do_visit(args, dirname, names): + # do_visit helper function to call func on every extension file. + global output_name + func, extension = args + for f in names: + if len(f) > len(extension) and f[-len(extension):] == extension: + output_name = f + func(os.path.join(dirname, f)) + + +def visit_dir(startDir, ext, func): + # visit_dir call func for each file in startDir which has ext. + global output_name, seen_files + for dirName, subdirList, fileList in os.walk(startDir): + for fname in fileList: + if (len(fname) > len(ext)) and (fname[-len(ext):] == ext): + fullpath = os.path.join(dirName, fname) + output_name = fullpath + if not (fullpath in seen_files): + seen_files += [fullpath] + func(fullpath) + # Remove the first entry in the list of sub-directories + # if there are any sub-directories present + if len(subdirList) > 0: + del subdirList[0] + + +def find_files(): + # find_files for each file extension call the appropriate tidy routine. + visit_dir(args.recursive, '.h.in', c_tidy) + visit_dir(args.recursive, '.in', in_tidy) + visit_dir(args.recursive, '.sh', in_tidy) + visit_dir(args.recursive, '.py', python_tidy) + visit_dir(args.recursive, '.c', c_tidy) + visit_dir(args.recursive, '.h', c_tidy) + visit_dir(args.recursive, '.cc', c_tidy) + visit_dir(args.recursive, '.def', m2_tidy) + visit_dir(args.recursive, '.mod', m2_tidy) + visit_dir(args.recursive, '.bnf', bnf_tidy) + + +def handle_arguments(): + # handle_arguments create and return the args object. + parser = argparse.ArgumentParser() + parser.add_argument('-c', '--contribution', + help='set the contribution string ' + + 'at the top of the file.', + default='', action='store') + parser.add_argument('-d', '--debug', help='turn on internal debugging.', + default=False, action='store_true') + parser.add_argument('-f', '--force', + help='force a check to insist that the ' + + 'contribution, summary and GPL exist.', + default=False, action='store_true') + parser.add_argument('-g', '--gplv3', help='change to GPLv3', + default=False, action='store_true') + parser.add_argument('-o', '--outputfile', help='set the output file', + default='-', action='store') + parser.add_argument('-r', '--recursive', + help='recusively scan directory for known file ' + + 'extensions (.def, .mod, .c, .h, .py, .in, .sh).', + default='.', action='store') + parser.add_argument('-s', '--summary', + help='set the summary line for the file.', + default=None, action='store') + parser.add_argument('-u', '--update', help='update all dates.', + default=False, action='store_true') + parser.add_argument('-v', '--verbose', + help='display copyright, ' + + 'date and contribution messages', + action='store_true') + parser.add_argument('-x', '--extensions', + help='change to GPLv3 with GCC runtime extensions.', + default=False, action='store_true') + parser.add_argument('-N', '--no', + help='do not modify any file.', + action='store_true') + args = parser.parse_args() + return args + + +def has_ext(name, ext): + # has_ext return True if, name, ends with, ext. + if len(name) > len(ext): + return name[-len(ext):] == ext + return False + + +def single_file(name): + # single_file scan the single file for a GPL boilerplate which + # has a GPL, contribution field and a summary heading. + if has_ext(name, '.def') or has_ext(name, '.mod'): + m2_tidy(name) + elif has_ext(name, '.h') or has_ext(name, '.c') or has_ext(name, '.cc'): + c_tidy(name) + elif has_ext(name, '.in'): + in_tidy(name) + elif has_ext(name, '.sh'): + in_tidy(name) # uses magic number for actual sh/bash + elif has_ext(name, '.py'): + python_tidy(name) + + +def main(): + # main - handle_arguments and then find source files. + global args, output_name + args = handle_arguments() + output_name = args.outputfile + if args.recursive: + find_files() + elif args.inputfile is None: + print('an input file must be specified on the command line') + else: + single_file(args.inputfile) + halt_on_error() + + +main() diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/tools-src/buildpg --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/tools-src/buildpg 2022-12-06 02:56:51.380775219 +0000 @@ -0,0 +1,289 @@ +#!/bin/sh + +# Copyright (C) 2000-2022 Free Software Foundation, Inc. +# 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 COPYING. If not, write to the +# Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301, USA. +# + +# builds the pg.bnf from ppg.mod +# usage buildpg ppg.mod destination [-e] +# -e build without error recovery +# +PPGSRC=$1 +PPGDST=$2 + +includeNonErrorChecking () { + sed -e "1,/StartNonErrorChecking/d" < $PPGSRC |\ + sed -e "1,/EndNonErrorChecking/!d" +} + +includeErrorChecking () { + sed -e "1,/StartErrorChecking/d" < $PPGSRC |\ + sed -e "1,/EndErrorChecking/!d" +} + + +echo "% module" $PPGDST "begin" +sed -e "1,/% declaration/!d" < $PPGSRC | sed -e "s/ppg/${PPGDST}/g" + +echo "% declaration" $PPGDST "begin" + +sed -e "1,/% declaration/d" < $PPGSRC | sed -e "1,/% rules/!d" | sed -e "s/ppg/${PPGDST}/g" + +if [ "$3" = "-e" ] ; then + includeNonErrorChecking + echo "% module" $PPGDST "end" + sed -e "1,/% module pg end/d" < $PPGSRC | sed -e "s/ppg/${PPGDST}/g" +else + includeErrorChecking + echo "% module" $PPGDST "end" + sed -e "1,/% module pg end/d" < $PPGSRC | sed -e "s/ppg/${PPGDST}/g" |\ + sed -e "s/WasNoError := Main() ;/Main({eoftok}) ;/" +fi + +echo "% rules" + +cat << EOFEOF | sed -e "s/ppg/${PPGDST}/g" +error 'WarnError' 'WarnString' +tokenfunc 'GetCurrentTokenType()' + +token 'identifier' identtok -- internal token +token 'literal' literaltok +token '%' codetok +token ':=' lbecomestok +token '=:' rbecomestok +token '|' bartok +token '[' lsparatok +token ']' rsparatok +token '{' lcparatok -- left curly para +token '}' rcparatok -- right curly para +token '(' lparatok +token ')' rparatok +token "error" errortok +token "tokenfunc" tfunctok +token "symfunc" symfunctok +token '"' dquotetok +token "'" squotetok +token "module" moduletok +token "begin" begintok +token "rules" rulestok +token "end" endtok +token '<' lesstok +token '>' gretok +token "token" tokentok +token "special" specialtok +token "first" firsttok +token "follow" followtok +token "BNF" BNFtok +token "FNB" FNBtok +token "declaration" declarationtok +token "epsilon" epsilontok +token '' eoftok -- internal token + +special Ident first { < identtok > } follow { } +special Modula2Code first { } follow { '%' } +special StartModName first { < identtok > } follow { } +special EndModName first { < identtok > } follow { } +special DoDeclaration first { < identtok > } follow { } +special CollectLiteral first { < literaltok > } follow { } +special CollectTok first { < identtok > } follow { } +special DefineToken first { < identtok > } follow { } + +BNF + +Rules := "%" "rules" { Defs } ExtBNF =: + +Special := Ident + % VAR p: ProductionDesc ; % + % p := NewProduction() ; + p^.statement := NewStatement() ; + p^.statement^.followinfo^.calcfollow := TRUE ; + p^.statement^.followinfo^.epsilon := false ; + p^.statement^.followinfo^.reachend := false ; + p^.statement^.ident := CurrentIdent ; + p^.statement^.expr := NIL ; + p^.firstsolved := TRUE ; + p^.followinfo^.calcfollow := TRUE ; + p^.followinfo^.epsilon := false ; + p^.followinfo^.reachend := false % + First Follow [ "epsilon" % p^.statement^.followinfo^.epsilon := true ; (* these are not used - but they are displayed when debugging *) + p^.statement^.followinfo^.reachend := true ; + p^.followinfo^.epsilon := true ; + p^.followinfo^.reachend := true + % ] + [ Literal % p^.description := LastLiteral % ] + =: + +Factor := "%" Modula2Code "%" | + Ident % WITH CurrentFactor^ DO + type := id ; + ident := CurrentIdent + END ; % | + Literal % WITH CurrentFactor^ DO + type := lit ; + string := LastLiteral ; + IF GetSymKey(Aliases, LastLiteral)=NulName + THEN + WarnError1('no token defined for literal %s', LastLiteral) + END + END ; % | + "{" % WITH CurrentFactor^ DO + type := mult ; + expr := NewExpression() ; + CurrentExpression := expr ; + END ; % + Expression "}" | + "[" % WITH CurrentFactor^ DO + type := opt ; + expr := NewExpression() ; + CurrentExpression := expr ; + END ; % + Expression "]" | + "(" % WITH CurrentFactor^ DO + type := sub ; + expr := NewExpression() ; + CurrentExpression := expr ; + END ; % + Expression ")" =: + +Statement := % VAR i: IdentDesc ; % + Ident + % VAR p: ProductionDesc ; % + % p := FindDefinition(CurrentIdent^.name) ; + IF p=NIL + THEN + p := NewProduction() + ELSE + IF NOT ((p^.statement=NIL) OR (p^.statement^.expr=NIL)) + THEN + WarnError1('already declared rule %s', CurrentIdent^.name) + END + END ; + i := CurrentIdent ; % + ":=" + % VAR e: ExpressionDesc ; % + % e := NewExpression() ; + CurrentExpression := e ; % + % VAR s: StatementDesc ; % + % s := NewStatement() ; + WITH s^ DO + ident := i ; + expr := e + END ; % + Expression + % p^.statement := s ; % + "=:" =: + +Defs := "special" Special | "token" Token | "error" ErrorProcedures | + "tokenfunc" TokenProcedure | "symfunc" SymProcedure =: +ExtBNF := "BNF" { Production } "FNB" =: +Main := Header Decls Footer Rules =: +Header := "%" "module" StartModName =: +Decls := "%" "declaration" DoDeclaration =: +Footer := "%" "module" EndModName =: + +First := "first" "{" { LitOrTokenOrIdent + % WITH CurrentSetDesc^ DO + next := TailProduction^.first ; + END ; + TailProduction^.first := CurrentSetDesc + % + } "}" =: +Follow := "follow" "{" { LitOrTokenOrIdent + % WITH CurrentSetDesc^ DO + next := TailProduction^.followinfo^.follow ; + END ; + TailProduction^.followinfo^.follow := CurrentSetDesc + % + } "}" =: +LitOrTokenOrIdent := Literal % CurrentSetDesc := NewSetDesc() ; + WITH CurrentSetDesc^ DO + type := litel ; + string := LastLiteral ; + END ; + % | + '<' CollectTok '>' | + Ident % CurrentSetDesc := NewSetDesc() ; + WITH CurrentSetDesc^ DO + type := idel ; + ident := CurrentIdent ; + END ; + % =: + +Literal := '"' CollectLiteral '"' | + "'" CollectLiteral "'" =: + +CollectTok := % CurrentSetDesc := NewSetDesc() ; + WITH CurrentSetDesc^ DO + type := tokel ; + string := GetCurrentToken() ; + END ; + IF NOT ContainsSymKey(Values, GetCurrentToken()) + THEN + AddEntry(Values, GetCurrentToken(), LargestValue) ; + AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ; + AddEntry(Aliases, GetCurrentToken(), GetCurrentToken()) ; + AddEntry(ReverseAliases, GetCurrentToken(), GetCurrentToken()) ; + INC(LargestValue) + END ; + AdvanceToken() ; % =: + +CollectLiteral := % LastLiteral := GetCurrentToken() ; + AdvanceToken ; % =: + +DefineToken := % AddEntry(Aliases, LastLiteral, GetCurrentToken()) ; + AddEntry(ReverseAliases, GetCurrentToken(), LastLiteral) ; + AddEntry(Values, GetCurrentToken(), LargestValue) ; + AddEntry(ReverseValues, Name(LargestValue), GetCurrentToken()) ; + INC(LargestValue) ; + AdvanceToken ; % =: + +Token := Literal DefineToken =: + +ErrorProcedures := Literal % ErrorProcArray := LastLiteral % + Literal % ErrorProcString := LastLiteral % =: +TokenProcedure := Literal % TokenTypeProc := LastLiteral % =: +SymProcedure := Literal % SymIsProc := LastLiteral % =: + +Production := Statement =: +Expression := % VAR t1, t2: TermDesc ; + e : ExpressionDesc ; % + % e := CurrentExpression ; + t1 := NewTerm() ; + CurrentTerm := t1 ; % + Term % e^.term := t1 ; % + { "|" % t2 := NewTerm() ; + CurrentTerm := t2 % + Term % t1^.next := t2 ; + t1 := t2 % } =: + +Term := % VAR t1: TermDesc ; f1, f2: FactorDesc ; % + % CurrentFactor := NewFactor() ; + f1 := CurrentFactor ; + t1 := CurrentTerm ; % + Factor % t1^.factor := f1 ; + f2 := NewFactor() ; + CurrentFactor := f2 % + { Factor % f1^.next := f2 ; + f1 := f2 ; + f2 := NewFactor() ; + CurrentFactor := f2 ; % } + =: + +FNB + +EOFEOF diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/tools-src/calcpath --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/tools-src/calcpath 2022-12-06 02:56:51.380775219 +0000 @@ -0,0 +1,51 @@ +#!/bin/sh + +# calcpath return a path which is $1/$2/$3 when $2 is relative and $2/$3 if absolute. + +# Copyright (C) 2021-2022 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 gm2; see the file COPYING. If not, write to the Free Software +# Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) + + +Usage () { + echo "Usage: calcpath pathcomponent1 pathcomponent2 subdir" + echo -n " if pathcomponent1 is relative then pathcomponent1/pathcomponet2/subdir is" + echo " returned" + echo " otherwise pathcomponet2/subdir is returned" + echo " the path is checked for legality in subdir." +} + + +if [ $# -eq 3 ]; then + if [ "$(echo $2 | cut -b 1)" = "." ] ; then + # relative path + the_path=$1/$2/$3 + else + the_path=$2/$3 + fi + cd $3 + if realpath ${the_path} > /dev/null ; then + echo ${the_path} + else + echo "calcpath: error ${the_path} is not a valid path in subdirectory $3" 1>&2 + exit 1 + fi +else + Usage + exit 1 +fi diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/tools-src/makeSystem --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/tools-src/makeSystem 2022-12-06 02:56:51.380775219 +0000 @@ -0,0 +1,108 @@ +#!/bin/sh + +# makeSystem creates a target SYSTEM.def using the appropriate dialect template. + +# Copyright (C) 2008-2022 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 gm2; see the file COPYING. If not, write to the Free Software +# Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) + + +Usage () { + echo "Usage: makesystem dialectflag SYSTEM.def SYSTEM.mod librarypath compiler" +} + +if [ $# -lt 6 ] ; then + Usage + exit 1 +fi + +DIALECT=$1 +SYSTEMDEF=$2 +SYSTEMMOD=$3 +LIBRARY=$4 +COMPILER=$5 +OUTPUTFILE=$6 + +if [ "$COMPILER" = "" ] ; then + echo "parameter 5 of makeSystem is incorrect, GM2_FOR_TARGET was unset" + exit 1 +fi + +if [ "$DIALECT" != "-fiso" -a "$DIALECT" != "-fpim" ] ; then + Usage + echo "dialect must be -fiso or -fpim" + exit 1 +fi + +displayExportedTypes () { + n=1 + c=0 + for i in ${types} ; do + if [ $n -eq 1 ] ; then + n=0 + echo -n " " >> ${OUTPUTFILE} + fi + echo -n "$i, " >> ${OUTPUTFILE} + if [ $c -eq 4 ] ; then + echo " " >> ${OUTPUTFILE} + n=1 + c=0 + fi + c=`expr $c + 1` + done + echo " " >> ${OUTPUTFILE} +} + +displayBuiltinTypes () { + for i in ${types} ; do + echo " $i ; " >> ${OUTPUTFILE} + done +} + +displayStart () { + sed -e "1,/@SYSTEM_DATATYPES@/!d" < ${SYSTEMDEF} | \ + sed -e "/@SYSTEM_DATATYPES@/d" >> ${OUTPUTFILE} +} + +displayMiddle () { + sed -e "1,/@SYSTEM_DATATYPES@/d" < ${SYSTEMDEF} | \ + sed -e "1,/@SYSTEM_TYPES@/!d" | \ + sed -e "/@SYSTEM_TYPES@/d" >> ${OUTPUTFILE} +} + +displayEnd () { + sed -e "1,/@SYSTEM_TYPES@/d" < ${SYSTEMDEF} >> ${OUTPUTFILE} +} + +MINIMAL="-fno-scaffold-main -fno-scaffold-dynamic -fno-scaffold-static -fno-m2-plugin" + +rm -f ${OUTPUTFILE} +if ${COMPILER} ${DIALECT} ${LIBRARY} ${MINIMAL} \ + -c -fdump-system-exports ${SYSTEMMOD} -o /dev/null 2>&1 > /dev/null ; then + types=`${COMPILER} ${DIALECT} ${LIBRARY} ${MINIMAL} -fno-m2-plugin -c -fdump-system-exports ${SYSTEMMOD} -o /dev/null | cut -f5 -d' '` + touch ${OUTPUTFILE} + displayStart + displayExportedTypes + displayMiddle + displayBuiltinTypes + displayEnd +else + ${COMPILER} ${DIALECT} ${LIBRARY} ${MINIMAL} \ + -c -fdump-system-exports ${SYSTEMMOD} -o /dev/null + exit $? +fi diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/tools-src/README --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/tools-src/README 2022-12-06 02:56:51.380775219 +0000 @@ -0,0 +1,3 @@ +This directory contains miscellaneous scripts and programs (mklink.c) +to allow for bootstrap linking and creating library documentation from +sources. \ No newline at end of file diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/tools-src/def2doc.py --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/tools-src/def2doc.py 2022-12-06 02:56:51.380775219 +0000 @@ -0,0 +1,519 @@ +#!/usr/bin/env python3 + +# def2doc.py creates texi library documentation for all exported procedures. +# Contributed by Gaius Mulley . + +# Copyright (C) 2000-2022 Free Software Foundation, Inc. +# 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 COPYING. If not, write to the +# Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301, USA. +# + +import argparse +import os +import sys + +Base_Libs = ['gm2-libs', 'Base libraries', 'Basic M2F compatible libraries'] + +PIM_Log_Desc = 'PIM and Logitech 3.0 compatible libraries' +PIM_Log = ['gm2-libs-pim', 'PIM and Logitech 3.0 Compatible', PIM_Log_Desc] +PIM_Cor_Desc = 'PIM compatible process support' +PIM_Cor = ['gm2-libs-coroutines', 'PIM coroutine support', PIM_Cor_Desc] +ISO_Libs = ['gm2-libs-iso', 'M2 ISO Libraries', 'ISO defined libraries'] + +library_classifications = [Base_Libs, PIM_Log, PIM_Cor, ISO_Libs] + +# state_states +state_none, state_var, state_type, state_const = range(4) +# block states +block_none, block_code, block_text, block_index = range(4) + + +class state: + def __init__(self): + self._state_state = state_none + self._block = block_none + def get_state (self): + return self._state_state + def set_state (self, value): + self._state_state = value + def is_const(self): + return self._state_state == state_const + def is_type(self): + return self._state_state == state_type + def is_var(self): + return self._state_state == state_var + def get_block(self): + return self._block + def _change_block(self, new_block): + if self._block != new_block: + self._block = new_block + self._emit_block_desc() + def _emit_block_desc(self): + if self._block == block_code: + output.write('.. code-block:: modula2\n') + elif self._block == block_index: + output.write('.. index::\n') + def to_code(self): + self._change_block(block_code) + def to_index(self): + self._change_block(block_index) + + +def init_state(): + global state_obj + state_obj = state() + + +def emit_node(name, nxt, previous, up): + if args.texinfo: + output.write('@node ' + name + ', ' + nxt + ', ') + output.write(previous + ', ' + up + '\n') + elif args.sphinx: + output.write('@c @node ' + name + ', ' + nxt + ', ') + output.write(previous + ', ' + up + '\n') + + +def emit_section(name): + if args.texinfo: + output.write('@section ' + name + '\n') + elif args.sphinx: + output.write(name + '\n') + output.write('=' * len(name) + '\n') + + +def emit_sub_section(name): + if args.texinfo: + output.write('@subsection ' + name + '\n') + elif args.sphinx: + output.write(name + '\n') + output.write('-' * len(name) + '\n') + + +def display_library_class(): + # display_library_class displays a node for a library directory and invokes + # a routine to summarize each module. + global args + previous = '' + nxt = library_classifications[1][1] + i = 0 + lib = library_classifications[i] + while True: + emit_node(lib[1], nxt, previous, args.up) + emit_section(lib[1]) + output.write('\n') + display_modules(lib[1], lib[0], args.builddir, args.sourcedir) + output.write('\n') + output.write('@c ' + '-' * 60 + '\n') + previous = lib[1] + i += 1 + if i == len(library_classifications): + break + lib = library_classifications[i] + if i+1 == len(library_classifications): + nxt = '' + else: + nxt = library_classifications[i+1][1] + + +def display_menu(): + # display_menu displays the top level menu for library documentation. + output.write('@menu\n') + for lib in library_classifications: + output.write('* ' + lib[1] + '::' + lib[2] + '\n') + output.write('@end menu\n') + output.write('\n') + output.write('@c ' + '=' * 60 + '\n') + output.write('\n') + + +def remote_initial_comments(file, line): + # remote_initial_comments removes any (* *) at the top + # of the definition module. + while (line.find('*)') == -1): + line = file.readline() + + +def removeable_field(line): + # removeable_field - returns True if a comment field should be removed + # from the definition module. + field_list = ['Author', 'Last edit', 'LastEdit', 'Last update', + 'Date', 'Title', 'Revision'] + for field in field_list: + if (line.find(field) != -1) and (line.find(':') != -1): + return True + ignore_list = ['System', 'SYSTEM'] + for ignore_field in ignore_list: + if line.find(ignore_field) != -1: + if line.find(':') != -1: + if line.find('Description:') == -1: + return True + return False + + +def remove_fields(file, line): + # remove_fields removes Author/Date/Last edit/SYSTEM/Revision + # fields from a comment within the start of a definition module. + while (line.find('*)') == -1): + if not removeable_field(line): + output.write(str.replace(str.replace(str.rstrip(line), + '{', '@{'), '}', '@}') + '\n') + line = file.readline() + output.write(line.rstrip() + '\n') + + +def emit_index(entry, tag): + global state_obj + if args.texinfo: + if tag == '': + output.write('@findex ' + entry.rstrip() + '\n') + else: + output.write('@findex ' + entry.rstrip() + ' ' + tag + '\n') + elif args.sphinx: + if tag == '': + state_obj.to_index() + output.write(' ' * 3 + entry.rstrip() + '\n') + else: + state_obj.to_index() + output.write(' ' * 3 + 'pair: ' + entry.rstrip() + '; ' + tag + '\n') + + +def check_index(line): + # check_index - create an index entry for a PROCEDURE, TYPE, CONST or VAR. + global state_obj + + words = line.split() + procedure = '' + if (len(words) > 1) and (words[0] == 'PROCEDURE'): + state_obj.set_state(state_none) + if (words[1] == '__BUILTIN__') and (len(words) > 2): + procedure = words[2] + else: + procedure = words[1] + if (len(line) > 1) and (line[0:2] == '(*'): + state_obj.set_state(state_none) + elif line == 'VAR': + state_obj.set_state(state_var) + return + elif line == 'TYPE': + state_obj.set_state(state_type) + return + elif line == 'CONST': + state_obj.set_state(state_const) + if state_obj.is_var(): + words = line.split(',') + for word in words: + word = word.lstrip() + if word != '': + if word.find(':') == -1: + emit_index(word, '(var)') + elif len(word) > 0: + var = word.split(':') + if len(var) > 0: + emit_index(var[0], '(var)') + if state_obj.is_type(): + words = line.lstrip() + if words.find('=') != -1: + word = words.split('=') + if (len(word[0]) > 0) and (word[0][0] != '_'): + emit_index(word[0].rstrip(), '(type)') + else: + word = words.split() + if (len(word) > 1) and (word[1] == ';'): + # hidden type + if (len(word[0]) > 0) and (word[0][0] != '_'): + emit_index(word[0].rstrip(), '(type)') + if state_obj.is_const(): + words = line.split(';') + for word in words: + word = word.lstrip() + if word != '': + if word.find('=') != -1: + var = word.split('=') + if len(var) > 0: + emit_index(var[0], '(const)') + if procedure != '': + name = procedure.split('(') + if name[0] != '': + proc = name[0] + if proc[-1] == ';': + proc = proc[:-1] + if proc != '': + emit_index(proc, '') + + +def emit_texinfo_content(f, line): + global state_obj + state_obj.to_code() + output.write(line.rstrip() + '\n') + line = f.readline() + if len(line.rstrip()) == 0: + output.write('\n') + line = f.readline() + if (line.find('(*') != -1): + remove_fields(f, line) + else: + output.write(line.rstrip() + '\n') + else: + output.write(line.rstrip() + '\n') + line = f.readline() + while line: + line = line.rstrip() + check_index(line) + state_obj.to_code() + output.write(str.replace(str.replace(line, '{', '@{'), '}', '@}')) + output.write('\n') + line = f.readline() + return f + + +def emit_sphinx_content(f, line): + global state_obj + state_obj.to_code() + indent = ' ' * 4 + output.write(indent + line.rstrip() + '\n') + line = f.readline() + if len(line.rstrip()) == 0: + output.write('\n') + line = f.readline() + if (line.find('(*') != -1): + remove_fields(f, line) + else: + output.write(indent + line.rstrip() + '\n') + else: + output.write(indent + line.rstrip() + '\n') + line = f.readline() + while line: + line = line.rstrip() + check_index(line) + state_obj.to_code() + output.write(indent + line + '\n') + line = f.readline() + return f + + +def emit_example_content(f, line): + if args.texinfo: + return emit_texinfo_content(f, line) + elif args.sphinx: + return emit_sphinx_content(f, line) + + +def emit_example_begin(): + if args.texinfo: + output.write('@example\n') + + +def emit_example_end(): + if args.texinfo: + output.write('@end example\n') + + +def emit_page(need_page): + if need_page and args.texinfo: + output.write('@page\n') + + +def parse_definition(dir, source, build, file, need_page): + # parse_definition reads a definition module and creates + # indices for procedures, constants, variables and types. + output.write('\n') + with open(find_file(dir, build, source, file), 'r') as f: + init_state() + line = f.readline() + while (line.find('(*') != -1): + remote_initial_comments(f, line) + line = f.readline() + while (line.find('DEFINITION') == -1): + line = f.readline() + emit_example_begin() + f = emit_example_content(f, line) + emit_example_end() + emit_page(need_page) + + +def parse_modules(up, dir, build, source, list_of_modules): + previous = '' + i = 0 + if len(list_of_modules) > 1: + nxt = dir + '/' + list_of_modules[1][:-4] + else: + nxt = '' + while i < len(list_of_modules): + emit_node(dir + '/' + list_of_modules[i][:-4], nxt, previous, up) + emit_sub_section(dir + '/' + list_of_modules[i][:-4]) + parse_definition(dir, source, build, list_of_modules[i], True) + output.write('\n') + previous = dir + '/' + list_of_modules[i][:-4] + i = i + 1 + if i+1 < len(list_of_modules): + nxt = dir + '/' + list_of_modules[i+1][:-4] + else: + nxt = '' + + +def do_cat(name): + # do_cat displays the contents of file, name, to stdout + with open(name, 'r') as file: + line = file.readline() + while line: + output.write(line.rstrip() + '\n') + line = file.readline() + + +def module_menu(dir, build, source): + # module_menu generates a simple menu for all definition modules + # in dir + output.write('@menu\n') + list_of_files = [] + if os.path.exists(os.path.join(source, dir)): + list_of_files += os.listdir(os.path.join(source, dir)) + if os.path.exists(os.path.join(source, dir)): + list_of_files += os.listdir(os.path.join(build, dir)) + list_of_files = list(dict.fromkeys(list_of_files).keys()) + list_of_files.sort() + for file in list_of_files: + if found_file(dir, build, source, file): + if (len(file) > 4) and (file[-4:] == '.def'): + output.write('* ' + dir + '/' + file[:-4] + '::' + file + '\n') + output.write('@end menu\n') + output.write('\n') + + +def check_directory(dir, build, source): + # check_directory - returns True if dir exists in either build or source. + if os.path.isdir(build) and os.path.exists(os.path.join(build, dir)): + return True + elif os.path.isdir(source) and os.path.exists(os.path.join(source, dir)): + return True + else: + return False + + +def found_file(dir, build, source, file): + # found_file return True if file is found in build/dir/file or + # source/dir/file. + name = os.path.join(os.path.join(build, dir), file) + if os.path.exists(name): + return True + name = os.path.join(os.path.join(source, dir), file) + if os.path.exists(name): + return True + return False + + +def find_file(dir, build, source, file): + # find_file return the path to file searching in build/dir/file + # first then source/dir/file. + name1 = os.path.join(os.path.join(build, dir), file) + if os.path.exists(name1): + return name1 + name2 = os.path.join(os.path.join(source, dir), file) + if os.path.exists(name2): + return name2 + sys.stderr.write('file cannot be found in either ' + name1) + sys.stderr.write(' or ' + name2 + '\n') + os.sys.exit(1) + + +def display_modules(up, dir, build, source): + # display_modules walks though the files in dir and parses + # definition modules and includes README.texi + if check_directory(dir, build, source): + if args.texinfo: + ext = ".texi" + elif args.sphinx: + ext = ".rst" + else: + ext = "" + if found_file(dir, build, source, 'README' + ext): + do_cat(find_file(dir, build, source, 'README' + ext)) + module_menu(dir, build, source) + list_of_files = [] + if os.path.exists(os.path.join(source, dir)): + list_of_files += os.listdir(os.path.join(source, dir)) + if os.path.exists(os.path.join(source, dir)): + list_of_files += os.listdir(os.path.join(build, dir)) + list_of_files = list(dict.fromkeys(list_of_files).keys()) + list_of_files.sort() + list_of_modules = [] + for file in list_of_files: + if found_file(dir, build, source, file): + if (len(file) > 4) and (file[-4:] == '.def'): + list_of_modules += [file] + list_of_modules.sort() + parse_modules(up, dir, build, source, list_of_modules) + else: + line = 'directory ' + dir + ' not found in either ' + line += build + ' or ' + source + sys.stderr.write(line + '\n') + + +def display_copyright(): + output.write('@c Copyright (C) 2000-2022 Free Software Foundation, Inc.\n') + output.write('@c This file is part of GNU Modula-2.\n') + output.write(''' +@c Permission is granted to copy, distribute and/or modify this document +@c under the terms of the GNU Free Documentation License, Version 1.2 or +@c any later version published by the Free Software Foundation. +''') + + +def collect_args(): + parser = argparse.ArgumentParser() + parser.add_argument('-v', '--verbose', help='generate progress messages', + action='store_true') + parser.add_argument('-b', '--builddir', help='set the build directory', + default='.', action='store') + parser.add_argument('-f', '--inputfile', help='set the input file', + default=None, action='store') + parser.add_argument('-o', '--outputfile', help='set the output file', + default=None, action='store') + parser.add_argument('-s', '--sourcedir', help='set the source directory', + default='.', action='store') + parser.add_argument('-t', '--texinfo', + help='generate texinfo documentation', + default=False, action='store_true') + parser.add_argument('-u', '--up', help='set the up node', + default='', action='store') + parser.add_argument('-x', '--sphinx', help='generate sphinx documentation', + default=False, action='store_true') + args = parser.parse_args() + return args + + +def handle_file(): + if args.inputfile is None: + display_copyright() + display_menu() + display_library_class() + else: + parse_definition('.', args.sourcedir, args.builddir, + args.inputfile, False) + + +def main(): + global args, output + args = collect_args() + if args.outputfile is None: + output = sys.stdout + handle_file() + else: + with open(args.outputfile, 'w') as output: + handle_file() + + +main() diff -ruw /dev/null gcc-git-devel-modula2/gcc/m2/tools-src/mklink.c --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/m2/tools-src/mklink.c 2022-12-06 02:56:51.380775219 +0000 @@ -0,0 +1,807 @@ +/* mklink.c creates startup code and the link command line. + +Copyright (C) 2000-2022 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 +. */ + + +#include "config.h" +#include "system.h" + +#define MAX_FILE_NAME 8192 +#define MAXSTACK 4096 +#define STDIN 0 +#define STDOUT 1 +#define ENDOFILE ((char)-1) +#define ERROR(X) \ + (fprintf (stderr, "%s:%d error %s\n", __FILE__, __LINE__, X) \ + && (fflush (stderr))) +#define DEBUG(X) \ + ((Debug) && (fprintf (stderr, "%s\n", X) && (fflush (stderr)))) + +#if !defined(TRUE) +#define TRUE (1 == 1) +#endif + +#if !defined(FALSE) +#define FALSE (1 == 0) +#endif + +typedef struct functlist +{ + char *functname; + struct functlist *next; +} functList; + +/* Prototypes. */ + +static void ParseFileLinkCommand (void); +static void ParseFileStartup (void); +static void ParseFile (char *Name); +static void ParseComments (void); +static void CopyUntilEof (void); +static void CopyUntilEol (void); +static int IsSym (char *s); +static int SymIs (char *s); +static int FindString (char *String); +static void GetNL (void); +static char GetChar (void); +static void ResetBuffer (void); +static int GetSingleChar (char *ch); +static int InRange (int Element, unsigned int Min, unsigned int Max); +static char PutChar (char ch); +static int IsSpace (char ch); +static void SkipSpaces (void); +static void SkipText (void); +static void SilentSkipSpaces (void); +static void SilentSkipText (void); +static void PushBack (char *s); +static int IsDigit (char ch); +static void GetName (char *Name); +static void OpenOutputFile (void); +static void CloseFile (void); +static void FindSource (char *Name); +static void CopyUntilEolInto (char *Buffer); +static void FindObject (char *Name); +static int IsExists (char *Name); + +/* Global variables. */ + +static char *NameOfFile = NULL; +static const char *NameOfMain = "main"; +static int StackPtr = 0; +static char Stack[MAXSTACK]; +static int CurrentFile = STDIN; +static int OutputFile; +static int LinkCommandLine = FALSE; +static int ProfilePCommand = FALSE; +static int ProfilePGCommand = FALSE; +static int ExitNeeded = TRUE; +static char *libraries = NULL; +static char *args = NULL; +static functList *head = NULL; +static functList *tail = NULL; +static int langC = FALSE; /* FALSE = C++, TRUE = C. */ + +/* addLibrary - adds libname to the list of libraries to be linked. */ + +static void +addLibrary (char *libname) +{ + if (libraries == NULL) + libraries = strdup (libname); + else + { + char *old = libraries; + char *newlib + = (char *)malloc (strlen (libname) + strlen (libraries) + 1 + 1); + strcpy (newlib, libraries); + strcat (newlib, " "); + strcat (newlib, libname); + libraries = newlib; + free (old); + } +} + +/* addGccArg - adds arg to the list of gcc arguments. */ + +static void +addGccArg (char *arg) +{ + if (args == NULL) + args = strdup (arg); + else + { + char *old = args; + char *newarg = (char *)malloc (strlen (old) + strlen (arg) + 1 + 1); + strcpy (newarg, old); + strcat (newarg, " "); + strcat (newarg, arg); + args = newarg; + free (old); + } +} + +int +main (int argc, char *argv[]) +{ + int i; + + if (argc >= 3) + { + if (strcmp (argv[1], "-l") == 0) + LinkCommandLine = TRUE; + else if (strcmp (argv[1], "-s") == 0) + LinkCommandLine = FALSE; + else + { + fprintf (stderr, "Usage: mklink (-l|-s) [--langc|--langc++] [--pg|-p] " + "[--lib library] [--main name] [--exit] --name " + "filename \n"); + fprintf (stderr, " must supply -l or -s option\n"); + exit (1); + } + ProfilePCommand = FALSE; + ProfilePGCommand = FALSE; + i = 2; + while (i < argc - 1) + { + if (strcmp (argv[i], "--langc++") == 0) + langC = FALSE; + else if (strcmp (argv[i], "--langc") == 0) + langC = TRUE; + else if (strncmp (argv[i], "-f", 2) == 0) + addGccArg (argv[i]); + else if (strcmp (argv[i], "--pg") == 0) + ProfilePGCommand = TRUE; + else if (strcmp (argv[i], "-p") == 0) + ProfilePCommand = TRUE; + else if (strcmp (argv[i], "--exit") == 0) + ExitNeeded = FALSE; + else if (strcmp (argv[i], "--lib") == 0) + { + i++; + addLibrary (argv[i]); + } + else if (strcmp (argv[i], "--main") == 0) + { + i++; + NameOfMain = argv[i]; + } + else if (strcmp (argv[i], "--name") == 0) + { + i++; + NameOfFile = argv[i]; + } + i++; + } + ParseFile (argv[i]); + } + else + { + fprintf (stderr, "Usage: mklink (-l|-s) [--gcc|--g++] [--pg|-p] [--lib " + "library] [--main name] [--exit] --name filename " + "\n"); + exit (1); + } + if (NameOfFile == NULL) + { + fprintf (stderr, "mklink must have a --name argument\n"); + fprintf (stderr, "Usage: mklink (-l|-s) [--gcc|--g++] [--pg|-p] [--lib " + "library] [--main name] [--exit] --name filename " + "\n"); + exit (1); + } + exit (0); +} + +/* ParseFile - parses the input file and generates the output file. */ + +static void +ParseFile (char *Name) +{ + FindSource (Name); + OpenOutputFile (); + if (LinkCommandLine) + ParseFileLinkCommand (); + else + ParseFileStartup (); + CloseFile (); +} + +/* ParseFileLinkCommand - generates the link command. */ + +static void +ParseFileLinkCommand (void) +{ + char name[MAX_FILE_NAME]; + char *s = NULL; + char *l = NULL; + char *c = NULL; + + s = getenv ("CC"); + if (s == NULL) + { + if (langC) + printf ("gcc -g "); + else + printf ("g++ -g "); + } + else + printf ("%s -g ", s); + + if (args != NULL) + printf ("%s ", args); + + l = getenv ("LDFLAGS"); + if (l != NULL) + printf ("%s ", l); + + c = getenv ("CFLAGS"); + if (c != NULL) + printf ("%s ", c); + + if (ProfilePGCommand) + printf (" -pg"); + else if (ProfilePCommand) + printf (" -p"); + + while (PutChar (GetChar ()) != (char)EOF) + { + CopyUntilEolInto (name); + if ((strlen (name) > 0) && (name[0] != '#')) + FindObject (name); + } + printf (" %s\n", libraries); +} + +/* FindObject - searches the M2PATH variable to find the object file. + If it finds the object file it prints it to stdout otherwise it + writes an error on stderr. */ + +static void +FindObject (char *Name) +{ + char m2search[4096]; + char m2path[4096]; + char name[4096]; + char exist[4096]; + int s, p; + + if (getenv ("M2PATH") == NULL) + strcpy (m2path, "."); + else + strcpy (m2path, getenv ("M2PATH")); + + snprintf (name, sizeof (name), "%s.o", Name); + p = 0; + while (m2path[p] != (char)0) + { + s = 0; + while ((m2path[p] != (char)0) && (m2path[p] != ' ')) + { + m2search[s] = m2path[p]; + s++; + p++; + } + if (m2path[p] == ' ') + p++; + m2search[s] = (char)0; + snprintf (exist, sizeof (exist), "%s/%s", m2search, name); + if (IsExists (exist)) + { + printf (" %s", exist); + return; + } + } + fprintf (stderr, "cannot find %s\n", name); +} + +/* IsExists - returns true if a file, Name, exists. It returns false + otherwise. */ + +static int +IsExists (char *Name) +{ + struct stat buf; + + return (stat (Name, &buf) == 0); +} + +/* add_function - adds a name to the list of functions, in order. */ + +void +add_function (char *name) +{ + functList *p = (functList *)malloc (sizeof (functList)); + p->functname = (char *)malloc (strlen (name) + 1); + strcpy (p->functname, name); + + if (head == NULL) + { + head = p; + tail = p; + p->next = NULL; + } + else + { + tail->next = p; + tail = p; + tail->next = NULL; + } +} + +static void +GenerateInitCalls (functList *p) +{ + while (p != NULL) + { + printf (" _M2_%s_init (argc, argv, envp);\n", p->functname); + p = p->next; + } +} + +static void +GenerateFinishCalls (functList *p) +{ + if (p->next != NULL) + GenerateFinishCalls (p->next); + printf (" _M2_%s_finish (argc, argv, envp);\n", p->functname); +} + +static void +GeneratePrototypes (functList *p) +{ + while (p != NULL) + { + if (langC) + { + printf ("extern void _M2_%s_init (int argc, char *argv[], char *envp[]);\n", + p->functname); + printf ("extern void _M2_%s_finish (int argc, char *argv[], char *envp[]);\n", + p->functname); + } + else + { + printf ("extern \"C\" void _M2_%s_init (int argc, char *argv[], char *envp[]);\n", + p->functname); + printf ("extern \"C\" void _M2_%s_finish (int argc, char *argv[], char *envp[]);\n", + p->functname); + } + p = p->next; + } +} + +/* ParseFileStartup - generates the startup code. */ + +static void +ParseFileStartup (void) +{ + char name[MAX_FILE_NAME]; + functList *p; + + while (PutChar (GetChar ()) != (char)EOF) + { + CopyUntilEolInto (name); + if ((strlen (name) > 0) && (strcmp (name, "mod_init") != 0) + && (name[0] != '#')) + add_function (name); + } + GeneratePrototypes (head); + printf ("extern"); + if (!langC) + printf (" \"C\""); + printf (" void _exit(int);\n"); + + printf ("\n\nint %s(int argc, char *argv[], char *envp[])\n", NameOfMain); + printf ("{\n"); + GenerateInitCalls (head); + GenerateFinishCalls (head); + if (ExitNeeded) + printf (" _exit(0);\n"); + printf (" return(0);\n"); + printf ("}\n"); +} + +/* OpenOutputFile - shut down stdout and open the new mod_init.c */ + +static void +OpenOutputFile (void) +{ + if (strcmp (NameOfFile, "-") != 0) + { + if (close (STDOUT) != 0) + { + ERROR ("Unable to close stdout"); + exit (1); + } + OutputFile = creat (NameOfFile, 0666); + if (OutputFile != STDOUT) + { + ERROR ("Expected that the file descriptor should be 1"); + } + } +} + +/* CloseFile - flush and close the file. */ + +static void +CloseFile (void) +{ +#if 0 + fflush(stdout); + if (close(STDOUT) != 0) { + ERROR("Unable to close our output file"); exit(1); + } +#endif +} + +/* CopyUntilEof - copies from the current input marker until ENDOFILE + is reached. */ + +static void +CopyUntilEof (void) +{ + char ch; + + while ((ch = GetChar ()) != ENDOFILE) + putchar (ch); +} + +/* CopyUntilEol - copies from the current input marker until '\n' is + reached. */ + +static void +CopyUntilEol (void) +{ + char ch; + + while (((ch = GetChar ()) != '\n') && (ch != (char)EOF)) + putchar (ch); + if (ch == '\n') + putchar (ch); +} + +/* CopyUntilEolInto - copies from the current input marker until '\n' + is reached into a Buffer. */ + +static void +CopyUntilEolInto (char *Buffer) +{ + char ch; + int i = 0; + + while (((ch = GetChar ()) != '\n') && (ch != (char)EOF)) + { + Buffer[i] = ch; + i++; + } + if ((ch == '\n') || (ch == (char)EOF)) + Buffer[i] = (char)0; +} + +/* IsSym - returns true if string, s, was found in the input stream. + The input stream is uneffected. */ + +static int +IsSym (char *s) +{ + int i = 0; + + while ((s[i] != (char)0) && (s[i] == PutChar (GetChar ()))) + { + GetChar (); + i++; + } + if (s[i] == (char)0) + { + PushBack (s); + /* found s in input string. */ + return (TRUE); + } + else + { + /* push back the characters we have scanned. */ + if (i > 0) + { + do + { + i--; + PutChar (s[i]); + } + while (i > 0); + } + return (FALSE); + } +} + +/* SymIs - returns true if string, s, was found in the input stream. + The token s is consumed from the input stream. */ + +static int +SymIs (char *s) +{ + int i = 0; + + while ((s[i] != (char)0) && (s[i] == PutChar (GetChar ()))) + { + GetChar (); + i++; + } + if (s[i] == (char)0) + { + /* found s in input string. */ + return (TRUE); + } + else + { + /* push back the characters we have scanned. */ + if (i > 0) + { + do + { + i--; + PutChar (s[i]); + } + while (i > 0); + } + return (FALSE); + } +} + +/* FindString - keeps on reading input until a string, String, is + matched. If end of file is reached then FALSE is returned, otherwise + TRUE is returned. */ + +static int +FindString (char *String) +{ + int StringIndex = 0; + int Found = FALSE; + int eof = FALSE; + char ch; + + while ((!Found) && (!eof)) + { + if (String[StringIndex] == (char)0) + /* must have found string. */ + Found = TRUE; + else + { + ch = GetChar (); + eof = (ch == ENDOFILE); + if (ch == String[StringIndex]) + StringIndex++; + else + StringIndex = 0; + } + } + return (Found); +} + +/* GetNL - keeps on reading input from until a new line is found. */ + +static void +GetNL (void) +{ + char ch; + + while ((ch = GetChar ()) != '\n') + putchar (ch); + putchar ('\n'); +} + +/* GetChar - returns the current character in input. */ + +static char +GetChar (void) +{ + char ch; + + if (StackPtr > 0) + { + StackPtr--; + return (Stack[StackPtr]); + } + else + { + if (GetSingleChar (&ch)) + return (ch); + else + return (ENDOFILE); + } +} + +#define MAXBUF 0x1000 +static int Pointer = 0; +static int AmountRead = 0; +static char Buffer[MAXBUF]; + +/* ResetBuffer - resets the buffer information to an initial state. */ + +static void +ResetBuffer (void) +{ + StackPtr = 0; + Pointer = 0; + AmountRead = 0; +} + +/* GetSingleChar - gets a single character from input. TRUE is + returned upon success. */ + +static int +GetSingleChar (char *ch) +{ + if (Pointer == AmountRead) + { + AmountRead = read (CurrentFile, &Buffer, MAXBUF); + if (AmountRead < 0) + AmountRead = 0; + Pointer = 0; + } + if (Pointer == AmountRead) + { + *ch = ENDOFILE; + return (FALSE); + } + else + { + *ch = Buffer[Pointer]; + Pointer++; + return (TRUE); + } +} + +/* InRange - returns true if Element is within the range Min..Max. */ + +static int +InRange (int Element, unsigned int Min, unsigned int Max) +{ + return ((Element >= Min) && (Element <= Max)); +} + +/* PutChar - pushes a character back onto input. This character is + also returned. */ + +static char +PutChar (char ch) +{ + if (StackPtr < MAXSTACK) + { + Stack[StackPtr] = ch; + StackPtr++; + } + else + { + ERROR ("Stack overflow in PutChar"); + } + return (ch); +} + +/* IsSpace - returns true if character, ch, is a space. */ + +static int +IsSpace (char ch) +{ + return ((ch == ' ') || (ch == '\t')); +} + +/* SkipSpaces - eats up spaces in input. */ + +static void +SkipSpaces (void) +{ + while (IsSpace (PutChar (GetChar ()))) + putchar (GetChar ()); +} + +/* SilentSkipSpaces - eats up spaces in input. */ + +static void +SilentSkipSpaces (void) +{ + char ch; + + while (IsSpace (PutChar (GetChar ()))) + ch = GetChar (); /* throw away character. */ +} + +/* SkipText - skips ascii text, it does not skip white spaces. */ + +static void +SkipText (void) +{ + while (!IsSpace (PutChar (GetChar ()))) + putchar (GetChar ()); +} + +/* SilentSkipText - skips ascii text, it does not skip white spaces. */ + +static void +SilentSkipText (void) +{ + char ch; + + while (!IsSpace (PutChar (GetChar ()))) + ch = GetChar (); /* throw away character. */ +} + +/* PushBack - pushes a string, backwards onto the input stack. */ + +static void +PushBack (char *s) +{ + int i; + + i = strlen (s); + while (i > 0) + { + i--; + PutChar (s[i]); + } +} + +/* IsDigit - returns true if a character, ch, is a decimal digit. */ + +static int +IsDigit (char ch) +{ + return (((ch >= '0') && (ch <= '9'))); +} + +/* GetName - returns the next name found. */ + +static void +GetName (char *Name) +{ + int i; + char ch; + + SkipSpaces (); + ch = GetChar (); + i = 0; + while (!IsSpace (ch)) + { + Name[i] = ch; + i++; + ch = GetChar (); + } + Name[i] = '\0'; +} + +/* FindSource - open source file on StdIn. */ + +static void +FindSource (char *Name) +{ + if (close (STDIN) != 0) + { + ERROR ("close on STDIN failed"); + } + CurrentFile = open (Name, O_RDONLY); + if (CurrentFile < 0) + { + perror ("failed to open file"); + exit (1); + } + if (CurrentFile != STDIN) + { + ERROR ("Expecting file descriptor value of 1"); + } +} From patchwork Tue Dec 6 14:47:28 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Gaius Mulley X-Patchwork-Id: 61581 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 7FA50383FD75 for ; Tue, 6 Dec 2022 14:50:25 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 7FA50383FD75 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1670338225; bh=6waFAXrhSIlm6BKXFe0beM4BcWzGVqdwnGuY+CQ7aNo=; h=Subject:To:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=VZGwerdZey3K25bsBtdVvDWVekR3Scf1Zm0eVUmtNENhaEbcqz2ZHIp2OfvAq98Nr qLvMDLJKjCgmtxd0e4cpSTg+N8Pl+DSnn19nHEhlguhdUBLQN7YXNsmrwr8tGd4y7o pteKn2oH957BNE45xIV4CV7eeVRu5/KCvND5wZHI= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x433.google.com (mail-wr1-x433.google.com [IPv6:2a00:1450:4864:20::433]) by sourceware.org (Postfix) with ESMTPS id E38813842313 for ; Tue, 6 Dec 2022 14:47:35 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org E38813842313 Received: by mail-wr1-x433.google.com with SMTP id h12so23747007wrv.10 for ; Tue, 06 Dec 2022 06:47:35 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=date:message-id:to:subject:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=6waFAXrhSIlm6BKXFe0beM4BcWzGVqdwnGuY+CQ7aNo=; b=Bj3wLyOG4SeP4EzLbJME+jpfhgJjazWbNrPbH8RE+7RG98FwXCCARq2kSG9rkNTFYn qzpPOe9xidstlByTvXZwVni/dtWzbvAzKszJ7oMNw0A6kFntueWI+ZgegZlKYgEuxdK3 DWL8GbWmaBS/yjcwqH7zJ3gB+N0omERma/VCxDxMLNvNSBmhZ6apKe8o7cpdQquEEgiz tZCubdxLmPWCGVAWueSQrzF+Q4IOzE5C/F669IH0C8LyL0HIffoZjdGmwXKKHtCnhIm6 AdM9j+WA8E6CD7GWdSn+hZh9UTNnYMKOtEras4GteNj7U3Z5mtrYqbTsMMB/tkOt53Mr MMSg== X-Gm-Message-State: ANoB5pk0TMiv2OdZSbw3XiRsO+PyouvN0qV7rgZw8ZayPhqwR7F+SvEY 5oW4a6EB6EARwp/XB/l/6rqtBgNwS/Y= X-Google-Smtp-Source: AA0mqf7GVikNV+Nas1Y6X2pyLdmHuJafD6LHfDX7Jf86gAxvgqspOAo5VRZ8vKbTnwexi8zatRpAKg== X-Received: by 2002:a05:6000:16c6:b0:236:6e66:3447 with SMTP id h6-20020a05600016c600b002366e663447mr53100497wrf.24.1670338054231; Tue, 06 Dec 2022 06:47:34 -0800 (PST) Received: from lancelot ([195.147.220.46]) by smtp.gmail.com with ESMTPSA id e18-20020a5d4e92000000b0024206ed539fsm16820378wru.66.2022.12.06.06.47.32 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 06 Dec 2022 06:47:33 -0800 (PST) X-Google-Original-From: Gaius Mulley Received: from gaius by lancelot with local (Exim 4.94.2) (envelope-from ) id 1p2ZEG-004Qhj-S4 for gcc-patches@gcc.gnu.org; Tue, 06 Dec 2022 14:47:28 +0000 Subject: [PATCH v3 17/19] modula2 front end: dejagnu expect library scripts To: X-Mailer: mail (GNU Mailutils 3.10) Message-Id: Date: Tue, 06 Dec 2022 14:47:28 +0000 X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_ENVFROM_END_DIGIT, FREEMAIL_FROM, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Gaius Mulley via Gcc-patches From: Gaius Mulley Reply-To: Gaius Mulley Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Here are the dejagnu expect library scripts for the gm2 testsuite. ------8<----------8<----------8<----------8<----------8<----------8<---- diff -ruw /dev/null gcc-git-devel-modula2/gcc/testsuite/lib/gm2.exp --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/testsuite/lib/gm2.exp 2022-12-06 02:56:51.424775814 +0000 @@ -0,0 +1,498 @@ +# Copyright (C) 2003-2020 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 +# . + +# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk) +# for GNU Modula-2. + +# we want to use libgloss so we can get find_gcc. +load_lib libgloss.exp +load_lib prune.exp +load_lib gcc-defs.exp +load_lib target-libpath.exp + + +# +# GCC_UNDER_TEST is the compiler under test. +# + +# +# default_gcc_version -- extract and print the version number of the compiler +# + +proc default_gcc_version { } { + global GCC_UNDER_TEST + + gm2_init; + + # ignore any arguments after the command + set compiler [lindex $GCC_UNDER_TEST 0] + + if ![is_remote host] { + set compiler_name [which $compiler]; + } else { + set compiler_name $compiler; + } + + # verify that the compiler exists + if { $compiler_name != 0 } then { + set tmp [remote_exec host "$compiler --version"] + set status [lindex $tmp 0]; + set output [lindex $tmp 1]; + regexp "version.*$" $output version + if { $status == 0 && [info exists version] } then { + clone_output "$compiler_name $version\n" + } else { + clone_output "Couldn't determine version of $compiler_name: $output\n" + } + } else { + # compiler does not exist (this should have already been detected) + warning "$compiler does not exist" + } +} + +# +# gcc_version -- Call default_gcc_version, so we can override it if needed. +# + +proc gcc_version { } { + default_gcc_version; +} + +# +# gm2_init -- called at the start of each .exp script. +# +# There currently isn't much to do, but always using it allows us to +# make some enhancements without having to go back and rewrite the scripts. +# + +set gm2_initialized 0; +set gm2_compile_method "default"; +set gm2_link_path ""; +set gm2_link_libraries "m2pim m2iso"; +set gm2_link_objects ""; + +proc gm2_set_compile_method { arg } { + global gm2_compile_method; + + send_log "********************************************\n" + send_log "**** setting gm2_compile_method to $arg ****\n" + send_log "********************************************\n" + set gm2_compile_method $arg; +} + + +proc gm2_init { args } { + global tmpdir; + global objdir; + global rootme; + global base_dir; + global tool_root_dir; + global gluefile wrap_flags; + global gm2_initialized; + global GCC_UNDER_TEST; + global TOOL_EXECUTABLE; + global gm2_link_libraries; + global gm2_link_objects; + global gm2_link_path; + global HAVE_LIBSTDCXX_V3; + + if { $gm2_initialized == 1 } { return; } + + set gm2_link_objects ""; + set GCC_UNDER_TEST [lookfor_file $rootme gm2]; + append GCC_UNDER_TEST " " -B[file dirname $rootme]/gcc " " ${args}; + append GCC_UNDER_TEST " " -fno-diagnostics-show-caret + append GCC_UNDER_TEST " " -fno-diagnostics-show-line-numbers + append GCC_UNDER_TEST " " -fdiagnostics-color=never + send_log "GCC_UNDER_TEST is ${GCC_UNDER_TEST}\n" + + if ![info exists tmpdir] then { + set tmpdir /tmp; + } + if {[target_info needs_status_wrapper] != "" && \ + [target_info needs_status_wrapper] != "0" && \ + ![info exists gluefile]} { + set gluefile ${tmpdir}/gcc-testglue.o; + set result [build_wrapper $gluefile]; + if { $result != "" } { + set gluefile [lindex $result 0]; + set wrap_flags [lindex $result 1]; + } else { + unset gluefile + } + } + + set gm2_link_path "[gm2_link_flags [get_multilibs]]"; + verbose $gm2_link_path 1 +} + +# +# gm2_target_compile_default -- compile a source file +# + +proc gm2_target_compile_default { source dest type options } { + global gluefile wrap_flags + global GCC_UNDER_TEST + global TOOL_OPTIONS + global TEST_ALWAYS_FLAGS + global gm2_link_objects + global gm2_link_libraries + global gm2_link_path + + if {[target_info needs_status_wrapper] != "" && \ + [target_info needs_status_wrapper] != "0" && \ + [info exists gluefile] } { + lappend options "libs=${gluefile}" + lappend options "ldflags=$wrap_flags" + } + + # 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] { + set options [concat "{additional_flags=$TEST_ALWAYS_FLAGS}" $options] + } + + global TEST_EXTRA_LIBS + if [info exists TEST_EXTRA_LIBS] { + lappend options "ldflags=$TEST_EXTRA_LIBS" + } + + if [target_info exists gcc,stack_size] { + lappend options "additional_flags=-DSTACK_SIZE=[target_info gcc,stack_size]" + } + if [target_info exists gcc,no_trampolines] { + lappend options "additional_flags=-DNO_TRAMPOLINES" + } + if [target_info exists gcc,no_label_values] { + lappend options "additional_flags=-DNO_LABEL_VALUES" + } + if [info exists TOOL_OPTIONS] { + lappend options "additional_flags=$TOOL_OPTIONS" + } + if [target_info exists gcc,timeout] { + lappend options "timeout=[target_info gcc,timeout]" + } + lappend options "compiler=$GCC_UNDER_TEST" + # puts stderr "options = $options\n" + # puts stderr "***** target_compile: $source $dest $type $options\n" + return [target_compile $source $dest $type $options] +} + + +# +# gm2_target_compile -- compile a source file +# + +proc gm2_target_compile { source dest type options } { + global gm2_compile_method; + + return [gm2_target_compile_${gm2_compile_method} $source $dest $type $options] +} + +# +# gm2_link_lib - allows tests to specify link libraries. +# This _must_ be called before gm2_init. +# + +proc gm2_link_lib { libraries } { + global gm2_link_libraries; + + set gm2_link_libraries $libraries; +} + + +# +# gm2_link_obj - allows tests to specify link with objects. +# + +proc gm2_link_obj { objects } { + global gm2_link_objects; + + set gm2_link_objects $objects; +} + + +# +# gm2_link_flags - detects the whereabouts of libraries (-lstdc++). +# + +proc gm2_link_flags { paths } { + global srcdir; + global ld_library_path; + global gccpath; + global gm2_link_libraries; + + set gccpath ${paths} + set libio_dir "" + set flags "" + set ld_library_path "." + + set shlib_ext [get_shlib_extension] + verbose "shared lib extension: $shlib_ext" + + if { $gccpath == "" } { + global tool_root_dir + + set libstdcpp [lookfor_file ${tool_root_dir} libstdc++] + if { $libstdcpp != "" } { + append flags "-L${libstdcpp} " + append ld_library_path ":${libstdcpp}" + } + } else { + if [file exists "${gccpath}/lib/libstdc++.a"] { + append ld_library_path ":${gccpath}/lib" + } + if [file exists "${gccpath}/libstdc++/libstdc++.a"] { + append flags "-L${gccpath}/libstdc++ " + append ld_library_path ":${gccpath}/libstdc++" + } + if [file exists "${gccpath}/libstdc++-v3/src/.libs/libstdc++.a"] { + append flags " -L${gccpath}/libstdc++-v3/src/.libs " + append ld_library_path ":${gccpath}/libstdc++-v3/src/.libs" + } + # Look for libstdc++.${shlib_ext}. + if [file exists "${gccpath}/libstdc++-v3/src/.libs/libstdc++.${shlib_ext}"] { + append flags " -L${gccpath}/libstdc++-v3/src/.libs " + append ld_library_path ":${gccpath}/libstdc++-v3/src/.libs" + } + + # puts stderr "${gm2_link_libraries} before foreach" + foreach d [list {*}${gm2_link_libraries}] { + # puts stderr "${d} XXXX" + send_log "ld_library_path was ${ld_library_path}\n" + send_log "looking for ${gccpath}/lib${d}/.libs/lib${d}.a\n" + if [file exists "${gccpath}/libgm2/lib${d}/.libs/lib${d}.a"] { + send_log "good found ${gccpath}/libgm2/lib${d}/.libs/lib${d}.a\n" + # append flags " -L${gccpath}/libgm2/lib${d}/.libs -l${d}" + append flags " ${gccpath}/libgm2/lib${d}/.libs/lib${d}.a" + append ld_library_path ":${gccpath}/libgm2/lib${d}/.libs" + } + send_log "ld_library_path is ${ld_library_path}\n" + } + } + + set_ld_library_path_env_vars + return "$flags" +} + + +# +# gm2_init_pimx - set the default libraries to choose PIM and then ISO. +# choose Modula-2, dialect. +# +# + +proc gm2_init_pimx { dialect {path ""} args } { + global srcdir; + global gccpath; + + set gm2src ${srcdir}/../m2; + + send_log "srcdir is $srcdir\n" + send_log "gccpath is $gccpath\n" + send_log "gm2src is $gm2src\n" + + set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs"; + set pimLpath "${gccpath}/libgm2/libm2pim/.libs"; + + set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso"; + set isoLpath "${gccpath}/libgm2/libm2iso/.libs"; + + set theIpath "-I${pimIpath} -I${isoIpath}"; + set theLpath "-L${pimLpath} -L${isoLpath}"; + + if { $path != "" } then { + append theIpath " -I" + append theIpath ${path} + } + gm2_init {*}${theIpath} {*}${dialect} {*}${theLpath} {*}${args}; +} + +# +# gm2_init_pim - set the default libraries to choose PIM and then ISO. +# +# + +proc gm2_init_pim { {path ""} args } { + gm2_init_pimx -fpim {*}${path} {*}${args}; +} + + +# +# gm2_init_pim2 - set the default libraries to choose PIM and then ISO. +# It uses the PIM2 dialect. +# + +proc gm2_init_pim2 { {path ""} args } { + gm2_init_pimx -fpim2 {*}${path} {*}${args}; +} + + +# +# gm2_init_pim3 - set the default libraries to choose PIM and then ISO. +# It uses the PIM3 dialect. +# + +proc gm2_init_pim3 { {path ""} args } { + gm2_init_pimx -fpim3 {*}${path} {*}${args}; +} + + +# +# gm2_init_pim4 - set the default libraries to choose PIM and then ISO. +# It uses the PIM4 dialect. +# + +proc gm2_init_pim4 { {path ""} args } { + gm2_init_pimx -fpim4 {*}${path} {*}${args}; +} + + +# +# gm2_init_iso - set the default libraries to choose ISO and then PIM. +# + +proc gm2_init_iso { {path ""} args } { + global srcdir; + global gccpath; + + set gm2src ${srcdir}/../m2; + + set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso"; + set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs"; + + set isoLpath "${gccpath}/libgm2/libm2iso/.libs"; + set pimLpath "${gccpath}/libgm2/libm2pim/.libs"; + + set corIpath "${gccpath}/libgm2/libm2cor:${gm2src}/gm2-libs-coroutines"; + set corLpath "${gccpath}/libgm2/libm2cor/.libs"; + + set theIpath "-I${isoIpath} -I${corIpath} -I${pimIpath}"; + set theLpath "-L${isoLpath} -L${corLpath} -L${pimLpath}"; + + if { $path != "" } then { + append theIpath " -I" + append theIpath ${path} + } + + gm2_init {*}${theIpath} -fiso {*}${theLpath} {*}${args}; +} + + +# +# gm2_init_ulm - set the default libraries to choose the ULM and PIM libraries. +# + +proc gm2_init_ulm { {path ""} args } { + global srcdir; + global gccpath; + + set gm2src ${srcdir}/../m2; + + set ulmIpath "${gccpath}/libgm2/libm2ulm:${gm2src}/ulm-lib-gm2/std:${gm2src}/ulm-lib-gm2/sys"; + set ulmLpath "${gccpath}/libgm2/libm2ulm/.libs"; + + set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs"; + set pimLpath "${gccpath}/libgm2/libm2pim/.libs"; + + set theIpath "-I${ulmIpath} -I${pimIpath}"; + set theLpath "-L${ulmLpath} -L${pimLpath}"; + + if { $path != "" } then { + append theIpath " -I" + append theIpath ${path} + } + + gm2_init {*}${theIpath} -fpim {*}${theLpath} {*}${args}; +} + + +# +# gm2_init_log - set the default libraries to choose LOG and then PIM. +# +# + +proc gm2_init_log { {path ""} args } { + global srcdir; + global gccpath; + + set gm2src ${srcdir}/../m2; + + send_log "srcdir is $srcdir\n" + send_log "gccpath is $gccpath\n" + send_log "gm2src is $gm2src\n" + + set logIpath "${gccpath}/libgm2/libm2log:${gm2src}/gm2-libs-pim"; + set logLpath "${gccpath}/libgm2/libm2log/.libs"; + + set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs"; + set pimLpath "${gccpath}/libgm2/libm2pim/.libs"; + + set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso"; + set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs"; + + set theIpath "-I${logIpath} -I${pimIpath} -I${isoIpath}"; + set theLpath "-L${logLpath} -L${pimLpath}"; + + if { $path != "" } then { + append theIpath " -I" + append theIpath ${path} + } + + gm2_link_lib "m2log m2pim m2iso" + gm2_init {*}${theIpath} -fpim {*}${theLpath} {*}${args}; +} + +# +# gm2_init_cor - set the default libraries to choose COR and then PIM. +# +# + +proc gm2_init_cor { {path ""} args } { + global srcdir; + global gccpath; + global gm2_link_libraries; + + set gm2src ${srcdir}/../m2; + + send_log "srcdir is $srcdir\n" + send_log "gccpath is $gccpath\n" + send_log "gm2src is $gm2src\n" + + set corIpath "${gccpath}/libgm2/libm2cor:${gm2src}/gm2-libs-coroutines"; + set corLpath "${gccpath}/libgm2/libm2cor/.libs"; + + set pimIpath "${gccpath}/libgm2/libm2pim:${gm2src}/gm2-libs"; + set pimLpath "${gccpath}/libgm2/libm2pim/.libs"; + + set isoIpath "${gccpath}/libgm2/libm2iso:${gm2src}/gm2-libs-iso"; + set isoLpath "${gccpath}/libgm2/libm2iso/.libs"; + + set logIpath "${gccpath}/libgm2/libm2log:${gm2src}/gm2-libs-pim"; + set logLpath "${gccpath}/libgm2/libm2log/.libs"; + + set theIpath "-I${corIpath} -I${pimIpath} -I${logIpath} -I${isoIpath}"; + set theLpath "-L${corLpath} -L${pimLpath} -L${logLpath} -L${isoLpath}"; + + if { $path != "" } then { + append theIpath " -I" + append theIpath ${path} + } + + gm2_link_lib "m2cor m2pim m2iso" + gm2_init {*}${theIpath} -fpim {*}${theLpath} {*}${args}; +} diff -ruw /dev/null gcc-git-devel-modula2/gcc/testsuite/lib/gm2-dg.exp --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/testsuite/lib/gm2-dg.exp 2022-12-06 02:56:51.424775814 +0000 @@ -0,0 +1,77 @@ +# Copyright (C) 2021 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 gm2 callbacks for dg.exp. + +proc gm2-dg-test { prog do_what extra_tool_flags } { + verbose "begin:gm2-dg-test" 1 + upvar dg-do-what dg-do-what + + # For now demote link and run tests to compile-only. + switch $do_what { + link - + run { + set do_what compile + set dg-do-what compile + } + } + + set result \ + [gcc-dg-test-1 gm2_target_compile $prog $do_what $extra_tool_flags] + + set comp_output [lindex $result 0] + set output_file [lindex $result 1] + verbose "end:gm2-dg-test" 1 + return [list $comp_output $output_file] +} + +proc gm2-dg-prune { system text } { + return [gcc-dg-prune $system $text] +} + +# Utility routines. + +# Modified dg-runtest that can cycle through a list of optimization options +# as c-torture does. +proc gm2-dg-runtest { testcases flags default-extra-flags } { + global runtests + global TORTURE_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 { -O } ] + } + + 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 "$flags $flags_t" ${default-extra-flags} + } + } +} diff -ruw /dev/null gcc-git-devel-modula2/gcc/testsuite/lib/gm2-simple.exp --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/testsuite/lib/gm2-simple.exp 2022-12-06 02:56:51.424775814 +0000 @@ -0,0 +1,137 @@ +# Copyright (C) 2003-2020 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 +# . + +# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk) +# for GNU Modula-2 + +load_lib file-format.exp +load_lib gm2.exp + +# +# gm2-simple-compile -- runs the compiler +# +# SRC is the full pathname of the testcase. +# OPTION is the specific compiler flag we're testing (eg: -O2). +# +proc gm2-simple-compile { src option } { + global output + global srcdir tmpdir + global host_triplet + + set output "$tmpdir/[file tail [file rootname $src]].o" + + regsub "^$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 analyze the results. + set options "" + lappend options "additional_flags=$option" + + set comp_output [gm2_target_compile "$src" "$output" object $options]; + gm2_check_compile $testcase $option $output $comp_output + remote_file build delete $output + verbose "$comp_output" 1 +} + + +# +# gm2-simple-execute -- utility to compile and execute a testcase +# +# SOURCES is a list of full pathnames to the test source files. +# The first filename in this list forms 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 gm2-simple-execute { sources args option } { + global tmpdir tool srcdir output compiler_conditional_xfail_data; + global gm2_link_libraries; + global gm2_link_path; + global gm2_link_objects; + + # Use the first source filename given as the filename under test. + set src [lindex $sources 0]; + + if { [llength $args] > 0 } { + set additional_flags [lindex $args 0]; + } else { + set additional_flags ""; + } + # 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 + } + } + + set executable $tmpdir/[file tail [file rootname $src].x]; + set objectfile $tmpdir/[file tail [file rootname $src].o]; + + regsub "^$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]" + } + + set execname "${executable}"; + + remote_file build delete $execname; + verbose "Testing $testcase, $option" 1 + + # start by setting options with option + set options [concat "{additional_flags=$gm2_link_objects} " $option] + # now append path -fno-libs=- and objects + set options [concat "{additional_flags=$gm2_link_path} " $options] + set options [concat "{additional_flags=-fno-libs=-} " $options] + set options [concat "{additional_flags=$gm2_link_objects} " $options] + + set comp_output [gm2_target_compile "${sources}" "${execname}" executable ${options}]; + + if ![gm2_check_compile "${testcase} compilation" ${option} ${execname} $comp_output] { + unresolved "${testcase} execution, ${option}" + remote_file build delete $objectfile + return 0 + } + + set result [gm2_load "$execname" "" ""] + + set status [lindex $result 0]; + set output [lindex $result 1]; + if { $status == "fail" } { + ${tool}_fail $testcase $option + send_log "executed $execname with result $status" + } + if { $status == "pass" } { + ${tool}_pass $testcase $option + remote_file build delete $execname; + } + return 1 +} diff -ruw /dev/null gcc-git-devel-modula2/gcc/testsuite/lib/gm2-torture.exp --- /dev/null 2022-08-24 16:22:16.888000070 +0100 +++ gcc-git-devel-modula2/gcc/testsuite/lib/gm2-torture.exp 2022-12-06 02:56:51.424775814 +0000 @@ -0,0 +1,538 @@ +# Copyright (C) 2003-2020 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 +# . + +# This file was written by Rob Savoye. (rob@cygnus.com) +# and modified by Gaius Mulley (gaius.mulley@southwales.ac.uk) +# for GNU Modula-2 + +load_lib file-format.exp +load_lib target-libpath.exp + +# The default option list can be overridden by +# TORTURE_OPTIONS="{ { list1 } ... { listN } }" + +if ![info exists TORTURE_OPTIONS] { + # It is theoretically beneficial to group all of the O2/O3 options together, + # as in many cases the compiler will generate identical executables for + # all of them--and the c-torture testsuite will skip testing identical + # executables multiple times. + # Also note that -finline-functions is explicitly included in one of the + # items below, even though -O3 is also specified, because some ports may + # choose to disable inlining functions by default, even when optimizing. + set TORTURE_OPTIONS [list \ + { -g } \ + { -O } \ + { -O -g } \ + { -Os } \ + { -O3 -fomit-frame-pointer } \ + { -O3 -fomit-frame-pointer -finline-functions } ] +} + + +# +# very costly options follow +# +# set TORTURE_OPTIONS [list \ +\# { -g } \ +\# { -O } \ +\# { -O -g } \ +\# { -Os } \ +\# { -Os -g } \ +\# { -O0 } \ +\# { -O0 -g } \ +\# { -O1 } \ +\# { -O1 -g } \ +\# { -O2 } \ +\# { -O2 -g } \ +\# { -O3 } \ +\# { -O3 -g } \ +\# { -O3 -fomit-frame-pointer } \ +\# { -O3 -fomit-frame-pointer -finline-functions } ] +# +# +# + + + +# +# gm2-torture-compile -- runs the gm2-torture test +# +# SRC is the full pathname of the testcase. +# OPTION is the specific compiler flag we're testing (eg: -O2). +# +proc gm2-torture-compile { src option } { + global output + global srcdir tmpdir + global host_triplet + + set output "$tmpdir/[file tail [file rootname $src]].o" + + regsub "^$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]" + } + + # puts stderr "gm2-torture-compiler src = $src, option = $option\n" + + # Run the compiler and analyze the results. + set options "" + lappend options "additional_flags=${option}" + + set comp_output [gm2_target_compile "$src" "$output" object $options]; + # puts stderr "*** gm2 torture compile: $comp_output ${options} " + gm2_check_compile $testcase "$option" $output $comp_output + remote_file build delete $output + verbose "$comp_output" 1 +} + + +# +# gm2_check_compile_fail -- Reports and returns pass/fail for a compilation +# + +proc gm2_check_compile_fail {testcase option objname gcc_output} { + global tool + set fatal_signal "*cc: Internal compiler error: program*got fatal signal" + + if [string match "$fatal_signal 6" $gcc_output] then { + ${tool}_fail $testcase "Got Signal 6, $option" + return 0 + } + + if [string match "$fatal_signal 11" $gcc_output] then { + ${tool}_fail $testcase "Got Signal 11, $option" + return 0 + } + +# # We shouldn't get these because of -w, but just in case. +# if [string match "*cc:*warning:*" $gcc_output] then { +# warning "$testcase: (with warnings) $option" +# send_log "$gcc_output\n" +# unresolved "$testcase, $option" +# return 0 +# } + + set gcc_output [prune_warnings $gcc_output] + + set unsupported_message [${tool}_check_unsupported_p $gcc_output] + if { $unsupported_message != "" } { + unsupported "$testcase: $unsupported_message" + return 0 + } + + # remove any leftover LF/CR to make sure any output is legit + regsub -all -- "\[\r\n\]*" $gcc_output "" gcc_output + + # check for any internal error + if { [string match "internal error" $gcc_output] || + [string match "internal compiler error" $gcc_output] } then { + ${tool}_fail $testcase $option + return 0 + } + + # If any message remains, we pass, as it will be the error message + if ![string match "" $gcc_output] then { + ${tool}_pass $testcase $option + return 1 + } + + # a clean compilation means this test has failed + ${tool}_fail $testcase $option + return 1 +} + +# +# gm2-torture-compile-fail -- runs the gm2-torture test +# +# SRC is the full pathname of the testcase. +# OPTION is the specific compiler flag we're testing (eg: -O2). +# +proc gm2-torture-compile-fail { src option } { + global output + global srcdir tmpdir + global host_triplet + + # puts stderr "gm2-torture-compile-fail: ${option}\n" + set output "$tmpdir/[file tail [file rootname $src]].o" + + regsub "^$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 expected failure $testcase, $option" 1 + + # Run the compiler and analyze the results. + set options "" + set additional_flags "" + lappend options "additional_flags=$option" # do not use -w for gm2 + if { $additional_flags != "" } { + lappend options "additional_flags=$additional_flags" + } + + set comp_output [gm2_target_compile "$src" "$output" object $options]; + gm2_check_compile_fail $testcase $option $output $comp_output + remote_file build delete $output + verbose "$comp_output" 1 +} + +# +# gm2-torture-execute -- utility to compile and execute a testcase +# +# SOURCES is a list of full pathnames to the test source files. +# The first filename in this list forms 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 gm2-torture-execute { sources args success } { + global tmpdir tool srcdir output compiler_conditional_xfail_data; + global TORTURE_OPTIONS; + global gm2_link_libraries; + global gm2_link_objects; + global gm2_link_path; + + # Use the first source filename given as the filename under test. + set src [lindex $sources 0]; + + if { [llength $args] > 0 } { + set additional_flags [lindex $args 0]; + } else { + set additional_flags ""; + } + # 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 + } + } + + set executable $tmpdir/[file tail [file rootname $src].x]; + set objectfile $tmpdir/[file tail [file rootname $src].o]; + + regsub "^$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]" + } + + set option_list $TORTURE_OPTIONS; + + set count 0; + set oldstatus "foo"; + foreach option $option_list { + if { $count > 0 } { + set oldexec $execname; + } + set execname "${executable}${count}"; + incr count; + + # torture_{compile,execute}_xfail are set by the .x script + # (if present) + if [info exists torture_compile_xfail] { + setup_xfail $torture_compile_xfail + } + + # torture_execute_before_{compile,execute} can be set by the .x script + # (if present) + if [info exists torture_eval_before_compile] { + set ignore_me [eval $torture_eval_before_compile] + } + + remote_file build delete $execname; + verbose "Testing $testcase, $option" 1 + + set options "" + lappend options "additional_flags=$option" + if { $additional_flags != "" } { + lappend options "additional_flags=$additional_flags" + } + set comp_output [gm2_target_compile "$sources" "${objectfile}" object "$options"]; + + # puts stderr "torture gm2 case: $comp_output ${options} " + + if ![gm2_check_compile "$testcase compilation" ${options} $objectfile $comp_output] { + unresolved "$testcase execution, ${options}" + send_log "compile failed not attempting link\n" + remote_file build delete $objectfile + continue + } + + send_log "finished compile now attempting link\n" + # now link the test + set options ${option}; + + if { [llength ${args}] > 0 } { + lappend options "additional_flags=[lindex ${args} 0]" + } + + lappend options " additional_flags=${gm2_link_path}" + + if {$gm2_link_path != ""} { + lappend options " ldflags=$gm2_link_path" + } + + if {$gm2_link_libraries != ""} { + lappend options " ldflags=$gm2_link_libraries" + } + +# lappend options "ldflags=/home/gaius/GM2/graft-combine/build-devel-modula2-enabled/x86_64-pc-linux-gnu/libgm2/libm2pim/.libs/libm2pim.a" +# lappend options "ldflags=/home/gaius/GM2/graft-combine/build-devel-modula2-enabled/x86_64-pc-linux-gnu/libgm2/libm2iso/.libs/libm2iso.a" +# lappend options "ldflags=-lm2pim -lm2iso" +# + if {$gm2_link_objects != ""} { + lappend options " additional_flags=${gm2_link_objects}" + } + if {$gm2_link_path != ""} { + lappend options " additional_flags=${gm2_link_path}" + } + + # lappend options " additional_flags=${gm2_link_objects}" + # lappend options " additional_flags=${gm2_link_path}" + # lappend options " additional_flags=${gm2_link_libraries}" + set options [concat "{additional_flags=$gm2_link_path} " $options] + set options [concat "{additional_flags=-fno-libs=-} " $options] + set options [concat "{additional_flags=$gm2_link_objects} " $options] + # set options [concat "{additional_flags=$gm2_link_libraries} " $options] + + send_log "gm2_link_path = $gm2_link_path\n" + send_log "attempting link\n" + set comp_output [gm2_target_compile "${sources}" "${execname}" executable ${options}]; + # puts "Link libraries are: ${gm2_link_libraries}" + # puts "Link path is : ${gm2_link_path}" + + if ![gm2_check_compile "${testcase} compilation" ${option} ${execname} ${comp_output}] { + send_log "unsuccessful link\n" + unresolved "${testcase} execution, ${option} (link failed)" + verbose "tried to link ${testcase} ${sources} ${execname} executable ${options}" 1 + verbose "Link libraries are: ${gm2_link_libraries}" 1 + verbose "Link path is : ${gm2_link_path}" 1 + verbose "$comp_output" 1 + lappend options "additional_flags=-fsources" + lappend options "additional_flags=-v" + verbose "****** s t a r t *********" 1 + set comp_output [gm2_target_compile "$sources" "${objectfile}" object ${options}]; + verbose "$comp_output" 1 + set comp_output [gm2_target_compile "${sources}" "${execname}" executable ${options}]; + verbose "$comp_output" 1 + verbose "****** e n d *********" 1 + remote_file build delete $execname + remote_file build delete $objectfile + continue + } + + send_log "successful link\n" + # See if this source file uses "long long" types, if it does, and + # no_long_long is set, skip execution of the test. + if [target_info exists no_long_long] then { + if [expr [search_for $src "long long"]] then { + unsupported "$testcase execution, $option" + continue + } + } + + 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] + } + + # Sometimes we end up creating identical executables for two + # consecutive sets of different of compiler options. + # + # In such cases we know the result of this test will be identical + # to the result of the last test. + # + # So in cases where the time to load and run/simulate the test + # is relatively high, compare the two binaries and avoid rerunning + # tests if the executables are identical. + # + # Do not do this for native testing since the cost to load/execute + # the test is fairly small and the comparison step actually slows + # the entire process down because it usually does not "hit". + set skip 0; + if { ![isnative] && [info exists oldexec] } { + if { [remote_file build cmp $oldexec $execname] == 0 } { + set skip 1; + } + } + if { $skip == 0 } { + set result [gm2_load "$execname" "" ""] + set status [lindex $result 0]; + set output [lindex $result 1]; + if { $success == "fail" } { + # invert the result + if { $status == "pass" } { + set status "fail" + } else { + set status "pass" + } + } + send_log "executed $execname with result $status" + } + if { $oldstatus == "pass" } { + remote_file build delete $oldexec; + } + $status "$testcase execution, $option" + set oldstatus $status; + } + if [info exists status] { + if { $status == "pass" } { + remote_file build delete $execname; + remote_file build delete $objectfile; + } + } +} + +# +# search_for -- looks for a string match in a file +# +proc search_for { file pattern } { + set fd [open $file r] + while { [gets $fd cur_line]>=0 } { + if [string match "*$pattern*" $cur_line] then { + close $fd + return 1 + } + } + close $fd + return 0 +} + +# +# gm2-torture -- the gm2-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 gm2-torture { args } { + global srcdir subdir compiler_conditional_xfail_data 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 + } + } + + set option_list $TORTURE_OPTIONS + + # loop through all the 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] + } + + gm2-torture-compile $src "$option $options" + } +} + +# +# gm2-torture -- the gm2-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 gm2-torture-fail { args } { + global srcdir subdir compiler_conditional_xfail_data 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 + } + } + + set option_list $TORTURE_OPTIONS + + # loop through all the 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] + } + + gm2-torture-compile-fail $src "$option $options" + } +}