m2comp step 1 — Coco/R syntax front end (M2comp.atg, gm2 -fiso, 3/3 tests green)

build.sh

@@ -0,0 +1,38 @@
+#!/bin/sh
+#
+# Builds the M2comp compiler (step 1: Coco/R syntax front end).
+# Requires GNU Modula-2 (gm2 -fiso) and the Coco/R CR binary.
+#
+# Usage: ./build.sh   (from the m2comp directory)
+#
+# All sources live in src/ (grammar, frames, hand modules, generated
+# scanner/parser/driver). The binary links to ./M2comp (project root).
+#
+# Pipeline: src/M2comp.atg -> src/M2compS/M2compP/M2comp (.mod)
+#           -> gm2 -fiso -> ./M2comp
+#
+
+CRBIN="${CRBIN:-/home/eric/Projets/Projets-Modula2/MyWork/CocoGm2/CR}"
+
+echo "=== Regenerating M2compS / M2compP / M2comp from M2comp.atg ==="
+cd src || exit 1
+CRFRAMES="$(pwd)" "$CRBIN" -m -C M2comp.atg || exit 1
+
+echo "=== Deleting all o files ==="
+rm -f ./*.o
+
+echo "=== Compiling the needed modules ==="
+for m in FileIO M2compS M2compP M2comp; do
+  gm2 -fiso -c "$m.mod" || exit 1
+done
+
+echo "=== Phase 1: generating the module list ==="
+gm2 -fiso -fgen-module-list=modules.lst -o /dev/null \
+    M2compS.o M2compP.o FileIO.o M2comp.mod || exit 1
+
+echo "=== Phase 2: compiling main module and linking using the module list ==="
+gm2 -fiso -fuse-list=modules.lst -o ../M2comp \
+    M2compS.o M2compP.o FileIO.o M2comp.mod || exit 1
+cd ..
+
+echo "=== M2comp built ==="

docs/Document 1 sans titre

@@ -0,0 +1,491 @@
+On the Maintenance of Classic Modula-2 Compilers
+Benjamin Kowarsch, Modula-2 Software Foundation
+arXiv:1809.07080v1 [cs.PL] 19 Sep 2018
+September 2018 (arXiv.org preprint)
+Abstract
+The classic Modula-2 language was specified in [Wir78] by N.Wirth at ETH Zürich in
+1978. The last revision [Wir88] was published in 1988. Many computer science books of that
+era used Modula-2 in programming examples. Many of these are still valuable resources in
+computer science education today. To compile and run the examples therein, it is essential
+to have compilers available that follow the classic Modula-2 language definition and run on
+modern computer hardware and operating systems. Although most Modula-2 compilers of
+that era have disappeared, a few have since been re-released under open source licenses.
+Whilst the original authors have long ceased work on these compilers, new maintainers have
+stepped in. This paper gives recommendations for maintenance on classic Modula-2 compil-
+ers while balancing the aim to modernise with the need to maintain the capability to compile
+programming examples in the literature with minimal effort. Nevertheless, the principles,
+methods and conclusions presented are adaptable to maintenance on other languages.
+1Methodology
+1.1Design Principles
+The following design principles strongly influenced the recommendations in this paper:
+1.1.1
+Single Syntax Principle (SSP)
+There should be one and only one syntax form to express any given concept [Dij78].
+1.1.2
+Literate Syntax Principle (LSP)
+Syntax should be chosen for readability and comprehensibility by a human reader [Knu84].
+1.1.3
+Consistency of Syntax Principle (COSP)
+Syntax should be consistent. Analogous concepts should be expressed by analogous syntax.
+1.1.4
+Principle of Least Astonishment (POLA)
+Of any number of possible syntax forms or semantics, the one likely to cause the least astonish-
+ment for a human reader should be chosen and the alternatives should be discarded [Geo87].
+1.1.5
+Single Responsibility Principle (SRP)
+Units of decomposition, such as modules, classes, procedures and functions should have a single
+focus and purpose [Mar09].
+1.1.6
+Principle of Information Hiding (POIH)
+Implementation specific details should always be hidden, public access should be denied [Par72].
+1.1.7
+Safety Perimeter Principle (SPP)
+Facilities that undermine the safety otherwise safeguarded within the language should be segre-
+gated from other facilities [Wir88, ch.29]. Their use should require an explicit expression of intent
+by the author and be syntactically recognisable so as to alert the author, maintainer and reader
+of the possible implications. This applies and extends the principle of least privilege [Sal74].
+1On the Maintenance of Classic Modula-2 Compilers
+1.2
+2
+Maintenance Objectives
+The primary objectives for the recommendations in this paper are:
+(1) to remove facilities that are harmful, outdated or violate any of [1.1]
+(2) to resolve ambiguities in [Wir88] and incompatibilities between implementations
+(3) to maintain the capability to compile programming examples in the literature with
+minimal effort
+1.2.1
+Weighing Objectives by Impact
+The objectives given above may from case to case conflict with one another. Which objective
+should be given preference in the event of a conflict depends on the following factors:
+(1) the severity of the offending facility
+(2) the estimated frequency of use of the offending facility
+(3) the effort to update sources impacted by change or removal of the offending facility
+The greater the severity of an offending facility, the stronger is the case for change or removal;
+the lower the estimated frequency of use and the less the effort to update impacted sources, the
+stronger the case for change or removal. In the event that the estimated frequency of use is
+high and the effort to update impacted sources is significant, deprecation is recommended.
+1.3
+Mitigation Methods
+Terms of mitigation methods used in this paper have well defined meanings:
+1.3.1
+Warning
+A warning should be issued for each and every use of the offending facility.
+1.3.2
+Change
+The offending facility should be replaced with a proposed alternative.
+1.3.3
+Deprecation
+A compiler switch to enable and disable the offending facility should be provided and it should
+be disabled by default. When it is enabled, a deprecation warning should be isued for each and
+every use of the offending facility.
+1.3.4
+Removal
+Support for the offending facility should be removed altogether.
+From an educational perspective, the availability of offending facilities promotes bad habits.
+Replacement or removal is therefore generally preferable to warning or deprecation.
+1.3.5
+Transformation
+To be used in combination with any of change, deprecation or removal. A conversion program
+should be provided that transforms source code that uses offending facilities into semantically
+equivalent source code that complies with the recommendations given in this paper.
+2Lexis
+2.1Octal Literals
+Support for octal literals should be removed.
+Copyright c 2018 Benjamin Kowarsch – arXiv.org preprint for non-commercial useOn the Maintenance of Classic Modula-2 Compilers
+2.1.1
+3
+Rationale
+The use of octal numbers has long been outdated. Further, the B and C suffixes used to denote
+octal literals are also legal digits within hexadecimal literals, which is confusing to human readers
+of the source code as it violates POLA [1.1.4] and it unnecessarily complicates lexing.
+2.1.2
+Substitution
+The built-in CHR() function can be used instead without penalty as it is evaluated at compile time
+for constant arguments. The function accepts decimal and hexadecimal arguments. Code that
+uses the CHR() function instead of octal literals can always be compiled on any classic Modula-2
+compiler, regardless of whether octal literals are recognised or not.
+2.1.3
+Backwards Compatibility
+Preferably, transformation should be used to replace all occurences of octal literals in existing
+Modula-2 sources. Alternatively, octal literals could be deprecated instead.
+2.2
+Synonym Symbols
+Support for synonym symbols <>, & and ˜ should be removed.
+2.2.1
+Rationale
+The availability of alternative symbols violates SSP (1.1.1) and they are are notably absent
+from the grammar in [Wir88, pp.156-157].
+The inequality operator symbol # is preferable to its synonym <> because it resembles the
+mathematical inequality symbol 6= and as a single character symbol it simplifies lexing. Reserved
+words AND and NOT are preferable to their respective synonyms & and ˜ because of consistency:
+While there are synonyms for AND and NOT, there is none for OR. Although | could have been used
+to denote OR, it is already used to separate case labels and would have caused ambiguity.
+2.2.2
+Substitution
+Symbol # can be used in place of <>, while AND can be used in place of & and NOT in place of ˜.
+2.2.3
+Backwards Compatibility
+Preferably, transformation should be used to replace all occurences of synonym symbols in
+existing Modula-2 sources. Alternatively, synonym symbols could be deprecated instead.
+2.3
+Non-Semantic Compiler Directives
+Whilst compiler directives are implementation defined, the delimiters of non-semantic compiler
+directives should not be. They should be denoted by an opening (*$ and a closing *) delimiter.
+2.3.1
+Rationale
+Although [Wir88, p.18] mentions (* and *) as delimiters for both comments and directives, it
+does not specify their use in any normative manner. Some compiler implementors have taken
+this to mean that the delimiters are implementation defined. Several compilers still in use today
+do not follow the convention, for example the venerable MOCKA compiler [EV94].
+As a result, source code with compiler directives is often not portable across different im-
+plementations. This is unfortunate, because non-semantic directives can safely be ignored in
+the event that they are not supported. Even where an implementation issues warnings about
+unrecognised directives, to be able to identify a directive as such in the first place, a common
+delimiter convention needs to be followed across implementations.
+2.3.2
+Backwards Compatibility
+Non-compliant directives within existing source code should be replaceable with minimal effort
+using regular expressions and a filter program such as sed or awk.
+Copyright c 2018 Benjamin Kowarsch – arXiv.org preprint for non-commercial useOn the Maintenance of Classic Modula-2 Compilers
+2.4
+4
+Semantic Compiler Directives
+Semantic compiler directives should not be denoted by the same delimiters used for non-semantic
+compiler directives.
+2.4.1
+Rationale
+Whilst non-semantic compiler directives can safely be ignored, semantic compiler directives can-
+not. A semantic compiler directive that is not supported by an implementation must be reported
+as an error. Consequently, an implementation needs to be able to distinguish between semantic
+and non-semantic directives. In order to do so, different delimiters must be used.
+2.4.2
+Substitution
+Some Modula-2 compilers have used a % prefix to denote compiler directives, in particular for
+conditional compilation, for example the MOCKA compiler [EV94]. We recommend to follow
+that convention to denote non-semantic compiler directives if any are provided. The % symbol is
+not otherwise used in the language.
+2.4.3
+Backwards Compatibility
+Non-compliant directives within existing source code should be replaceable with minimal effort
+using regular expressions and a filter program such as sed or awk.
+3Syntax
+3.1Multi-Dimensional Arrays
+Inconsistent definition or declaration of multi-dimensional arrays should trigger warnings.
+3.1.1
+Rationale
+[Wir88, p.138] specifies alternative syntax forms for multi-dimensional array type declaration:
+TYPE Matrix = ARRAY [0 .. Cols], [0 .. Rows] OF REAL;
+is an abbreviation of and thus equivalent to
+TYPE Matrix = ARRAY [0 .. Cols] OF ARRAY [0 .. Rows] OF REAL;
+The availability of alternative syntax forms violates SSP [1.1.1] and COSP [1.1.3]. The more
+dimensions an array type has, the more preferable the abbreviated form becomes. However, it is
+more effort to remove or deprecate the long form. The impact of removal or deprecation on
+existing sources with multi-dimensional arrays would likely be high. It is less effort and sufficient
+to modify an implementation to detect and warn about mixed use in any given compilation unit.
+3.1.2
+Backwards Compatibility
+The proposed mitigation does not impact the compatibility of legacy sources.
+3.2
+Local Modules
+Local Modules should be deprecated.
+3.2.1
+Rationale
+If there is sufficient reason to delegate certain responsibilities of a library module to a local
+module, then there is also sufficient reason to delegate those responsibilities to a separate library
+module. There is no reason why a local module should be chosen over a separate library.
+Furthermore, a local module within a program or library module unnecessarily increases the
+line count of the module and thus reduces its readabililty and maintainability. It runs counter
+to the very rationale of decomposing source code into separate modules in the first place.
+Copyright c 2018 Benjamin Kowarsch – arXiv.org preprint for non-commercial useOn the Maintenance of Classic Modula-2 Compilers
+5
+Finally, a test environment for testing a local module must necessarily be provided within
+the hosting module. This further increases clutter and poses the question whether to release the
+module with or without the embedded test environment. By contrast, a proper library module
+can be imported into any number of lexically independent test environments.
+3.2.2
+Substitution
+Local modules should be removed from their enclosing module and provided as proper library
+modules with their own definition and implementation parts.
+3.2.3
+Backwards Compatibility
+Backwards compatibility can be provided via compiler switch.
+3.2.4
+Private-Use Aspect
+The private-use aspect of local modules is lost when they are removed from their host modules
+and converted into library modules. However, this aspect is useful when the local module’s API is
+considered unstable and subject to frequent changes. A satisfactory solution can be implemented
+easily by introducing a non-semantic compiler directive that specifies a library’s intended client
+modules and causes the compiler to issue warnings whenever such a library is imported by a
+module other than its designated client modules. An example is given below:
+DEFINITION MODULE PrivateLib; (*$CLIENTS=FooLib, BarLib, BazLib*)
+(∗ ATTENTION !!! This module is intended for private use only.
+∗ Its API is subject to frequent change without prior notice.
+∗ The compiler will issue a warning when it is imported from
+∗ any other than the designated client modules. ∗)
+···
+END PrivateLib.
+3.3
+Unary Minus
+Unary minus should only be permitted before a factor.
+simpleExpression :=
+( ’+’ )? term ( addOp term )* | ’-’ factor
+;
+instead of
+simpleExpression :=
+( ’+’ | ’-’ )? term ( addOp term )*
+;
+3.3.1
+Rationale
+[Wir88] does not state the scope of the unary minus operator other than through the grammar.
+An expression of the form
+− a ∗ b + c
+could be interpreted mathematically correct
+(−a) ∗ b + c
+or grammatically correct
+−(a ∗ b + c)
+The former interpretation conforms to mathematical convention. The latter can be deduced
+from the grammar in [Wir88, pp.156-157] and is intended to be the correct interpretation1 .
+1 The author obtained clarification on the precedence of unary minus from Prof. Wirth by email.
+Copyright c 2018 Benjamin Kowarsch – arXiv.org preprint for non-commercial useOn the Maintenance of Classic Modula-2 Compilers
+6
+However, this violates POLA [1.1.4] and some implementations therefore follow the mathemat-
+ically correct interpretation, for example the ACK compiler [Jac85] and the MOCKA compiler
+[EV94]. Requiring a factor after a unary minus forces the use of parentheses whenever there is
+more than one factor to follow which makes programmer intent explicit.
+3.3.2
+Backwards Compatibility
+Unary minus is an infrequently used operation. When it is used, it is usually in a form that
+is compliant with the syntax proposed in this paper. In the unlikely event that it is not in
+a compliant form, the source code is ambiguous and needed to be fixed anyway. It may well
+have been written for and tested with a compiler that uses a different interpretation than the
+compiler now used to compile the sources. The proposed mitigation will thereby help identify
+any non-compliant occurrences which can then be corrected with minimal effort.
+4Pervasives
+4.1Conversion
+Pervasive function VAL() should be changed to cover all numeric conversions and numeric conver-
+sions only. Pervasive functions FLOAT() and TRUNC() should then be deprecated. Any additional
+non-standard conversion functions such as INT(), CARD() and LFLOAT() should be removed.
+4.1.1
+Rationale
+[Wir88, p.150] specifies pevasive conversion function VAL() which covers all possible use cases for
+safe type conversion between whole number types. There is no reason why VAL() could not also
+cover all possible use cases for conversions between whole and real number types. By contrast,
+CHR() and ORD() are not conversion functions2 and they should not be duplicated by VAL().
+Duplication violates SSP [1.1.1].
+Furthermore, function FLOAT() is confusingly named since the type it converts to is REAL and
+there is no type FLOAT. [Wir88] does not specify how real number types are to be implemented.
+They need not be implemented as floating point numbers but could be implemented as binary
+coded decimals, for instance. The naming of FLOAT() is thus misleading and violates COSP [1.1.3]
+and POLA [1.1.4].
+Finally, function TRUNC() violates SRP [1.1.5] as it represents both a conversion function and
+the mathematical function trunc(x). Its name is misleading as it does not suggest conversion,
+violating POLA [1.1.4]. Conversion should be the responsibility of function VAL() and truncation
+the responsibility of a math function trunc() to be provided in a library such as MathLib and
+return the same type as its argument, it should not perform any type conversion.
+4.1.2
+Substitution
+Once function VAL() has been extended to provide type conversion between whole and real
+number types, any invocation of functions FLOAT() and TRUNC() within existing source code may
+be safely replaced with an invocation of VAL().
+4.1.3
+Backwards Compatibility
+Backwards compatibility can be provided via compiler switch.
+4.1.4
+Implementation
+It should be noted that function VAL() is not generally implemented as a single function, nor
+should it be. Instead, it is usually and preferably implemented as a built-in macro, resolved
+at compile time to a function internal to the compiler that is specific to the source and target
+types of its arguments, since the types are known at compile time. VAL() thereby simplifies the
+user interface without incurring the penalty of increasing the complexity of its implementation.
+The specific conversion functions need to be implemented within the compiler anyway, but they
+should not be individually exposed in the user interface.
+2 CHR() performs a lookup while ORD() returns a property.
+Copyright c 2018 Benjamin Kowarsch – arXiv.org preprint for non-commercial useOn the Maintenance of Classic Modula-2 Compilers
+5Semantics
+5.1Exported Variables
+7
+Variables defined in definition parts should be exported read-only.
+5.1.1
+Rationale
+Allowing a client module to write to imported variables violates POIH [1.1.6]. And indeed,
+[Wir88, p.88] explicitly states that “imported variables should be treated as ‘read-only’ objects”.
+5.1.2
+Substitution
+A setter procedure can be defined and exported by the same module if needed.
+DEFINITION MODULE Foo;
+VAR bar : Bar; (∗ read−only ∗)
+PROCEDURE SetBar ( value : Bar );
+END Foo.
+5.1.3
+Backwards Compatibility
+Considering that Wirth explicitly stated to treat imported variables as “read-only” objects, noone
+should have written any code that treats them as mutable objects. Unfortunately, there will be
+code written by careless programmers who didn’t follow his advice. The cautious maintainer may
+therefore consider providing a compiler switch to enable and disable write-access to imported
+variables, which should then be disabled by default.
+5.2
+Pointer Variables
+All pointer variables should be initialised to NIL and deallocation should reset them to NIL.
+5.2.1
+Rationale
+The two primary paradigms of Modula-2 are (a) program decomposition through data encapsu-
+lation and information hiding, and (b) reliability through type safety. Opaque pointer types are
+the primary instrument through which the former is achieved. The ability to test whether an
+opaque pointer type has been allocated or deallocated is central to achieving the latter.
+5.2.2
+Backwards Compatibility
+The proposed mitigation does not impact the compatibility of legacy sources.
+5.3
+Unsafe Facilities
+Any facility that bypasses the type safety provided by the language should be disabled by default.
+5.3.1
+Unsafe Facilities provided by SYSTEM
+[Wir88, p.121] defines pseudo-module SYSTEM as a container for unsafe facilities. The facilities
+provided therein are only enabled by import. This is desirable as it sensitises programmers to
+the fact that the facilities are unsafe and thereby discourages their use.
+Copyright c 2018 Benjamin Kowarsch – arXiv.org preprint for non-commercial useOn the Maintenance of Classic Modula-2 Compilers
+5.3.2
+8
+Unsafe Facilities NOT provided by SYSTEM
+Unfortunately, not all unsafe facilities are provided through pseudo-module SYSTEM. Two unsafe
+facilities are provided in the language core and are enabled by default without import:
+(1) Unsafe type transfers [Wir88, p.119], also known as type casts
+(2) Records with variant parts [Wir88, p.71, p.138], also known as variant records
+This is a violation of SPP [1.1.7] and given its implications for program safety it is unacceptable.
+In order to mitigate this situation, support for type casts and variant records should be disabled
+by default and require enabling by compiler switch.
+5.3.3
+Ideal World Scenario
+In an ideal world, the type cast syntax would be replaced with a CAST() function provided by
+SYSTEM as in ISO Modula-2 [JTC96], and variant records with type safe extensible records as
+in Oberon [Wir90]. However, this would constitute a substantial language revision and as such
+go beyond the scope of the maintenance aspect of this paper. It would also run counter to the
+objective to allow the compilation of programming examples in the literature with minimal effort.
+6Language Extensions
+6.1Availability
+All language extensions should be disabled by default and only enabled by compiler switch.
+6.1.1
+Rationale
+Disabling language extensions by default aids and promotes writing of portable source code.
+6.2
+Smallest Addressable Unit
+Under no circumstances should any implementation change the definition of type SYSTEM.WORD.
+However, an implementation targeting an architecture where the smallest addressable storage
+unit is eight bits wide should provide an alias type BYTE in module SYSTEM as follows:
+TYPE BYTE = WORD;
+6.2.1
+Rationale
+[Wir88, p.153] specifies SYSTEM.WORD as the smallest addressable unit3 . Whilst the report permits
+provision of additional facilities in SYSTEM, it does not permit alterations of SYSTEM facilities
+specified in the report.
+It would thus be permissible to provide an additional type SYSTEM.MACHINEWORD that represents
+a machine word larger than the smallest addressable unit, but it is not permissible to change
+SYSTEM.WORD to represent a machine word that is not the smallest addressable unit.
+6.3
+Foreign Identifiers
+An implementation that provides a means to interface to foreign APIs, should also allow the
+use of foreign identifiers. Such an identifier may contain one or more dollar $ and/or lowline
+_ characters. The use of foreign identifiers for other purposes should be discouraged. Support
+should be disabled by default and enabled by compiler switch when needed.
+To avoid any collission with name mangled symbols generated by the Modula-2 compiler, no
+consecutive and no trailing dollar signs should be permitted; no leading, no consecutive and no
+trailing lowlines should be permitted. Further, dollar signs and lowlines should not be permitted
+within module identifiers.
+3 When the first report on Modula-2 was written it was still common to call the smallest addressable storage
+unit a word. Since then the terminology has changed and it has become common to use the term byte instead.
+Copyright c 2018 Benjamin Kowarsch – arXiv.org preprint for non-commercial useOn the Maintenance of Classic Modula-2 Compilers
+6.3.1
+9
+Rationale
+Operating system APIs and other foreign APIs often include variables and procedures with
+identifiers that include dollar $ (predominantly on the VMS operating system) and lowline _
+(predominantly on Unix systems and C APIs in general).
+6.4
+Foreign Definition Modules
+An implementation that provides a means to interface to foreign APIs, should use a non-semantic
+compiler directive to mark a definition module as a foreign definition module.
+6.4.1
+Rationale
+[Wir88] does not mention foreign definition modules. As a result, implementors have invented
+their own syntax to mark a definition module as foreign, and this varies between implementations.
+However, the corresponding implementation could in principle be done in Modula-2. The
+marking of a definition module as foreign does not alter its semantics. Consequently, any such
+marking constitutes de-facto a non-semantic compiler directive.
+6.4.2
+Proposed Syntax
+The directive should be placed after the module header, its proposed syntax is as follows:
+ffiPragma :=
+’(*$’ ffiPragmaKey ’=’ ’"’ foreignAPI ’"’ ’*)’
+;
+ffiPragmaKey :=
+’F’ | /* if implementation uses single-letter keys */
+’FFI’ /* if implementation uses multi-letter keys */
+;
+foreignAPI :=
+’ASM’ | ’C’ | ’Fortran’ | ’Pascal’ | ...
+;
+7Miscellaneous
+7.1Filename Suffixes
+Modula-2 implementations should only recognise input files with suffixes def and mod.
+7.1.1
+Rationale
+Neither [Wir78] nor [Wir88] mention filename suffixes for Modula-2 source files. A de-facto
+standard has been established by the compilers distributed by ETH Zürich: Suffix def is used
+for definition module files and suffix mod for implementation and program module files.
+The absence of any mentioning of filename suffixes in [Wir78] and [Wir88] has been taken by
+some implementors as an invitation to define their own non-standard filename suffixes.
+The use of non-standard suffixes leads to unnecessary effort when compiling sources across dif-
+ferent implementations. Moreover, it has led to conflicts with other notations in and inconsistent
+support for Modula-2 by various text editors and source code renderers.
+7.2
+Pre-Revision Compilers
+An implementation that follows the original monograph [Wir78] or the second edition [Wir83]
+should be updated to follow the third [Wir85] or, preferably the fourth [Wir88] edition.
+7.2.1
+Rationale
+Prior to [Wir85] a definition module was required to have an export list. This was unnecessary
+duplication since the purpose of a definition module is to export all its contents.
+Copyright c 2018 Benjamin Kowarsch – arXiv.org preprint for non-commercial useOn the Maintenance of Classic Modula-2 Compilers
+10
+Definitions
+API
+Application programming interface.
+compiler directive
+A directive within the source to instruct a language processor how to process the input.
+ETH
+Eidgenössisch Technische Hochschule – Swiss Federal Institute of Technology.
+foreign API
+An API implemented in a language other than Modula-2.
+foreign definition module
+A definition module that specifies an interface to a foreign API .
+foreign identifier
+An identifier of a foreign API.
+non-semantic compiler directive
+A compiler directive that does not alter the semantics of the source code.
+offending facility
+A language facility that is (a) outdated, harmful or bad habit forming in general,
+or (b) violates any of the design principles in section 1.1 in particular.
+semantic compiler directive
+A compiler directive that alters the semantics of the source code.
+References
+[Dij78]Edsger W. Dijkstra. On the GREEN Language submitted to the DoD.
+E.W.Dijkstra Archive, originally circulated privately, 1978.
+[EV94]H. Emmelmann and J. Vollmer. GMD Modula-2 System MOCKA User Manual, 1994.
+[Geo87] James Geoffrey. The Tao of Programming. InfoBooks, 1987.
+[Jac85] Ceriel J.H. Jacobs. The ACK Modula-2 Compiler, 1985.
+[JTC96] ISO/IEC JTC1/SC22/WG13. Information Technology – Programming Languages –
+Part 1: Modula-2, Base Language. International Standard 10514-1, ISO/IEC, 1996.
+[Knu84] Donald E. Knuth. Literate Programming. The Computer Journal, 27(2), 1984.
+[Mar09] Robert C. Martin. Clean Code: A Handbook of Agile Software Craftsmanship.
+Prentice Hall, 2009.
+[Par72] David L. Parnas. On the Criteria to be Used in Decomposing Systems into Modules.
+Comunications of the ACM, 15(12), 1972.
+[Sal74]
+Jerome H. Saltzer. The Protection of Information in Computer Systems.
+Comunications of the ACM, 17(7), 1974.
+[Wir78] Niklaus Wirth. Modula-2. Technical report, ETH Zürich, 1978.
+[Wir83] Niklaus Wirth. Programming in Modula-2. Springer, Heidelberg, 2nd edition, 1983.
+[Wir85] Niklaus Wirth. Programming in Modula-2. Springer, Heidelberg, 3rd edition, 1985.
+[Wir88] Niklaus Wirth. Programming in Modula-2. Springer, Heidelberg, 4th edition, 1988.
+[Wir90] Niklaus Wirth. Oberon Language Report. Technical report, ETH Zürich, 1990.
+Copyright c 2018 Benjamin Kowarsch – arXiv.org preprint for non-commercial use

docs/summary_m2comp_step1.md

@@ -0,0 +1,56 @@
+# m2comp step 1 — Coco/R syntax front end (tag: `m2comp-step1`)
+
+## Goal
+
+Fresh `m2comp/` project (distinct from `m2c/` at step 11): prove the
+toolchain end to end before any language work — Coco/R grammar
+→ generated scanner/parser/driver → `gm2 -fiso` build → test runner.
+Lexer and parser are FULLY Coco/R-generated; no hand-written lexer.
+
+## What was built
+
+- `m2comp/src/M2comp.atg` — Modula-2 program modules:
+  `MODULE` + `FROM/IMPORT`, `CONST/TYPE/VAR`, `PROCEDURE` (nested,
+  value/`VAR` params, function result), local `MODULE`s (Wirth form:
+  `[Priority]`, `[Export [QUALIFIED]]`), statements (assign/call, `IF`,
+  `WHILE`, `REPEAT`, `LOOP/EXIT`, `FOR/BY`, `RETURN`), full expressions.
+  Only check is the `MODULE`/`END` name match (error 202).
+- Kowarsch adaptations (from `docs/`, arXiv:1809.07080): unary minus
+  takes a `Factor` (§3.3: `-b+c` ok, bare `-b*c+a` rejected, parens
+  required); abbreviated multi-dim arrays via comma index list with
+  subrange-capable `IndexType` (§3.1 strict); no octal `B`/`C` suffixes
+  (§2.1); `<>` kept (open, §2.2); `(*$ *)` still comments (open, §2.3/2.4).
+- `m2comp/src/` holds ALL sources: `M2comp.atg`, `compiler.frm`
+  (listing driver, no `SymTab`/`MGen` yet), `scanner.frm`,
+  `parser.frm`, `FileIO.def/.mod` (copied from `m2c/`), generated
+  `M2compS/M2compP/M2comp` (`.def/.mod`), `Hello.mod` (gm2 smoke test).
+  Deleted as unnecessary: hand `M2Lex` (replaced by `M2compS`),
+  unused `Err`, empty `build/`.
+- `m2comp/build.sh` — regenerate (`CRFRAMES=src CR -m -C`),
+  compile with `gm2 -fiso`, link via the two-phase module-list
+  workaround; produces `./M2comp` (project root).
+- `m2comp/run_tests.sh` — `expect_ok`/`expect_fail` on
+  `tests/ok_minimal.mod`, `tests/ok_proc.mod` (local module,
+  2-D abbreviated array, `-v+1`), `tests/bad_mismatch.mod` (202).
+
+## Tests — 3/3
+
+| test | result |
+| ---- | ------ |
+| ok_minimal | `MODULE M; BEGIN END M.` accepted |
+| ok_proc | imports, `VAR`, 2-D array, proc + local module accepted |
+| bad_mismatch | `END WrongName` rejected (`Incorrect source`) |
+
+`gm2 -fiso src/Hello.mod` → `Hello m2comp (gm2 -fiso)` verified.
+
+## Notes
+
+- Grammar name `M2comp` keeps generated modules short
+  (`M2compS`/`M2compP`/`M2comp`, no Coco/R truncation surprises).
+- LL(1) fix: `FieldSeq = Field { ";" Field }` (first field mandatory,
+  may be empty) — the fully-optional form made `END` ambiguous.
+- ISO gotchas: no anonymous `ARRAY[0..63]` formals (open
+  `ARRAY OF CHAR` in `GetIdent`); no whole-array `#` (name match via
+  `Strings.Equal`, hence `IMPORT Strings` in the `.atg`).
+- Step 2: `SymTab` (duplicate/undeclared, type checks 200/210-224,
+  nested-`ARRAY OF ARRAY` long-form flag) + `MGen`/MC64 backend.

run_tests.sh

@@ -0,0 +1,23 @@
+#!/bin/sh
+# Regression for M2comp step 1 (Coco/R syntax front end).
+# Usage: ./run_tests.sh   (from the m2comp directory)
+pass=0; fail=0
+expect_ok() {
+  if ./M2comp "$1" 2>&1 | grep -q "Parsed correctly"; then
+    pass=$((pass+1)); echo "PASS(ok): $1"
+  else
+    fail=$((fail+1)); echo "FAIL(ok, rejected): $1"
+  fi
+}
+expect_fail() {
+  if ./M2comp "$1" 2>&1 | grep -q "Incorrect source"; then
+    pass=$((pass+1)); echo "PASS(fail): $1"
+  else
+    fail=$((fail+1)); echo "FAIL(fail, accepted): $1"
+  fi
+}
+expect_ok tests/ok_minimal.mod
+expect_ok tests/ok_proc.mod
+expect_fail tests/bad_mismatch.mod
+echo "--- $pass passed, $fail failed ---"
+[ "$fail" -eq 0 ]

src/FileIO.def

@@ -0,0 +1,330 @@
+DEFINITION MODULE FileIO;
+(* This module attempts to provide several potentially non-portable
+   facilities for Coco/R.
+
+   (a)  A general file input/output module, with all routines required for
+        Coco/R itself, as well as several other that would be useful in
+        Coco-generated applications.
+   (b)  Definition of the "LONGINT" type needed by Coco.
+   (c)  Some conversion functions to handle this long type.
+   (d)  Some "long" and other constant literals that may be problematic
+        on some implementations.
+   (e)  Some string handling primitives needed to interface to a variety
+        of known implementations.
+
+   The intention is that the rest of the code of Coco and its generated
+   parsers should be as portable as possible.  Provided the definition
+   module given, and the associated implementation, satisfy the
+   specification given here, this should be almost 100% possible (with
+   the exception of a few constants, avoid changing anything in this
+   specification).
+
+   FileIO is based on code by MB 1990/11/25; heavily modified and extended
+   by PDT and others between 1992/1/6 and the present day. *)
+
+(* This is the ISO Gardens Point Modula (Linux/FreeBSD) version *)
+
+IMPORT SYSTEM, Strings;
+
+TYPE
+  File;                (* Preferably opaque *)
+  INT32 = INTEGER;     (* This may require a special import; on 32 bit
+                          systems INT32 = INTEGER may even suffice. *)
+
+CONST
+  EOF = 0C;            (* FileIO.Read returns EOF when eof is reached. *)
+  EOL = 12C;           (* FileIO.Read maps line marks onto EOL
+                          FileIO.Write maps EOL onto cr, lf, or cr/lf
+                          as appropriate for filing system. *)
+  ESC = 33C;           (* Standard ASCII escape. *)
+  CR  = 15C;           (* Standard ASCII carriage return. *)
+  LF  = 12C;           (* Standard ASCII line feed. *)
+  BS  = 10C;           (* Standard ASCII backspace. *)
+  DEL = 177C;          (* Standard ASCII DEL (rub-out). *)
+
+  BitSetSize = 16;     (* number of bits actually used in BITSET type *)
+
+  Long0 = VAL(INT32, 0); (* Some systems allow 0 or require 0L. *)
+  Long1 = VAL(INT32, 1); (* Some systems allow 1 or require 1L. *)
+  Long2 = VAL(INT32, 2); (* Some systems allow 2 or require 2L. *)
+
+  FrmExt = ".frm";     (* supplied frame files have this extension. *)
+  TxtExt = ".txt";     (* generated text files may have this extension. *)
+  ErrExt = ".err";     (* generated error files may have this extension. *)
+  DefExt = ".def";     (* generated definition modules have this extension. *)
+  PasExt = ".pas";     (* generated Pascal units have this extension. *)
+  ModExt = ".mod";     (* generated implementation/program modules have this
+                          extension. *)
+  PathSep = ":";       (* separate components in path environment variables
+                          DOS = ";"  UNIX = ":" *)
+  DirSep  = "/";       (* separate directory element of file specifiers
+                          DOS = "\"  UNIX = "/" *)
+
+VAR
+  Okay: BOOLEAN;       (* Status of last I/O operation. *)
+  con, err:  File;     (* Standard terminal and error channels. *)
+  StdIn, StdOut: File; (* standard input/output - redirectable *)
+  EOFChar: CHAR;       (* Signal EOF interactively *)
+
+(* The following routines provide access to command line parameters and
+   the environment. *)
+
+PROCEDURE NextParameter (VAR s: ARRAY OF CHAR);
+(* Extracts next parameter from command line.
+   Returns empty string (s[0] = 0C) if no further parameter can be found. *)
+
+PROCEDURE GetEnv (envVar: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
+(* Returns s as the value of environment variable envVar, or empty string
+   if that variable is not defined. *)
+
+(* The following routines provide a minimal set of file opening routines
+   and closing routines. *)
+
+PROCEDURE Open (VAR f: File; fileName: ARRAY OF CHAR; newFile: BOOLEAN);
+(* Opens file f whose full name is specified by fileName.
+   Opening mode is specified by newFile:
+       TRUE:  the specified file is opened for output only.  Any existing
+              file with the same name is deleted.
+      FALSE:  the specified file is opened for input only.
+   FileIO.Okay indicates whether the file f has been opened successfully. *)
+
+PROCEDURE SearchFile (VAR f: File; envVar, fileName: ARRAY OF CHAR;
+                      newFile: BOOLEAN);
+(* As for Open, but tries to open file of given fileName by searching each
+   directory specified by the environment variable named by envVar. *)
+
+PROCEDURE Close (VAR f: File);
+(* Closes file f.  f becomes NIL.
+   If possible, Close should be called automatically for all files that
+   remain open when the application terminates.  This will be possible on
+   implementations that provide some sort of termination or at-exit
+   facility. *)
+
+PROCEDURE CloseAll;
+(* Closes all files opened by Open or SearchFile.
+   On systems that allow this, CloseAll should be automatically installed
+   as the termination (at-exit) procedure *)
+
+(* The following utility procedure is not used by Coco, but may be useful.
+   However, some operating systems may not allow for its implementation. *)
+
+PROCEDURE Delete (VAR f: File);
+(* Deletes file f.  f becomes NIL. *)
+
+(* The following routines provide a minimal set of file name manipulation
+   routines.  These are modelled after MS-DOS conventions, where a file
+   specifier is of a form exemplified by D:\DIR\SUBDIR\PRIMARY.EXT
+   Other conventions may be introduced; these routines are used by Coco to
+   derive names for the generated modules from the grammar name and the
+   directory in which the grammar specification is located. *)
+
+PROCEDURE ExtractDirectory (fullName: ARRAY OF CHAR;
+                            VAR directory: ARRAY OF CHAR);
+(* Extracts D:\DIRECTORY\ portion of fullName. *)
+
+PROCEDURE ExtractFileName (fullName: ARRAY OF CHAR;
+                           VAR fileName: ARRAY OF CHAR);
+(* Extracts PRIMARY.EXT portion of fullName. *)
+
+PROCEDURE AppendExtension (oldName, ext: ARRAY OF CHAR;
+                           VAR newName: ARRAY OF CHAR);
+(* Constructs newName as complete file name by appending ext to oldName
+   if it doesn't end with "."  Examples: (assume ext = "EXT")
+         old.any ==> OLD.EXT
+         old.    ==> OLD.
+         old     ==> OLD.EXT
+   This is not a file renaming facility, merely a string manipulation
+   routine. *)
+
+PROCEDURE ChangeExtension (oldName, ext: ARRAY OF CHAR;
+                           VAR newName: ARRAY OF CHAR);
+(* Constructs newName as a complete file name by changing extension of
+   oldName to ext.  Examples: (assume ext = "EXT")
+         old.any ==> OLD.EXT
+         old.    ==> OLD.EXT
+         old     ==> OLD.EXT
+   This is not a file renaming facility, merely a string manipulation
+   routine. *)
+
+(* The following routines provide a minimal set of file positioning routines.
+   Others may be introduced, but at least these should be implemented.
+   Success of each operation is recorded in FileIO.Okay. *)
+
+PROCEDURE Length (f: File): INT32;
+(* Returns length of file f. *)
+
+PROCEDURE GetPos (f: File): INT32;
+(* Returns the current read/write position in f. *)
+
+PROCEDURE SetPos (f: File; pos: INT32);
+(* Sets the current position for f to pos. *)
+
+(* The following routines provide a minimal set of file rewinding routines.
+   These two are not currently used by Coco itself.
+   Success of each operation is recorded in FileIO.Okay *)
+
+PROCEDURE Reset (f: File);
+(* Sets the read/write position to the start of the file *)
+
+PROCEDURE Rewrite (f: File);
+(* Truncates the file, leaving open for writing *)
+
+(* The following routines provide a minimal set of input routines.
+   Others may be introduced, but at least these should be implemented.
+   Success of each operation is recorded in FileIO.Okay. *)
+
+PROCEDURE EndOfLine (f: File): BOOLEAN;
+(* TRUE if f is currently at the end of a line, or at end of file. *)
+
+PROCEDURE EndOfFile (f: File): BOOLEAN;
+(* TRUE if f is currently at the end of file. *)
+
+PROCEDURE Read (f: File; VAR ch: CHAR);
+(* Reads a character ch from file f.
+   Maps filing system line mark sequence to FileIO.EOL. *)
+
+PROCEDURE ReadAgain (f: File);
+(* Prepares to re-read the last character read from f.
+   There is no buffer, so at most one character can be re-read. *)
+
+PROCEDURE ReadLn (f: File);
+(* Reads to start of next line on file f, or to end of file if no next
+   line.  Skips to, and consumes next line mark. *)
+
+PROCEDURE ReadString (f: File; VAR str: ARRAY OF CHAR);
+(* Reads a string of characters from file f.
+   Leading blanks are skipped, and str is delimited by line mark.
+   Line mark is not consumed. *)
+
+PROCEDURE ReadLine (f: File; VAR str: ARRAY OF CHAR);
+(* Reads a string of characters from file f.
+   Leading blanks are not skipped, and str is terminated by line mark or
+   control character, which is not consumed. *)
+
+PROCEDURE ReadToken (f: File; VAR str: ARRAY OF CHAR);
+(* Reads a string of characters from file f.
+   Leading blanks and line feeds are skipped, and token is terminated by a
+   character <= ' ', which is not consumed. *)
+
+PROCEDURE ReadInt (f: File; VAR i: INTEGER);
+(* Reads an integer value from file f. *)
+
+PROCEDURE ReadCard (f: File; VAR i: CARDINAL);
+(* Reads a cardinal value from file f. *)
+
+PROCEDURE ReadBytes (f: File; VAR buf: ARRAY OF SYSTEM.BYTE; VAR len: CARDINAL);
+(* Attempts to read len bytes from the current file position into buf.
+   After the call, len contains the number of bytes actually read. *)
+
+(* The following routines provide a minimal set of output routines.
+   Others may be introduced, but at least these should be implemented. *)
+
+PROCEDURE Write (f: File; ch: CHAR);
+(* Writes a character ch to file f.
+   If ch = FileIO.EOL, writes line mark appropriate to filing system. *)
+
+PROCEDURE WriteLn (f: File);
+(* Skips to the start of the next line on file f.
+   Writes line mark appropriate to filing system. *)
+
+PROCEDURE WriteString (f: File; str: ARRAY OF CHAR);
+(* Writes entire string str to file f. *)
+
+PROCEDURE WriteText (f: File; text: ARRAY OF CHAR; len: INTEGER);
+(* Writes text to file f.
+   At most len characters are written.  Trailing spaces are introduced
+   if necessary (thus providing left justification). *)
+
+PROCEDURE WriteInt (f: File; int: INTEGER; wid: CARDINAL);
+(* Writes an INTEGER int into a field of wid characters width.
+   If the number does not fit into wid characters, wid is expanded.
+   If wid = 0, exactly one leading space is introduced. *)
+
+PROCEDURE WriteCard (f: File; card, wid: CARDINAL);
+(* Writes a CARDINAL card into a field of wid characters width.
+   If the number does not fit into wid characters, wid is expanded.
+   If wid = 0, exactly one leading space is introduced. *)
+
+PROCEDURE WriteBytes (f: File; VAR buf: ARRAY OF SYSTEM.BYTE; len: CARDINAL);
+(* Writes len bytes from buf to f at the current file position. *)
+
+(* The following procedures are not currently used by Coco, and may be
+   safely omitted, or implemented as null procedures.  They might be
+   useful in measuring performance. *)
+
+PROCEDURE WriteDate (f: File);
+(* Write current date DD/MM/YYYY to file f. *)
+
+PROCEDURE WriteTime (f: File);
+(* Write time HH:MM:SS to file f. *)
+
+PROCEDURE WriteElapsedTime (f: File);
+(* Write elapsed time in seconds since last call of this procedure. *)
+
+PROCEDURE WriteExecutionTime (f: File);
+(* Write total execution time in seconds thus far to file f. *)
+
+(* The following procedures are a minimal set used within Coco for
+   string manipulation.  They almost follow the conventions of the ISO
+   routines, and are provided here to interface onto whatever Strings
+   library is available.  On ISO compilers it should be possible to
+   implement most of these with CONST declarations, and even replace
+   SLENGTH with the pervasive function LENGTH at the points where it is
+   called.
+
+CONST
+  SLENGTH = Strings.Length;
+  Assign  = Strings.Assign;
+  Extract = Strings.Extract;
+  Concat  = Strings.Concat;
+
+*)
+
+PROCEDURE SLENGTH (stringVal: ARRAY OF CHAR): CARDINAL;
+(* Returns number of characters in stringVal, not including nul *)
+
+PROCEDURE Assign (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+(* Copies as much of source to destination as possible, truncating if too
+   long, and nul terminating if shorter.
+   Be careful - some libraries have the parameters reversed! *)
+
+PROCEDURE Extract (source: ARRAY OF CHAR;
+                   startIndex, numberToExtract: CARDINAL;
+                   VAR destination: ARRAY OF CHAR);
+(* Extracts at most numberToExtract characters from source[startIndex]
+   to destination.  If source is too short, fewer will be extracted, even
+   zero perhaps *)
+
+PROCEDURE Concat (stringVal1, stringVal2: ARRAY OF CHAR;
+                  VAR destination: ARRAY OF CHAR);
+(* Concatenates stringVal1 and stringVal2 to form destination.
+   Nul terminated if concatenation is short enough, truncated if it is
+   too long *)
+
+PROCEDURE Compare (stringVal1, stringVal2: ARRAY OF CHAR): INTEGER;
+(* Returns -1, 0, 1 depending whether stringVal1 < = > stringVal2.
+   This is not directly ISO compatible *)
+
+(* The following routines are for conversions to and from the INT32 type.
+   Their names are modelled after the ISO pervasive routines that would
+   achieve the same end.  Where possible, replacing calls to these routines
+   by the pervasives would improve performance markedly.  As used in Coco,
+   these routines should not give range problems. *)
+
+PROCEDURE ORDL (n: INT32): CARDINAL;
+(* Convert long integer n to corresponding (short) cardinal value.
+   Potentially FileIO.ORDL(n) = VAL(CARDINAL, n) *)
+
+PROCEDURE INTL (n: INT32): INTEGER;
+(* Convert long integer n to corresponding short integer value.
+   Potentially FileIO.INTL(n) = VAL(INTEGER, n) *)
+
+PROCEDURE INT (n: CARDINAL): INT32;
+(* Convert cardinal n to corresponding long integer value.
+   Potentially FileIO.INT(n) = VAL(INT32, n) *)
+
+PROCEDURE QuitExecution;
+(* Close all files and halt execution.
+   On some implementations QuitExecution will be simply implemented as HALT *)
+
+END FileIO.

src/FileIO.mod

@@ -0,0 +1,881 @@
+IMPLEMENTATION MODULE FileIO;
+(* ISO (GPM) version by Pat Terry.  Sat  04-25-98  p.terry@ru.ac.za *)
+
+(* This module attempts to provide several potentially non-portable
+   facilities for Coco/R.
+
+   (a)  A general file input/output module, with all routines required for
+        Coco/R itself, as well as several other that would be useful in
+        Coco-generated applications.
+   (b)  Definition of the "LONGINT" type needed by Coco.
+   (c)  Some conversion functions to handle this long type.
+   (d)  Some "long" and other constant literals that may be problematic
+        on some implementations.
+   (e)  Some string handling primitives needed to interface to a variety
+        of known implementations.
+
+   The intention is that the rest of the code of Coco and its generated
+   parsers should be as portable as possible.  Provided the definition
+   module given, and the associated implementation, satisfy the
+   specification given here, this should be almost 100% possible.
+
+   FileIO is based on code by MB 1990/11/25; heavily modified and extended
+   by PDT and others between 1992/1/6 and the present day. *)
+
+IMPORT (* GNU Modula-2 specific *) Environment,FileSysOp,
+       SYSTEM, Strings, SysClock, ProgramArgs, TextIO, RawIO, WholeIO,
+       IOChan, IOResult, RndFile, TermFile, StdChans, ChanConsts;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE;
+
+CONST
+  MaxFiles = BitSetSize;
+  NameLength = 256;
+
+TYPE
+  File = POINTER TO FileRec;
+  FileRec = RECORD
+              ref: IOChan.ChanId;
+              self: File;
+              handle: CARDINAL;
+              savedCh: CHAR;
+              textOK, eof, eol, noOutput, noInput, haveCh: BOOLEAN;
+              name: ARRAY [0 .. NameLength] OF CHAR;
+            END;
+
+VAR
+  Handles: BITSET;
+  Opened: ARRAY [0 .. MaxFiles-1] OF File;
+  FromKeyboard, ToScreen: BOOLEAN;
+  res: ChanConsts.OpenResults;
+
+PROCEDURE NotRead (f: File): BOOLEAN;
+  BEGIN
+    RETURN (f = NIL) OR (f^.self # f) OR (f^.noInput);
+  END NotRead;
+
+PROCEDURE NotWrite (f: File): BOOLEAN;
+  BEGIN
+    RETURN (f = NIL) OR (f^.self # f) OR (f^.noOutput);
+  END NotWrite;
+
+PROCEDURE NotFile (f: File): BOOLEAN;
+  BEGIN
+    RETURN (f = NIL) OR (f^.self # f) OR (f = con) OR (f = err)
+      OR (f = StdIn) & FromKeyboard
+      OR (f = StdOut) & ToScreen
+  END NotFile;
+
+PROCEDURE CheckRedirection;
+  BEGIN
+    FromKeyboard := TRUE; ToScreen := TRUE; (* ISO fail safe *)
+    (* Ideally we would like
+       FromKeyboard := NOT (StdIn has been redirected )
+       ToScreen := NOT (StdOut has been redirected )
+    *)
+  END CheckRedirection;
+
+PROCEDURE ASCIIZ (VAR s1, s2: ARRAY OF CHAR);
+(* Convert s2 to a nul terminated string in s1 *)
+  VAR
+    i: CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE (i <= HIGH(s2)) & (s2[i] # 0C) DO
+      s1[i] := s2[i]; INC(i)
+    END;
+    s1[i] := 0C
+  END ASCIIZ;
+
+PROCEDURE NextParameter (VAR s: ARRAY OF CHAR);
+  BEGIN
+    IF ProgramArgs.IsArgPresent()
+      THEN
+        TextIO.ReadToken(ProgramArgs.ArgChan(), s);
+        ProgramArgs.NextArg()
+      ELSE s[0] := 0C
+    END
+  END NextParameter;
+
+PROCEDURE GetEnv (envVar: ARRAY OF CHAR; VAR s: ARRAY OF CHAR);
+(* ++++ GNU Modula-2 specific routine used ++++ *)
+
+  VAR
+    OK : BOOLEAN;
+
+  BEGIN
+    OK := Environment.GetEnvironment(envVar, s);
+  END GetEnv;
+
+PROCEDURE Open (VAR f: File; fileName: ARRAY OF CHAR; newFile: BOOLEAN);
+  VAR
+    i: CARDINAL;
+    name: ARRAY [0 .. NameLength] OF CHAR;
+  BEGIN
+    ExtractFileName(fileName, name);
+    FOR i := 0 TO NameLength - 1 DO name[i] := CAP(name[i]) END;
+    IF (name[0] = 0C) OR (Compare(name, "CON") = 0) THEN
+      (* con already opened, but reset it *)
+      Okay := TRUE; f := con;
+      f^.savedCh := 0C; f^.haveCh := FALSE;
+      f^.eof := FALSE; f^.eol := FALSE; f^.name := "CON";
+      RETURN
+    ELSIF Compare(name, "ERR") = 0 THEN
+      Okay := TRUE; f := err; RETURN
+    ELSE
+      ALLOCATE(f, SYSTEM.TSIZE(FileRec));
+      (* Flags below may have to be altered according to implementation *)
+      IF newFile
+        THEN RndFile.OpenClean(f^.ref, fileName,
+             RndFile.old (* + RndFile.text *) + RndFile.raw, res)
+        ELSE RndFile.OpenOld(f^.ref, fileName,
+             RndFile.read (* + RnfDile.text *) +RndFile.raw, res)
+      END;
+      Okay := res = RndFile.opened;
+      IF ~ Okay
+        THEN
+          DEALLOCATE(f, SYSTEM.TSIZE(FileRec)); f := NIL
+        ELSE
+      (* textOK below may have to be altered according to implementation *)
+          f^.savedCh := 0C; f^.haveCh := FALSE; f^.textOK := FALSE;
+          f^.eof := newFile; f^.eol := newFile; f^.self := f;
+          f^.noInput := newFile; f^.noOutput := ~ newFile;
+          ASCIIZ(f^.name, fileName);
+          i := 0 (* find next available filehandle *);
+          WHILE (i IN Handles) & (i < MaxFiles) DO INC(i) END;
+          IF i < MaxFiles
+            THEN f^.handle := i; INCL(Handles, i); Opened[i] := f
+            ELSE WriteString(err, "Too many files"); Okay := FALSE
+          END;
+      END
+    END
+  END Open;
+
+PROCEDURE Close (VAR f: File);
+  BEGIN
+    Okay := TRUE;
+    IF NotFile(f) OR (f = StdIn) OR (f = StdOut)
+      THEN Okay := FALSE
+      ELSE
+        EXCL(Handles, f^.handle);
+        RndFile.Close(f^.ref);
+        IF Okay THEN DEALLOCATE(f, SYSTEM.TSIZE(FileRec)) END;
+        f := NIL
+    END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; f := NIL; RETURN
+*)
+  END Close;
+
+PROCEDURE Delete (VAR f: File);
+(* ++++ GNU Modula-2 specific routine used ++++ *)
+  VAR
+    fname : ARRAY [0 .. NameLength] OF CHAR;
+  BEGIN
+    IF NotFile(f) OR (f = StdIn) OR (f = StdOut)
+      THEN Okay := FALSE
+      ELSE
+        Assign(f^.name, fname);
+        Close(f);
+        Okay := FileSysOp.Unlink(fname);
+    END
+  END Delete;
+
+PROCEDURE SearchFile (VAR f: File; envVar, fileName: ARRAY OF CHAR;
+                      newFile: BOOLEAN);
+  VAR
+    i, j: INTEGER;
+    k: CARDINAL;
+    c: CHAR;
+    fname: ARRAY [0 .. NameLength] OF CHAR;
+    path: ARRAY [0 .. NameLength] OF CHAR;
+  BEGIN
+    FOR k := 0 TO HIGH(envVar) DO envVar[k] := CAP(envVar[k]) END;
+    GetEnv(envVar, path);
+    i := 0;
+    REPEAT
+      j := 0;
+      REPEAT
+        c := path[i]; fname[j] := c; INC(i); INC(j)
+      UNTIL (c = PathSep) OR (c = 0C);
+      IF (j > 1) & (fname[j-2] = DirSep) THEN DEC(j) ELSE fname[j-1] := DirSep END;
+      fname[j] := 0C; Concat(fname, fileName, fname);
+      Open(f, fname, newFile);
+    UNTIL (c = 0C) OR Okay
+  END SearchFile;
+
+PROCEDURE ExtractDirectory (fullName: ARRAY OF CHAR;
+                            VAR directory: ARRAY OF CHAR);
+  VAR
+    i, start: CARDINAL;
+  BEGIN
+    start := 0; i := 0;
+    WHILE (i <= HIGH(fullName)) & (fullName[i] # 0C) DO
+      IF i <= HIGH(directory) THEN
+        directory[i] := fullName[i];
+      END;
+      IF (fullName[i] = ":") OR (fullName[i] = DirSep) THEN start := i + 1 END;
+      INC(i)
+    END;
+    IF start <= HIGH(directory) THEN directory[start] := 0C END
+  END ExtractDirectory;
+
+PROCEDURE ExtractFileName (fullName: ARRAY OF CHAR;
+                           VAR fileName: ARRAY OF CHAR);
+  VAR
+    i, l, start: CARDINAL;
+  BEGIN
+    start := 0; l := 0;
+    WHILE (l <= HIGH(fullName)) & (fullName[l] # 0C) DO
+      IF (fullName[l] = ":") OR (fullName[l] = DirSep) THEN start := l + 1 END;
+      INC(l)
+    END;
+    i := 0;
+    WHILE (start < l) & (i <= HIGH(fileName)) DO
+      fileName[i] := fullName[start]; INC(start); INC(i)
+    END;
+    IF i <= HIGH(fileName) THEN fileName[i] := 0C END
+  END ExtractFileName;
+
+PROCEDURE AppendExtension (oldName, ext: ARRAY OF CHAR;
+                           VAR newName: ARRAY OF CHAR);
+  VAR
+    i, j: CARDINAL;
+    fn: ARRAY [0 .. NameLength] OF CHAR;
+  BEGIN
+    ExtractDirectory(oldName, newName);
+    ExtractFileName(oldName, fn);
+    i := 0; j := 0;
+    WHILE (i <= NameLength) & (fn[i] # 0C) DO
+      IF fn[i] = "." THEN j := i + 1 END;
+      INC(i)
+    END;
+    IF (j # i) (* then name did not end with "." *) OR (i = 0) THEN
+      IF j # 0 THEN i := j - 1 END;
+      IF (ext[0] # ".") & (ext[0] # 0C) THEN
+        IF i <= NameLength THEN fn[i] := "."; INC(i) END
+      END;
+      j := 0;
+      WHILE (j <= HIGH(ext)) & (ext[j] # 0C) & (i <= NameLength) DO
+        fn[i] := ext[j]; INC(i); INC(j)
+      END
+    END;
+    IF i <= NameLength THEN fn[i] := 0C END;
+    Concat(newName, fn, newName)
+  END AppendExtension;
+
+PROCEDURE ChangeExtension (oldName, ext: ARRAY OF CHAR;
+                           VAR newName: ARRAY OF CHAR);
+  VAR
+    i, j: CARDINAL;
+    fn: ARRAY [0 .. NameLength] OF CHAR;
+  BEGIN
+    ExtractDirectory(oldName, newName);
+    ExtractFileName(oldName, fn);
+    i := 0; j := 0;
+    WHILE (i <= NameLength) & (fn[i] # 0C) DO
+      IF fn[i] = "." THEN j := i + 1 END;
+      INC(i)
+    END;
+    IF j # 0 THEN i := j - 1 END;
+    IF (ext[0] # ".") & (ext[0] # 0C) THEN
+      IF i <= NameLength THEN fn[i] := "."; INC(i) END
+    END;
+    j := 0;
+    WHILE (j <= HIGH(ext)) & (ext[j] # 0C) & (i <= NameLength) DO
+      fn[i] := ext[j]; INC(i); INC(j)
+    END;
+    IF i <= NameLength THEN fn[i] := 0C END;
+    Concat(newName, fn, newName)
+  END ChangeExtension;
+
+PROCEDURE Length (f: File): INT32;
+(* ++++ implementation specific coercion routine may have to be used ++++ *)
+  VAR
+    pos: RndFile.FilePos;
+  BEGIN
+    IF NotFile(f)
+      THEN
+        Okay := FALSE; RETURN Long0
+      ELSE
+        Okay := TRUE;
+        pos := RndFile.EndPos(f^.ref);
+        (* ++++ GPM specific routine used ++++ *)
+        RETURN VAL(INT32, pos)
+    END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; RETURN Long0
+*)
+  END Length;
+
+PROCEDURE GetPos (f: File): INT32;
+(* ++++ implementation specific coercion routine may have to be used ++++ *)
+  VAR
+    pos: RndFile.FilePos;
+  BEGIN
+    IF NotFile(f)
+      THEN
+        Okay := FALSE; RETURN Long0
+      ELSE
+        Okay := TRUE;
+        pos := RndFile.CurrentPos(f^.ref);
+        (* ++++ GPM specific casting used ++++ *)
+        RETURN VAL(INT32, pos)
+    END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; RETURN Long0
+*)
+  END GetPos;
+
+PROCEDURE SetPos (f: File; pos: INT32);
+(* ++++ implementation specific coercion routine may have to be used ++++ *)
+  BEGIN
+    IF NotFile(f)
+      THEN
+        Okay := FALSE
+      ELSE
+        Okay := TRUE; f^.haveCh := FALSE;
+        (* ++++ GPM specific routine used ++++ *)
+        RndFile.SetPos(f^.ref, VAL(CARDINAL, pos));
+    END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; f^.haveCh := FALSE; RETURN
+*)
+  END SetPos;
+
+PROCEDURE Reset (f: File);
+  BEGIN
+    IF NotFile(f)
+      THEN
+        Okay := FALSE
+      ELSE
+        SetPos(f, 0);
+        IF Okay THEN
+          f^.haveCh := FALSE; f^.eof := f^.noInput; f^.eol := f^.noInput
+        END
+    END
+  END Reset;
+
+PROCEDURE Rewrite (f: File);
+  BEGIN
+    IF NotFile(f)
+      THEN
+        Okay := FALSE
+      ELSE
+        RndFile.Close(f^.ref);
+        (* Flags below may have to be altered according to implementation *)
+        RndFile.OpenClean(f^.ref, f^.name,
+                          RndFile.old + (* RndFile.text + *) RndFile.raw, res);
+        Okay := res = RndFile.opened;
+        IF ~ Okay
+          THEN
+            DEALLOCATE(f, SYSTEM.TSIZE(FileRec)); f := NIL
+          ELSE
+            f^.savedCh := 0C; f^.haveCh := FALSE;
+            f^.eof := TRUE; f^.eol := TRUE; 
+            f^.noInput := TRUE; f^.noOutput := FALSE;
+        END
+    END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; RETURN
+*)
+  END Rewrite;
+
+PROCEDURE EndOfLine (f: File): BOOLEAN;
+  BEGIN
+    IF NotRead(f)
+      THEN Okay := FALSE; RETURN TRUE
+      ELSE Okay := TRUE; RETURN f^.eol OR f^.eof
+    END
+  END EndOfLine;
+
+PROCEDURE EndOfFile (f: File): BOOLEAN;
+  BEGIN
+    IF NotRead(f)
+      THEN Okay := FALSE; RETURN TRUE
+      ELSE Okay := TRUE; RETURN f^.eof
+    END
+  END EndOfFile;
+
+PROCEDURE Read (f: File; VAR ch: CHAR);
+  BEGIN
+    IF NotRead(f) THEN Okay := FALSE; ch := 0C; RETURN END;
+    IF f^.haveCh OR f^.eof
+      THEN
+        ch := f^.savedCh; Okay := ch # 0C;
+      ELSE
+        Okay := TRUE;
+        IF ~ f^.textOK (* Work around as best one can *)
+          THEN RawIO.Read(f^.ref, ch)
+          ELSE TextIO.ReadChar(f^.ref, ch);
+        END; 
+        IF f^.textOK & (IOResult.ReadResult(f^.ref) = IOResult.endOfLine)
+          THEN TextIO.SkipLine(f^.ref); ch := EOL
+          ELSIF ch = LF (* Work around possible bug *) THEN ch := EOL
+        END;
+        IF IOResult.ReadResult(f^.ref) = IOResult.endOfInput THEN
+          Okay := FALSE; ch := 0C;
+        END;
+        IF ch = EOFChar THEN Okay := FALSE; ch := 0C END;
+    END;
+    IF ~ Okay THEN ch := 0C END;
+    f^.savedCh := ch; f^.haveCh := ~ Okay;
+    f^.eof := ch = 0C; f^.eol := f^.eof OR (ch = EOL);
+  END Read;
+
+PROCEDURE ReadAgain (f: File);
+  BEGIN
+    IF NotRead(f)
+      THEN Okay := FALSE
+      ELSE f^.haveCh := TRUE
+    END
+  END ReadAgain;
+
+PROCEDURE ReadLn (f: File);
+  VAR
+    ch: CHAR;
+  BEGIN
+    IF NotRead(f) THEN Okay := FALSE; RETURN END;
+    WHILE ~ f^.eol DO Read(f, ch) END;
+    f^.haveCh := FALSE; f^.eol := FALSE;
+  END ReadLn;
+
+PROCEDURE ReadString (f: File; VAR str: ARRAY OF CHAR);
+  VAR
+    j: CARDINAL;
+    ch: CHAR;
+  BEGIN
+    str[0] := 0C; j := 0;
+    IF NotRead(f) THEN Okay := FALSE; RETURN END;
+    REPEAT Read(f, ch) UNTIL (ch # " ") OR ~ Okay;
+    IF Okay THEN
+      WHILE ch >= " " DO
+        IF j <= HIGH(str) THEN str[j] := ch END; INC(j);
+        Read(f, ch);
+        WHILE (ch = BS) OR (ch = DEL) DO
+          IF j > 0 THEN DEC(j) END; Read(f, ch)
+        END
+      END;
+      IF j <= HIGH(str) THEN str[j] := 0C END;
+      Okay := j > 0; f^.haveCh := TRUE; f^.savedCh := ch;
+    END
+  END ReadString;
+
+PROCEDURE ReadLine (f: File; VAR str: ARRAY OF CHAR);
+  VAR
+    j: CARDINAL;
+    ch: CHAR;
+  BEGIN
+    str[0] := 0C; j := 0;
+    IF NotRead(f) THEN Okay := FALSE; RETURN END;
+    Read(f, ch);
+    IF Okay THEN
+      WHILE ch >= " " DO
+        IF j <= HIGH(str) THEN str[j] := ch END; INC(j);
+        Read(f, ch);
+        WHILE (ch = BS) OR (ch = DEL) DO
+          IF j > 0 THEN DEC(j) END; Read(f, ch)
+        END
+      END;
+      IF j <= HIGH(str) THEN str[j] := 0C END;
+      Okay := j > 0; f^.haveCh := TRUE; f^.savedCh := ch;
+    END
+  END ReadLine;
+
+PROCEDURE ReadToken (f: File; VAR str: ARRAY OF CHAR);
+  VAR
+    j: CARDINAL;
+    ch: CHAR;
+  BEGIN
+    str[0] := 0C; j := 0;
+    IF NotRead(f) THEN Okay := FALSE; RETURN END;
+    REPEAT Read(f, ch) UNTIL (ch > " ") OR ~ Okay;
+    IF Okay THEN
+      WHILE ch > " " DO
+        IF j <= HIGH(str) THEN str[j] := ch END; INC(j);
+        Read(f, ch);
+        WHILE (ch = BS) OR (ch = DEL) DO
+          IF j > 0 THEN DEC(j) END; Read(f, ch)
+        END
+      END;
+      IF j <= HIGH(str) THEN str[j] := 0C END;
+      Okay := j > 0; f^.haveCh := TRUE; f^.savedCh := ch;
+    END
+  END ReadToken;
+
+PROCEDURE ReadInt (f: File; VAR i: INTEGER);
+  VAR
+    Digit: INTEGER;
+    j: CARDINAL;
+    Negative: BOOLEAN;
+    s: ARRAY [0 .. 80] OF CHAR;
+  BEGIN
+    i := 0; j := 0;
+    IF NotRead(f) THEN Okay := FALSE; RETURN END;
+    ReadToken(f, s);
+    IF s[0] = "-" (* deal with sign *)
+      THEN Negative := TRUE; INC(j)
+      ELSE Negative := FALSE; IF s[0] = "+" THEN INC(j) END
+    END;
+    IF (s[j] < "0") OR (s[j] > "9") THEN Okay := FALSE END;
+    WHILE (j <= 80) & (s[j] >= "0") & (s[j] <= "9") DO
+      Digit := VAL(INTEGER, ORD(s[j]) - ORD("0"));
+      IF i <= (MAX(INTEGER) - Digit) DIV 10
+        THEN i := 10 * i + Digit
+        ELSE Okay := FALSE
+      END;
+      INC(j)
+    END;
+    IF Negative THEN i := -i END;
+    IF (j > 80) OR (s[j] # 0C) THEN Okay := FALSE END;
+    IF ~ Okay THEN i := 0 END;
+  END ReadInt;
+
+PROCEDURE ReadCard (f: File; VAR i: CARDINAL);
+  VAR
+    Digit: CARDINAL;
+    j: CARDINAL;
+    s: ARRAY [0 .. 80] OF CHAR;
+  BEGIN
+    i := 0; j := 0;
+    IF NotRead(f) THEN Okay := FALSE; RETURN END;
+    ReadToken(f, s);
+    WHILE (j <= 80) & (s[j] >= "0") & (s[j] <= "9") DO
+      Digit := ORD(s[j]) - ORD("0");
+      IF i <= (MAX(CARDINAL) - Digit) DIV 10
+        THEN i := 10 * i + Digit
+        ELSE Okay := FALSE
+      END;
+      INC(j)
+    END;
+    IF (j > 80) OR (s[j] # 0C) THEN Okay := FALSE END;
+    IF ~ Okay THEN i := 0 END;
+  END ReadCard;
+
+PROCEDURE ReadBytes (f: File; VAR buf: ARRAY OF SYSTEM.BYTE; VAR len: CARDINAL);
+  VAR
+    TooMany: BOOLEAN;
+    Wanted: CARDINAL;
+  BEGIN
+    IF NotRead(f) OR (f = con)
+      THEN Okay := FALSE; len := 0;
+      ELSE
+        IF len = 0 THEN Okay := TRUE; RETURN END;
+        TooMany := len - 1 > HIGH(buf);
+        IF TooMany THEN Wanted := HIGH(buf) + 1 ELSE Wanted := len END;
+        IOChan.RawRead(f^.ref, SYSTEM.ADR(buf), Wanted, Wanted);
+        Okay := Wanted # 0;
+        IF len # Wanted THEN Okay := FALSE END;
+        len := Wanted;
+    END;
+    IF ~ Okay THEN f^.eof := TRUE END;
+    IF TooMany THEN Okay := FALSE END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; len := 0; RETURN
+*)
+  END ReadBytes;
+
+PROCEDURE Write (f: File; ch: CHAR);
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    Okay := TRUE;
+    IF ch = EOL
+      THEN (* implementation may not support Text operations on all files *)
+        IF f^.textOK 
+          THEN TextIO.WriteLn(f^.ref)
+          ELSE ch := LF; RawIO.Write(f^.ref, ch)
+              (* but you may have to write CR/LF or CR or LF *)
+        END
+      ELSE 
+        IF f^.textOK
+          THEN TextIO.WriteChar(f^.ref, ch)
+          ELSE RawIO.Write(f^.ref, ch)
+        END
+    END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; RETURN
+*)
+  END Write;
+
+PROCEDURE WriteLn (f: File);
+  BEGIN
+    IF NotWrite(f)
+      THEN Okay := FALSE;
+      ELSE Write(f, EOL)
+    END
+  END WriteLn;
+
+PROCEDURE WriteString (f: File; str: ARRAY OF CHAR);
+  VAR
+    pos: CARDINAL;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    pos := 0;
+    WHILE (pos <= HIGH(str)) & (str[pos] # 0C) DO
+      Write(f, str[pos]); INC(pos)
+    END
+  END WriteString;
+
+PROCEDURE WriteText (f: File; text: ARRAY OF CHAR; len: INTEGER);
+  VAR
+    i, slen: INTEGER;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    slen := LENGTH(text);
+    FOR i := 0 TO len - 1 DO
+      IF i < slen THEN Write(f, text[i]) ELSE Write(f, " ") END;
+    END
+  END WriteText;
+
+PROCEDURE WriteInt (f: File; n: INTEGER; wid: CARDINAL);
+  VAR
+    l, d: CARDINAL;
+    x: INTEGER;
+    t: ARRAY [1 .. 25] OF CHAR;
+    sign: CHAR;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    IF n < 0
+      THEN sign := "-"; x := - n;
+      ELSE sign := " "; x := n;
+    END;
+    l := 0;
+    REPEAT
+      d := x MOD 10; x := x DIV 10;
+      INC(l); t[l] := CHR(ORD("0") + d);
+    UNTIL x = 0;
+    IF wid = 0 THEN Write(f, " ") END;
+    WHILE wid > l + 1 DO Write(f, " "); DEC(wid); END;
+    IF (sign = "-") OR (wid > l) THEN Write(f, sign); END;
+    WHILE l > 0 DO Write(f, t[l]); DEC(l); END;
+  END WriteInt;
+
+PROCEDURE WriteCard (f: File; n, wid: CARDINAL);
+  VAR
+    l, d: CARDINAL;
+    t: ARRAY [1 .. 25] OF CHAR;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    l := 0;
+    REPEAT
+      d := n MOD 10; n := n DIV 10;
+      INC(l); t[l] := CHR(ORD("0") + d);
+    UNTIL n = 0;
+    IF wid = 0 THEN Write(f, " ") END;
+    WHILE wid > l DO Write(f, " "); DEC(wid); END;
+    WHILE l > 0 DO Write(f, t[l]); DEC(l); END;
+  END WriteCard;
+
+PROCEDURE WriteBytes (f: File; VAR buf: ARRAY OF SYSTEM.BYTE; len: CARDINAL);
+  VAR
+    TooMany: BOOLEAN;
+  BEGIN
+    TooMany := (len > 0) & (len - 1 > HIGH(buf));
+    IF NotWrite(f) OR (f = con) OR (f = err)
+      THEN
+        Okay := FALSE
+      ELSE
+        Okay := TRUE;
+        IF TooMany THEN len := HIGH(buf) + 1 END;
+        IOChan.RawWrite(f^.ref, SYSTEM.ADR(buf), len);
+    END;
+    IF TooMany THEN Okay := FALSE END;
+(*
+  EXCEPT (* For ISO compilers *)
+    Okay := FALSE; RETURN
+*)
+  END WriteBytes;
+
+PROCEDURE GetDate (VAR Year, Month, Day: CARDINAL);
+  VAR
+    time: SysClock.DateTime;
+  BEGIN
+    SysClock.GetClock(time);
+    Year := time.year;
+    Month := time.month;
+    Day := time.day;
+  END GetDate;
+
+PROCEDURE GetTime (VAR Hrs, Mins, Secs, Hsecs: CARDINAL);
+  VAR
+    time: SysClock.DateTime;
+  BEGIN
+    SysClock.GetClock(time);
+    Hrs := time.hour;
+    Mins := time.minute;
+    Secs := time.second;
+    Hsecs := time.fractions;
+  END GetTime;
+
+PROCEDURE Write2 (f: File; i: CARDINAL);
+  BEGIN
+    Write(f, CHR(i DIV 10 + ORD("0")));
+    Write(f, CHR(i MOD 10 + ORD("0")));
+  END Write2;
+
+PROCEDURE WriteDate (f: File);
+  VAR
+    Year, Month, Day: CARDINAL;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    GetDate(Year, Month, Day);
+    Write2(f, Day); Write(f, "/"); Write2(f, Month); Write(f, "/");
+    WriteCard(f, Year, 1)
+  END WriteDate;
+
+PROCEDURE WriteTime (f: File);
+  VAR
+    Hrs, Mins, Secs, Hsecs: CARDINAL;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    GetTime(Hrs, Mins, Secs, Hsecs);
+    Write2(f, Hrs); Write(f, ":"); Write2(f, Mins); Write(f, ":");
+    Write2(f, Secs)
+  END WriteTime;
+
+VAR
+  Hrs0, Mins0, Secs0, Hsecs0: CARDINAL;
+  Hrs1, Mins1, Secs1, Hsecs1: CARDINAL;
+
+PROCEDURE WriteElapsedTime (f: File);
+  VAR
+    Hrs, Mins, Secs, Hsecs, s, hs: CARDINAL;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    GetTime(Hrs, Mins, Secs, Hsecs);
+    WriteString(f, "Elapsed time: ");
+    IF Hrs >= Hrs1
+      THEN s := (Hrs - Hrs1) * 3600 + (Mins - Mins1) * 60 + Secs - Secs1
+      ELSE s := (Hrs + 24 - Hrs1) * 3600 + (Mins - Mins1) * 60 + Secs - Secs1
+    END;
+    IF Hsecs >= Hsecs1
+      THEN hs := Hsecs - Hsecs1
+      ELSE hs := (Hsecs + 100) - Hsecs1; DEC(s);
+    END;
+    WriteCard(f, s, 1); Write(f, ".");
+    Write2(f, hs); WriteString(f, " s"); WriteLn(f);
+    Hrs1 := Hrs; Mins1 := Mins; Secs1 := Secs; Hsecs1 := Hsecs;
+  END WriteElapsedTime;
+
+PROCEDURE WriteExecutionTime (f: File);
+  VAR
+    Hrs, Mins, Secs, Hsecs, s, hs: CARDINAL;
+  BEGIN
+    IF NotWrite(f) THEN Okay := FALSE; RETURN END;
+    GetTime(Hrs, Mins, Secs, Hsecs);
+    WriteString(f, "Execution time: ");
+    IF Hrs >= Hrs0
+      THEN s := (Hrs - Hrs0) * 3600 + (Mins - Mins0) * 60 + Secs - Secs0
+      ELSE s := (Hrs + 24 - Hrs0) * 3600 + (Mins - Mins0) * 60 + Secs - Secs0
+    END;
+    IF Hsecs >= Hsecs0
+      THEN hs := Hsecs - Hsecs0
+      ELSE hs := (Hsecs + 100) - Hsecs0; DEC(s);
+    END;
+    WriteCard(f, s, 1); Write(f, "."); Write2(f, hs);
+    WriteString(f, " s"); WriteLn(f);
+  END WriteExecutionTime;
+
+(* The code for the next four procedures below may be commented out if your
+   compiler supports ISO PROCEDURE constant declarations and these declarations
+   are made in the DEFINITION MODULE *)
+
+PROCEDURE SLENGTH (stringVal: ARRAY OF CHAR): CARDINAL;
+  BEGIN
+    RETURN LENGTH(stringVal)
+  END SLENGTH;
+
+PROCEDURE Assign (source: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  BEGIN
+  (* Be careful - some libraries have the parameters reversed! *)
+    Strings.Assign(source, destination)
+  END Assign;
+
+PROCEDURE Extract (source: ARRAY OF CHAR; startIndex: CARDINAL;
+                   numberToExtract: CARDINAL; VAR destination: ARRAY OF CHAR);
+  BEGIN
+    Strings.Extract(source, startIndex, numberToExtract, destination)
+  END Extract;
+
+PROCEDURE Concat (source1, source2: ARRAY OF CHAR; VAR destination: ARRAY OF CHAR);
+  BEGIN
+    Strings.Concat(source1, source2, destination);
+  END Concat;
+
+(* The code for the four procedures above may be commented out if your
+   compiler supports ISO PROCEDURE constant declarations and these declarations
+   are made in the DEFINITION MODULE *)
+
+PROCEDURE Compare (stringVal1, stringVal2: ARRAY OF CHAR): INTEGER;
+  BEGIN
+    RETURN VAL(INTEGER, Strings.Compare(stringVal1, stringVal2)) - 1;
+  END Compare;
+
+PROCEDURE ORDL (n: INT32): CARDINAL;
+   BEGIN RETURN VAL(CARDINAL, n) END ORDL;
+
+PROCEDURE INTL (n: INT32): INTEGER;
+   BEGIN RETURN VAL(INTEGER, n) END INTL;
+
+PROCEDURE INT (n: CARDINAL): INT32;
+   BEGIN RETURN VAL(INT32, n) END INT;
+
+PROCEDURE CloseAll;
+  VAR
+    handle: CARDINAL;
+  BEGIN
+    FOR handle := 0 TO MaxFiles - 1 DO
+      IF handle IN Handles THEN Close(Opened[handle]) END
+    END;
+  END CloseAll;
+
+PROCEDURE QuitExecution;
+  BEGIN
+    HALT
+  END QuitExecution;
+
+BEGIN
+  CheckRedirection; (* Not apparently available on many systems *)
+  ProgramArgs.NextArg(); (* Not necessary on some systems *)
+  GetTime(Hrs0, Mins0, Secs0, Hsecs0);
+  Hrs1 := Hrs0; Mins1 := Mins0; Secs1 := Secs0; Hsecs1 := Hsecs0;
+  Handles := BITSET{};
+  Okay := FALSE; EOFChar := 04C;
+
+  ALLOCATE(con, SYSTEM.TSIZE(FileRec));
+  TermFile.Open(con^.ref, TermFile.read + TermFile.write + TermFile.text
+                + TermFile.echo, res);
+  con^.savedCh := 0C; con^.haveCh := FALSE; con^.self := con;
+  con^.noOutput := FALSE; con^.noInput := FALSE; con^.textOK := TRUE;
+  con^.eof := FALSE; con^.eol := FALSE;
+
+  ALLOCATE(StdIn, SYSTEM.TSIZE(FileRec));
+  StdIn^.ref := StdChans.StdInChan();
+  StdIn^.savedCh := 0C; StdIn^.haveCh := FALSE; StdIn^.self := StdIn;
+  StdIn^.noOutput := TRUE; StdIn^.noInput := FALSE; StdIn^.textOK := TRUE;
+  StdIn^.eof := FALSE; StdIn^.eol := FALSE;
+
+  ALLOCATE(StdOut, SYSTEM.TSIZE(FileRec));
+  StdOut^.ref := StdChans.StdOutChan();
+  StdOut^.savedCh := 0C; StdOut^.haveCh := FALSE; StdOut^.self := StdOut;
+  StdOut^.noOutput := FALSE; StdOut^.noInput := TRUE; StdOut^.textOK := TRUE;
+  StdOut^.eof := TRUE; StdOut^.eol := TRUE;
+
+  ALLOCATE(err, SYSTEM.TSIZE(FileRec));
+  err^.ref := StdChans.StdErrChan();
+  err^.savedCh := 0C; err^.haveCh := FALSE; err^.self := err;
+  err^.noOutput := FALSE; err^.noInput := TRUE; err^.textOK := TRUE;
+  err^.eof := TRUE; err^.eol := TRUE;
+
+(* 
+  FINALLY (* For ISO compilers *)
+  (* Preferably find some way to install CloseAll as an at-exit procedure *)
+  CloseAll;
+*)
+END FileIO.

src/Hello.mod

@@ -0,0 +1,8 @@
+MODULE Hello;
+
+FROM STextIO IMPORT WriteString, WriteLn;
+
+BEGIN
+  WriteString("Hello m2comp (gm2 -fiso)");
+  WriteLn
+END Hello.

src/M2comp.atg

@@ -0,0 +1,264 @@
+COMPILER M2comp
+(* Step 1 — Coco/R lexer + parser for Modula-2 program modules.
+   Lexer/scanner and parser are FULLY generated by Coco/R (CR):
+     M2comp.atg  --CR-->  M2compS (scanner) + M2compP (parser)
+                          + M2comp (driver from compiler.frm)
+   No hand-written lexer (replaces src/M2Lex). gm2 -fiso build.
+   Subset: MODULE, IMPORT/FROM..IMPORT, CONST/TYPE/VAR, PROCEDURE
+   (nested, value/VAR params, function result), LOCAL MODULES per Wirth
+   (MODULE ident [Priority] [Import] [Export] Block ident, pimmod2 form),
+   statements (assign, call, IF, WHILE, REPEAT, LOOP/EXIT, FOR, RETURN),
+   expressions with Kowarsch unary-minus rule (3.3: '-' takes a Factor)
+   and abbreviated multi-dim arrays (3.1 strict: comma index list).
+   Semantic checking + codegen arrive later; only MODULE/END name
+   matches are checked (error 202). Synonym "<>" kept for now (2.2 open);
+   octal B/C suffixes already absent (2.1); (*$ *) directives treated
+   as comments until a PRAGMAS section is added (2.3/2.4 open). *)
+
+IMPORT Strings;
+
+CHARACTERS
+  eol      = CHR(13) .
+  letter   = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" .
+  digit    = "0123456789" .
+  hexDigit = digit + "ABCDEF" .
+  noQuote1 = ANY - "'" - eol .
+  noQuote2 = ANY - '"' - eol .
+
+IGNORE CHR(9) .. CHR(13)
+
+COMMENTS
+  FROM "(*" TO "*)" NESTED
+
+TOKENS
+  ident   = letter { letter | digit } .
+  integer = digit { digit }
+          | digit { digit } CONTEXT("..")
+          | digit { hexDigit } "H" .
+  real    = digit { digit } "." { digit }
+            [ "E" [ "+" | "-" ] digit { digit } ] .
+  string  = "'" { noQuote1 } "'"
+          | '"' { noQuote2 } '"' .
+
+PRODUCTIONS
+  (* NOTE: Coco/R numbers tokens by first occurrence; M2comp.mod's Msg
+     table is regenerated from M2comp.err on every build (via
+     compiler.frm). After grammar edits, rebuild and check that
+     the messages still name the right tokens. *)
+  M2comp
+    = Module "." .
+  Module                              (. VAR m1, m2: ARRAY [0..63] OF CHAR; .)
+    = "MODULE"
+      GetIdent<m1>
+      ";"
+      { Import }
+      Block
+      GetIdent<m2>                    (. IF ~Strings.Equal(m1, m2) THEN SemError(202) END; .) .
+  Import                              (. VAR n: ARRAY [0..63] OF CHAR; .)
+    = [ "FROM"
+        GetIdent<n> ]
+      "IMPORT"
+      IdentList
+      ";" .
+  IdentList
+    = ident
+      { ","
+        ident } .
+  GetIdent<VAR n: ARRAY OF CHAR>
+    = ident                           (. LexName(n); .) .
+  Block
+    = { Declaration }
+      [ "BEGIN"
+        StatSeq ]
+      "END" .
+  Declaration
+    = "CONST"
+      { ident
+        "="
+        Expr
+        ";" }
+    | "TYPE"
+      { ident
+        "="
+        Type
+        ";" }
+    | "VAR"
+      { IdentList
+        ":"
+        Type
+        ";" }
+    | ProcDecl
+      ";"
+    | ModuleDecl
+      ";" .
+  ModuleDecl                          (. VAR m1, m2: ARRAY [0..63] OF CHAR; .)
+    = "MODULE"                        (* local module, Wirth form *)
+      GetIdent<m1>
+      [ Priority ]
+      ";"
+      { Import }
+      [ Export ]
+      Block
+      GetIdent<m2>                    (. IF ~Strings.Equal(m1, m2) THEN SemError(202) END; .) .
+  Priority
+    = "["
+      Expr
+      "]" .
+  Export
+    = "EXPORT"
+      [ "QUALIFIED" ]
+      IdentList
+      ";" .
+  ProcDecl                            (. VAR m1, m2: ARRAY [0..63] OF CHAR; .)
+    = "PROCEDURE"
+      GetIdent<m1>
+      [ FormalParams ]
+      [ ":"
+        QualIdent ]
+      ";"
+      Block
+      GetIdent<m2>                    (. IF ~Strings.Equal(m1, m2) THEN SemError(202) END; .) .
+  FormalParams
+    = "("
+      [ FPSection
+        { ";"
+          FPSection } ]
+      ")" .
+  FPSection
+    = [ "VAR" ]
+      IdentList
+      ":"
+      Type .
+  Type
+    = QualIdent
+      [ "[" Expr ".." Expr "]" ]
+    | "ARRAY"                         (* abbreviated form only (3.1):
+                                         comma index list; a nested
+                                         ARRAY OF ARRAY long form is
+                                         flagged in step 2 semantic check *)
+      [ IndexType { "," IndexType } ]
+      "OF"
+      Type
+    | "RECORD"
+      FieldSeq
+      "END"
+    | "SET"
+      "OF"
+      QualIdent
+    | "POINTER"
+      "TO"
+      Type .
+  IndexType
+    = QualIdent
+      [ "[" Expr ".." Expr "]" ]
+    | "["
+      Expr
+      ".."
+      Expr
+      "]" .
+  FieldSeq
+    = Field { ";" Field } .
+  Field
+    = [ IdentList ":" Type ] .
+  QualIdent
+    = ident
+      { "."
+        ident } .
+  StatSeq
+    = Stat
+      { ";"
+        Stat } .
+  Stat
+    = [ AssignOrCall
+      | IfStat
+      | WhileStat
+      | RepeatStat
+      | LoopStat
+      | ForStat
+      | ReturnStat
+      | "EXIT" ] .
+  AssignOrCall
+    = Designator
+      ( ":="
+        Expr
+      | [ ActParams ] ) .
+  Designator
+    = QualIdent
+      { "[" Expr { "," Expr } "]"
+      | "^" } .
+  ActParams
+    = "("
+      [ Expr { "," Expr } ]
+      ")" .
+  IfStat
+    = "IF"
+      Expr
+      "THEN"
+      StatSeq
+      { "ELSIF"
+        Expr
+        "THEN"
+        StatSeq }
+      [ "ELSE"
+        StatSeq ]
+      "END" .
+  WhileStat
+    = "WHILE"
+      Expr
+      "DO"
+      StatSeq
+      "END" .
+  RepeatStat
+    = "REPEAT"
+      StatSeq
+      "UNTIL"
+      Expr .
+  LoopStat
+    = "LOOP"
+      StatSeq
+      "END" .
+  ForStat
+    = "FOR"
+      ident
+      ":="
+      Expr
+      "TO"
+      Expr
+      [ "BY"
+        Expr ]
+      "DO"
+      StatSeq
+      "END" .
+  ReturnStat
+    = "RETURN"
+      [ Expr ] .
+  Expr
+    = SimpleExpr
+      [ Relation SimpleExpr ] .
+  Relation
+    = "=" | "#" | "<>" | "<" | "<=" | ">" | ">=" | "IN" .
+  SimpleExpr
+    = [ "+" ]                         (* Kowarsch 3.3: unary '+' takes a Term,
+                                         unary '-' takes a Factor, so -a*b+c
+                                         needs parens: (-a)*b+c or -(a*b+c) *)
+      Term
+      { AddOp Term }
+    | "-"
+      Factor
+      { AddOp Term } .
+  AddOp
+    = "+" | "-" | "OR" .
+  Term
+    = Factor
+      { MulOp Factor } .
+  MulOp
+    = "*" | "/" | "DIV" | "MOD" | "AND" .
+  Factor
+    = integer
+    | real
+    | string
+    | Designator
+      [ ActParams ]
+    | "(" Expr ")"
+    | "NOT" Factor .
+END M2comp.

src/M2comp.err

@@ -0,0 +1,73 @@
+   0: Msg("EOF expected")
+|  1: Msg("ident expected")
+|  2: Msg("integer expected")
+|  3: Msg("real expected")
+|  4: Msg("string expected")
+|  5: Msg("'.' expected")
+|  6: Msg("'MODULE' expected")
+|  7: Msg("';' expected")
+|  8: Msg("'FROM' expected")
+|  9: Msg("'IMPORT' expected")
+| 10: Msg("',' expected")
+| 11: Msg("'BEGIN' expected")
+| 12: Msg("'END' expected")
+| 13: Msg("'CONST' expected")
+| 14: Msg("'=' expected")
+| 15: Msg("'TYPE' expected")
+| 16: Msg("'VAR' expected")
+| 17: Msg("':' expected")
+| 18: Msg("'[' expected")
+| 19: Msg("']' expected")
+| 20: Msg("'EXPORT' expected")
+| 21: Msg("'QUALIFIED' expected")
+| 22: Msg("'PROCEDURE' expected")
+| 23: Msg("'(' expected")
+| 24: Msg("')' expected")
+| 25: Msg("'..' expected")
+| 26: Msg("'ARRAY' expected")
+| 27: Msg("'OF' expected")
+| 28: Msg("'RECORD' expected")
+| 29: Msg("'SET' expected")
+| 30: Msg("'POINTER' expected")
+| 31: Msg("'TO' expected")
+| 32: Msg("'EXIT' expected")
+| 33: Msg("':=' expected")
+| 34: Msg("'^' expected")
+| 35: Msg("'IF' expected")
+| 36: Msg("'THEN' expected")
+| 37: Msg("'ELSIF' expected")
+| 38: Msg("'ELSE' expected")
+| 39: Msg("'WHILE' expected")
+| 40: Msg("'DO' expected")
+| 41: Msg("'REPEAT' expected")
+| 42: Msg("'UNTIL' expected")
+| 43: Msg("'LOOP' expected")
+| 44: Msg("'FOR' expected")
+| 45: Msg("'BY' expected")
+| 46: Msg("'RETURN' expected")
+| 47: Msg("'#' expected")
+| 48: Msg("'<>' expected")
+| 49: Msg("'<' expected")
+| 50: Msg("'<=' expected")
+| 51: Msg("'>' expected")
+| 52: Msg("'>=' expected")
+| 53: Msg("'IN' expected")
+| 54: Msg("'+' expected")
+| 55: Msg("'-' expected")
+| 56: Msg("'OR' expected")
+| 57: Msg("'*' expected")
+| 58: Msg("'/' expected")
+| 59: Msg("'DIV' expected")
+| 60: Msg("'MOD' expected")
+| 61: Msg("'AND' expected")
+| 62: Msg("'NOT' expected")
+| 63: Msg("not expected")
+| 64: Msg("invalid MulOp")
+| 65: Msg("invalid Factor")
+| 66: Msg("invalid AddOp")
+| 67: Msg("invalid Relation")
+| 68: Msg("invalid SimpleExpr")
+| 69: Msg("invalid AssignOrCall")
+| 70: Msg("invalid IndexType")
+| 71: Msg("invalid Type")
+| 72: Msg("invalid Declaration")

src/M2comp.lst

@@ -0,0 +1,28 @@
+Coco/R - Compiler-Compiler V1.53
+Released by Pat Terry 17 September 2002
+Source file: M2comp.atg
+
+Grammar Tests:
+
+Deletable symbols:
+     Stat
+     Field
+     FieldSeq
+     StatSeq
+Undefined nonterminals:   -- none --
+Unreachable nonterminals: -- none --
+Circular derivations:     -- none --
+Underivable nonterminals: -- none --
+LL(1) conditions:         --  ok  --
+
+Statistics:
+
+  nr of terminals:        64 (limit   400)
+  nr of non-terminals:    36 (limit   210)
+  nr of pragmas:           0 (limit   436)
+  nr of symbolnodes:     100 (limit   500)
+  nr of graphnodes:      311 (limit  1500)
+  nr of conditionsets:     6 (limit   100)
+  nr of charactersets:     9 (limit   250)
+
+

src/M2comp.mod

@@ -0,0 +1,325 @@
+MODULE M2comp;
+(* Driver for the M2comp Modula-2 compiler (Coco/R, step 1: syntax only).
+   Generated <Grammar>S (scanner) + <Grammar>P (parser) do lexing/parsing;
+   no hand-written lexer. SymTab/MGen plug in at step 2. *)
+
+  FROM M2compS IMPORT lst, src, errors, Error, CharAt;
+  FROM M2compP IMPORT Parse, Successful;
+  IMPORT
+    Strings, Storage, SYSTEM, FileIO;
+
+  TYPE
+    INT32 = FileIO.INT32 (* 32 bit integers needed *);
+
+  MODULE ListHandler;
+  (* ------------------- Source Listing and Error handler -------------- *)
+    FROM FileIO IMPORT CR, LF, EOF, WriteString, Write, WriteLn, WriteInt, Long0;
+    FROM Storage IMPORT ALLOCATE;
+    FROM SYSTEM IMPORT TSIZE;
+    IMPORT lst, CharAt, errors, INT32;
+    EXPORT StoreError, PrintListing;
+
+    TYPE
+      Err = POINTER TO ErrDesc;
+      ErrDesc = RECORD
+        nr, line, col: INTEGER;
+        next: Err
+      END;
+
+    CONST
+      tab = 11C;
+
+    VAR
+      firstErr, lastErr: Err;
+      Extra: INTEGER;
+
+    PROCEDURE StoreError (nr, line, col: INTEGER; pos: INT32);
+    (* Store an error message for later printing *)
+      VAR
+        nextErr: Err;
+      BEGIN
+        ALLOCATE(nextErr, TSIZE(ErrDesc));
+        nextErr^.nr := nr; nextErr^.line := line; nextErr^.col := col;
+        nextErr^.next := NIL;
+        IF firstErr = NIL
+          THEN firstErr := nextErr
+          ELSE lastErr^.next := nextErr
+        END;
+        lastErr := nextErr;
+        INC(errors)
+      END StoreError;
+
+    PROCEDURE GetLine (VAR pos: INT32;
+                       VAR line: ARRAY OF CHAR;
+                       VAR eof: BOOLEAN);
+    (* Read a source line. Return empty line if eof *)
+      VAR
+        ch: CHAR;
+        i: CARDINAL;
+      BEGIN
+        i := 0; eof := FALSE; ch := CharAt(pos); INC(pos);
+        WHILE (ch # CR) & (ch # LF) & (ch # EOF) DO
+          line[i] := ch; INC(i); ch := CharAt(pos); INC(pos);
+        END;
+        eof := (i = 0) & (ch = EOF); line[i] := 0C;
+        IF ch = CR THEN (* check for MsDos *)
+          ch := CharAt(pos);
+          IF ch = LF THEN INC(pos); Extra := 0 END
+        END
+      END GetLine;
+
+    PROCEDURE PrintErr (line: ARRAY OF CHAR; nr, col: INTEGER);
+    (* Print an error message *)
+
+      PROCEDURE Msg (s: ARRAY OF CHAR);
+        BEGIN
+          WriteString(lst, s)
+        END Msg;
+
+      PROCEDURE Pointer;
+        VAR
+          i: INTEGER;
+        BEGIN
+          WriteString(lst, "*****  ");
+          i := 0;
+          WHILE i < col + Extra - 2 DO
+            IF line[i] = tab
+              THEN Write(lst, tab)
+              ELSE Write(lst, ' ')
+            END;
+            INC(i)
+          END;
+          WriteString(lst, "^ ")
+        END Pointer;
+
+      BEGIN
+        Pointer;
+        CASE nr OF
+           0: Msg("EOF expected")
+        |  1: Msg("ident expected")
+        |  2: Msg("integer expected")
+        |  3: Msg("real expected")
+        |  4: Msg("string expected")
+        |  5: Msg("'.' expected")
+        |  6: Msg("'MODULE' expected")
+        |  7: Msg("';' expected")
+        |  8: Msg("'FROM' expected")
+        |  9: Msg("'IMPORT' expected")
+        | 10: Msg("',' expected")
+        | 11: Msg("'BEGIN' expected")
+        | 12: Msg("'END' expected")
+        | 13: Msg("'CONST' expected")
+        | 14: Msg("'=' expected")
+        | 15: Msg("'TYPE' expected")
+        | 16: Msg("'VAR' expected")
+        | 17: Msg("':' expected")
+        | 18: Msg("'[' expected")
+        | 19: Msg("']' expected")
+        | 20: Msg("'EXPORT' expected")
+        | 21: Msg("'QUALIFIED' expected")
+        | 22: Msg("'PROCEDURE' expected")
+        | 23: Msg("'(' expected")
+        | 24: Msg("')' expected")
+        | 25: Msg("'..' expected")
+        | 26: Msg("'ARRAY' expected")
+        | 27: Msg("'OF' expected")
+        | 28: Msg("'RECORD' expected")
+        | 29: Msg("'SET' expected")
+        | 30: Msg("'POINTER' expected")
+        | 31: Msg("'TO' expected")
+        | 32: Msg("'EXIT' expected")
+        | 33: Msg("':=' expected")
+        | 34: Msg("'^' expected")
+        | 35: Msg("'IF' expected")
+        | 36: Msg("'THEN' expected")
+        | 37: Msg("'ELSIF' expected")
+        | 38: Msg("'ELSE' expected")
+        | 39: Msg("'WHILE' expected")
+        | 40: Msg("'DO' expected")
+        | 41: Msg("'REPEAT' expected")
+        | 42: Msg("'UNTIL' expected")
+        | 43: Msg("'LOOP' expected")
+        | 44: Msg("'FOR' expected")
+        | 45: Msg("'BY' expected")
+        | 46: Msg("'RETURN' expected")
+        | 47: Msg("'#' expected")
+        | 48: Msg("'<>' expected")
+        | 49: Msg("'<' expected")
+        | 50: Msg("'<=' expected")
+        | 51: Msg("'>' expected")
+        | 52: Msg("'>=' expected")
+        | 53: Msg("'IN' expected")
+        | 54: Msg("'+' expected")
+        | 55: Msg("'-' expected")
+        | 56: Msg("'OR' expected")
+        | 57: Msg("'*' expected")
+        | 58: Msg("'/' expected")
+        | 59: Msg("'DIV' expected")
+        | 60: Msg("'MOD' expected")
+        | 61: Msg("'AND' expected")
+        | 62: Msg("'NOT' expected")
+        | 63: Msg("not expected")
+        | 64: Msg("invalid MulOp")
+        | 65: Msg("invalid Factor")
+        | 66: Msg("invalid AddOp")
+        | 67: Msg("invalid Relation")
+        | 68: Msg("invalid SimpleExpr")
+        | 69: Msg("invalid AssignOrCall")
+        | 70: Msg("invalid IndexType")
+        | 71: Msg("invalid Type")
+        | 72: Msg("invalid Declaration")
+        
+        (* add customized cases here *)
+        | 200: Msg("duplicate identifier")
+        | 201: Msg("undeclared identifier")
+        | 202: Msg("module/procedure name mismatch")
+        | 210: Msg("incompatible assignment")
+        | 211: Msg("arithmetic operand must be numeric")
+        | 212: Msg("boolean operand required")
+        | 213: Msg("incompatible comparison")
+        | 214: Msg("BOOLEAN condition required")
+        | 215: Msg("not a RECORD type")
+        | 216: Msg("unknown field")
+        | 217: Msg("not an ARRAY type")
+        | 218: Msg("array index must be integer")
+        | 219: Msg("not a POINTER type")
+        | 220: Msg("FOR needs integer variable and bounds")
+        | 221: Msg("not a type name")
+        | 222: Msg("set operand mismatch")
+        | 223: Msg("cyclical type definition")
+        | 224: Msg("ordinal type required")
+        | 230: Msg("not supported in this phase")
+        | 231: Msg("procedure forward mismatch or missing body")
+        | 232: Msg("bad RETURN")
+        | 233: Msg("invalid procedure call")
+        ELSE         Msg("Error: "); WriteInt(lst, nr, 0);
+        END;
+        WriteLn(lst)
+      END PrintErr;
+
+    PROCEDURE PrintListing;
+    (* Print a source listing with error messages *)
+      VAR
+        nextErr: Err;
+        eof: BOOLEAN;
+        lnr, errC: INTEGER;
+        srcPos: INT32;
+        line: ARRAY [0 .. 255] OF CHAR;
+      BEGIN
+        WriteString(lst, "Listing:");
+        WriteLn(lst); WriteLn(lst);
+        srcPos := 0; nextErr := firstErr;
+        GetLine(srcPos, line, eof); lnr := 1; errC := 0;
+        WHILE ~ eof DO
+          WriteInt(lst, lnr, 5); WriteString(lst, "  ");
+          WriteString(lst, line); WriteLn(lst);
+          WHILE (nextErr # NIL) & (nextErr^.line = lnr) DO
+            PrintErr(line, nextErr^.nr, nextErr^.col); INC(errC);
+            nextErr := nextErr^.next
+          END;
+          GetLine(srcPos, line, eof); INC(lnr);
+        END;
+        IF nextErr # NIL THEN
+          WriteInt(lst, lnr, 5); WriteLn(lst);
+          WHILE nextErr # NIL DO
+            PrintErr(line, nextErr^.nr, nextErr^.col); INC(errC);
+            nextErr := nextErr^.next
+          END
+        END;
+        WriteLn(lst);
+        WriteInt(lst, errC, 5); WriteString(lst, " error");
+        IF errC # 1 THEN Write(lst, 's') END;
+        WriteLn(lst); WriteLn(lst); WriteLn(lst);
+      END PrintListing;
+
+    BEGIN
+      firstErr := NIL; Extra := 1;
+    END ListHandler;
+
+  (* --------------------------- main module ------------------------------- *)
+
+  PROCEDURE ChangeExtension (oldName, Ext: ARRAY OF CHAR;
+                             VAR newName: ARRAY OF CHAR);
+  (* Constructs newName by replacing the extension of oldName with Ext. *)
+    VAR
+      i, l: CARDINAL;
+    BEGIN
+      Strings.Assign(oldName, newName);
+      i := LENGTH(oldName); l := i;
+      WHILE (i > 0) & (oldName[i -1] # '.')
+            & (oldName[i -1] # '\') & (oldName[i -1] # '/') DO
+        DEC(i)
+      END;
+      IF (i > 0) & (oldName[i-1] = '.') THEN
+        Strings.Delete(newName, i - 1, l + 1 - i)
+      END;
+      IF Ext[0] = '.' THEN Strings.Delete(Ext, 0, 1) END;
+      Strings.Append(".", newName);
+      Strings.Append(Ext, newName)
+    END ChangeExtension;
+
+  VAR
+    sourceName, listName: ARRAY [0 .. 255] OF CHAR;
+    failed: BOOLEAN;
+
+  BEGIN
+    (* check on correct parameter usage *)
+    FileIO.NextParameter(sourceName);
+    IF sourceName[0] = 0C THEN
+      FileIO.WriteString(FileIO.StdOut, "No input file specified");
+      HALT
+    END;
+
+    (* step 1: syntax only, no symbol table yet (see M2comp.atg) *)
+
+    (* install error reporting procedure - Scanner.Error *)
+    Error := StoreError;
+
+    failed := FALSE;
+    LOOP
+      IF sourceName[0] = 0C THEN EXIT END;
+
+      (* open the source file - Scanner.src *)
+      FileIO.Open(src, sourceName, FALSE);
+      IF ~ FileIO.Okay THEN
+        FileIO.WriteString(FileIO.StdOut, "Could not open input file");
+        FileIO.WriteLn(FileIO.StdOut);
+        HALT
+      END;
+
+      (* open the output file for the source listing - Scanner.lst *)
+      ChangeExtension(sourceName, ".LST", listName);
+      FileIO.Open(lst, listName, TRUE);
+      IF ~ FileIO.Okay THEN
+        FileIO.WriteString(FileIO.StdOut, "Could not open listing file");
+        FileIO.WriteLn(FileIO.StdOut);
+        (* default Scanner.lst to screen *) lst := FileIO.StdOut;
+      END;
+
+      (* instigate the compilation - Parser.Parse *)
+      FileIO.WriteString(FileIO.StdOut, "Parsing ");
+      FileIO.WriteString(FileIO.StdOut, sourceName);
+      FileIO.WriteLn(FileIO.StdOut);
+      Parse;
+
+      (* generate the source listing on lst file *)
+      PrintListing;
+      IF lst # FileIO.StdOut THEN FileIO.Close(lst) END;
+
+      (* fail fast: later files build on this one's tables *)
+      IF NOT Successful()
+        THEN
+          FileIO.WriteString(FileIO.StdOut, "Incorrect source");
+          FileIO.WriteLn(FileIO.StdOut);
+          failed := TRUE;
+          EXIT
+      END;
+
+      FileIO.NextParameter(sourceName);
+    END;
+
+    (* examine the outcome *)
+    IF NOT failed THEN
+      FileIO.WriteString(FileIO.StdOut, "Parsed correctly");
+    END;
+  END M2comp.

src/M2compP.def

@@ -0,0 +1,28 @@
+DEFINITION MODULE M2compP;
+
+(* Parser generated by Coco/R *)
+
+PROCEDURE Parse;
+
+PROCEDURE Successful (): BOOLEAN;
+(* Returns TRUE if no errors have been recorded while parsing *)
+
+PROCEDURE SynError (errNo: INTEGER);
+(* Report syntax error errNo *)
+
+PROCEDURE SemError (errNo: INTEGER);
+(* Report semantic error errNo *)
+
+PROCEDURE LexString (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as exact spelling of current token *)
+
+PROCEDURE LexName (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as name of current token (capitalized if IGNORE CASE) *)
+
+PROCEDURE LookAheadName (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as exact spelling of lookahead token *)
+
+PROCEDURE LookAheadString (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as name of lookahead token (capitalized if IGNORE CASE) *)
+
+END M2compP.

src/M2compP.mod

@@ -0,0 +1,713 @@
+IMPLEMENTATION MODULE M2compP;
+
+(* Parser generated by Coco/R - assuming ISO IO library will be available. *)
+
+IMPORT M2compS, FileIO;
+
+IMPORT Strings;
+
+
+
+CONST 
+  maxT = 63;
+  minErrDist  =  2;  (* minimal distance (good tokens) between two errors *)
+  setsize     = 16;  (* sets are stored in 16 bits *)
+
+TYPE
+  SymbolSet = ARRAY [0 .. maxT DIV setsize] OF BITSET;
+
+VAR
+  symSet:  ARRAY [0 ..   5] OF SymbolSet; (*symSet[0] = allSyncSyms*)
+  errDist: CARDINAL;   (* number of symbols recognized since last error *)
+  sym:     CARDINAL;   (* current input symbol *)
+
+PROCEDURE SemError (errNo: INTEGER);
+  BEGIN
+    IF errDist >= minErrDist THEN
+      M2compS.Error(errNo, M2compS.line, M2compS.col, M2compS.pos);
+    END;
+    errDist := 0;
+  END SemError;
+
+PROCEDURE SynError (errNo: INTEGER);
+  BEGIN
+    IF errDist >= minErrDist THEN
+      M2compS.Error(errNo, M2compS.nextLine, M2compS.nextCol, M2compS.nextPos);
+    END;
+    errDist := 0;
+  END SynError;
+
+PROCEDURE Get;
+  VAR
+    s: ARRAY [0 .. 31] OF CHAR;
+  BEGIN
+    REPEAT
+      M2compS.Get(sym);
+      IF sym <= maxT THEN
+        INC(errDist);
+      ELSE
+        
+      END;
+    UNTIL sym <= maxT
+  END Get;
+
+PROCEDURE In (VAR s: SymbolSet; x: CARDINAL): BOOLEAN;
+  BEGIN
+    RETURN x MOD setsize IN s[x DIV setsize];
+  END In;
+
+PROCEDURE Expect (n: CARDINAL);
+  BEGIN
+    IF sym = n THEN Get ELSE SynError(n) END
+  END Expect;
+
+PROCEDURE ExpectWeak (n, follow: CARDINAL);
+  BEGIN
+    IF sym = n
+      THEN Get
+      ELSE SynError(n); WHILE ~ In(symSet[follow], sym) DO Get END
+    END
+  END ExpectWeak;
+
+PROCEDURE WeakSeparator (n, syFol, repFol: CARDINAL): BOOLEAN;
+  VAR
+    s: SymbolSet;
+    i: CARDINAL;
+  BEGIN
+    IF sym = n
+      THEN Get; RETURN TRUE
+      ELSIF In(symSet[repFol], sym) THEN RETURN FALSE
+      ELSE
+        i := 0;
+        WHILE i <= maxT DIV setsize DO
+          s[i] := symSet[0, i] + symSet[syFol, i] + symSet[repFol, i]; INC(i)
+        END;
+        SynError(n); WHILE ~ In(s, sym) DO Get END;
+        RETURN In(symSet[syFol], sym)
+    END
+  END WeakSeparator;
+
+PROCEDURE LexName (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    M2compS.GetName(M2compS.pos, M2compS.len, Lex)
+  END LexName;
+
+PROCEDURE LexString (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    M2compS.GetString(M2compS.pos, M2compS.len, Lex)
+  END LexString;
+
+PROCEDURE LookAheadName (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    M2compS.GetName(M2compS.nextPos, M2compS.nextLen, Lex)
+  END LookAheadName;
+
+PROCEDURE LookAheadString (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    M2compS.GetString(M2compS.nextPos, M2compS.nextLen, Lex)
+  END LookAheadString;
+
+PROCEDURE Successful (): BOOLEAN;
+  BEGIN
+    RETURN M2compS.errors = 0
+  END Successful;
+
+(* ----- FORWARD not needed in multipass compilers
+
+PROCEDURE MulOp; FORWARD;
+PROCEDURE Factor; FORWARD;
+PROCEDURE AddOp; FORWARD;
+PROCEDURE Term; FORWARD;
+PROCEDURE Relation; FORWARD;
+PROCEDURE SimpleExpr; FORWARD;
+PROCEDURE ActParams; FORWARD;
+PROCEDURE Designator; FORWARD;
+PROCEDURE ReturnStat; FORWARD;
+PROCEDURE ForStat; FORWARD;
+PROCEDURE LoopStat; FORWARD;
+PROCEDURE RepeatStat; FORWARD;
+PROCEDURE WhileStat; FORWARD;
+PROCEDURE IfStat; FORWARD;
+PROCEDURE AssignOrCall; FORWARD;
+PROCEDURE Stat; FORWARD;
+PROCEDURE Field; FORWARD;
+PROCEDURE FieldSeq; FORWARD;
+PROCEDURE IndexType; FORWARD;
+PROCEDURE FPSection; FORWARD;
+PROCEDURE QualIdent; FORWARD;
+PROCEDURE FormalParams; FORWARD;
+PROCEDURE Export; FORWARD;
+PROCEDURE Priority; FORWARD;
+PROCEDURE ModuleDecl; FORWARD;
+PROCEDURE ProcDecl; FORWARD;
+PROCEDURE Type; FORWARD;
+PROCEDURE Expr; FORWARD;
+PROCEDURE StatSeq; FORWARD;
+PROCEDURE Declaration; FORWARD;
+PROCEDURE IdentList; FORWARD;
+PROCEDURE Block; FORWARD;
+PROCEDURE Import; FORWARD;
+PROCEDURE GetIdent (VAR n: ARRAY OF CHAR); FORWARD;
+PROCEDURE Module; FORWARD;
+PROCEDURE M2comp; FORWARD;
+
+----- *)
+
+PROCEDURE MulOp;
+  BEGIN
+    IF (sym = 57) THEN
+      Get;
+    ELSIF (sym = 58) THEN
+      Get;
+    ELSIF (sym = 59) THEN
+      Get;
+    ELSIF (sym = 60) THEN
+      Get;
+    ELSIF (sym = 61) THEN
+      Get;
+    ELSE SynError(64);
+    END;
+  END MulOp;
+
+PROCEDURE Factor;
+  BEGIN
+    CASE sym OF
+      2 :
+        Get;
+    | 3 :
+        Get;
+    | 4 :
+        Get;
+    | 1 :
+        Designator;
+        IF (sym = 23) THEN
+          ActParams;
+        END;
+    | 23 :
+        Get;
+        Expr;
+        Expect(24);
+    | 62 :
+        Get;
+        Factor;
+    ELSE SynError(65);
+    END;
+  END Factor;
+
+PROCEDURE AddOp;
+  BEGIN
+    IF (sym = 54) THEN
+      Get;
+    ELSIF (sym = 55) THEN
+      Get;
+    ELSIF (sym = 56) THEN
+      Get;
+    ELSE SynError(66);
+    END;
+  END AddOp;
+
+PROCEDURE Term;
+  BEGIN
+    Factor;
+    WHILE (sym = 57) OR (sym = 58) OR (sym = 59) OR (sym = 60) OR (sym = 61) DO
+      MulOp;
+      Factor;
+    END;
+  END Term;
+
+PROCEDURE Relation;
+  BEGIN
+    CASE sym OF
+      14 :
+        Get;
+    | 47 :
+        Get;
+    | 48 :
+        Get;
+    | 49 :
+        Get;
+    | 50 :
+        Get;
+    | 51 :
+        Get;
+    | 52 :
+        Get;
+    | 53 :
+        Get;
+    ELSE SynError(67);
+    END;
+  END Relation;
+
+PROCEDURE SimpleExpr;
+  BEGIN
+    IF In(symSet[1], sym) THEN
+      IF (sym = 54) THEN
+        Get;
+      END;
+      Term;
+      WHILE (sym = 54) OR (sym = 55) OR (sym = 56) DO
+        AddOp;
+        Term;
+      END;
+    ELSIF (sym = 55) THEN
+      Get;
+      Factor;
+      WHILE (sym = 54) OR (sym = 55) OR (sym = 56) DO
+        AddOp;
+        Term;
+      END;
+    ELSE SynError(68);
+    END;
+  END SimpleExpr;
+
+PROCEDURE ActParams;
+  BEGIN
+    Expect(23);
+    IF In(symSet[2], sym) THEN
+      Expr;
+      WHILE (sym = 10) DO
+        Get;
+        Expr;
+      END;
+    END;
+    Expect(24);
+  END ActParams;
+
+PROCEDURE Designator;
+  BEGIN
+    QualIdent;
+    WHILE (sym = 18) OR (sym = 34) DO
+      IF (sym = 18) THEN
+        Get;
+        Expr;
+        WHILE (sym = 10) DO
+          Get;
+          Expr;
+        END;
+        Expect(19);
+      ELSE
+        Get;
+      END;
+    END;
+  END Designator;
+
+PROCEDURE ReturnStat;
+  BEGIN
+    Expect(46);
+    IF In(symSet[2], sym) THEN
+      Expr;
+    END;
+  END ReturnStat;
+
+PROCEDURE ForStat;
+  BEGIN
+    Expect(44);
+    Expect(1);
+    Expect(33);
+    Expr;
+    Expect(31);
+    Expr;
+    IF (sym = 45) THEN
+      Get;
+      Expr;
+    END;
+    Expect(40);
+    StatSeq;
+    Expect(12);
+  END ForStat;
+
+PROCEDURE LoopStat;
+  BEGIN
+    Expect(43);
+    StatSeq;
+    Expect(12);
+  END LoopStat;
+
+PROCEDURE RepeatStat;
+  BEGIN
+    Expect(41);
+    StatSeq;
+    Expect(42);
+    Expr;
+  END RepeatStat;
+
+PROCEDURE WhileStat;
+  BEGIN
+    Expect(39);
+    Expr;
+    Expect(40);
+    StatSeq;
+    Expect(12);
+  END WhileStat;
+
+PROCEDURE IfStat;
+  BEGIN
+    Expect(35);
+    Expr;
+    Expect(36);
+    StatSeq;
+    WHILE (sym = 37) DO
+      Get;
+      Expr;
+      Expect(36);
+      StatSeq;
+    END;
+    IF (sym = 38) THEN
+      Get;
+      StatSeq;
+    END;
+    Expect(12);
+  END IfStat;
+
+PROCEDURE AssignOrCall;
+  BEGIN
+    Designator;
+    IF (sym = 33) THEN
+      Get;
+      Expr;
+    ELSIF In(symSet[3], sym) THEN
+      IF (sym = 23) THEN
+        ActParams;
+      END;
+    ELSE SynError(69);
+    END;
+  END AssignOrCall;
+
+PROCEDURE Stat;
+  BEGIN
+    IF In(symSet[4], sym) THEN
+      CASE sym OF
+        1 :
+          AssignOrCall;
+      | 35 :
+          IfStat;
+      | 39 :
+          WhileStat;
+      | 41 :
+          RepeatStat;
+      | 43 :
+          LoopStat;
+      | 44 :
+          ForStat;
+      | 46 :
+          ReturnStat;
+      | 32 :
+          Get;
+      END;
+    END;
+  END Stat;
+
+PROCEDURE Field;
+  BEGIN
+    IF (sym = 1) THEN
+      IdentList;
+      Expect(17);
+      Type;
+    END;
+  END Field;
+
+PROCEDURE FieldSeq;
+  BEGIN
+    Field;
+    WHILE (sym = 7) DO
+      Get;
+      Field;
+    END;
+  END FieldSeq;
+
+PROCEDURE IndexType;
+  BEGIN
+    IF (sym = 1) THEN
+      QualIdent;
+      IF (sym = 18) THEN
+        Get;
+        Expr;
+        Expect(25);
+        Expr;
+        Expect(19);
+      END;
+    ELSIF (sym = 18) THEN
+      Get;
+      Expr;
+      Expect(25);
+      Expr;
+      Expect(19);
+    ELSE SynError(70);
+    END;
+  END IndexType;
+
+PROCEDURE FPSection;
+  BEGIN
+    IF (sym = 16) THEN
+      Get;
+    END;
+    IdentList;
+    Expect(17);
+    Type;
+  END FPSection;
+
+PROCEDURE QualIdent;
+  BEGIN
+    Expect(1);
+    WHILE (sym = 5) DO
+      Get;
+      Expect(1);
+    END;
+  END QualIdent;
+
+PROCEDURE FormalParams;
+  BEGIN
+    Expect(23);
+    IF (sym = 1) OR (sym = 16) THEN
+      FPSection;
+      WHILE (sym = 7) DO
+        Get;
+        FPSection;
+      END;
+    END;
+    Expect(24);
+  END FormalParams;
+
+PROCEDURE Export;
+  BEGIN
+    Expect(20);
+    IF (sym = 21) THEN
+      Get;
+    END;
+    IdentList;
+    Expect(7);
+  END Export;
+
+PROCEDURE Priority;
+  BEGIN
+    Expect(18);
+    Expr;
+    Expect(19);
+  END Priority;
+
+PROCEDURE ModuleDecl;
+  VAR m1, m2: ARRAY [0..63] OF CHAR;
+  BEGIN
+    Expect(6);
+    GetIdent(m1);
+    IF (sym = 18) THEN
+      Priority;
+    END;
+    Expect(7);
+    WHILE (sym = 8) OR (sym = 9) DO
+      Import;
+    END;
+    IF (sym = 20) THEN
+      Export;
+    END;
+    Block;
+    GetIdent(m2);
+    IF ~Strings.Equal(m1, m2) THEN SemError(202) END;;
+  END ModuleDecl;
+
+PROCEDURE ProcDecl;
+  VAR m1, m2: ARRAY [0..63] OF CHAR;
+  BEGIN
+    Expect(22);
+    GetIdent(m1);
+    IF (sym = 23) THEN
+      FormalParams;
+    END;
+    IF (sym = 17) THEN
+      Get;
+      QualIdent;
+    END;
+    Expect(7);
+    Block;
+    GetIdent(m2);
+    IF ~Strings.Equal(m1, m2) THEN SemError(202) END;;
+  END ProcDecl;
+
+PROCEDURE Type;
+  BEGIN
+    IF (sym = 1) THEN
+      QualIdent;
+      IF (sym = 18) THEN
+        Get;
+        Expr;
+        Expect(25);
+        Expr;
+        Expect(19);
+      END;
+    ELSIF (sym = 26) THEN
+      Get;
+      IF (sym = 1) OR (sym = 18) THEN
+        IndexType;
+        WHILE (sym = 10) DO
+          Get;
+          IndexType;
+        END;
+      END;
+      Expect(27);
+      Type;
+    ELSIF (sym = 28) THEN
+      Get;
+      FieldSeq;
+      Expect(12);
+    ELSIF (sym = 29) THEN
+      Get;
+      Expect(27);
+      QualIdent;
+    ELSIF (sym = 30) THEN
+      Get;
+      Expect(31);
+      Type;
+    ELSE SynError(71);
+    END;
+  END Type;
+
+PROCEDURE Expr;
+  BEGIN
+    SimpleExpr;
+    IF In(symSet[5], sym) THEN
+      Relation;
+      SimpleExpr;
+    END;
+  END Expr;
+
+PROCEDURE StatSeq;
+  BEGIN
+    Stat;
+    WHILE (sym = 7) DO
+      Get;
+      Stat;
+    END;
+  END StatSeq;
+
+PROCEDURE Declaration;
+  BEGIN
+    IF (sym = 13) THEN
+      Get;
+      WHILE (sym = 1) DO
+        Get;
+        Expect(14);
+        Expr;
+        Expect(7);
+      END;
+    ELSIF (sym = 15) THEN
+      Get;
+      WHILE (sym = 1) DO
+        Get;
+        Expect(14);
+        Type;
+        Expect(7);
+      END;
+    ELSIF (sym = 16) THEN
+      Get;
+      WHILE (sym = 1) DO
+        IdentList;
+        Expect(17);
+        Type;
+        Expect(7);
+      END;
+    ELSIF (sym = 22) THEN
+      ProcDecl;
+      Expect(7);
+    ELSIF (sym = 6) THEN
+      ModuleDecl;
+      Expect(7);
+    ELSE SynError(72);
+    END;
+  END Declaration;
+
+PROCEDURE IdentList;
+  BEGIN
+    Expect(1);
+    WHILE (sym = 10) DO
+      Get;
+      Expect(1);
+    END;
+  END IdentList;
+
+PROCEDURE Block;
+  BEGIN
+    WHILE (sym = 6) OR (sym = 13) OR (sym = 15) OR (sym = 16) OR (sym = 22) DO
+      Declaration;
+    END;
+    IF (sym = 11) THEN
+      Get;
+      StatSeq;
+    END;
+    Expect(12);
+  END Block;
+
+PROCEDURE Import;
+  VAR n: ARRAY [0..63] OF CHAR;
+  BEGIN
+    IF (sym = 8) THEN
+      Get;
+      GetIdent(n);
+    END;
+    Expect(9);
+    IdentList;
+    Expect(7);
+  END Import;
+
+PROCEDURE GetIdent (VAR n: ARRAY OF CHAR);
+  BEGIN
+    Expect(1);
+    LexName(n);;
+  END GetIdent;
+
+PROCEDURE Module;
+  VAR m1, m2: ARRAY [0..63] OF CHAR;
+  BEGIN
+    Expect(6);
+    GetIdent(m1);
+    Expect(7);
+    WHILE (sym = 8) OR (sym = 9) DO
+      Import;
+    END;
+    Block;
+    GetIdent(m2);
+    IF ~Strings.Equal(m1, m2) THEN SemError(202) END;;
+  END Module;
+
+PROCEDURE M2comp;
+  BEGIN
+    Module;
+    Expect(5);
+  END M2comp;
+
+
+
+PROCEDURE Parse;
+  BEGIN
+    M2compS.Reset; Get;
+    M2comp;
+
+  END Parse;
+
+BEGIN
+  errDist := minErrDist;
+  symSet[ 0, 0] := BITSET{0};
+  symSet[ 0, 1] := BITSET{};
+  symSet[ 0, 2] := BITSET{};
+  symSet[ 0, 3] := BITSET{};
+  symSet[ 1, 0] := BITSET{1, 2, 3, 4};
+  symSet[ 1, 1] := BITSET{7};
+  symSet[ 1, 2] := BITSET{};
+  symSet[ 1, 3] := BITSET{6, 14};
+  symSet[ 2, 0] := BITSET{1, 2, 3, 4};
+  symSet[ 2, 1] := BITSET{7};
+  symSet[ 2, 2] := BITSET{};
+  symSet[ 2, 3] := BITSET{6, 7, 14};
+  symSet[ 3, 0] := BITSET{7, 12};
+  symSet[ 3, 1] := BITSET{7};
+  symSet[ 3, 2] := BITSET{5, 6, 10};
+  symSet[ 3, 3] := BITSET{};
+  symSet[ 4, 0] := BITSET{1};
+  symSet[ 4, 1] := BITSET{};
+  symSet[ 4, 2] := BITSET{0, 3, 7, 9, 11, 12, 14};
+  symSet[ 4, 3] := BITSET{};
+  symSet[ 5, 0] := BITSET{14};
+  symSet[ 5, 1] := BITSET{};
+  symSet[ 5, 2] := BITSET{15};
+  symSet[ 5, 3] := BITSET{0, 1, 2, 3, 4, 5};
+END M2compP.
+

src/M2compS.def

@@ -0,0 +1,39 @@
+DEFINITION MODULE M2compS;
+
+(* Scanner generated by Coco/R - using the FileIO library supplied with this project. *)
+
+IMPORT FileIO;
+
+TYPE
+  INT32 = FileIO.INT32 (* need 32 bit integers *);
+
+VAR
+  src, lst:    FileIO.File;(*source/list files. To be opened by the main pgm*)
+  directory:   ARRAY [0 .. 255] OF CHAR (*of source file*);
+  line, col:   INTEGER;      (*line and column of current symbol*)
+  len:         CARDINAL;     (*length of current symbol*)
+  pos:         INT32;        (*file position of current symbol*)
+  nextLine:    INTEGER;      (*line of lookahead symbol*)
+  nextCol:     INTEGER;      (*column of lookahead symbol*)
+  nextLen:     CARDINAL;     (*length of lookahead symbol*)
+  nextPos:     INT32;        (*file position of lookahead symbol*)
+  errors:      INTEGER;      (*number of detected errors*)
+  Error:       PROCEDURE ((*nr*)INTEGER, (*line*)INTEGER, (*col*)INTEGER,
+                          (*pos*)INT32);
+
+PROCEDURE Get (VAR sym: CARDINAL);
+(* Gets next symbol from source file *)
+
+PROCEDURE GetString (pos: INT32; len: CARDINAL; VAR name: ARRAY OF CHAR);
+(* Retrieves exact string of max length len from position pos in source file *)
+
+PROCEDURE GetName (pos: INT32; len: CARDINAL; VAR name: ARRAY OF CHAR);
+(* Retrieves name of symbol of length len at position pos in source file *)
+
+PROCEDURE CharAt (pos: INT32): CHAR;
+(* Returns exact character at position pos in source file *)
+
+PROCEDURE Reset;
+(* Reads and stores source file internally *)
+
+END M2compS.

src/M2compS.mod

@@ -0,0 +1,391 @@
+IMPLEMENTATION MODULE M2compS;
+
+(* Scanner generated by Coco/R - using the FileIO library supplied with this project. *)
+
+IMPORT FileIO, Storage;
+
+CONST
+  noSYMB  = 63; (*error token code*)
+  (* not only for errors but also for not finished states of scanner analysis *)
+  eof     = 32C (* MS-DOS Keyboard eof char *);
+  EOF     = 0C;
+  EOL     = 15C;
+  CR      = 15C;
+  LF      = 12C;
+  Long0   = 0;
+  Long1   = 1;
+  BlkSize = 16384;
+TYPE
+  BufBlock   = ARRAY [0 .. BlkSize-1] OF CHAR;
+  Buffer     = ARRAY [0 .. 31] OF POINTER TO BufBlock;
+  StartTable = ARRAY [0 .. 255] OF INTEGER;
+  GetCH      = PROCEDURE (INT32): CHAR;
+VAR
+  lastCh,
+  ch:        CHAR;       (*current input character*)
+  curLine:   INTEGER;    (*current input line (may be higher than line)*)
+  lineStart: INT32;      (*start position of current line*)
+  apx:       INT32;      (*length of appendix (CONTEXT phrase)*)
+  oldEols:   INTEGER;    (*number of EOLs in a comment*)
+  bp, bp0:   INT32;      (*current position in buf
+                           (bp0: position of current token)*)
+  inputLen:  INT32;      (*source file size*)
+  buf:       Buffer;     (*source buffer for low-level access*)
+  start:     StartTable; (*start state for every character*)
+  CurrentCh: GetCH;
+
+PROCEDURE Err (nr, line, col: INTEGER; pos: INT32);
+  BEGIN
+    INC(errors)
+  END Err;
+
+PROCEDURE NextCh;
+(* Return global variable ch *)
+  BEGIN
+    lastCh := ch; INC(bp); ch := CurrentCh(bp);
+    IF (ch = EOL) OR (ch = LF) AND (lastCh # EOL) THEN
+      INC(curLine); lineStart := bp
+    END
+  END NextCh;
+
+PROCEDURE Comment (): BOOLEAN;
+  VAR
+    level, startLine: INTEGER;
+    oldLineStart: INT32;
+  BEGIN
+    level := 1; startLine := curLine; oldLineStart := lineStart;
+    IF (ch = "(") THEN
+      NextCh;
+      IF (ch = "*") THEN
+        NextCh;
+        LOOP
+          IF (ch = "*") THEN
+            NextCh;
+            IF (ch = ")") THEN
+              DEC(level); NextCh;
+              IF level = 0 THEN RETURN TRUE END
+            END;
+          ELSIF (ch = "(") THEN
+            NextCh;
+            IF (ch = "*") THEN INC(level); NextCh END;
+          ELSIF ch = EOF THEN RETURN FALSE
+          ELSE NextCh END;
+        END; (* LOOP *)
+      ELSE
+        IF (ch = CR) OR (ch = LF) THEN
+          DEC(curLine); lineStart := oldLineStart
+        END;
+        DEC(bp); ch := lastCh;
+      END;
+    END;
+    RETURN FALSE;
+  END Comment;
+
+PROCEDURE Get (VAR sym: CARDINAL);
+  VAR
+    state: CARDINAL;
+
+  PROCEDURE Equal (s: ARRAY OF CHAR): BOOLEAN;
+    VAR
+      i: CARDINAL;
+      q: INT32;
+    BEGIN
+      IF nextLen # LENGTH(s) THEN RETURN FALSE END;
+      i := 1; q := bp0; INC(q);
+      WHILE i < nextLen DO
+        IF CurrentCh(q) # s[i] THEN RETURN FALSE END;
+        INC(i); INC(q)
+      END;
+      RETURN TRUE
+    END Equal;
+
+  PROCEDURE CheckLiteral;
+    BEGIN
+      CASE CurrentCh(bp0) OF
+        "A": IF Equal("AND") THEN sym := 61; 
+             ELSIF Equal("ARRAY") THEN sym := 26; 
+             END
+      | "B": IF Equal("BEGIN") THEN sym := 11; 
+             ELSIF Equal("BY") THEN sym := 45; 
+             END
+      | "C": IF Equal("CONST") THEN sym := 13; 
+             END
+      | "D": IF Equal("DIV") THEN sym := 59; 
+             ELSIF Equal("DO") THEN sym := 40; 
+             END
+      | "E": IF Equal("ELSE") THEN sym := 38; 
+             ELSIF Equal("ELSIF") THEN sym := 37; 
+             ELSIF Equal("END") THEN sym := 12; 
+             ELSIF Equal("EXIT") THEN sym := 32; 
+             ELSIF Equal("EXPORT") THEN sym := 20; 
+             END
+      | "F": IF Equal("FOR") THEN sym := 44; 
+             ELSIF Equal("FROM") THEN sym := 8; 
+             END
+      | "I": IF Equal("IF") THEN sym := 35; 
+             ELSIF Equal("IMPORT") THEN sym := 9; 
+             ELSIF Equal("IN") THEN sym := 53; 
+             END
+      | "L": IF Equal("LOOP") THEN sym := 43; 
+             END
+      | "M": IF Equal("MOD") THEN sym := 60; 
+             ELSIF Equal("MODULE") THEN sym := 6; 
+             END
+      | "N": IF Equal("NOT") THEN sym := 62; 
+             END
+      | "O": IF Equal("OF") THEN sym := 27; 
+             ELSIF Equal("OR") THEN sym := 56; 
+             END
+      | "P": IF Equal("POINTER") THEN sym := 30; 
+             ELSIF Equal("PROCEDURE") THEN sym := 22; 
+             END
+      | "Q": IF Equal("QUALIFIED") THEN sym := 21; 
+             END
+      | "R": IF Equal("RECORD") THEN sym := 28; 
+             ELSIF Equal("REPEAT") THEN sym := 41; 
+             ELSIF Equal("RETURN") THEN sym := 46; 
+             END
+      | "S": IF Equal("SET") THEN sym := 29; 
+             END
+      | "T": IF Equal("THEN") THEN sym := 36; 
+             ELSIF Equal("TO") THEN sym := 31; 
+             ELSIF Equal("TYPE") THEN sym := 15; 
+             END
+      | "U": IF Equal("UNTIL") THEN sym := 42; 
+             END
+      | "V": IF Equal("VAR") THEN sym := 16; 
+             END
+      | "W": IF Equal("WHILE") THEN sym := 39; 
+             END
+      ELSE
+      END
+    END CheckLiteral;
+
+  BEGIN (*Get*)
+    WHILE (ch = ' ') OR
+          ((ch >= CHR(9)) & (ch <= CHR(13))) DO NextCh END;
+    IF ((ch = "(")) & Comment() THEN Get(sym); RETURN END;
+    pos := nextPos;   nextPos := bp;
+    col := nextCol;   nextCol := VAL(INTEGER, bp - lineStart);
+    line := nextLine; nextLine := curLine;
+    len := nextLen;   nextLen := 0;
+    apx := 0; state := start[ORD(ch)]; bp0 := bp;
+    LOOP
+      NextCh; INC(nextLen);
+      CASE state OF
+         1: IF ((ch >= "0") & (ch <= "9") OR
+               (ch >= "A") & (ch <= "Z") OR
+               (ch >= "a") & (ch <= "z")) THEN 
+            ELSE sym := 1; CheckLiteral; RETURN
+            END;
+      |  2: IF ((ch >= "0") & (ch <= "9") OR
+               (ch >= "A") & (ch <= "F")) THEN 
+            ELSIF (ch = "H") THEN state := 4; 
+            ELSE sym := noSYMB; RETURN
+            END;
+      |  3: bp := bp - apx - Long1; DEC(nextLen, ORDL(apx)); NextCh; sym := 2; RETURN
+      |  4: sym := 2; RETURN
+      |  5: IF ((ch >= "0") & (ch <= "9")) THEN 
+            ELSIF (ch = "E") THEN state := 6; 
+            ELSE sym := 3; RETURN
+            END;
+      |  6: IF ((ch >= "0") & (ch <= "9")) THEN state := 8; 
+            ELSIF ((ch = "+") OR
+                  (ch = "-")) THEN state := 7; 
+            ELSE sym := noSYMB; RETURN
+            END;
+      |  7: IF ((ch >= "0") & (ch <= "9")) THEN state := 8; 
+            ELSE sym := noSYMB; RETURN
+            END;
+      |  8: IF ((ch >= "0") & (ch <= "9")) THEN 
+            ELSE sym := 3; RETURN
+            END;
+      |  9: IF ((ch <= CHR(12)) OR
+               (ch >= CHR(14)) & (ch <= "&") OR
+               (ch >= "(")) THEN 
+            ELSIF (ch = "'") THEN state := 11; 
+            ELSE sym := noSYMB; RETURN
+            END;
+      | 10: IF ((ch <= CHR(12)) OR
+               (ch >= CHR(14)) & (ch <= "!") OR
+               (ch >= "#")) THEN 
+            ELSIF (ch = '"') THEN state := 11; 
+            ELSE sym := noSYMB; RETURN
+            END;
+      | 11: sym := 4; RETURN
+      | 12: IF ((ch >= "0") & (ch <= "9")) THEN 
+            ELSIF ((ch >= "A") & (ch <= "F")) THEN state := 2; 
+            ELSIF (ch = ".") THEN state := 13; INC(apx) 
+            ELSIF (ch = "H") THEN state := 4; 
+            ELSE sym := 2; RETURN
+            END;
+      | 13: IF ((ch >= "0") & (ch <= "9")) THEN state := 5; apx := Long0 
+            ELSIF (ch = ".") THEN state := 3; INC(apx) 
+            ELSIF (ch = "E") THEN state := 6; apx := Long0 
+            ELSE sym := 3; RETURN
+            END;
+      | 14: IF (ch = ".") THEN state := 23; 
+            ELSE sym := 5; RETURN
+            END;
+      | 15: sym := 7; RETURN
+      | 16: sym := 10; RETURN
+      | 17: sym := 14; RETURN
+      | 18: IF (ch = "=") THEN state := 24; 
+            ELSE sym := 17; RETURN
+            END;
+      | 19: sym := 18; RETURN
+      | 20: sym := 19; RETURN
+      | 21: sym := 23; RETURN
+      | 22: sym := 24; RETURN
+      | 23: sym := 25; RETURN
+      | 24: sym := 33; RETURN
+      | 25: sym := 34; RETURN
+      | 26: sym := 47; RETURN
+      | 27: IF (ch = ">") THEN state := 28; 
+            ELSIF (ch = "=") THEN state := 29; 
+            ELSE sym := 49; RETURN
+            END;
+      | 28: sym := 48; RETURN
+      | 29: sym := 50; RETURN
+      | 30: IF (ch = "=") THEN state := 31; 
+            ELSE sym := 51; RETURN
+            END;
+      | 31: sym := 52; RETURN
+      | 32: sym := 54; RETURN
+      | 33: sym := 55; RETURN
+      | 34: sym := 57; RETURN
+      | 35: sym := 58; RETURN
+      | 36: sym := 0; ch := 0C; DEC(bp); RETURN
+      ELSE sym := noSYMB; RETURN (*NextCh already done*)
+      END
+    END
+  END Get;
+
+PROCEDURE GetString (pos: INT32; len: CARDINAL; VAR s: ARRAY OF CHAR);
+  VAR
+    i: CARDINAL;
+    p: INT32;
+  BEGIN
+    IF len > HIGH(s) THEN len := HIGH(s) END;
+    p := pos; i := 0;
+    WHILE i < len DO
+      s[i] := CharAt(p); INC(i); INC(p)
+    END;
+    s[len] := 0C;
+  END GetString;
+
+PROCEDURE GetName (pos: INT32; len: CARDINAL; VAR s: ARRAY OF CHAR);
+  VAR
+    i: CARDINAL;
+    p: INT32;
+  BEGIN
+    IF len > HIGH(s) THEN len := HIGH(s) END;
+    p := pos; i := 0;
+    WHILE i < len DO
+      s[i] := CurrentCh(p); INC(i); INC(p)
+    END;
+    s[len] := 0C;
+  END GetName;
+
+PROCEDURE CharAt (pos: INT32): CHAR;
+  VAR
+    ch: CHAR;
+  BEGIN
+    IF pos >= inputLen THEN RETURN EOF END;
+    ch := buf[ORD(pos DIV BlkSize)]^[ORD(pos MOD BlkSize)];
+    IF ch # eof THEN RETURN ch ELSE RETURN EOF END
+  END CharAt;
+
+PROCEDURE CapChAt (pos: INT32): CHAR;
+  VAR
+    ch: CHAR;
+  BEGIN
+    IF pos >= inputLen THEN RETURN EOF END;
+    ch := CAP(buf[ORD(pos DIV BlkSize)]^[ORD(pos MOD BlkSize)]);
+    IF ch # eof THEN RETURN ch ELSE RETURN EOF END
+  END CapChAt;
+
+PROCEDURE Reset;
+  VAR
+    i, read: CARDINAL;
+  BEGIN (*assert: src has been opened*)
+    i := 0; inputLen := 0;
+    REPEAT
+      Storage.ALLOCATE(buf[i], BlkSize);
+      read := BlkSize; FileIO.ReadBytes(src, buf[i]^, read);
+      INC(i); INC(inputLen, VAL(INT32, read))
+    UNTIL read # BlkSize;
+    buf[i-1]^[read] := EOF;
+    curLine := 1; lineStart := -2; bp := -1;
+    oldEols := 0; apx := 0; errors := 0;
+    NextCh;
+  END Reset;
+
+BEGIN
+  CurrentCh := CharAt;
+  start[  0] := 36; start[  1] := 37; start[  2] := 37; start[  3] := 37; 
+  start[  4] := 37; start[  5] := 37; start[  6] := 37; start[  7] := 37; 
+  start[  8] := 37; start[  9] := 37; start[ 10] := 37; start[ 11] := 37; 
+  start[ 12] := 37; start[ 13] := 37; start[ 14] := 37; start[ 15] := 37; 
+  start[ 16] := 37; start[ 17] := 37; start[ 18] := 37; start[ 19] := 37; 
+  start[ 20] := 37; start[ 21] := 37; start[ 22] := 37; start[ 23] := 37; 
+  start[ 24] := 37; start[ 25] := 37; start[ 26] := 37; start[ 27] := 37; 
+  start[ 28] := 37; start[ 29] := 37; start[ 30] := 37; start[ 31] := 37; 
+  start[ 32] := 37; start[ 33] := 37; start[ 34] := 10; start[ 35] := 26; 
+  start[ 36] := 37; start[ 37] := 37; start[ 38] := 37; start[ 39] :=  9; 
+  start[ 40] := 21; start[ 41] := 22; start[ 42] := 34; start[ 43] := 32; 
+  start[ 44] := 16; start[ 45] := 33; start[ 46] := 14; start[ 47] := 35; 
+  start[ 48] := 12; start[ 49] := 12; start[ 50] := 12; start[ 51] := 12; 
+  start[ 52] := 12; start[ 53] := 12; start[ 54] := 12; start[ 55] := 12; 
+  start[ 56] := 12; start[ 57] := 12; start[ 58] := 18; start[ 59] := 15; 
+  start[ 60] := 27; start[ 61] := 17; start[ 62] := 30; start[ 63] := 37; 
+  start[ 64] := 37; start[ 65] :=  1; start[ 66] :=  1; start[ 67] :=  1; 
+  start[ 68] :=  1; start[ 69] :=  1; start[ 70] :=  1; start[ 71] :=  1; 
+  start[ 72] :=  1; start[ 73] :=  1; start[ 74] :=  1; start[ 75] :=  1; 
+  start[ 76] :=  1; start[ 77] :=  1; start[ 78] :=  1; start[ 79] :=  1; 
+  start[ 80] :=  1; start[ 81] :=  1; start[ 82] :=  1; start[ 83] :=  1; 
+  start[ 84] :=  1; start[ 85] :=  1; start[ 86] :=  1; start[ 87] :=  1; 
+  start[ 88] :=  1; start[ 89] :=  1; start[ 90] :=  1; start[ 91] := 19; 
+  start[ 92] := 37; start[ 93] := 20; start[ 94] := 25; start[ 95] := 37; 
+  start[ 96] := 37; start[ 97] :=  1; start[ 98] :=  1; start[ 99] :=  1; 
+  start[100] :=  1; start[101] :=  1; start[102] :=  1; start[103] :=  1; 
+  start[104] :=  1; start[105] :=  1; start[106] :=  1; start[107] :=  1; 
+  start[108] :=  1; start[109] :=  1; start[110] :=  1; start[111] :=  1; 
+  start[112] :=  1; start[113] :=  1; start[114] :=  1; start[115] :=  1; 
+  start[116] :=  1; start[117] :=  1; start[118] :=  1; start[119] :=  1; 
+  start[120] :=  1; start[121] :=  1; start[122] :=  1; start[123] := 37; 
+  start[124] := 37; start[125] := 37; start[126] := 37; start[127] := 37; 
+  start[128] := 37; start[129] := 37; start[130] := 37; start[131] := 37; 
+  start[132] := 37; start[133] := 37; start[134] := 37; start[135] := 37; 
+  start[136] := 37; start[137] := 37; start[138] := 37; start[139] := 37; 
+  start[140] := 37; start[141] := 37; start[142] := 37; start[143] := 37; 
+  start[144] := 37; start[145] := 37; start[146] := 37; start[147] := 37; 
+  start[148] := 37; start[149] := 37; start[150] := 37; start[151] := 37; 
+  start[152] := 37; start[153] := 37; start[154] := 37; start[155] := 37; 
+  start[156] := 37; start[157] := 37; start[158] := 37; start[159] := 37; 
+  start[160] := 37; start[161] := 37; start[162] := 37; start[163] := 37; 
+  start[164] := 37; start[165] := 37; start[166] := 37; start[167] := 37; 
+  start[168] := 37; start[169] := 37; start[170] := 37; start[171] := 37; 
+  start[172] := 37; start[173] := 37; start[174] := 37; start[175] := 37; 
+  start[176] := 37; start[177] := 37; start[178] := 37; start[179] := 37; 
+  start[180] := 37; start[181] := 37; start[182] := 37; start[183] := 37; 
+  start[184] := 37; start[185] := 37; start[186] := 37; start[187] := 37; 
+  start[188] := 37; start[189] := 37; start[190] := 37; start[191] := 37; 
+  start[192] := 37; start[193] := 37; start[194] := 37; start[195] := 37; 
+  start[196] := 37; start[197] := 37; start[198] := 37; start[199] := 37; 
+  start[200] := 37; start[201] := 37; start[202] := 37; start[203] := 37; 
+  start[204] := 37; start[205] := 37; start[206] := 37; start[207] := 37; 
+  start[208] := 37; start[209] := 37; start[210] := 37; start[211] := 37; 
+  start[212] := 37; start[213] := 37; start[214] := 37; start[215] := 37; 
+  start[216] := 37; start[217] := 37; start[218] := 37; start[219] := 37; 
+  start[220] := 37; start[221] := 37; start[222] := 37; start[223] := 37; 
+  start[224] := 37; start[225] := 37; start[226] := 37; start[227] := 37; 
+  start[228] := 37; start[229] := 37; start[230] := 37; start[231] := 37; 
+  start[232] := 37; start[233] := 37; start[234] := 37; start[235] := 37; 
+  start[236] := 37; start[237] := 37; start[238] := 37; start[239] := 37; 
+  start[240] := 37; start[241] := 37; start[242] := 37; start[243] := 37; 
+  start[244] := 37; start[245] := 37; start[246] := 37; start[247] := 37; 
+  start[248] := 37; start[249] := 37; start[250] := 37; start[251] := 37; 
+  start[252] := 37; start[253] := 37; start[254] := 37; start[255] := 37; 
+  Error := Err; lastCh := EOF;
+END M2compS.

src/compiler.frm

@@ -0,0 +1,252 @@
+MODULE -->Grammar;
+(* Driver for the M2comp Modula-2 compiler (Coco/R, step 1: syntax only).
+   Generated <Grammar>S (scanner) + <Grammar>P (parser) do lexing/parsing;
+   no hand-written lexer. SymTab/MGen plug in at step 2. *)
+
+  FROM -->Scanner IMPORT lst, src, errors, Error, CharAt;
+  FROM -->Parser IMPORT Parse, Successful;
+  IMPORT
+    Strings, Storage, SYSTEM, FileIO;
+
+  TYPE
+    INT32 = FileIO.INT32 (* 32 bit integers needed *);
+
+  MODULE ListHandler;
+  (* ------------------- Source Listing and Error handler -------------- *)
+    FROM FileIO IMPORT CR, LF, EOF, WriteString, Write, WriteLn, WriteInt, Long0;
+    FROM Storage IMPORT ALLOCATE;
+    FROM SYSTEM IMPORT TSIZE;
+    IMPORT lst, CharAt, errors, INT32;
+    EXPORT StoreError, PrintListing;
+
+    TYPE
+      Err = POINTER TO ErrDesc;
+      ErrDesc = RECORD
+        nr, line, col: INTEGER;
+        next: Err
+      END;
+
+    CONST
+      tab = 11C;
+
+    VAR
+      firstErr, lastErr: Err;
+      Extra: INTEGER;
+
+    PROCEDURE StoreError (nr, line, col: INTEGER; pos: INT32);
+    (* Store an error message for later printing *)
+      VAR
+        nextErr: Err;
+      BEGIN
+        ALLOCATE(nextErr, TSIZE(ErrDesc));
+        nextErr^.nr := nr; nextErr^.line := line; nextErr^.col := col;
+        nextErr^.next := NIL;
+        IF firstErr = NIL
+          THEN firstErr := nextErr
+          ELSE lastErr^.next := nextErr
+        END;
+        lastErr := nextErr;
+        INC(errors)
+      END StoreError;
+
+    PROCEDURE GetLine (VAR pos: INT32;
+                       VAR line: ARRAY OF CHAR;
+                       VAR eof: BOOLEAN);
+    (* Read a source line. Return empty line if eof *)
+      VAR
+        ch: CHAR;
+        i: CARDINAL;
+      BEGIN
+        i := 0; eof := FALSE; ch := CharAt(pos); INC(pos);
+        WHILE (ch # CR) & (ch # LF) & (ch # EOF) DO
+          line[i] := ch; INC(i); ch := CharAt(pos); INC(pos);
+        END;
+        eof := (i = 0) & (ch = EOF); line[i] := 0C;
+        IF ch = CR THEN (* check for MsDos *)
+          ch := CharAt(pos);
+          IF ch = LF THEN INC(pos); Extra := 0 END
+        END
+      END GetLine;
+
+    PROCEDURE PrintErr (line: ARRAY OF CHAR; nr, col: INTEGER);
+    (* Print an error message *)
+
+      PROCEDURE Msg (s: ARRAY OF CHAR);
+        BEGIN
+          WriteString(lst, s)
+        END Msg;
+
+      PROCEDURE Pointer;
+        VAR
+          i: INTEGER;
+        BEGIN
+          WriteString(lst, "*****  ");
+          i := 0;
+          WHILE i < col + Extra - 2 DO
+            IF line[i] = tab
+              THEN Write(lst, tab)
+              ELSE Write(lst, ' ')
+            END;
+            INC(i)
+          END;
+          WriteString(lst, "^ ")
+        END Pointer;
+
+      BEGIN
+        Pointer;
+        CASE nr OF
+        -->Errors
+        (* add customized cases here *)
+        | 200: Msg("duplicate identifier")
+        | 201: Msg("undeclared identifier")
+        | 202: Msg("module/procedure name mismatch")
+        | 210: Msg("incompatible assignment")
+        | 211: Msg("arithmetic operand must be numeric")
+        | 212: Msg("boolean operand required")
+        | 213: Msg("incompatible comparison")
+        | 214: Msg("BOOLEAN condition required")
+        | 215: Msg("not a RECORD type")
+        | 216: Msg("unknown field")
+        | 217: Msg("not an ARRAY type")
+        | 218: Msg("array index must be integer")
+        | 219: Msg("not a POINTER type")
+        | 220: Msg("FOR needs integer variable and bounds")
+        | 221: Msg("not a type name")
+        | 222: Msg("set operand mismatch")
+        | 223: Msg("cyclical type definition")
+        | 224: Msg("ordinal type required")
+        | 230: Msg("not supported in this phase")
+        | 231: Msg("procedure forward mismatch or missing body")
+        | 232: Msg("bad RETURN")
+        | 233: Msg("invalid procedure call")
+        ELSE         Msg("Error: "); WriteInt(lst, nr, 0);
+        END;
+        WriteLn(lst)
+      END PrintErr;
+
+    PROCEDURE PrintListing;
+    (* Print a source listing with error messages *)
+      VAR
+        nextErr: Err;
+        eof: BOOLEAN;
+        lnr, errC: INTEGER;
+        srcPos: INT32;
+        line: ARRAY [0 .. 255] OF CHAR;
+      BEGIN
+        WriteString(lst, "Listing:");
+        WriteLn(lst); WriteLn(lst);
+        srcPos := 0; nextErr := firstErr;
+        GetLine(srcPos, line, eof); lnr := 1; errC := 0;
+        WHILE ~ eof DO
+          WriteInt(lst, lnr, 5); WriteString(lst, "  ");
+          WriteString(lst, line); WriteLn(lst);
+          WHILE (nextErr # NIL) & (nextErr^.line = lnr) DO
+            PrintErr(line, nextErr^.nr, nextErr^.col); INC(errC);
+            nextErr := nextErr^.next
+          END;
+          GetLine(srcPos, line, eof); INC(lnr);
+        END;
+        IF nextErr # NIL THEN
+          WriteInt(lst, lnr, 5); WriteLn(lst);
+          WHILE nextErr # NIL DO
+            PrintErr(line, nextErr^.nr, nextErr^.col); INC(errC);
+            nextErr := nextErr^.next
+          END
+        END;
+        WriteLn(lst);
+        WriteInt(lst, errC, 5); WriteString(lst, " error");
+        IF errC # 1 THEN Write(lst, 's') END;
+        WriteLn(lst); WriteLn(lst); WriteLn(lst);
+      END PrintListing;
+
+    BEGIN
+      firstErr := NIL; Extra := 1;
+    END ListHandler;
+
+  (* --------------------------- main module ------------------------------- *)
+
+  PROCEDURE ChangeExtension (oldName, Ext: ARRAY OF CHAR;
+                             VAR newName: ARRAY OF CHAR);
+  (* Constructs newName by replacing the extension of oldName with Ext. *)
+    VAR
+      i, l: CARDINAL;
+    BEGIN
+      Strings.Assign(oldName, newName);
+      i := LENGTH(oldName); l := i;
+      WHILE (i > 0) & (oldName[i -1] # '.')
+            & (oldName[i -1] # '\') & (oldName[i -1] # '/') DO
+        DEC(i)
+      END;
+      IF (i > 0) & (oldName[i-1] = '.') THEN
+        Strings.Delete(newName, i - 1, l + 1 - i)
+      END;
+      IF Ext[0] = '.' THEN Strings.Delete(Ext, 0, 1) END;
+      Strings.Append(".", newName);
+      Strings.Append(Ext, newName)
+    END ChangeExtension;
+
+  VAR
+    sourceName, listName: ARRAY [0 .. 255] OF CHAR;
+    failed: BOOLEAN;
+
+  BEGIN
+    (* check on correct parameter usage *)
+    FileIO.NextParameter(sourceName);
+    IF sourceName[0] = 0C THEN
+      FileIO.WriteString(FileIO.StdOut, "No input file specified");
+      HALT
+    END;
+
+    (* step 1: syntax only, no symbol table yet (see M2comp.atg) *)
+
+    (* install error reporting procedure - Scanner.Error *)
+    Error := StoreError;
+
+    failed := FALSE;
+    LOOP
+      IF sourceName[0] = 0C THEN EXIT END;
+
+      (* open the source file - Scanner.src *)
+      FileIO.Open(src, sourceName, FALSE);
+      IF ~ FileIO.Okay THEN
+        FileIO.WriteString(FileIO.StdOut, "Could not open input file");
+        FileIO.WriteLn(FileIO.StdOut);
+        HALT
+      END;
+
+      (* open the output file for the source listing - Scanner.lst *)
+      ChangeExtension(sourceName, ".LST", listName);
+      FileIO.Open(lst, listName, TRUE);
+      IF ~ FileIO.Okay THEN
+        FileIO.WriteString(FileIO.StdOut, "Could not open listing file");
+        FileIO.WriteLn(FileIO.StdOut);
+        (* default Scanner.lst to screen *) lst := FileIO.StdOut;
+      END;
+
+      (* instigate the compilation - Parser.Parse *)
+      FileIO.WriteString(FileIO.StdOut, "Parsing ");
+      FileIO.WriteString(FileIO.StdOut, sourceName);
+      FileIO.WriteLn(FileIO.StdOut);
+      Parse;
+
+      (* generate the source listing on lst file *)
+      PrintListing;
+      IF lst # FileIO.StdOut THEN FileIO.Close(lst) END;
+
+      (* fail fast: later files build on this one's tables *)
+      IF NOT Successful()
+        THEN
+          FileIO.WriteString(FileIO.StdOut, "Incorrect source");
+          FileIO.WriteLn(FileIO.StdOut);
+          failed := TRUE;
+          EXIT
+      END;
+
+      FileIO.NextParameter(sourceName);
+    END;
+
+    (* examine the outcome *)
+    IF NOT failed THEN
+      FileIO.WriteString(FileIO.StdOut, "Parsed correctly");
+    END;
+  END -->Grammar.

src/modules.lst

@@ -0,0 +1,65 @@
+SYSTEM
+ASCII
+Strings
+StrLib
+Environment
+CFileSysOp
+Indexing
+SysExceptions
+M2EXCEPTION
+RTExceptions
+M2Dependent
+M2RTS
+wrapc
+FIO
+errno
+termios
+IO
+StdIO
+StrIO
+NumberIO
+Debug
+Selective
+ldtoa
+dtoa
+StringConvert
+M2Diagnostic
+SysStorage
+RTentity
+EXCEPTIONS
+Storage
+Assertion
+DynamicStrings
+StringFileSysOp
+FileSysOp
+wrapclock
+UnixArgs
+Args
+SysClock
+IOConsts
+ChanConsts
+IOLink
+RTio
+ErrnoCategory
+RTgenif
+RTfio
+RTgen
+StdChans
+IOChan
+RTdata
+ProgramArgs
+CharClass
+TextUtil
+TextIO
+RawIO
+ConvTypes
+WholeConv
+StringChan
+WholeIO
+IOResult
+RndFile
+TermFile
+FileIO
+M2compS
+M2compP
+M2comp

src/parser.frm

@@ -0,0 +1,152 @@
+IMPLEMENTATION MODULE -->modulename;
+
+(* Parser generated by Coco/R - assuming ISO IO library will be available. *)
+
+IMPORT -->scanner, FileIO;
+
+-->declarations
+
+CONST 
+  -->constants
+  minErrDist  =  2;  (* minimal distance (good tokens) between two errors *)
+  setsize     = 16;  (* sets are stored in 16 bits *)
+
+TYPE
+  SymbolSet = ARRAY [0 .. maxT DIV setsize] OF BITSET;
+
+VAR
+  symSet:  ARRAY [0 .. -->symSetSize] OF SymbolSet; (*symSet[0] = allSyncSyms*)
+  errDist: CARDINAL;   (* number of symbols recognized since last error *)
+  sym:     CARDINAL;   (* current input symbol *)
+
+PROCEDURE SemError (errNo: INTEGER);
+  BEGIN
+    IF errDist >= minErrDist THEN
+      -->error
+    END;
+    errDist := 0;
+  END SemError;
+
+PROCEDURE SynError (errNo: INTEGER);
+  BEGIN
+    IF errDist >= minErrDist THEN
+      -->error
+    END;
+    errDist := 0;
+  END SynError;
+
+PROCEDURE Get;
+  VAR
+    s: ARRAY [0 .. 31] OF CHAR;
+  BEGIN
+    REPEAT
+      -->scanner.Get(sym);
+      IF sym <= maxT THEN
+        INC(errDist);
+      ELSE
+        -->pragmas
+      END;
+    UNTIL sym <= maxT
+  END Get;
+
+PROCEDURE In (VAR s: SymbolSet; x: CARDINAL): BOOLEAN;
+  BEGIN
+    RETURN x MOD setsize IN s[x DIV setsize];
+  END In;
+
+PROCEDURE Expect (n: CARDINAL);
+  BEGIN
+    IF sym = n THEN Get ELSE SynError(n) END
+  END Expect;
+
+PROCEDURE ExpectWeak (n, follow: CARDINAL);
+  BEGIN
+    IF sym = n
+      THEN Get
+      ELSE SynError(n); WHILE ~ In(symSet[follow], sym) DO Get END
+    END
+  END ExpectWeak;
+
+PROCEDURE WeakSeparator (n, syFol, repFol: CARDINAL): BOOLEAN;
+  VAR
+    s: SymbolSet;
+    i: CARDINAL;
+  BEGIN
+    IF sym = n
+      THEN Get; RETURN TRUE
+      ELSIF In(symSet[repFol], sym) THEN RETURN FALSE
+      ELSE
+        i := 0;
+        WHILE i <= maxT DIV setsize DO
+          s[i] := symSet[0, i] + symSet[syFol, i] + symSet[repFol, i]; INC(i)
+        END;
+        SynError(n); WHILE ~ In(s, sym) DO Get END;
+        RETURN In(symSet[syFol], sym)
+    END
+  END WeakSeparator;
+
+PROCEDURE LexName (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    -->scanner.GetName(-->scanner.pos, -->scanner.len, Lex)
+  END LexName;
+
+PROCEDURE LexString (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    -->scanner.GetString(-->scanner.pos, -->scanner.len, Lex)
+  END LexString;
+
+PROCEDURE LookAheadName (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    -->scanner.GetName(-->scanner.nextPos, -->scanner.nextLen, Lex)
+  END LookAheadName;
+
+PROCEDURE LookAheadString (VAR Lex: ARRAY OF CHAR);
+  BEGIN
+    -->scanner.GetString(-->scanner.nextPos, -->scanner.nextLen, Lex)
+  END LookAheadString;
+
+PROCEDURE Successful (): BOOLEAN;
+  BEGIN
+    RETURN -->scanner.errors = 0
+  END Successful;
+
+-->productions
+
+PROCEDURE Parse;
+  BEGIN
+    -->parseRoot
+  END Parse;
+
+BEGIN
+  errDist := minErrDist;
+  -->initialization
+END -->modulename.
+
+-->definitionDEFINITION MODULE -->modulename;
+
+(* Parser generated by Coco/R *)
+
+PROCEDURE Parse;
+
+PROCEDURE Successful (): BOOLEAN;
+(* Returns TRUE if no errors have been recorded while parsing *)
+
+PROCEDURE SynError (errNo: INTEGER);
+(* Report syntax error errNo *)
+
+PROCEDURE SemError (errNo: INTEGER);
+(* Report semantic error errNo *)
+
+PROCEDURE LexString (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as exact spelling of current token *)
+
+PROCEDURE LexName (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as name of current token (capitalized if IGNORE CASE) *)
+
+PROCEDURE LookAheadName (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as exact spelling of lookahead token *)
+
+PROCEDURE LookAheadString (VAR Lex: ARRAY OF CHAR);
+(* Retrieves Lex as name of lookahead token (capitalized if IGNORE CASE) *)
+
+END -->modulename.

src/scanner.frm

@@ -0,0 +1,201 @@
+IMPLEMENTATION MODULE -->modulename;
+
+(* Scanner generated by Coco/R - using the FileIO library supplied with this project. *)
+
+IMPORT FileIO, Storage;
+
+CONST
+  noSYMB  = -->unknownsym; (*error token code*)
+  (* not only for errors but also for not finished states of scanner analysis *)
+  eof     = 32C (* MS-DOS Keyboard eof char *);
+  EOF     = 0C;
+  EOL     = 15C;
+  CR      = 15C;
+  LF      = 12C;
+  Long0   = 0;
+  Long1   = 1;
+  BlkSize = 16384;
+TYPE
+  BufBlock   = ARRAY [0 .. BlkSize-1] OF CHAR;
+  Buffer     = ARRAY [0 .. 31] OF POINTER TO BufBlock;
+  StartTable = ARRAY [0 .. 255] OF INTEGER;
+  GetCH      = PROCEDURE (INT32): CHAR;
+VAR
+  lastCh,
+  ch:        CHAR;       (*current input character*)
+  curLine:   INTEGER;    (*current input line (may be higher than line)*)
+  lineStart: INT32;      (*start position of current line*)
+  apx:       INT32;      (*length of appendix (CONTEXT phrase)*)
+  oldEols:   INTEGER;    (*number of EOLs in a comment*)
+  bp, bp0:   INT32;      (*current position in buf
+                           (bp0: position of current token)*)
+  inputLen:  INT32;      (*source file size*)
+  buf:       Buffer;     (*source buffer for low-level access*)
+  start:     StartTable; (*start state for every character*)
+  CurrentCh: GetCH;
+
+PROCEDURE Err (nr, line, col: INTEGER; pos: INT32);
+  BEGIN
+    INC(errors)
+  END Err;
+
+PROCEDURE NextCh;
+(* Return global variable ch *)
+  BEGIN
+    lastCh := ch; INC(bp); ch := CurrentCh(bp);
+    IF (ch = EOL) OR (ch = LF) AND (lastCh # EOL) THEN
+      INC(curLine); lineStart := bp
+    END
+  END NextCh;
+
+PROCEDURE Comment (): BOOLEAN;
+  VAR
+    level, startLine: INTEGER;
+    oldLineStart: INT32;
+  BEGIN
+    level := 1; startLine := curLine; oldLineStart := lineStart;
+    -->commentRETURN FALSE;
+  END Comment;
+
+PROCEDURE Get (VAR sym: CARDINAL);
+  VAR
+    state: CARDINAL;
+
+  PROCEDURE Equal (s: ARRAY OF CHAR): BOOLEAN;
+    VAR
+      i: CARDINAL;
+      q: INT32;
+    BEGIN
+      IF nextLen # LENGTH(s) THEN RETURN FALSE END;
+      i := 1; q := bp0; INC(q);
+      WHILE i < nextLen DO
+        IF CurrentCh(q) # s[i] THEN RETURN FALSE END;
+        INC(i); INC(q)
+      END;
+      RETURN TRUE
+    END Equal;
+
+  PROCEDURE CheckLiteral;
+    BEGIN
+      -->literals
+    END CheckLiteral;
+
+  BEGIN (*Get*)
+    -->GetSy1
+    pos := nextPos;   nextPos := bp;
+    col := nextCol;   nextCol := VAL(INTEGER, bp - lineStart);
+    line := nextLine; nextLine := curLine;
+    len := nextLen;   nextLen := 0;
+    apx := 0; state := start[ORD(ch)]; bp0 := bp;
+    LOOP
+      NextCh; INC(nextLen);
+      CASE state OF
+      -->GetSy2
+      ELSE sym := noSYMB; RETURN (*NextCh already done*)
+      END
+    END
+  END Get;
+
+PROCEDURE GetString (pos: INT32; len: CARDINAL; VAR s: ARRAY OF CHAR);
+  VAR
+    i: CARDINAL;
+    p: INT32;
+  BEGIN
+    IF len > HIGH(s) THEN len := HIGH(s) END;
+    p := pos; i := 0;
+    WHILE i < len DO
+      s[i] := CharAt(p); INC(i); INC(p)
+    END;
+    s[len] := 0C;
+  END GetString;
+
+PROCEDURE GetName (pos: INT32; len: CARDINAL; VAR s: ARRAY OF CHAR);
+  VAR
+    i: CARDINAL;
+    p: INT32;
+  BEGIN
+    IF len > HIGH(s) THEN len := HIGH(s) END;
+    p := pos; i := 0;
+    WHILE i < len DO
+      s[i] := CurrentCh(p); INC(i); INC(p)
+    END;
+    s[len] := 0C;
+  END GetName;
+
+PROCEDURE CharAt (pos: INT32): CHAR;
+  VAR
+    ch: CHAR;
+  BEGIN
+    IF pos >= inputLen THEN RETURN EOF END;
+    ch := buf[ORD(pos DIV BlkSize)]^[ORD(pos MOD BlkSize)];
+    IF ch # eof THEN RETURN ch ELSE RETURN EOF END
+  END CharAt;
+
+PROCEDURE CapChAt (pos: INT32): CHAR;
+  VAR
+    ch: CHAR;
+  BEGIN
+    IF pos >= inputLen THEN RETURN EOF END;
+    ch := CAP(buf[ORD(pos DIV BlkSize)]^[ORD(pos MOD BlkSize)]);
+    IF ch # eof THEN RETURN ch ELSE RETURN EOF END
+  END CapChAt;
+
+PROCEDURE Reset;
+  VAR
+    i, read: CARDINAL;
+  BEGIN (*assert: src has been opened*)
+    i := 0; inputLen := 0;
+    REPEAT
+      Storage.ALLOCATE(buf[i], BlkSize);
+      read := BlkSize; FileIO.ReadBytes(src, buf[i]^, read);
+      INC(i); INC(inputLen, VAL(INT32, read))
+    UNTIL read # BlkSize;
+    buf[i-1]^[read] := EOF;
+    curLine := 1; lineStart := -2; bp := -1;
+    oldEols := 0; apx := 0; errors := 0;
+    NextCh;
+  END Reset;
+
+BEGIN
+  -->initializations
+  Error := Err; lastCh := EOF;
+END -->modulename.
+-->definitionDEFINITION MODULE -->modulename;
+
+(* Scanner generated by Coco/R - using the FileIO library supplied with this project. *)
+
+IMPORT FileIO;
+
+TYPE
+  INT32 = FileIO.INT32 (* need 32 bit integers *);
+
+VAR
+  src, lst:    FileIO.File;(*source/list files. To be opened by the main pgm*)
+  directory:   ARRAY [0 .. 255] OF CHAR (*of source file*);
+  line, col:   INTEGER;      (*line and column of current symbol*)
+  len:         CARDINAL;     (*length of current symbol*)
+  pos:         INT32;        (*file position of current symbol*)
+  nextLine:    INTEGER;      (*line of lookahead symbol*)
+  nextCol:     INTEGER;      (*column of lookahead symbol*)
+  nextLen:     CARDINAL;     (*length of lookahead symbol*)
+  nextPos:     INT32;        (*file position of lookahead symbol*)
+  errors:      INTEGER;      (*number of detected errors*)
+  Error:       PROCEDURE ((*nr*)INTEGER, (*line*)INTEGER, (*col*)INTEGER,
+                          (*pos*)INT32);
+
+PROCEDURE Get (VAR sym: CARDINAL);
+(* Gets next symbol from source file *)
+
+PROCEDURE GetString (pos: INT32; len: CARDINAL; VAR name: ARRAY OF CHAR);
+(* Retrieves exact string of max length len from position pos in source file *)
+
+PROCEDURE GetName (pos: INT32; len: CARDINAL; VAR name: ARRAY OF CHAR);
+(* Retrieves name of symbol of length len at position pos in source file *)
+
+PROCEDURE CharAt (pos: INT32): CHAR;
+(* Returns exact character at position pos in source file *)
+
+PROCEDURE Reset;
+(* Reads and stores source file internally *)
+
+END -->modulename.

tests/bad_mismatch.LST

@@ -0,0 +1,10 @@
+Listing:
+
+    1  MODULE BadMismatch;
+    2  BEGIN
+    3  END WrongName.
+*****      ^ module/procedure name mismatch
+
+    1 error
+
+

tests/bad_mismatch.mod

@@ -0,0 +1,3 @@
+MODULE BadMismatch;
+BEGIN
+END WrongName.

tests/ok_minimal.LST

@@ -0,0 +1,9 @@
+Listing:
+
+    1  MODULE OkMinimal;
+    2  BEGIN
+    3  END OkMinimal.
+
+    0 errors
+
+

tests/ok_minimal.mod

@@ -0,0 +1,3 @@
+MODULE OkMinimal;
+BEGIN
+END OkMinimal.

tests/ok_proc.LST

@@ -0,0 +1,36 @@
+Listing:
+
+    1  MODULE OkProc;
+    2  FROM In IMPORT x;
+    3  IMPORT y, z;
+    4  VAR
+    5    i : INTEGER;
+    6    a : ARRAY [0..9], [0..3] OF INTEGER;
+    7    r : RECORD f : INTEGER; END;
+    8  
+    9  PROCEDURE P(VAR v : INTEGER; n : CARDINAL) : BOOLEAN;
+   10  BEGIN
+   11    IF n > 0 THEN v := -v + 1 ELSE v := 0 END;
+   12    RETURN TRUE
+   13  END P;
+   14  
+   15  MODULE Local;
+   16  EXPORT q;
+   17  VAR q : INTEGER;
+   18  BEGIN
+   19    q := 1
+   20  END Local;
+   21  
+   22  BEGIN
+   23    i := 0;
+   24    WHILE i < 10 DO
+   25      i := i + 1
+   26    END;
+   27    FOR i := 1 TO 10 BY 2 DO
+   28      P(i, i)
+   29    END
+   30  END OkProc.
+
+    0 errors
+
+

tests/ok_proc.mod

@@ -0,0 +1,30 @@
+MODULE OkProc;
+FROM In IMPORT x;
+IMPORT y, z;
+VAR
+  i : INTEGER;
+  a : ARRAY [0..9], [0..3] OF INTEGER;
+  r : RECORD f : INTEGER; END;
+
+PROCEDURE P(VAR v : INTEGER; n : CARDINAL) : BOOLEAN;
+BEGIN
+  IF n > 0 THEN v := -v + 1 ELSE v := 0 END;
+  RETURN TRUE
+END P;
+
+MODULE Local;
+EXPORT q;
+VAR q : INTEGER;
+BEGIN
+  q := 1
+END Local;
+
+BEGIN
+  i := 0;
+  WHILE i < 10 DO
+    i := i + 1
+  END;
+  FOR i := 1 TO 10 BY 2 DO
+    P(i, i)
+  END
+END OkProc.