├── .gitattributes ├── CHANGES.md ├── CONTRIBUTING.md ├── COPYRIGHT ├── LICENSE.md ├── README.md ├── ROADMAP.md ├── docs ├── DEBUGGING ├── MOBIL Intermediate Language Report (1992).pdf ├── MOCKA User Manual (1994).pdf └── MOCKA User Manual (1999).pdf ├── ver1807 ├── CHANGES.md ├── bin │ ├── Mocka │ └── Mocka.md5 ├── man │ └── mocka.1 └── src │ ├── CgAssOut.def │ ├── CgAssOut.mod │ ├── CgBase.def │ ├── CgBase.mod │ ├── CgDebug.def │ ├── CgDebug.mod │ ├── CgMobil.def │ ├── CgMobil.mod │ ├── CgTypeMap.def │ ├── CgTypeMap.mod │ ├── CgUtilities.def │ ├── CgUtilities.mod │ ├── DfFiles.def │ ├── DfFiles.mod │ ├── DfScopes.def │ ├── DfScopes.mod │ ├── DfTable.def │ ├── DfTable.mod │ ├── Emit.def │ ├── Emit.dot │ ├── Emit.mod │ ├── FileName.def │ ├── FileName.mod │ ├── GcgStorage.def │ ├── GcgStorage.mod │ ├── GcgTab.def │ ├── GcgTab.mod │ ├── IR.def │ ├── IR.mod │ ├── Lister.mod │ ├── M2RTS-ErrNo.c │ ├── M2RTS-elf.s │ ├── M2RTS.s │ ├── Mocka.mod │ ├── MockaArgs.def │ ├── MockaArgs.mod │ ├── MockaBind.def │ ├── MockaBind.mod │ ├── MockaComp.def │ ├── MockaComp.mod │ ├── MockaMake.def │ ├── MockaMake.mod │ ├── MockaShell.def │ ├── MockaShell.mod │ ├── PaBodies.def │ ├── PaBodies.mod │ ├── PaDecls.def │ ├── PaDecls.mod │ ├── PaSymSets.def │ ├── PaSymSets.mod │ ├── Prints.def │ ├── Prints.mod │ ├── RegAlloc.def │ ├── RegAlloc.mod │ ├── Stat │ ├── SuAlloc.def │ ├── SuAlloc.mod │ ├── SuAlloc2.def │ ├── SuAlloc2.mod │ ├── SuAlloc3.def │ ├── SuAlloc3.mod │ ├── SuBase.def │ ├── SuBase.mod │ ├── SuErrors.def │ ├── SuErrors.mod │ ├── SuTokens.def │ ├── SuTokens.mod │ ├── SuTree.def │ ├── SuTree.mod │ ├── SuValues.def │ ├── SuValues.mod │ ├── TrBase.def │ ├── TrBase.mod │ ├── TrCompat.def │ ├── TrCompat.mod │ ├── TrDesig.def │ ├── TrDesig.mod │ ├── TrExpr.def │ ├── TrExpr.mod │ ├── TrParam.def │ ├── TrParam.mod │ ├── TrSets.def │ ├── TrSets.mod │ ├── TrStProc.def │ ├── TrStProc.mod │ ├── TrStmts.def │ ├── TrStmts.mod │ ├── Unlister.mod │ ├── bootstrap │ ├── i386.cgd │ └── makemocka └── ver1808 ├── AAA_SCOPE_OF_WORK.md ├── NEW_MODULES.md ├── cli-args-grammar.gll ├── conf-grammar.gll └── src ├── CodeGen.def ├── CodeGen.mod ├── CodeGenX86.def ├── CodeGenX86.mod ├── Emit.def ├── Emit.mod ├── MockaArgLexer.def ├── MockaArgLexer.mod ├── MockaArgParser.def ├── MockaArgParser.mod ├── MockaArgReader.def ├── MockaArgReader.mod ├── MockaBuildParams.def ├── MockaBuildParams.mod ├── MockaOptions.def ├── MockaOptions.mod ├── Newline.def ├── Newline.mod ├── Tabulator.def └── Tabulator.mod /.gitattributes: -------------------------------------------------------------------------------- 1 | *.def linguist-language=modula-2 2 | *.mod linguist-language=modula-2 3 | *.bat linguist-vendored 4 | *.com linguist-vendored 5 | *.dot linguist-vendored 6 | *.sh linguist-vendored 7 | *.txt linguist-vendored 8 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | For a change log of the current release, see: 2 | * https://github.com/trijezdci/MOCKA/blob/master/ver1807/CHANGES.md 3 | 4 | For the scope of work on the upcoming release, see: 5 | * https://github.com/trijezdci/MOCKA/blob/master/ver1808/AAA_SCOPE_OF_WORK.md 6 | 7 | For a general description of ongoing and future changes, see: 8 | * https://github.com/trijezdci/MOCKA/blob/master/TODO.md 9 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | ### Contributing 2 | 3 | MOCKA having been abandoned by its creators relies on volunteers to maintain it. Please consider contributing. 4 | 5 | ### Licensing 6 | 7 | All compiler source code is released under the GPL license. All library source code under the LGPL license. 8 | 9 | ### Coding Standard 10 | 11 | We use the coding standard of the Modula-2 Software Foundation's M2BSK project: 12 | 13 | https://github.com/m2sf/m2bsk/wiki/Coding-Standard 14 | 15 | However, since MOCKA is only supposed to be compiled using MOCKA itself, cross-dialect portability is not a goal. 16 | No ISO Modula-2 version of modules that use casting is required and no shim libraries are needed. 17 | All source code is PIM only. 18 | 19 | ### Work Items 20 | 21 | Please take a look at: 22 | 23 | * the [scope of work file](./ver1808/AAA_SCOPE_OF_WORK.md) for the upcoming version 24 | * the [roadmap](./ROADMAP.md) file of the project 25 | 26 | \[END OF FILE\] 27 | -------------------------------------------------------------------------------- /COPYRIGHT: -------------------------------------------------------------------------------- 1 | MOCKA Modula-2 Compiler System, Version 1807 2 | 3 | Copyright (C) 1988-2000 by 4 | GMD Gesellschaft fuer Mathematik und Datenverarbeitung, 5 | Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; 6 | [EN] German National Research Center for Computer Science, 7 | Former GMD Research Lab at the University of Karlsruhe. 8 | 9 | Copyright (C) 2001-2018 by 10 | Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; 11 | [EN] Fraunhofer Society for the Advancement of Applied Research. 12 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # Licensing Information 2 | 3 | MOCKA was initially conceived, developed and distributed by GMD[1] as a commercial closed-source product 4 | for diverse Unix platforms. A back end generator called [BEG](https://www.hei.biz/beg/) was also developed 5 | in order to generate the compiler's back ends for multiple target architectures automatically 6 | from a formal target description. 7 | 8 | The MOCKA version for Linux and BSD on the Intel x86 platform was however released open-source under the 9 | [GPL license](https://www.gnu.org/licenses/licenses.html#GPL). This included the automatically generated 10 | source code of the compiler's x86 back-end, but without the BEG software that generated these sources 11 | and without the code optimiser that was included in commercial versions of MOCKA. 12 | 13 | The MOCKA software in this repository is a derivative of this open-source version under GPL licensing. 14 | 15 | Although the GPL license demands that the license is distributed together with the software, the MOCKA 16 | distribution packages did not include any LICENSE file and the official MOCKA website is no longer online. 17 | As a result, some details regarding the licensing are currently unknown. While it is known that MOCKA was 18 | released when the current version of the GPL was [version 2](https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html), 19 | it is not known whether it was licensed with the clause *"... or any later version of this license"*. 20 | Also, it is not currently known whether MOCKA's runtime and Modula-2 standard library were licensed under 21 | the GPL or the LGPL. 22 | 23 | In order to comply strictly with the GPL/LGPL license terms, the LICENSE file should be made part of this 24 | repository and any distribution packages. To be able to do so, we have written to the director of 25 | intellectual property affairs at Fraunhofer Society[1] for clarification and confirmation. 26 | 27 | ___ 28 | [1] Former [German National Research Centre for Computer Science](https://de.wikipedia.org/wiki/GMD-Forschungszentrum_Informationstechnik) 29 | 30 | [2] [Fraunhofer Society](https://www.fraunhofer.de/en.html) now holds the copyrights to MOCKA. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # MOCKA 2 | MOCKA Modula-2 Compiler System, originally by GMD 3 | 4 | Follows the 3rd edition of Wirth's *Programming in Modula-2*, aka PIM3 [[1, 2](./README.md#references)] 5 | 6 | ### Background 7 | 8 | The MOCKA Modula-2 compiler was developed between 1988 and 1992 by the former German 9 | National Research Centre for Computer Science (GMD) [[3](./README.md#references)] at 10 | its former research lab at the University of Karlsruhe [[4](./README.md#references)]. 11 | GMD has since been dissolved and all its research institutes were merged into the 12 | [Fraunhofer Society](https://www.fraunhofer.de/en.html). 13 | 14 | The MOCKA compiler system was distributed for diverse Unix platforms and architectures 15 | as closed source commercial software and included an industrial strength optimiser. The 16 | Linux and BSD version of MOCKA with a back end for the Intel x86 architecture but without 17 | the optimiser was released open-source under GPL licensing free of charge. 18 | 19 | The software in this repository is a derivative of the aforementioned open-source version. 20 | 21 | ### Target Architecture 22 | * Intel x86 32-bit 23 | * generates [AT&T syntax](https://en.wikipedia.org/wiki/X86_assembly_language#Syntax) assembly output 24 | 25 | ### Operating System Support 26 | * Linux and BSD with [Elf](https://en.wikipedia.org/wiki/Executable_and_Linkable_Format) executable and linkable format 27 | 28 | ### Language Extensions 29 | * Conditional compilation 30 | * Lowline `_` in identifiers 31 | * Types `BYTE` and `LONGCARD` 32 | * `FOREIGN DEFINITION MODULE` for interfacing to C 33 | 34 | ### Last Release 35 | * [Version 1807](https://github.com/trijezdci/MOCKA/blob/master/ver1807), updated July 2018 36 | 37 | For **version change log**, see [CHANGES](https://github.com/trijezdci/MOCKA/blob/master/ver1807/CHANGES.md) 38 | 39 | ### Release History 40 | * last maintenance [release 0605](http://www.info.uni-karlsruhe.de/projects.php/id=37) from Uni Karlsruhe in May 2006 41 | * minor [release 1208](http://lwb.mi.fu-berlin.de/inf/mocka/installation.shtml) by Chr. Maurer in August 2012, based on 0605 42 | * clean-up [release 1807](https://github.com/trijezdci/MOCKA/blob/master/ver1807) by B.Kowarsch in July 2018, based on 1208 43 | 44 | ### Status 45 | 46 | MOCKA is no longer supported and will not be further maintained. 47 | 48 | ### Where do we go from here? 49 | 50 | MOCKA's backend was generated by an undocumented proprietary backend generator. This backend only supports the 32-bit Intel x86 architecture. In order to support the modern 64-bit AMD x86-64 architecture, this backend would need to be removed and replaced by a new backend which would need to be developed from scratch. Considering that the interfacing between front- and backend is not documented and would need to be experimentally discovered, the effort would likely be much higher than writing a new compiler from scratch. 51 | 52 | For this reason, code from a C99 based PIM Modula-2 to C translator project for which a working front end had been completed already in 2016 was repurposed and relaunched as project [MOTTO — Modula-2 Translator Tokyo](https://github.com/trijezdci/MOTTO). This translator will support all three classic Modula-2 dialects known as PIM2, PIM3 and PIM4, along with a MOCKA compatibility mode. For further details visit the MOTTO project page. 53 | 54 | ___ 55 | 56 | #### References 57 | [1] [Wikipedia entry on the Modula-2 programming language](https://en.wikipedia.org/wiki/Modula-2) 58 | 59 | [2] [Programming in Modula-2, 3rd edition, N.Wirth, Springer, 1988](https://www.springer.com/us/book/9783642835674) 60 | 61 | [3] [Google translation of Wikipedia entry on the former GMD](https://translate.google.co.jp/translate?hl=en&sl=de&u=https://de.wikipedia.org/wiki/GMD-Forschungszentrum_Informationstechnik&prev=search) 62 | 63 | [4] [Former MOCKA project page at University of Karlsruhe](http://www.info.uni-karlsruhe.de/projects.php/id=37&lang=en) 64 | 65 | ___ 66 | 67 | #### The Modula-2 Webring 68 | 69 | [All Sites](http://www.modulaware.com/m2wr/?ring=modula2&id=1&m=hub) | 70 | [Previous Site](http://www.modulaware.com/m2wr/?ring=modula2&id=1&m=prev) | 71 | [Next Site](http://www.modulaware.com/m2wr/?ring=modula2&id=1&m=next) | 72 | [Random Site](http://www.modulaware.com/m2wr/?ring=modula2&id=1&m=random) | 73 | [Join the Webring](http://www.modulaware.com/m2wr/?ring=modula2&m=addsite) 74 | 75 | \[END OF FILE\] 76 | -------------------------------------------------------------------------------- /ROADMAP.md: -------------------------------------------------------------------------------- 1 | ## Roadmap for MOCKA Modula-2 Compiler 2 | Status July 2018 3 | 4 | ### Ongoing 5 | 6 | * General clean up of the source code 7 | 8 | ### Short Term 9 | 10 | * Rename modules and procedures prefixed with 'Ass' to prefix 'Asm' 11 | * Bring compiler command line options in line with *nix standards 12 | * Add Mach-O support and compiler command line option `--mach-o` 13 | * Add parser for new configuration file /etc/mocka.conf 14 | * Rewrite the *MOCKA man page* to reflect all changes made since its last revision 15 | 16 | ### Mid Term 17 | 18 | * Build and test on FreeBSD 19 | * Remove shell from compiler and make it a standalone program 20 | * Add compiler switch to enable/disable MOCKA specific language extensions 21 | * Change pragma syntax from `%...` to standard classical Modula-2 `(*$...*)` 22 | * Rewrite the *MOCKA User Manual* to reflect all changes made since its last revision 23 | 24 | ### Long Term 25 | 26 | * Follow recommendations in [[Kow18]](https://github.com/trijezdci/PDFs/blob/master/Classic-M2-Compiler-Maintenance.pdf) 27 | * Explore the possibility of PIM4 support 28 | * Explore the possibility of a Windows port 29 | * Try to convince Fraunhofer to release the VAX/VMS version under the GPL 30 | 31 | ## Details 32 | 33 | #### Command Line Options 34 | 35 | `--octal-literals`, `--no-octal-literals` enable/disable octal literals 36 | 37 | `--synonym-symbols`, `--no-synonym-symbols` enable/disable `<>`, `&` and `~` 38 | 39 | `--mocka-extensions`, `--no-mocka-extensions` enable/disable language extensions 40 | 41 | `--index-checks`, `-I` add code to check array bounds (default) 42 | 43 | `--no-index-checks`, `-i` do not add code to check array bounds 44 | 45 | `--range-checks`, `-R` add code for numeric type range checking (default) 46 | 47 | `--no-range-checks`, `-r` do not add code for numeric type range checking 48 | 49 | `--elf` for ELF object file output (default) 50 | 51 | `--mach-o` for Mach-O object file output 52 | 53 | `--keep-asm`, `-A` keep assembly files after compilation (default) 54 | 55 | `--purge-asm`, `-a` purge assembly files after compilation 56 | 57 | `--build`, `-B` compile and link (default) 58 | 59 | `--no-build`, `-b` compile only 60 | 61 | `--static`, `-S` static linking (default) 62 | 63 | `--no-static`, `-s` dynamic linking 64 | 65 | `--debug`, `-D` add debugging information (default) 66 | 67 | `--no-debug`, `-d` strip debugging information 68 | 69 | `--verbose`, `-v` print more details during compilation (obsoletes -blip) 70 | 71 | `--show-settings` show compiler settings 72 | 73 | `--lib-path`, `-L` set library search path 74 | 75 | `--work-dir`, `-W` set working directory (for output) 76 | 77 | The grammar for the command line argument syntax is at: 78 | 79 | https://github.com/trijezdci/MOCKA/blob/master/ver1808/cli-args-grammar.gll 80 | 81 | ### Mach-O Support 82 | 83 | Differences between ELF and Mach-O: 84 | 85 | * ELF labels are prefixed by a dot, example `.L100:` 86 | * Mach-O labels are not prefixed 87 | * ELF procedures are not prefixed 88 | * Mach-O procedures are prefixed by a lowline, example `_Foo:` 89 | * Mach-O procedures are 16 byte aligned (important when calling extern) 90 | 91 | ##### Mach-O Labels 92 | 93 | Before MOCKA supported ELF, it generated labels for the a.out object format which 94 | was then common on Unix systems. MachO object format uses the a.out naming convention 95 | for labels and procedures. The code to produce these labels is still in MOCKA. 96 | 97 | ##### Mach-O Stack Alignment 98 | 99 | MOCKA defines a constant for stack alignment. Its value is four. If this works 100 | as it was probably intended, then changing stack alignment to the value used by 101 | Mach-O could be as simple a matter as changing the value to 16 and rebuild the 102 | compiler. However, it is not known whether this has ever been tested. 103 | 104 | ### Configuration File 105 | 106 | The grammar for the configuration file syntax is at: 107 | 108 | https://github.com/trijezdci/MOCKA/blob/master/ver1808/conf-grammar.gll 109 | 110 | ### References 111 | 112 | [Kow18] B.Kowarsch, [On the Maintenance of Classic Modula-2 Compilers](https://github.com/trijezdci/PDFs/blob/master/Classic-M2-Compiler-Maintenance.pdf), 2018. 113 | 114 | \[END OF FILE\] 115 | -------------------------------------------------------------------------------- /docs/DEBUGGING: -------------------------------------------------------------------------------- 1 | README for the -g option of the Mocka compiler 2 | ============================================== 3 | 4 | The gdb (and other) debuggers are written for debugging C and not MODULA-2. 5 | The support of debugging MODULA-2 is small and nearly not documented. For 6 | debugging Mocka you should know the following: 7 | 8 | 1. Procedures and Modules 9 | ------------------------- 10 | The Debugger must distinguish Procedures with the same Names, so the Procedures 11 | are named as modulename_procedurename. For nested Procedures you need more 12 | underscores, e.g. 13 | 14 | IMPLEMENTATION MODULE one; 15 | MODULE two; 16 | PROCEDURE A; 17 | PROCEDURE B; 18 | ... 19 | END B; 20 | END A; 21 | END two; 22 | END one. 23 | 24 | to break the procedure B use 25 | (gdb) break one_two_A_B 26 | to break the initialization of module one use 27 | (gdb) break one 28 | 29 | 2. Constants 30 | ------------ 31 | All constants are interpreted global in the debugger also if they were 32 | declared local. If you get problems with that, you can switch off the 33 | debugging of constants with the -nogc option. You cannot debug string constants. 34 | If you use the dbx debugger, you must use -nogc, because dbx does not 35 | understand the constant information. 36 | 37 | 3. Variables and Params 38 | ----------------------- 39 | - local variables and params 40 | no problems, see the notes for data types under 4. 41 | 42 | - global variables and params 43 | you cannot read the variables declared in upper procedures directly. You must 44 | use the 'up' and 'down' commands of the debugger to read. 45 | 46 | - static variables 47 | Variables declared in the module head are put together in one variable named 48 | modulename_s. You can read the static variables as a field in a record: 49 | (gdb) p modulename_s.variable 50 | 51 | 4. Data Types 52 | ------------- 53 | Note the following: 54 | 55 | - Open Arrays 56 | Open Arrays are structs with the two components 'start' (start address) and 57 | 'length' (length of the array). 58 | 59 | - Enumerations and BOOLEANs 60 | Enumerations and BOOLEANs are printed by their name (e.g. FALSE) if the 61 | -ge option is set. Some gdb versions (4.14, 4.15, 4.15.1) seg faults if 62 | enumerations are used. This gdb bug is fixed in version 4.16. 63 | You can switch off producing debugging symbols for enumerations with 64 | the -noge option. In this case enumerations and BOOLEANs are printed 65 | as integers (0=FALSE, 1=TRUE). 66 | 67 | - Records 68 | Record fields are printed in the wrong order. 69 | 70 | - Sets, BITSET 71 | They are declared as integers. Use the binary (octal, hexadecimal) format to 72 | read the bits. 73 | 74 | - Procedure types 75 | treated all as void procedure types. 76 | 77 | 5. WITH - construction 78 | ---------------------- 79 | The debugger has no information of the with construction. So you must use the 80 | whole name of a variable. 81 | 82 | 6. Bugs 83 | ------- 84 | Please report Bugs, etc. to modula@ipd.info.uni-karlsruhe.de 85 | -------------------------------------------------------------------------------- /docs/MOBIL Intermediate Language Report (1992).pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/trijezdci/MOCKA/cbbdbf4ff3b0ff4ca7c3a4fa1e6b587b200c8d12/docs/MOBIL Intermediate Language Report (1992).pdf -------------------------------------------------------------------------------- /docs/MOCKA User Manual (1994).pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/trijezdci/MOCKA/cbbdbf4ff3b0ff4ca7c3a4fa1e6b587b200c8d12/docs/MOCKA User Manual (1994).pdf -------------------------------------------------------------------------------- /docs/MOCKA User Manual (1999).pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/trijezdci/MOCKA/cbbdbf4ff3b0ff4ca7c3a4fa1e6b587b200c8d12/docs/MOCKA User Manual (1999).pdf -------------------------------------------------------------------------------- /ver1807/CHANGES.md: -------------------------------------------------------------------------------- 1 | ## Changes relative to MOCKA 1208 2 | 3 | * Updated help to include previously undocumented options 4 | * Reformatted help screen for better clarity and readability 5 | * Added a version command and option 6 | * Updated copyright notice in all source files 7 | * Mocka now prints a banner with copyright info 8 | * Changed default paths to comply with *nix conventions 9 | * Fixed some minor glitches 10 | * Renamed main program to Mocka 11 | * Changed prefix of Mc* modules to Mocka 12 | * Cleanup/reformatting of source code (ongoing) 13 | 14 | ### Banner 15 | 16 | ``` 17 | $ ./Mocka 18 | MOCKA Modula-2 Compiler System, Version 1807 19 | Copyright (C) 1988-2000 by GMD. All rights reserved. 20 | Gesellschaft fuer Mathematik und Datenverarbeitung; 21 | German National Research Center for Computer Science. 22 | Copyright (C) 2001-2018 by Fraunhofer. All rights reserved. 23 | Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; 24 | Fraunhofer Society for the Advancement of Applied Research. 25 | >> 26 | ``` 27 | 28 | ### Version 29 | 30 | ``` 31 | >> -version 32 | Mocka 1807 33 | >> 34 | ``` 35 | 36 | ### Default Paths 37 | 38 | ``` 39 | >> -info 40 | Compiler options in effect: 41 | noindex, norange, blip, noelf, noS, g, gc, ge, nostatic 42 | Current Library Path: . 43 | Secondary Libraries : /usr/local/lib/mocka /usr/local/lib/mocka/mockalib 44 | List Script : /usr/local/bin/mocka/list 45 | Edit Script : /usr/local/bin/mocka/edit 46 | Link Script : /usr/local/bin/mocka/link 47 | Assembler Script : /usr/local/bin/mocka/asm 48 | >> 49 | ``` 50 | 51 | ### Help Screen 52 | 53 | ``` 54 | >> -help 55 | usage: 56 | Mocka [options] [commands] module 57 | 58 | options: 59 | -help show help 60 | -info show settings 61 | -options show active options 62 | -version show release version 63 | 64 | commands: 65 | d edit definition part of module 66 | i edit implementation part of module 67 | s compile definition part of module 68 | c compile implementation part of module 69 | p compile and link module 70 | q quit Mocka shell 71 | >> 72 | ``` 73 | -------------------------------------------------------------------------------- /ver1807/bin/Mocka: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/trijezdci/MOCKA/cbbdbf4ff3b0ff4ca7c3a4fa1e6b587b200c8d12/ver1807/bin/Mocka -------------------------------------------------------------------------------- /ver1807/bin/Mocka.md5: -------------------------------------------------------------------------------- 1 | MD5: f4e2363c18980e7ef0b29c2d4d1d1865 2 | -------------------------------------------------------------------------------- /ver1807/src/CgAssOut.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE CgAssOut; (* TO DO: s/Ass/Asm *) 18 | (* Fast text output module used to produce Assembler output *) 19 | 20 | 21 | (* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 22 | Isn't this ironic? 23 | 24 | The ISO Modula-2 working group changed the designated identifier for the 25 | smalles addressable unit from SAU to LOC, because the German delegation 26 | had objected on the grounds that 'sau' was offensive. In German 'sau' 27 | means 'sow' and it is used as a derogative. So far so good. 28 | 29 | Yet here we have the sources of the MOCKA compiler, written by some of 30 | the members of that German delegation, with a module identifier and a 31 | whole bunch of procedures prefixed with 'Ass'. 32 | 33 | Oh the hypocrisy. You couldn't make this up. 34 | ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ *) 35 | 36 | 37 | PROCEDURE AssOpen ( VAR name : ARRAY OF CHAR ); 38 | 39 | 40 | PROCEDURE AssClose; 41 | 42 | 43 | PROCEDURE flush; (* why lowercase when all other procs aren't? *) 44 | (* emits buffer *) 45 | 46 | 47 | PROCEDURE AssLn; 48 | (* generate end of line *) 49 | (* a line may at most contain 128 characters *) 50 | 51 | 52 | PROCEDURE AssChar ( c : CHAR ); 53 | 54 | 55 | PROCEDURE AssString ( VAR s : ARRAY OF CHAR ); 56 | (* generate string *) 57 | (* GenHString the whole string is output, while GenString *) 58 | (* Outputs until the first 0c character *) 59 | 60 | (* NONSENSE! 61 | 62 | Procedure AssHString does no such thing. It is semantically equivalent 63 | to procedure AssString. Both procedures copy all characters from the 64 | argument string to the output buffer up to the NUL terminator. 65 | 66 | The only difference is that AssString iterates over each character, 67 | while AssHString iterates over chunks of four characters, making it 68 | a little faster but a lot uglier, less maintainable and to say the 69 | least CONFUSING, as evidenced by the fact that even the authors got 70 | it wrong when writing the above comment explaining what it does. 71 | 72 | Worse still is the fact that AssHString is overwhelmingly called on 73 | arguments of very short strings, typically less than 10 characters, 74 | often only one to four characters. Only very seldomly are arguments 75 | of ~20 characters passed to it. Hardly any justification for 76 | using a badly written and misdocumented "fast" procedure. 77 | 78 | The dictum "PREMATURE OPTIMISATION is the root of all evil" applies here. 79 | 80 | http://wiki.c2.com/?PrematureOptimization *) 81 | 82 | PROCEDURE AssHString ( VAR s : ARRAY OF CHAR ); (* TO BE AXED *) 83 | 84 | 85 | PROCEDURE AssInt ( i : INTEGER ); 86 | (* generate Integer *) 87 | 88 | END CgAssOut. 89 | -------------------------------------------------------------------------------- /ver1807/src/CgAssOut.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | IMPLEMENTATION MODULE CgAssOut; (* TO DO: s/Ass/Asm *) 18 | (* Fast text output module used to produce Assembler output *) 19 | 20 | IMPORT BasicIO; 21 | 22 | FROM BasicIO IMPORT 23 | OpenOutput, File, Close, DONE; 24 | 25 | FROM InOut IMPORT 26 | Read, Write, WriteLn, WriteInt, WriteCard, WriteString; 27 | 28 | FROM SYSTEM IMPORT 29 | ADR; 30 | 31 | 32 | CONST 33 | bufferlen = 10*1024; 34 | maxlinelen = 128+10; 35 | 36 | 37 | VAR 38 | f : File; 39 | buffer : ARRAY [0..bufferlen+maxlinelen] OF CHAR; 40 | bi : CARDINAL; 41 | 42 | 43 | PROCEDURE AssOpen ( VAR name : ARRAY OF CHAR ); 44 | BEGIN 45 | bi:=0; 46 | OpenOutput (f,name); 47 | IF NOT DONE THEN 48 | WriteString ('could not open assembler file'); 49 | WriteLn; 50 | HALT; 51 | END; 52 | END AssOpen; 53 | 54 | 55 | PROCEDURE AssClose; 56 | BEGIN 57 | flush; 58 | Close (f); 59 | END AssClose; 60 | 61 | 62 | PROCEDURE flush; 63 | BEGIN 64 | BasicIO.Write(f, ADR(buffer),bi); 65 | bi := 0; 66 | IF NOT DONE THEN 67 | WriteString ('could not write assembler file'); 68 | WriteLn; 69 | HALT; 70 | END; 71 | END flush; 72 | 73 | 74 | PROCEDURE AssLn; 75 | (* generate end of line *) 76 | BEGIN 77 | buffer[bi] := 12C; INC (bi); 78 | IF bi>=bufferlen THEN 79 | flush; 80 | END; 81 | (* WriteLn; *) 82 | END AssLn; 83 | 84 | 85 | PROCEDURE AssChar ( c : CHAR ); 86 | BEGIN 87 | buffer[bi] := c; INC(bi); 88 | (* Write(c); *) 89 | END AssChar; 90 | 91 | 92 | PROCEDURE AssHString ( VAR s : ARRAY OF CHAR ); 93 | VAR 94 | i, high : CARDINAL; 95 | BEGIN 96 | high := HIGH(s); 97 | WHILE(high > 0) AND (s[high] = 0C) DO 98 | DEC(high); 99 | END; (* WHILE *) 100 | i:=0; 101 | 102 | WHILE i+3<=high DO 103 | buffer[bi] := s[i]; 104 | buffer[bi+1] := s[i+1]; 105 | buffer[bi+2] := s[i+2]; 106 | buffer[bi+3] := s[i+3]; 107 | INC(bi, 4); INC(i, 4); 108 | END; (* WHILE *) 109 | 110 | CASE high-i OF 111 | 0 : buffer[bi] := s[i] 112 | | 1 : buffer[bi] := s[i]; 113 | buffer[bi+1] := s[i+1] 114 | | 2 : buffer[bi] := s[i]; 115 | buffer[bi+1] := s[i+1]; 116 | buffer[bi+2] := s[i+2] 117 | ELSE 118 | (* NOP *) 119 | END; (* CASE *) 120 | 121 | INC(bi, high-i+1); 122 | (* WriteString(s); *) 123 | END AssHString; 124 | 125 | 126 | PROCEDURE AssString ( VAR s : ARRAY OF CHAR ); 127 | VAR 128 | i : CARDINAL; 129 | BEGIN 130 | i:=0; 131 | WHILE (i <= HIGH(s)) AND (s[i] # 0C) DO 132 | buffer[bi] := s[i]; 133 | INC(i); INC(bi); 134 | END; 135 | (* WriteString (s); *) 136 | END AssString; 137 | 138 | 139 | PROCEDURE AssInt ( i : INTEGER ); 140 | (* generate Integer *) 141 | VAR 142 | s : ARRAY [0..20] OF CHAR; 143 | k, l : SHORTCARD; 144 | BEGIN 145 | (* WriteInt (i, 1); *) 146 | IF i < 0 THEN 147 | buffer[bi] := "-"; 148 | INC(bi) 149 | END; (* IF *) 150 | 151 | IF i = MIN(INTEGER) THEN 152 | AssHString ("2147483648"); 153 | ELSE 154 | i := ABS(i); 155 | k := 0; 156 | WHILE i > 0 DO 157 | s[k] := CHR(ORD("0") + CARDINAL (i MOD 10)); 158 | i := i DIV 10; 159 | INC(k); 160 | END; (* WHILE *) 161 | 162 | IF k = 0 THEN 163 | s[0] := "0"; 164 | INC(k); 165 | END; (* IF *) 166 | 167 | FOR l := k-1 TO 0 BY -1 DO 168 | buffer[bi] := s[l]; 169 | INC(bi); 170 | END; (* FOR *) 171 | END; (* IF *) 172 | END AssInt; 173 | 174 | 175 | END CgAssOut. 176 | -------------------------------------------------------------------------------- /ver1807/src/CgBase.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE CgBase; 18 | 19 | FROM SYSTEM IMPORT 20 | ADDRESS; 21 | 22 | 23 | TYPE SysProc = 24 | ( SysProcHALT, 25 | SysProcNewprocess, 26 | SysProcTransfer, 27 | SysProcCaseError, 28 | SysProcReturnError ); 29 | 30 | 31 | TYPE Mode = 32 | ( UnsignedByte, 33 | UnsignedWord, 34 | UnsignedLong, 35 | SignedByte, 36 | SignedWord, 37 | SignedLong, 38 | FloatShort, 39 | FloatLong, 40 | None ); 41 | 42 | 43 | TYPE Relation = 44 | ( RelEqual, 45 | RelUnequal, 46 | RelLess, 47 | RelLessOrEqual, 48 | RelGreater, 49 | RelGreaterOrEqual ); 50 | 51 | 52 | TYPE RelSymb = POINTER TO ARRAY [0..255] OF CHAR; 53 | 54 | 55 | TYPE Tempo = LONGINT; 56 | 57 | TYPE DataTempo = (* ALIAS OF *) Tempo; 58 | 59 | TYPE AddressTempo = (* ALIAS OF *) Tempo; 60 | 61 | 62 | TYPE Label = RelSymb; 63 | 64 | 65 | TYPE ModuleIndex = POINTER TO RECORD 66 | Name, 67 | Statics : RelSymb; 68 | Extern : BOOLEAN; 69 | END; (* ModuleIndex *) 70 | 71 | 72 | TYPE ProcIndex = POINTER TO ProcRecord; 73 | 74 | TYPE ProcRecord = RECORD 75 | Extern, 76 | IsFunction : BOOLEAN; 77 | Name, 78 | Entry : RelSymb; 79 | Number : SHORTCARD; 80 | Module : ModuleIndex; 81 | Level : SHORTCARD; 82 | Father : ProcIndex; 83 | END; (* ProcRecord *) 84 | 85 | 86 | TYPE StringIndex = RelSymb; 87 | 88 | 89 | TYPE LabelList = POINTER TO LabelListRecord; 90 | 91 | TYPE LabelListRecord = RECORD 92 | label : Label; 93 | next : LabelList; 94 | END; (* LabelListRecord *) 95 | 96 | 97 | VAR NullSymb : RelSymb; 98 | 99 | 100 | VAR ElfOption : CARDINAL; 101 | 102 | 103 | PROCEDURE MakeRelSymb ( VAR s : ARRAY OF CHAR ) : RelSymb; 104 | 105 | 106 | PROCEDURE GetLabel ( VAR lab : Label ); 107 | 108 | 109 | PROCEDURE NewSymb () : RelSymb; 110 | 111 | 112 | PROCEDURE InitCgBase; 113 | 114 | 115 | END CgBase. 116 | -------------------------------------------------------------------------------- /ver1807/src/CgBase.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | IMPLEMENTATION MODULE CgBase; 18 | 19 | FROM SuBase IMPORT Enabled; 20 | FROM GcgStorage IMPORT ALLOCATE; 21 | FROM CgUtilities IMPORT ConvertLONGINTtoString, StringAppend1; 22 | 23 | PROCEDURE MakeRelSymb (VAR s : ARRAY OF CHAR) : RelSymb; 24 | VAR i,high : INTEGER; RelSym : RelSymb; 25 | BEGIN 26 | high := HIGH(s); 27 | i:=0; WHILE (i<=high) AND (s[i]#0C) DO INC(i); END; 28 | ALLOCATE (RelSym, i+1); 29 | i:=0; WHILE (i<=high) AND (s[i]#0C) DO RelSym^[i]:=s[i]; INC(i); END; 30 | RelSym^[i]:=0C; 31 | RETURN(RelSym); 32 | END MakeRelSymb; 33 | 34 | 35 | PROCEDURE GetLabel (VAR lab : Label); 36 | BEGIN 37 | lab := NewSymb(); 38 | END GetLabel; 39 | 40 | VAR SymbolCnt : INTEGER; 41 | 42 | PROCEDURE NewSymb () : RelSymb; 43 | VAR s,t : ARRAY [0..15] OF CHAR; 44 | BEGIN 45 | INC (SymbolCnt); 46 | ConvertLONGINTtoString (SymbolCnt, s); 47 | IF Enabled (ElfOption) 48 | THEN t := '.Lab'; 49 | ELSE t := 'Lab'; 50 | END; 51 | StringAppend1 (t,s); 52 | RETURN (MakeRelSymb (t)); 53 | END NewSymb; 54 | 55 | PROCEDURE InitCgBase; 56 | BEGIN 57 | SymbolCnt := 0; 58 | END InitCgBase; 59 | 60 | BEGIN 61 | NullSymb := NIL; (* MakeRelSymb ('0'); *) 62 | END CgBase. 63 | -------------------------------------------------------------------------------- /ver1807/src/CgDebug.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE CgDebug; 18 | 19 | FROM SuErrors IMPORT SourcePosition; 20 | FROM DfTable IMPORT Object; 21 | 22 | PROCEDURE OpenDebug; 23 | (* Quelldateiname, Standardtypen, interne Initialisierung *) 24 | 25 | PROCEDURE CloseDebug; 26 | (* statische Variablen *) 27 | 28 | PROCEDURE ProcedureDebug (proc: Object); 29 | (* Prozedurname, zurueckgegebener Datentyp *) 30 | 31 | PROCEDURE BeginDebugBlock; 32 | PROCEDURE EndDebugBlock; 33 | (* Markiert Anfang und Ende einer Prozedur / eines Moduls *) 34 | 35 | PROCEDURE LocalObjectsDebug (firstlocalobj: Object); 36 | (* Nach dem Uebersetzen der Prozedur / des Moduls: 37 | Variablen, Parameter, Blockmarkierung; 38 | Vorher muss der Block mit 'BeginDebugBlock' und 'EndDebugBlock' 39 | markiert worden sein *) 40 | 41 | PROCEDURE LineNumberDebug (pos: SourcePosition); 42 | (* Zeilennummer im Sourcecode *) 43 | 44 | PROCEDURE LastLineNumberDebug; 45 | (* Erzeugt die Zeile hinter der letzten Zeile einer Prozedur durch 46 | Addition der letzten Zeilennummer mit 1. In der Regel steht dort 47 | ein 'END Prozedurname;'. Die letzte Zeile wird leider im Strukturbaum 48 | nur als NIL gekennzeichnet und aus NIL erhaelt man leider keine 49 | Information ueber die Zeilennummer... *) 50 | 51 | END CgDebug. 52 | 53 | 54 | 55 | 56 | 57 | -------------------------------------------------------------------------------- /ver1807/src/DfFiles.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE DfFiles; 18 | 19 | 20 | PROCEDURE ReadDefinitionFiles; 21 | 22 | PROCEDURE WriteSymFile; 23 | 24 | PROCEDURE WriteDebugFile; 25 | 26 | PROCEDURE InitDefFiles; 27 | 28 | PROCEDURE GetStaticVarSize (): LONGINT; 29 | 30 | PROCEDURE GetLastExternalProcNumber (): SHORTCARD; 31 | 32 | END DfFiles. 33 | -------------------------------------------------------------------------------- /ver1807/src/DfScopes.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE DfScopes; 18 | 19 | FROM SuErrors IMPORT 20 | SourcePosition; 21 | FROM SuTokens IMPORT 22 | Ident, 23 | IdentList; 24 | FROM DfTable IMPORT 25 | Type, 26 | Object; 27 | 28 | 29 | CONST 30 | 31 | NoObject = NIL; 32 | 33 | 34 | VAR 35 | 36 | (* Basic Types *) 37 | 38 | TypeBOOLEAN : Type; 39 | TypeCHAR : Type; 40 | TypeSHORTCARD : Type; 41 | TypeLONGCARD : Type; 42 | TypeSHORTINT : Type; 43 | TypeLONGINT : Type; 44 | TypeREAL : Type; 45 | TypeLONGREAL : Type; 46 | 47 | (* Standard Types *) 48 | 49 | TypeBITSET, TypePROC : Type; 50 | 51 | (* System Types *) 52 | 53 | TypeWORD, TypeADDRESS : Type; 54 | 55 | (* 'ambiguous' numeric types *) 56 | 57 | TypeSIorLI : Type; (* min(SI) .. 0 *) 58 | TypeSIorSCorLIorLC : Type; (* 0 .. max(SI) *) 59 | TypeSCorLIorLC : Type; (* max(SI) .. max(SC) *) 60 | TypeLIorLC : Type; (* max(SC) .. max(LI) *) 61 | TypeSRorLR : Type; (* SHORTREAL or LONGREAL *) 62 | 63 | TypeNIL, TypeSTRING, TypeVOID, TypeERROR : Type; 64 | 65 | RootObject : Object; 66 | CompUnitObject : Object; 67 | ErrorObject : Object; 68 | 69 | IdentSYSTEM : Ident; 70 | 71 | 72 | PROCEDURE declare 73 | (obj : Object; 74 | pos : SourcePosition); 75 | (* Declare obj in the current scope 76 | (define attributes next, HiddenObject, DefiningScope, DefNesting). *) 77 | 78 | PROCEDURE apply 79 | ( id : Ident; 80 | pos : SourcePosition; 81 | VAR obj : Object); 82 | (* Return in obj the object currently designated by id. 83 | Emit an error message if there is none and return 84 | the error object in this case. 85 | Mark obj as used. *) 86 | 87 | PROCEDURE applyControlVar 88 | ( id : Ident; 89 | pos : SourcePosition; 90 | VAR obj : Object); 91 | (* Return in obj the object currently designated by id. 92 | Emit an error message if there is none and return 93 | the error object in this case. 94 | Check whether id is declared in the current module 95 | Mark obj as used. *) 96 | 97 | PROCEDURE applyPointerTarget 98 | ( id : Ident; 99 | tp : Type; 100 | pos : SourcePosition; 101 | VAR obj : Object); 102 | (* Return in obj the object currently designated by id. 103 | Check whether the type definition 104 | TYPE T = POINTER TO P 105 | is valid when id stands for P and tp is the type represented by T *) 106 | 107 | PROCEDURE GetOpaqueBaseType 108 | ( OpaqueType : Type; 109 | VAR BaseType : Type); 110 | (* If the opaque type 'OpaqueType' has been redeclared 111 | as a pointer to T , 'BaseType' will contain T; 112 | otherwise 'BaseType' is set to NIL. *) 113 | 114 | PROCEDURE EnterScope1 115 | (scope : Object); 116 | (* Enter scope in pass 1 *) 117 | 118 | PROCEDURE EnterScope2 119 | (scope : Object); 120 | (* Enter scope in pass 2 *) 121 | 122 | PROCEDURE LeaveScope1 123 | (scope : Object); 124 | (* Leave scope in pass 1 *) 125 | 126 | PROCEDURE LeaveScope2 127 | (scope : Object); 128 | (* Leave scope in pass 2 *) 129 | 130 | PROCEDURE DescribeExport 131 | (ids : IdentList; 132 | IsQualified : BOOLEAN); 133 | (* Specifies the export of the current scope 134 | which is a module contaning 135 | "EXPORT [QUALIFIED] ids;" 136 | If QUALIFIED is missing IsQualified is FALSE *) 137 | 138 | PROCEDURE DescribeImportFromModule 139 | (mod : Ident; 140 | pos : SourcePosition; 141 | ids : IdentList; 142 | ImportingModule : Object); 143 | (* Specifies the import of ImportingModule 144 | which contains 145 | "FROM mod IMPORT ids" 146 | (pos is the source position of mod) *) 147 | 148 | PROCEDURE DescribeImportFromEnv 149 | (ids : IdentList; 150 | ImportingModule : Object); 151 | (* Specifies the import of ImportingModule 152 | which contains 153 | "IMPORT ids" *) 154 | 155 | 156 | PROCEDURE EnterWithStatement 157 | (RecordType : Type); 158 | (* Let "WITH r DO s END" be a WITH statement 159 | where r has type 'RecordType'. 160 | Make the fields of r visible while visiting s. 161 | Called in pass 2 before visiting s. *) 162 | 163 | PROCEDURE LeaveWithStatement; 164 | (* Corresponds to 'EnterWithStatement'. 165 | Make the fields of r invisible. 166 | Called in pass2 after visiting s. *) 167 | 168 | PROCEDURE CheckRedeclarations; 169 | (* Check whether an implementation module provides 170 | the neccessary redeclarations for objects introduced 171 | in the corresponding definition module. *) 172 | 173 | PROCEDURE NonPervasiveVars 174 | (VAR n: CARDINAL; VAR Table: ARRAY OF INTEGER); 175 | (* Return in 'Table' a list of the 'non-pervasive' Variables of the current 176 | scope, i.e. of those variables that are not apllied in a scope 177 | of a deeper nesting. Variables are represented by their offsets. 178 | 'n' is number of entries in table. 179 | Only scalar variables are considered. 180 | (Can be called after processing local scopes in the second pass) *) 181 | 182 | 183 | 184 | PROCEDURE InitScopes; 185 | (* Initialize module DfScopes *) 186 | 187 | END DfScopes. 188 | -------------------------------------------------------------------------------- /ver1807/src/DfTable.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE DfTable; 18 | 19 | FROM SuErrors IMPORT 20 | SourcePosition; 21 | FROM SuBase IMPORT 22 | OptionSet, TimeStampType; 23 | FROM SuValues IMPORT 24 | Value; 25 | FROM SuTokens IMPORT 26 | Ident, IdentList; 27 | FROM SuTree IMPORT 28 | Node; 29 | FROM CgMobil IMPORT 30 | ModuleIndex, ProcIndex; 31 | 32 | 33 | TYPE 34 | 35 | Object = POINTER TO ObjectDescription; 36 | 37 | Type = POINTER TO TypeDescription; 38 | 39 | ObjectClass = 40 | ( ModuleObj, ProcedureObj, StandardProcedureObj, 41 | VariableObj, ConstantObj, TypeObj, 42 | FieldObj, PseudoObj, ErrorObj ); 43 | 44 | VariableKind = 45 | ( LocalVar, VarParam, ValueParam ); 46 | 47 | StandardProcedure = 48 | ( ProcABS, ProcCAP, ProcCHR, ProcDEC, ProcDISPOSE, ProcEXCL, 49 | ProcFLOAT, ProcHALT, ProcHIGH, ProcINC, ProcINCL, 50 | ProcMAX, ProcMIN, ProcNEW, ProcODD, ProcORD, ProcSIZE, 51 | ProcTRUNC, ProcVAL, 52 | ProcADR, ProcTSIZE, ProcNEWPROCESS, 53 | ProcTRANSFER 54 | ); 55 | 56 | ObjectList = POINTER TO ObjectListElem; 57 | 58 | ObjectListElem = 59 | RECORD 60 | object : Object; 61 | next : ObjectList; 62 | END; 63 | 64 | Import = POINTER TO ImportDescription; 65 | 66 | ImportDescription = 67 | 68 | RECORD 69 | CASE FromModule: BOOLEAN OF 70 | | TRUE : 71 | ModuleName : Ident; 72 | ModulePos : SourcePosition; 73 | ModuleObject : Object; 74 | | FALSE : 75 | ImportedObjects: ObjectList; 76 | END; 77 | ids : IdentList; 78 | next : Import; 79 | END; 80 | 81 | ObjectDescription = 82 | 83 | RECORD 84 | name : Ident; 85 | 86 | next : Object; 87 | HiddenObject : Object; 88 | DefiningScope : Object; 89 | DefNesting : SHORTINT; 90 | UseIndex : SHORTINT; 91 | 92 | CASE class : ObjectClass OF 93 | | ModuleObj, ProcedureObj : 94 | ScopeIndex : SHORTINT; 95 | FirstLocalObject : Object; 96 | body : Node; 97 | ProcedureNumber : SHORTCARD; 98 | level : SHORTCARD; 99 | procindex : ProcIndex; 100 | options : OptionSet; 101 | 102 | CASE DummyTag (*for bootstrap*) : ObjectClass OF 103 | | ModuleObj : 104 | ExportIsQualified : BOOLEAN; 105 | ExportObjects : ObjectList; 106 | ExportIdents : IdentList; 107 | import : Import; 108 | TimeStamp : TimeStampType; 109 | priority : Value; 110 | moduleindex : ModuleIndex; 111 | IsForeignModule : BOOLEAN; 112 | | ProcedureObj : 113 | TypeOfProcedure : Type; 114 | SizeOfActivationRecord : LONGINT; 115 | END; 116 | | StandardProcedureObj : 117 | ProcName : StandardProcedure; 118 | | VariableObj : 119 | TypeOfVariable : Type; 120 | DefiningProcedure : Object; 121 | kind : VariableKind; 122 | offset : LONGINT; 123 | | ConstantObj : 124 | TypeOfConstant : Type; 125 | value : Value; 126 | | TypeObj : 127 | TypeOfType : Type; 128 | | FieldObj : 129 | TypeOfField : Type; 130 | FieldOffset : LONGINT; 131 | WithNesting : SHORTCARD; 132 | | PseudoObj : 133 | ObjectRepresented : Object; 134 | | ErrorObj : 135 | (* no fields *) 136 | END 137 | END; 138 | 139 | 140 | TypeClass = ( 141 | 142 | (* --Basic Types-- *) 143 | ClassBOOLEAN, ClassCHAR, 144 | ClassSHORTCARD, ClassLONGCARD, 145 | ClassSHORTINT, ClassLONGINT, 146 | ClassLONGREAL, ClassREAL, 147 | 148 | (* --Standard Types-- *) 149 | ClassBITSET, ClassPROC, 150 | 151 | (* --Types from module SYSTEM-- *) 152 | ClassWORD, ClassADDRESS, 153 | 154 | (* --'ambigous' numeric types -- *) 155 | (* min(SI) .. 0 *) ClassSIorLI, 156 | (* 0 .. max(SI) *) ClassSIorSCorLIorLC, 157 | (* max(SI) .. max(SC) *) ClassSCorLIorLC, 158 | (* max(SC) .. max(LI) *) ClassLIorLC, 159 | (* min(SR) .. max(SR) *) ClassSRorLR, 160 | 161 | (* -- compiler types -- *) 162 | ClassNIL, ClassSTRING, ClassOPAQUE, 163 | ClassVOID, 164 | ClassERROR, 165 | 166 | (* --Type Constructors-- *) 167 | EnumerationType, SubrangeType, ArrayType, RecordType, 168 | SetType, PointerType, ProcedureType 169 | ); 170 | 171 | RecordField = POINTER TO RecordFieldDescription; 172 | 173 | RecordFieldDescription = 174 | RECORD 175 | name : Ident; 176 | offset : LONGINT; 177 | type : Type; 178 | next : RecordField; 179 | END; 180 | 181 | FormalParam = POINTER TO FormalParamDescription; 182 | 183 | FormalParamDescription = 184 | RECORD 185 | IsVarParam : BOOLEAN; 186 | type : Type; 187 | offset : LONGINT; 188 | next : FormalParam; 189 | END; 190 | 191 | TypeDescription = 192 | RECORD 193 | size : LONGINT; 194 | align : SHORTCARD; (* he 4/90 *) 195 | 196 | DefiningObject : Object; 197 | 198 | CASE class : TypeClass OF 199 | 200 | | ClassBOOLEAN, ClassCHAR, 201 | ClassSHORTCARD, ClassLONGCARD, 202 | ClassSHORTINT, ClassLONGINT, 203 | ClassREAL, ClassLONGREAL, 204 | ClassBITSET, ClassPROC, 205 | ClassWORD, ClassADDRESS, 206 | ClassSIorLI, ClassSIorSCorLIorLC, 207 | ClassSCorLIorLC, ClassLIorLC, 208 | ClassSRorLR, 209 | ClassNIL, ClassSTRING, ClassOPAQUE, 210 | ClassVOID, 211 | ClassERROR : 212 | (* No Fields *) 213 | | EnumerationType : 214 | constants : ObjectList; 215 | MaxVal : Value; 216 | | SubrangeType : 217 | BaseTypeOfSubrangeType : Type; 218 | first : Value; 219 | last : Value; 220 | | ArrayType : 221 | IsOpenArray : BOOLEAN; 222 | IndexType : Type; 223 | ComponentType : Type; 224 | lwb : Value; 225 | upb : Value; 226 | | RecordType : 227 | FirstField : RecordField; 228 | | SetType : 229 | BaseTypeOfSetType : Type; 230 | | PointerType : 231 | BaseTypeOfPointerType : Type; 232 | | ProcedureType : 233 | ParameterSize : LONGINT; 234 | FirstParam : FormalParam; 235 | ResultType : Type; 236 | END 237 | END; 238 | 239 | END DfTable. 240 | -------------------------------------------------------------------------------- /ver1807/src/DfTable.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | IMPLEMENTATION MODULE DfTable; 18 | 19 | (* empty *) 20 | 21 | END DfTable. 22 | -------------------------------------------------------------------------------- /ver1807/src/Emit.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE Emit; 18 | 19 | (* ************************************************************************ * 20 | * This module was generated by BEG V1.84 * 21 | * ************************************************************************ *) 22 | 23 | IMPORT IR; 24 | FROM IR IMPORT RegisterSet; 25 | (*++++++ start insertion IpTypes ++++++*) 26 | 27 | IMPORT CgBase; 28 | FROM Strings IMPORT String; 29 | 30 | 31 | (*------ end insertion IpTypes ------*) 32 | (*++++++ start insertion IpEmit_d ++++++*) 33 | 34 | FROM SuErrors IMPORT SourcePosition; 35 | FROM IR IMPORT MemAdr; 36 | 37 | CONST MaxCallLevel = 32; (* Max. # nested procedurecalls *) 38 | 39 | VAR 40 | SizeTable : ARRAY CgBase.Mode OF SHORTINT; 41 | (* maps Mode to OpSize *) 42 | 43 | SuffixTable : ARRAY CgBase.Mode OF CHAR; 44 | (* maps Mode into suffix of load instruction *) 45 | 46 | SignedTable : ARRAY CgBase.Mode OF BOOLEAN; 47 | (* calculates wether Mode is signed *) 48 | 49 | NullSymb : CgBase.RelSymb; 50 | DisplaySym : CgBase.RelSymb; 51 | 52 | CurPos : SourcePosition; 53 | CurLevel : SHORTCARD; 54 | CallLevel : SHORTCARD; 55 | 56 | PROCEDURE DeclareModule 57 | ( extern : BOOLEAN; 58 | VAR CompUnitName : ARRAY OF CHAR; 59 | VAR ref : CgBase.ModuleIndex); 60 | 61 | PROCEDURE DeclareProcedure 62 | ( extern : BOOLEAN; 63 | isFunction : BOOLEAN; 64 | ProcMode : CgBase.Mode; 65 | VAR ProcName : ARRAY OF CHAR; 66 | ProcNumber : SHORTCARD; 67 | module : CgBase.ModuleIndex; 68 | level : SHORTCARD; 69 | father : CgBase.ProcIndex; 70 | VAR ref : CgBase.ProcIndex); 71 | 72 | PROCEDURE DeclareString 73 | ( length : SHORTCARD; 74 | VAR string : ARRAY OF CHAR; 75 | VAR ref : CgBase.StringIndex); 76 | 77 | PROCEDURE DeclareTempo 78 | ( mode: CgBase.Mode; 79 | VAR tempo: CgBase.Tempo); 80 | 81 | PROCEDURE BeginModule 82 | (AtModulName : ARRAY OF CHAR; 83 | AtFrameSize : LONGINT); 84 | 85 | PROCEDURE IsNilMemAdr (a: MemAdr) : BOOLEAN; 86 | 87 | 88 | 89 | (*------ end insertion IpEmit_d ------*) 90 | 91 | PROCEDURE EmitInstruction (e : IR.Expression); 92 | PROCEDURE EmitStatement (e: IR.Expression); 93 | 94 | 95 | END Emit. 96 | -------------------------------------------------------------------------------- /ver1807/src/FileName.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE FileName; 18 | 19 | FROM SuBase IMPORT FileName; 20 | 21 | (* Definition for all fixed filenames and suffixes *) 22 | 23 | CONST 24 | (* Christian Maurer, 21.2.00 >>>>>>>>>>> *) 25 | ImplementationSuffix = (* ".mi" *) ".mod"; 26 | DefinitionSuffix = (* ".md" *) ".def"; 27 | (* <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< *) 28 | ObjectSuffix = ".o"; 29 | DefSuffix = ".d"; 30 | DebugSuffix = ".i"; 31 | MapSuffix = ".m"; 32 | DepSuffix = ".r"; 33 | (* TODO : AssemblerSuffix is unused ! .s in asm script *) 34 | AssemblerSuffix = ".s"; 35 | 36 | 37 | END FileName. 38 | -------------------------------------------------------------------------------- /ver1807/src/FileName.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | IMPLEMENTATION MODULE FileName; 18 | 19 | 20 | (* empty *) 21 | 22 | END FileName. 23 | -------------------------------------------------------------------------------- /ver1807/src/GcgStorage.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE GcgStorage; 18 | 19 | FROM SYSTEM IMPORT 20 | ADDRESS; 21 | 22 | 23 | (* 3rd Heap *) 24 | 25 | PROCEDURE ALLOCATE 26 | (VAR a : ADDRESS; 27 | n : LONGCARD); 28 | (* Substitution procedure for 'NEW'. 29 | Allocate 'n' bytes and return in 'a' a pointer 30 | to that storage region. *) 31 | 32 | PROCEDURE InitGcgStorage; 33 | (* Initialize. 34 | May be called more than once in a single run, 35 | in this case the storage used by preceding allocations 36 | is reused. *) 37 | 38 | END GcgStorage. 39 | -------------------------------------------------------------------------------- /ver1807/src/GcgStorage.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | IMPLEMENTATION MODULE GcgStorage; 18 | 19 | FROM SYSTEM IMPORT ADDRESS; 20 | FROM MemPools IMPORT MemPool, NewPool, PoolAllocate, KillPool; 21 | 22 | VAR 23 | pool: MemPool; 24 | 25 | PROCEDURE ALLOCATE (VAR ptr : ADDRESS; size : LONGCARD); 26 | BEGIN 27 | PoolAllocate(pool, ptr, size); 28 | END ALLOCATE; 29 | 30 | PROCEDURE InitGcgStorage; 31 | BEGIN 32 | KillPool(pool); 33 | NewPool(pool); 34 | END InitGcgStorage; 35 | 36 | BEGIN 37 | NewPool(pool); 38 | END GcgStorage. 39 | -------------------------------------------------------------------------------- /ver1807/src/GcgTab.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE GcgTab; 18 | 19 | (* ************************************************************************ * 20 | * This module was generated by BEG V1.84 * 21 | * ************************************************************************ *) 22 | 23 | FROM IR IMPORT Register, RegisterSet, Rule, MaxPscArity, NonTerminal, MaxScratch; 24 | FROM IR IMPORT OpCode; 25 | 26 | 27 | TYPE 28 | 29 | Path = CARDINAL; 30 | 31 | RegKind = (RKRegister, RKAdrmode, RKMemory, RKCalc); 32 | 33 | RuleDescrRec = RECORD 34 | register : RegKind; 35 | pscarity : [0..MaxPscArity]; 36 | resregs : RegisterSet; 37 | changeregs : RegisterSet; 38 | target : [0..MaxPscArity]; 39 | closuretarget : BOOLEAN; 40 | result : [0..MaxPscArity]; 41 | unique : BOOLEAN; 42 | commutative: BOOLEAN; 43 | op : ARRAY [1..MaxPscArity] OF RECORD 44 | nt : NonTerminal; 45 | path : Path; 46 | calc : BOOLEAN; (* he 3/91 *) 47 | regs : RegisterSet; 48 | END; 49 | srcline : CARDINAL; 50 | scrnum : [0..MaxScratch]; 51 | scrrs : ARRAY [1..MaxScratch] OF RegisterSet; 52 | END; 53 | 54 | 55 | 56 | VAR 57 | RegDestroy : ARRAY Register OF RegisterSet; 58 | (* Constant, RegDestroy [r] contains the registers, which *) 59 | (* are destroyed, if r is altered *) 60 | 61 | RuleDescr : ARRAY Rule OF RuleDescrRec; 62 | (* Constant, contains a description of all rules or *) 63 | (* pseudo code statements *) 64 | 65 | 66 | 67 | END GcgTab. 68 | -------------------------------------------------------------------------------- /ver1807/src/M2RTS-ErrNo.c: -------------------------------------------------------------------------------- 1 | /* ------------------------------------------------------------------------ * 2 | * MOCKA Modula-2 Compiler System, Version 1807 * 3 | * * 4 | * Copyright (C) 1988-2000 by * 5 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 6 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 7 | * [EN] German National Research Center for Computer Science, * 8 | * Former GMD Research Lab at the University of Karlsruhe. * 9 | * * 10 | * Copyright (C) 2001-2018 by * 11 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 12 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 13 | * ------------------------------------------------------------------------ */ 14 | 15 | #include 16 | 17 | int ErrNo(void) { 18 | return __errno_location; 19 | } 20 | 21 | /* END OF FILE */ 22 | -------------------------------------------------------------------------------- /ver1807/src/M2RTS-elf.s: -------------------------------------------------------------------------------- 1 | /* ------------------------------------------------------------------------ * 2 | * MOCKA Modula-2 Compiler System, Version 1807 * 3 | * * 4 | * Copyright (C) 1988-2000 by * 5 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 6 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 7 | * [EN] German National Research Center for Computer Science, * 8 | * Former GMD Research Lab at the University of Karlsruhe. * 9 | * * 10 | * Copyright (C) 2001-2018 by * 11 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 12 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 13 | * ------------------------------------------------------------------------ */ 14 | 15 | 16 | /* ************************************************************************ * 17 | * MOCKA Runtime System for Intel 80386/80387 * 18 | * * 19 | * Student Project by Holger Hopp, Status: 1995-03-23 * 20 | * ************************************************************************ */ 21 | 22 | MaxDisplay_ = 16 23 | DisplaySize_ = 4 * MaxDisplay_ 24 | stderr_ = 2 25 | 26 | .globl _M2ROOT # Imports 27 | .globl write 28 | .globl abort 29 | .globl errno 30 | 31 | .globl main # Exports 32 | .globl GetArgs 33 | .globl GetEnv 34 | # .globl ErrNo 35 | .globl exit_ 36 | .globl ReturnErr_ 37 | .globl BoundErr_ 38 | .globl CaseErr_ 39 | .globl Transfer_ 40 | .globl NewProcess_ 41 | .globl RealOne_ 42 | .globl RealLog2e_ 43 | .globl RealLn2_ 44 | .globl TwoExp31_ 45 | .globl TwoExp32_ 46 | 47 | .comm argv_, 4 48 | .comm argc_, 4 49 | .comm env_, 4 50 | .comm DISPLAY_, DisplaySize_ 51 | .comm spsave_, 4 52 | .comm fpucw_round_to_nearest,2 # used in MathLib.exp 53 | .comm fpucw_round_to_zero,2 # used in TRUNC, LREAL.LTRUNC 54 | .comm fpucw_round_to_inf,2 # not used 55 | .comm fpucw_round_to_neginf,2 # used in MathLib.entier 56 | 57 | main: 58 | pushl %ebp 59 | movl %esp, %ebp 60 | 61 | movl %esp, spsave_ # save stack pointer 62 | 63 | movl 8(%ebp),%eax # save arguments of main 64 | movl %eax,argc_ 65 | movl 12(%ebp),%eax 66 | movl %eax,argv_ 67 | movl 16(%ebp),%eax 68 | movl %eax,env_ 69 | 70 | fnstcw fpucw_round_to_nearest # save fpu control words 71 | movw fpucw_round_to_nearest,%ax 72 | andw $0xf3ff,%ax 73 | movw %ax,fpucw_round_to_nearest 74 | orw $0x0400,%ax 75 | movw %ax,fpucw_round_to_neginf 76 | orw $0x0c00,%ax 77 | movw %ax,fpucw_round_to_zero 78 | andw $0xfbff,%ax 79 | movw %ax,fpucw_round_to_inf 80 | fldcw fpucw_round_to_zero # this is default for MOCKA 81 | 82 | call _M2ROOT 83 | 84 | .Lret_: 85 | movl $0,%eax 86 | # next 2 lines: different return code for libs in RedHat 6.0 87 | pushl %eax 88 | call _exit 89 | leave 90 | ret 91 | 92 | # IMPLEMENTATION MODULE Arguments 93 | # PROCEDURE GetArgs (VAR argc: SHORTCARD; VAR argv: ADDRESS) 94 | GetArgs: 95 | movl 4(%esp),%eax 96 | movl argc_,%ebx 97 | movl %ebx,(%eax) 98 | movl 8(%esp),%eax 99 | movl argv_,%ebx 100 | movl %ebx,(%eax) 101 | ret 102 | 103 | # PROCEDURE GetEnv (VAR env: ADDRESS) 104 | GetEnv: 105 | movl 4(%esp),%eax 106 | movl env_,%ebx 107 | movl %ebx,(%eax) 108 | ret 109 | 110 | # IMPLEMENTATION MODULE ErrNumbers 111 | # PROCEDURE ErrNo () : SHORTCARD; 112 | #ErrNo: 113 | # movl errno,%eax 114 | # ret 115 | 116 | # IMPLEMENTATION MODULE SYSTEM 117 | # PROCEDURE HALT 118 | exit_: 119 | movl spsave_, %esp 120 | movl spsave_, %ebp 121 | jmp .Lret_ 122 | 123 | # PROCEDURE TRANSFER (VAR from, to: ADDRESS) 124 | Transfer_: 125 | movl 4(%esp),%eax # eax := from 126 | movl 8(%esp),%ebx # ebx := to 127 | 128 | pushl %ebp # save base pointer 129 | 130 | subl $DisplaySize_,%esp # save display vector 131 | movl $MaxDisplay_,%ecx 132 | movl $DISPLAY_,%esi 133 | movl %esp,%edi 134 | cld 135 | repz 136 | movsl 137 | 138 | movl %esp,(%eax) # switch stack pointer 139 | movl (%ebx),%esp 140 | 141 | movl $MaxDisplay_,%ecx # get display vector 142 | movl %esp,%esi 143 | movl $DISPLAY_,%edi 144 | cld 145 | repz 146 | movsl 147 | addl $DisplaySize_,%esp 148 | 149 | popl %ebp # get base pointer 150 | 151 | ret # switch to to process 152 | 153 | # PROCEDURE NEWPROCESS (p: PROC; a: ADDRESS; s: CARDINAL; VAR co: ADDRESS) 154 | NewProcess_: 155 | movl 8(%esp),%eax # eax := a (Start of Workspace) 156 | 157 | addl 12(%esp),%eax # eax := a + s (End of Workspace) 158 | andl $-4,%eax # align End of Workspace 159 | 160 | movl $exit_,-4(%eax) # Exit of Coroutine 161 | 162 | movl 4(%esp),%ebx # Start of Procedure 163 | movl %ebx,-8(%eax) 164 | 165 | movl $MaxDisplay_,%ecx # copy display vector 166 | movl $DISPLAY_,%esi 167 | leal -12-DisplaySize_(%eax),%edi 168 | movl 16(%esp),%edx # edx := address of result co 169 | movl %edi,(%edx) # result 170 | cld 171 | repz 172 | movsl 173 | 174 | ret 175 | 176 | 177 | # RunTimeChecks 178 | 179 | .data 180 | returnerr_: 181 | .ascii "\012**** RUNTIME ERROR missing return from function\n\0" 182 | returnerrsize_ = . - returnerr_ 183 | bounderr_: 184 | .ascii "\012**** RUNTIME ERROR bound check error\n\0" 185 | bounderrsize_ = . - bounderr_ 186 | caseerr_: 187 | .ascii "\012**** RUNTIME ERROR case expression out of range\n\0" 188 | caseerrsize_ = . - caseerr_ 189 | .text 190 | 191 | ReturnErr_: 192 | pushl $returnerrsize_ 193 | pushl $returnerr_ 194 | RuntimeErr_: 195 | pushl $stderr_ 196 | call write 197 | addl $12,%esp 198 | #call abort 199 | mov $0,%ebx 200 | divl %ebx 201 | ret 202 | 203 | BoundErr_: 204 | pushl $bounderrsize_ 205 | pushl $bounderr_ 206 | jmp RuntimeErr_ 207 | 208 | CaseErr_: 209 | pushl $caseerrsize_ 210 | pushl $caseerr_ 211 | jmp RuntimeErr_ 212 | 213 | .data 214 | .align 4 215 | RealOne_: 216 | .single 0r0.1E1 217 | .align 8 218 | RealLog2e_: 219 | .double 0r0.144269504088896340737E1 220 | RealLn2_: 221 | .double 0r0.69314718055994530941E0 222 | TwoExp32_: 223 | .double 0r0.4294967296E10 224 | TwoExp31_: 225 | .double 0r0.2147483648E10 226 | -------------------------------------------------------------------------------- /ver1807/src/M2RTS.s: -------------------------------------------------------------------------------- 1 | /* ------------------------------------------------------------------------ * 2 | * MOCKA Modula-2 Compiler System, Version 1807 * 3 | * * 4 | * Copyright (C) 1988-2000 by * 5 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 6 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 7 | * [EN] German National Research Center for Computer Science, * 8 | * Former GMD Research Lab at the University of Karlsruhe. * 9 | * * 10 | * Copyright (C) 2001-2018 by * 11 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 12 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 13 | * ------------------------------------------------------------------------ */ 14 | 15 | 16 | /* ************************************************************************ * 17 | * MOCKA Runtime System for Intel 80386/80387 * 18 | * * 19 | * Author: Holger Hopp, Status: 2006-08-08 * 20 | * ************************************************************************ */ 21 | 22 | MaxDisplay_ = 16 23 | DisplaySize_ = 4 * MaxDisplay_ 24 | stderr_ = 2 25 | 26 | .globl _M2ROOT # Imports 27 | .globl write 28 | .globl abort 29 | .globl __errno_location # Ch. Maurer, 8.8.06 30 | 31 | .globl main # Exports 32 | .globl GetArgs 33 | .globl GetEnv 34 | .globl ErrNo 35 | .globl exit_ 36 | .globl ReturnErr_ 37 | .globl BoundErr_ 38 | .globl CaseErr_ 39 | .globl Transfer_ 40 | .globl NewProcess_ 41 | .globl RealOne_ 42 | .globl RealLog2e_ 43 | .globl RealLn2_ 44 | .globl TwoExp31_ 45 | .globl TwoExp32_ 46 | 47 | .comm argv_, 4 48 | .comm argc_, 4 49 | .comm env_, 4 50 | .comm DISPLAY_, DisplaySize_ 51 | .comm spsave_, 4 52 | .comm ebxsave_, 4 53 | .comm fpucw_round_to_nearest,2 # used in MathLib.exp 54 | .comm fpucw_round_to_zero,2 # used in TRUNC, LREAL.LTRUNC 55 | .comm fpucw_round_to_inf,2 # not used 56 | .comm fpucw_round_to_neginf,2 # used in MathLib.entier 57 | 58 | main: 59 | pushl %ebp 60 | movl %ebx, ebxsave_ # ebx must be restored 61 | movl %esp, %ebp 62 | 63 | movl %esp, spsave_ # save stack pointer 64 | 65 | movl 8(%ebp),%eax # save arguments of main 66 | movl %eax,argc_ 67 | movl 12(%ebp),%eax 68 | movl %eax,argv_ 69 | movl 16(%ebp),%eax 70 | movl %eax,env_ 71 | 72 | fnstcw fpucw_round_to_nearest # save fpu control words 73 | movw fpucw_round_to_nearest,%ax 74 | andw $0xf3ff,%ax 75 | movw %ax,fpucw_round_to_nearest 76 | orw $0x0400,%ax 77 | movw %ax,fpucw_round_to_neginf 78 | orw $0x0c00,%ax 79 | movw %ax,fpucw_round_to_zero 80 | andw $0xfbff,%ax 81 | movw %ax,fpucw_round_to_inf 82 | fldcw fpucw_round_to_zero # this is default for MOCKA 83 | 84 | call _M2ROOT 85 | 86 | .Lret_: 87 | movl ebxsave_,%ebx 88 | movl $0,%eax 89 | pushl %eax 90 | call exit 91 | leave 92 | ret 93 | 94 | # IMPLEMENTATION MODULE Arguments 95 | # PROCEDURE GetArgs (VAR argc: SHORTCARD; VAR argv: ADDRESS) 96 | GetArgs: 97 | movl 4(%esp),%eax 98 | movl argc_,%ebx 99 | movl %ebx,(%eax) 100 | movl 8(%esp),%eax 101 | movl argv_,%ebx 102 | movl %ebx,(%eax) 103 | ret 104 | 105 | # PROCEDURE GetEnv (VAR env: ADDRESS) 106 | GetEnv: 107 | movl 4(%esp),%eax 108 | movl env_,%ebx 109 | movl %ebx,(%eax) 110 | ret 111 | 112 | # IMPLEMENTATION MODULE ErrNumbers 113 | # PROCEDURE ErrNo () : SHORTCARD; 114 | ErrNo: 115 | call __errno_location # Ch. Maurer, 8.8.06 116 | movl (%eax),%eax 117 | ret 118 | 119 | # IMPLEMENTATION MODULE SYSTEM 120 | # PROCEDURE HALT 121 | exit_: 122 | movl spsave_, %esp 123 | movl spsave_, %ebp 124 | jmp .Lret_ 125 | 126 | # PROCEDURE TRANSFER (VAR from, to: ADDRESS) 127 | Transfer_: 128 | movl 4(%esp),%eax # eax := from 129 | movl 8(%esp),%ebx # ebx := to 130 | 131 | pushl %ebp # save base pointer 132 | 133 | subl $DisplaySize_,%esp # save display vector 134 | movl $MaxDisplay_,%ecx 135 | movl $DISPLAY_,%esi 136 | movl %esp,%edi 137 | cld 138 | repz 139 | movsl 140 | 141 | movl %esp,(%eax) # switch stack pointer 142 | movl (%ebx),%esp 143 | 144 | movl $MaxDisplay_,%ecx # get display vector 145 | movl %esp,%esi 146 | movl $DISPLAY_,%edi 147 | cld 148 | repz 149 | movsl 150 | addl $DisplaySize_,%esp 151 | 152 | popl %ebp # get base pointer 153 | 154 | ret # switch to to process 155 | 156 | # PROCEDURE NEWPROCESS (p: PROC; a: ADDRESS; s: CARDINAL; VAR co: ADDRESS) 157 | NewProcess_: 158 | movl 8(%esp),%eax # eax := a (Start of Workspace) 159 | 160 | addl 12(%esp),%eax # eax := a + s (End of Workspace) 161 | andl $-4,%eax # align End of Workspace 162 | 163 | movl $exit_,-4(%eax) # Exit of Coroutine 164 | 165 | movl 4(%esp),%ebx # Start of Procedure 166 | movl %ebx,-8(%eax) 167 | 168 | movl $MaxDisplay_,%ecx # copy display vector 169 | movl $DISPLAY_,%esi 170 | leal -12-DisplaySize_(%eax),%edi 171 | movl 16(%esp),%edx # edx := address of result co 172 | movl %edi,(%edx) # result 173 | cld 174 | repz 175 | movsl 176 | 177 | ret 178 | 179 | 180 | # RunTimeChecks 181 | 182 | .data 183 | returnerr_: 184 | .ascii "\012**** RUNTIME ERROR missing return from function\n\0" 185 | returnerrsize_ = . - returnerr_ 186 | bounderr_: 187 | .ascii "\012**** RUNTIME ERROR bound check error\n\0" 188 | bounderrsize_ = . - bounderr_ 189 | caseerr_: 190 | .ascii "\012**** RUNTIME ERROR case expression out of range\n\0" 191 | caseerrsize_ = . - caseerr_ 192 | .text 193 | 194 | ReturnErr_: 195 | pushl $returnerrsize_ 196 | pushl $returnerr_ 197 | RuntimeErr_: 198 | pushl $stderr_ 199 | call write 200 | addl $12,%esp 201 | #call abort 202 | mov $0,%ebx 203 | divl %ebx 204 | ret 205 | 206 | BoundErr_: 207 | pushl $bounderrsize_ 208 | pushl $bounderr_ 209 | jmp RuntimeErr_ 210 | 211 | CaseErr_: 212 | pushl $caseerrsize_ 213 | pushl $caseerr_ 214 | jmp RuntimeErr_ 215 | 216 | .data 217 | .align 4 218 | RealOne_: 219 | .single 0r0.1E1 220 | .align 8 221 | RealLog2e_: 222 | .double 0r0.144269504088896340737E1 223 | RealLn2_: 224 | .double 0r0.69314718055994530941E0 225 | TwoExp32_: 226 | .double 0r0.4294967296E10 227 | TwoExp31_: 228 | .double 0r0.2147483648E10 229 | -------------------------------------------------------------------------------- /ver1807/src/Mocka.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | MODULE Mocka; 18 | 19 | FROM MockaArgs IMPORT ScanArgs; 20 | FROM MockaComp IMPORT CompileDef, CompileImp; 21 | FROM MockaBind IMPORT Bind; 22 | FROM MockaShell IMPORT CommandLoop; 23 | FROM SuErrors IMPORT ErrorReport; 24 | FROM SuBase IMPORT Mode, ModeSpec, NameOfModule; 25 | 26 | (* rh 91-01 *) 27 | 28 | BEGIN 29 | ScanArgs; 30 | 31 | CASE ModeSpec OF 32 | | CompileDefMode : 33 | CompileDef(NameOfModule); ErrorReport 34 | | CompileImpMode : 35 | CompileImp(NameOfModule); ErrorReport 36 | | BindMode : 37 | Bind(NameOfModule) 38 | | InteractiveMode : 39 | CommandLoop 40 | END 41 | 42 | END Mocka. 43 | -------------------------------------------------------------------------------- /ver1807/src/MockaArgs.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE MockaArgs; 18 | 19 | PROCEDURE ScanArgs; 20 | 21 | END MockaArgs. 22 | -------------------------------------------------------------------------------- /ver1807/src/MockaArgs.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | IMPLEMENTATION MODULE MockaArgs; 18 | 19 | FROM Arguments IMPORT 20 | ArgTable, GetArgs; 21 | 22 | FROM Strings IMPORT 23 | String, EmptyString, Assign, Append, StrEq, Length; 24 | 25 | FROM SuBase IMPORT 26 | DefineVariant, SystemCommand, Mode, NameOfModule, ModeSpec, 27 | BindScript, EditScript, ListerScript, AssemblerScript, 28 | Libraries, SetOption, ShowOptions, NameOfSourceFile, 29 | LibraryDirectory, ShowPublicOptions; (* HE 2/90 *) 30 | 31 | FROM InOut IMPORT 32 | Done, Read,ReadString, Write, WriteString, WriteLn, WriteBf, WriteCard; 33 | 34 | FROM Storage IMPORT 35 | ALLOCATE; (* ms 5/90 *) 36 | 37 | FROM MockaShell IMPORT 38 | ShowHelp, ShowVersion; 39 | 40 | 41 | CONST 42 | BindScriptPath = "/usr/local/bin/mocka/link"; 43 | EditScriptPath = "/usr/local/bin/mocka/edit"; 44 | ListerScriptPath = "/usr/local/bin/mocka/list"; 45 | AssemblerScriptPath = "/usr/local/bin/mocka/asm"; 46 | 47 | (* Default path for library search, -d option *) 48 | DefaultLibraryPath = "/usr/local/lib/mocka/mockalib"; 49 | 50 | (* Default path for compilation products, -D option *) 51 | WorkingLibraryPath = "."; 52 | 53 | 54 | VAR 55 | argc : SHORTCARD; Argv : ArgTable; 56 | PromptString : String; 57 | 58 | 59 | PROCEDURE GetArg ( n : SHORTCARD; VAR str : ARRAY OF CHAR ); 60 | VAR 61 | i : SHORTCARD; 62 | histr : CARDINAL; (* ms 6/90 *) 63 | BEGIN 64 | i := 0; 65 | histr := HIGH(str); (* ms 6/90 *) 66 | LOOP 67 | str[i] := Argv^[n]^[i]; 68 | IF str[i] = 0C THEN 69 | EXIT 70 | END; (* IF *) 71 | INC(i); 72 | IF i > histr THEN 73 | ArgumentError("Argument too long.", ""); 74 | END; (* IF *) 75 | END; (* LOOP *) 76 | END GetArg; 77 | 78 | 79 | PROCEDURE ArgumentError ( s1, s2 : ARRAY OF CHAR ); 80 | BEGIN 81 | WriteString("Argument Error: "); 82 | WriteString(s1); 83 | WriteString(s2); 84 | WriteLn; 85 | HALT; 86 | END ArgumentError; 87 | 88 | 89 | PROCEDURE AppendCon ( VAR dest, suffix : ARRAY OF CHAR ); 90 | (* dest := dest + suffix *) 91 | BEGIN 92 | IF Length(dest) + Length(suffix) < HIGH(dest) THEN 93 | Append(dest,suffix); 94 | ELSE 95 | ArgumentError("Can't append.", ""); 96 | END; (* IF *) 97 | END AppendCon; 98 | 99 | 100 | PROCEDURE ScanArgs; 101 | VAR 102 | arg, DefaultLib : String; 103 | ArgIndex, LastArgIndex : SHORTCARD; 104 | ok : BOOLEAN; 105 | show, showpublic : BOOLEAN; 106 | i : SHORTCARD; 107 | 108 | PROCEDURE GetArgValue ( VAR argvalue : ARRAY OF CHAR ); 109 | BEGIN 110 | IF ArgIndex = LastArgIndex THEN 111 | ArgumentError("Too many calls to GetArgValue", ""); 112 | END; (* IF *) 113 | INC(ArgIndex); GetArg(ArgIndex, argvalue); 114 | END GetArgValue; 115 | 116 | PROCEDURE CompSizeArgv () : CARDINAL; 117 | VAR 118 | counter : SHORTCARD; 119 | bytes : CARDINAL; 120 | BEGIN 121 | bytes := 0; 122 | FOR counter := 1 TO LastArgIndex DO 123 | GetArg(counter, arg); 124 | INC(bytes, Length(arg)); 125 | END; (* FOR *) 126 | RETURN bytes; 127 | END CompSizeArgv; 128 | 129 | BEGIN (* ScanArgs *) 130 | ModeSpec := InteractiveMode; 131 | show := FALSE; showpublic := FALSE; 132 | Assign(NameOfModule, "NONAME"); 133 | Assign(BindScript, BindScriptPath); (* CM 2012-08-05 *) 134 | Assign(EditScript, EditScriptPath); (* CM 2012-08-05 *) 135 | Assign(ListerScript, ListerScriptPath); (* CM 2012-08-05 *) 136 | Assign(AssemblerScript, AssemblerScriptPath); (* CM 2012-08-05 *) 137 | Assign(DefaultLib, DefaultLibraryPath); (* CM 2012-08-05 *) 138 | Assign(LibraryDirectory, WorkingLibraryPath); (* BK 2018-07-10 *) 139 | Assign(PromptString, ">>"); 140 | GetArgs(argc, Argv); LastArgIndex := argc-1; ArgIndex := 1; 141 | ALLOCATE(Libraries, CompSizeArgv() + 1); 142 | EmptyString(Libraries^); 143 | IF ArgIndex > LastArgIndex THEN 144 | RETURN 145 | END; (* IF *) 146 | GetArg(ArgIndex,arg); 147 | LOOP 148 | IF StrEq(arg, "-s") THEN 149 | GetArgValue (NameOfModule); 150 | ModeSpec := CompileDefMode; 151 | ELSIF StrEq(arg, "-c") THEN 152 | GetArgValue (NameOfModule); 153 | ModeSpec := CompileImpMode; 154 | ELSIF StrEq(arg, "-p") THEN 155 | GetArgValue (NameOfModule); 156 | ModeSpec := BindMode; 157 | ELSIF StrEq(arg, "-d") THEN 158 | GetArgValue (arg); 159 | IF Length(Libraries^) > 0 THEN 160 | AppendCon(Libraries^," "); 161 | END; (* END *) 162 | AppendCon(Libraries^,arg); 163 | ELSIF StrEq(arg, "-D") THEN 164 | GetArgValue (LibraryDirectory); 165 | ELSIF StrEq(arg, "-link") THEN 166 | GetArgValue (BindScript); 167 | ELSIF StrEq(arg, "-edit") THEN 168 | GetArgValue (EditScript); 169 | ELSIF StrEq(arg, "-list") THEN 170 | GetArgValue (ListerScript); 171 | ELSIF StrEq(arg, "-asm") THEN 172 | GetArgValue (AssemblerScript); 173 | ELSIF StrEq(arg, "-syslib") THEN 174 | GetArgValue (DefaultLib); 175 | ELSIF StrEq(arg, "-prompt") THEN 176 | GetArgValue (PromptString); 177 | ELSIF StrEq(arg, "-help") THEN 178 | ShowHelp; HALT; 179 | ELSIF StrEq(arg, "-info") THEN 180 | showpublic := TRUE; 181 | ELSIF StrEq(arg, "-options") THEN 182 | show := TRUE; 183 | ELSIF StrEq(arg, "-version") THEN (* BK 2018-07-10 *) 184 | ShowVersion; HALT; 185 | ELSIF StrEq(arg, "-V") THEN 186 | GetArgValue (arg); 187 | IF arg [0] = '-' THEN 188 | ArgumentError("Argument to -V must not start with `-'", ""); 189 | END; (* IF *) 190 | DefineVariant(arg); 191 | ELSIF arg[0] = '-' THEN 192 | i := 1; 193 | WHILE arg[i] <> 0C DO 194 | arg[i-1] := arg[i]; 195 | INC(i); 196 | END; (* WHILE *) 197 | arg[i-1] := 0C; 198 | SetOption(arg, ok); 199 | IF NOT ok THEN 200 | ArgumentError("unknown compiler option:",arg); 201 | END; 202 | ELSE 203 | ArgumentError("illegal argument:", arg); 204 | END; 205 | IF ArgIndex = LastArgIndex THEN 206 | EXIT 207 | END; (* IF *) 208 | INC(ArgIndex); GetArg (ArgIndex, arg); 209 | END; (* LOOP *) 210 | AppendCon(Libraries^," "); AppendCon(Libraries^,DefaultLib); 211 | IF show THEN 212 | ShowOptions 213 | END; (* IF *) 214 | IF showpublic THEN 215 | ShowPublicOptions 216 | END; (* IF *) 217 | END ScanArgs; 218 | 219 | END MockaArgs. 220 | -------------------------------------------------------------------------------- /ver1807/src/MockaBind.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE MockaBind; 18 | 19 | PROCEDURE Bind ( VAR ProgramName : ARRAY OF CHAR ); 20 | (* Bind the program with name 'ProgramName'. *) 21 | 22 | PROCEDURE WriteDependencyFile; 23 | (* Write the dependency file for the current compilation unit. *) 24 | 25 | END MockaBind. 26 | -------------------------------------------------------------------------------- /ver1807/src/MockaComp.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE MockaComp; (* rh 91-01 *) 18 | 19 | PROCEDURE CompileDef ( module : ARRAY OF CHAR ); 20 | 21 | PROCEDURE CompileImp ( module : ARRAY OF CHAR ); 22 | 23 | END MockaComp. 24 | -------------------------------------------------------------------------------- /ver1807/src/MockaMake.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE MockaMake; 18 | 19 | TYPE GoalClass = ( GoalClassSpec, GoalClassCode, GoalClassProg ); 20 | 21 | 22 | PROCEDURE DefineGoal ( name : ARRAY OF CHAR; class : GoalClass ); 23 | 24 | PROCEDURE InitMake; 25 | 26 | PROCEDURE Make; 27 | 28 | 29 | END MockaMake. 30 | -------------------------------------------------------------------------------- /ver1807/src/MockaShell.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE MockaShell; 18 | 19 | PROCEDURE ShowHelp; 20 | 21 | PROCEDURE ShowVersion; 22 | 23 | PROCEDURE CommandLoop; 24 | 25 | END MockaShell. 26 | -------------------------------------------------------------------------------- /ver1807/src/PaBodies.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE PaBodies; 18 | 19 | FROM DfTable IMPORT 20 | Object; 21 | 22 | PROCEDURE body 23 | (obj : Object); 24 | (* Parse the body of a module or procedure and translate 25 | into abstract syntax. 26 | On exit obj^.body refers to the tree. *) 27 | 28 | PROCEDURE InitBodies; 29 | (* Initialize. *) 30 | 31 | END PaBodies. 32 | -------------------------------------------------------------------------------- /ver1807/src/PaDecls.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE PaDecls; 18 | 19 | PROCEDURE CompilationUnit; 20 | (* Parse the current source file. 21 | Process declarations and translate module and procedure bodies 22 | into abstact syntax. *) 23 | 24 | PROCEDURE InitDecls; 25 | (* Initialize. *) 26 | 27 | END PaDecls. 28 | -------------------------------------------------------------------------------- /ver1807/src/PaSymSets.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE PaSymSets; 18 | 19 | FROM SuErrors IMPORT 20 | SourcePosition; 21 | 22 | FROM SuTokens IMPORT 23 | Symbol; 24 | 25 | 26 | CONST 27 | NoOfSets = 2; 28 | 29 | 30 | TYPE 31 | SetOfSymbols = ARRAY [0 .. NoOfSets] OF BITSET; 32 | 33 | 34 | VAR 35 | EofSet, AddOperatorSet, AddMulOperatorSet, SignSet, MulOperatorSet, 36 | RelationSet, RangeCommaSet, CommaSet, RightSetBrackSet, 37 | RightparSet, FormalTypeSet, RangeSet, RightBrackSet, 38 | ColonSet, CaseSepSet, FieldListSet, ElseSet, BeginSet, 39 | EndSet, RightparCommaSet, RightparSemicolonSet, TypSet, 40 | ImportSet, SemicolonSet, DefinitionSet, ExportSet, 41 | LeftparLeftSetBrackSet, FactorSet, 42 | BecomesLeftparSet, ElsifElseSet, CaseSepElseEndSet, ToSet, 43 | BySet, DoSet, StmtSet, ThenSet, ByDoSet, UntilSet, OfSet, 44 | DeclarationSet, EmptySet, ExprSet, CommaOfSet 45 | : SetOfSymbols; 46 | 47 | 48 | PROCEDURE AddSets 49 | (VAR SySet1, SySet2, SySet3 : SetOfSymbols); 50 | (* Unite 'SySet2' and 'SySet3' yielding 'SySet1'. *) 51 | 52 | PROCEDURE ElemInSet 53 | ( sym : Symbol; 54 | VAR SySet : SetOfSymbols 55 | ) : BOOLEAN; 56 | (* Return true iff 'sym' is in 'SySet'. *) 57 | 58 | PROCEDURE ErrorMessage 59 | (VAR ErrText : ARRAY OF CHAR; 60 | pos : SourcePosition); 61 | (* Emit an error message 'ErrText' unless the source position of 62 | the preceding message is equal to 'pos' *) 63 | 64 | PROCEDURE Skip 65 | (VAR StopSet : SetOfSymbols); 66 | (* Skip tokens until a token from 'StopSet' is found. *) 67 | 68 | PROCEDURE Check 69 | ( sym : Symbol; 70 | VAR ErrText : ARRAY OF CHAR); 71 | (* Check whether the class of the current token is equal to 'sym'. 72 | If not emit an error message 'ErrMsg'. *) 73 | 74 | PROCEDURE CheckSymbol1 75 | (VAR StopSet : SetOfSymbols; 76 | VAR ErrText : ARRAY OF CHAR); 77 | (* Ckeck whether the class of current token is in 'StopSet'. 78 | If not emit an error message 'ErrMsg' and skip until a token from 79 | 'StopSet' is found. *) 80 | 81 | PROCEDURE CheckSymbol2 82 | (VAR StopSet1, StopSet2 : SetOfSymbols; 83 | VAR ErrText : ARRAY OF CHAR); 84 | (* Ckeck whether the class of current token is in 'StopSet1'. 85 | If not emit an error message 'ErrMsg' and skip until a token from 86 | 'StopSet1' or 'StopSet2' is found. *) 87 | 88 | PROCEDURE InitSymSets; 89 | (* Initialize. *) 90 | 91 | END PaSymSets. 92 | -------------------------------------------------------------------------------- /ver1807/src/Prints.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE Prints; 18 | 19 | IMPORT CgBase; 20 | 21 | FROM SYSTEM IMPORT ADDRESS; 22 | FROM IR IMPORT Register, MemAdr, AdrMode; 23 | FROM Strings IMPORT String; 24 | FROM CgBase IMPORT 25 | LabelList, 26 | (*Aux,*) 27 | Tempo, 28 | SysProc, 29 | Mode, 30 | (*Area,*) 31 | Relation, 32 | Label, 33 | ProcIndex, 34 | ModuleIndex, 35 | StringIndex; 36 | (*OpCode,*) 37 | 38 | 39 | PROCEDURE PrintSHORTCARD (x : SHORTCARD); 40 | PROCEDURE PrintLONGCARD (x : LONGCARD); 41 | PROCEDURE PrintSHORTINT (x : SHORTINT); 42 | PROCEDURE PrintLONGINT (x : LONGINT); 43 | PROCEDURE PrintDataTempo (x : Tempo); 44 | PROCEDURE PrintAddressTempo (x : Tempo); 45 | PROCEDURE PrintSysProc(x : SysProc); 46 | PROCEDURE PrintLabelList(x : LabelList); 47 | PROCEDURE PrintLabel(x : Label); 48 | PROCEDURE PrintBOOLEAN(x : BOOLEAN); 49 | PROCEDURE PrintMode(x : Mode); 50 | PROCEDURE PrintString (s : String); 51 | PROCEDURE PrintStringIndex(x : StringIndex); 52 | PROCEDURE PrintLONGREAL(x : LONGREAL); 53 | PROCEDURE PrintREAL(x : REAL); 54 | PROCEDURE PrintBITSET(x : BITSET); 55 | PROCEDURE PrintProcIndex(x : ProcIndex); 56 | PROCEDURE PrintRelation(x : Relation); 57 | PROCEDURE PrintModuleIndex(x : ModuleIndex); 58 | PROCEDURE PrintCHAR(x : CHAR); 59 | PROCEDURE PrintADDRESS (a : ADDRESS); 60 | PROCEDURE PrintRegister (r : Register); 61 | PROCEDURE PrintRelSymb (r : CgBase.RelSymb); 62 | PROCEDURE PrintMemAdr (am : MemAdr); 63 | PROCEDURE PrintAdrMode (am : AdrMode); 64 | 65 | 66 | END Prints. 67 | -------------------------------------------------------------------------------- /ver1807/src/RegAlloc.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE RegAlloc; 18 | 19 | (* ************************************************************************ * 20 | * This module was generated by BEG V1.84 * 21 | * ************************************************************************ *) 22 | 23 | FROM IR IMPORT Expression; 24 | FROM IR IMPORT MaxPscArity, Register, RegisterSet, MaxScratch; 25 | IMPORT IR; 26 | 27 | (*++++++ start insertion IpTypes ++++++*) 28 | 29 | IMPORT CgBase; 30 | FROM Strings IMPORT String; 31 | 32 | 33 | (*------ end insertion IpTypes ------*) 34 | (******* empty insertion IpRegAlloc_d *******) 35 | 36 | TYPE Action = (aLr, aRestore); 37 | Spilllocation = CARDINAL; 38 | AllocIndex = [1..4096]; 39 | AllocDescr = RECORD 40 | reg : Register; 41 | actionafter : BOOLEAN; (* he 08/91 *) 42 | spilllocation : Spilllocation; 43 | regmove : Register; (* he 08/91 *) 44 | op : ARRAY [1..MaxPscArity] OF Register; 45 | scr : ARRAY [1..MaxScratch] OF Register; 46 | num : [0..MaxPscArity]; 47 | a : ARRAY [1..MaxPscArity] OF RECORD 48 | CASE action : Action OF 49 | | aLr : regto, regfrom : Register; 50 | | aRestore: reg : Register; 51 | spilllocation : Spilllocation; 52 | END; 53 | END; 54 | END; 55 | VAR ai : AllocIndex; 56 | allocation : ARRAY AllocIndex OF AllocDescr; 57 | UsedReg : RegisterSet; 58 | 59 | PROCEDURE RegAllo ( e : Expression; av : RegisterSet ); 60 | 61 | PROCEDURE PrintAllocation (i : AllocIndex); 62 | END RegAlloc. 63 | -------------------------------------------------------------------------------- /ver1807/src/SuAlloc.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE SuAlloc; 18 | 19 | FROM SYSTEM IMPORT 20 | ADDRESS; 21 | 22 | PROCEDURE ALLOCATE 23 | (VAR a : ADDRESS; 24 | n : LONGCARD); 25 | (* Substitution procedure for 'NEW'. 26 | Allocate 'n' bytes and return in 'a' a pointer 27 | to that storage region. *) 28 | 29 | PROCEDURE InitAlloc; 30 | (* Initialize. 31 | May be called more than once in a single run, 32 | in this case the storage used by preceding allocations 33 | is reused. *) 34 | 35 | END SuAlloc. 36 | -------------------------------------------------------------------------------- /ver1807/src/SuAlloc.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | IMPLEMENTATION MODULE SuAlloc; 18 | 19 | FROM SYSTEM IMPORT ADDRESS; 20 | FROM MemPools IMPORT MemPool, NewPool, PoolAllocate, KillPool; 21 | 22 | VAR 23 | pool: MemPool; 24 | 25 | PROCEDURE ALLOCATE (VAR ptr : ADDRESS; size : LONGCARD); 26 | BEGIN 27 | PoolAllocate(pool, ptr, size); 28 | END ALLOCATE; 29 | 30 | PROCEDURE InitAlloc; 31 | BEGIN 32 | KillPool(pool); 33 | NewPool(pool); 34 | END InitAlloc; 35 | 36 | BEGIN 37 | NewPool(pool); 38 | END SuAlloc. 39 | -------------------------------------------------------------------------------- /ver1807/src/SuAlloc2.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE SuAlloc2; 18 | 19 | FROM SYSTEM IMPORT 20 | ADDRESS; 21 | 22 | PROCEDURE ALLOCATE 23 | (VAR a : ADDRESS; 24 | n : LONGCARD); 25 | (* Substitution procedure for 'NEW'. 26 | Allocate 'n' bytes and return in 'a' a pointer 27 | to that storage region. *) 28 | 29 | PROCEDURE InitAlloc2; 30 | (* Initialize. 31 | May be called more than once in a single run, 32 | in this case the storage used by preceding allocations 33 | is reused. *) 34 | 35 | END SuAlloc2. 36 | -------------------------------------------------------------------------------- /ver1807/src/SuAlloc2.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | IMPLEMENTATION MODULE SuAlloc2; 18 | 19 | FROM SYSTEM IMPORT ADDRESS; 20 | FROM MemPools IMPORT MemPool, NewPool, PoolAllocate, KillPool; 21 | 22 | VAR 23 | pool: MemPool; 24 | 25 | PROCEDURE ALLOCATE (VAR ptr : ADDRESS; size : LONGCARD); 26 | BEGIN 27 | PoolAllocate(pool, ptr, size); 28 | END ALLOCATE; 29 | 30 | PROCEDURE InitAlloc2; 31 | BEGIN 32 | KillPool(pool); 33 | NewPool(pool); 34 | END InitAlloc2; 35 | 36 | BEGIN 37 | NewPool(pool); 38 | END SuAlloc2. 39 | -------------------------------------------------------------------------------- /ver1807/src/SuAlloc3.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE SuAlloc3; 18 | 19 | FROM SYSTEM IMPORT 20 | ADDRESS; 21 | 22 | PROCEDURE ALLOCATE 23 | (VAR a : ADDRESS; 24 | n : LONGCARD); 25 | (* Substitution procedure for 'NEW'. 26 | Allocate 'n' bytes and return in 'a' a pointer 27 | to that storage region. *) 28 | 29 | PROCEDURE InitAlloc3; 30 | (* Initialize. 31 | May be called more than once in a single run, 32 | in this case the storage used by preceding allocations 33 | is reused. *) 34 | 35 | END SuAlloc3. 36 | -------------------------------------------------------------------------------- /ver1807/src/SuAlloc3.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | IMPLEMENTATION MODULE SuAlloc3; 18 | 19 | FROM SYSTEM IMPORT ADDRESS; 20 | FROM MemPools IMPORT MemPool, NewPool, PoolAllocate, KillPool; 21 | 22 | VAR 23 | pool: MemPool; 24 | 25 | PROCEDURE ALLOCATE (VAR ptr : ADDRESS; size : LONGCARD); 26 | BEGIN 27 | PoolAllocate(pool, ptr, size); 28 | END ALLOCATE; 29 | 30 | PROCEDURE InitAlloc3; 31 | BEGIN 32 | KillPool(pool); 33 | NewPool(pool); 34 | END InitAlloc3; 35 | 36 | BEGIN 37 | NewPool(pool); 38 | END SuAlloc3. 39 | -------------------------------------------------------------------------------- /ver1807/src/SuBase.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE SuBase; 18 | 19 | FROM ByteIO IMPORT 20 | File; 21 | 22 | FROM Strings IMPORT 23 | String; 24 | 25 | 26 | CONST 27 | MaxOptions = 31; 28 | MaxVariants = 10; 29 | 30 | 31 | TYPE 32 | Mode = ( CompileDefMode, CompileImpMode, BindMode, InteractiveMode ); 33 | 34 | FileKind = 35 | ( KindSourceFile, KindObjectFile, KindErrorFile, KindCodeFile, 36 | KindRelocFile, KindDefFile, KindDebugFile, KindMapFile, 37 | KindDepFile, KindAssemblerSourceFile ); 38 | (* Note: Transputer executable files have suffix "exe". Use 39 | procedure BuildLibraryFileName to compose .exe filenames. *) 40 | 41 | FileName = ARRAY [0..255] OF CHAR; 42 | 43 | CompUnitClass = 44 | ( DefinitionModuleClass, ImplementationModuleClass, ProgramModuleClass, 45 | ForeignModuleClass, ErrorModuleClass ); 46 | 47 | TimeStampType = LONGINT; 48 | 49 | OptionSet = SET OF [0..MaxOptions]; 50 | 51 | 52 | VAR 53 | NameOfSourceFile : FileName; 54 | ThisCompUnitClass : CompUnitClass; 55 | TimeStampNull : TimeStampType; 56 | CurrentTimeStamp : TimeStampType; 57 | GlobalOptions : OptionSet; 58 | CurOptions : OptionSet; 59 | IndexCheckOption, SubrangeCheckOption : CARDINAL; 60 | DebugOption : CARDINAL; (* he 2/90 *) 61 | ModeSpec : Mode; 62 | NameOfModule : String; 63 | LibraryDirectory : String; (* he 2/90 *) 64 | Libraries : POINTER TO ARRAY [0..65000] OF CHAR; (* ms 5/90 *) 65 | BindScript : String; 66 | EditScript : String; 67 | ListerScript : String; 68 | AssemblerScript : String; 69 | 70 | 71 | PROCEDURE SystemCommand ( VAR command : ARRAY OF CHAR; VAR success : BOOLEAN ); 72 | (* Fork a shell executing 'command'. Status passed back in success. *) 73 | 74 | 75 | PROCEDURE Blip; 76 | (* Called whenever a block is compiled (by pass one or two). 77 | Updates the procedure counter that is shown on the screen. *) 78 | 79 | 80 | PROCEDURE InitBlip ( text : ARRAY OF CHAR ); 81 | (* Initialize procedure Blip. 'text' is a string preceding the counter. *) 82 | 83 | 84 | PROCEDURE OpenLibraryFile 85 | ( VAR moduleName : ARRAY OF CHAR; 86 | kind : FileKind; 87 | VAR file : File; 88 | VAR path : ARRAY OF CHAR; 89 | VAR success : BOOLEAN ); 90 | (* Open the file 'file' for input. 91 | The name is constructed from 'moduleName' and the suffix corresponding 92 | to 'kind'. The directories as defined by 'DefineLibraries' are 93 | inspected. On exit 'path' contains the path which has to be added 94 | to the file name in order to open the file. 95 | 'success' is TRUE if the file has been opened successfully. *) 96 | 97 | 98 | PROCEDURE BuildFileName ( kind : FileKind; VAR name : FileName ); 99 | (* Construct the name of a file according to file kind 'kind'. 100 | This procedure is used for the source file and the temporary files 101 | error, reloc and code file. On exit 'name' contains the name. *) 102 | 103 | 104 | PROCEDURE BuildLibraryFileName 105 | ( VAR moduleName : ARRAY OF CHAR; kind : FileKind; VAR name : FileName ); 106 | (* Construct the name of a library file according to module name 'ModuleName' 107 | and file kind 'kind'. On exit 'name' contains the name. *) 108 | 109 | 110 | PROCEDURE InitSuBase; 111 | (* Initialize. *) 112 | 113 | 114 | PROCEDURE DefineOption 115 | ( VAR option: CARDINAL; id: ARRAY OF CHAR; init : BOOLEAN; public : BOOLEAN ); 116 | (* he 2/90 *) 117 | PROCEDURE SetOption ( id : ARRAY OF CHAR; VAR success : BOOLEAN ); 118 | 119 | 120 | PROCEDURE Enabled ( option : CARDINAL ) : BOOLEAN; 121 | 122 | 123 | PROCEDURE ShowOptions; 124 | (* Show compiler options *) 125 | 126 | 127 | (* TO DO: Rename this procedure *) 128 | PROCEDURE ShowPublicOptions; 129 | (* show options and settings *) 130 | 131 | 132 | PROCEDURE DefineVariant ( str : ARRAY OF CHAR ); 133 | 134 | (*TO DO: Change function identifier to camelCase *) 135 | PROCEDURE DefinedVariant ( str : ARRAY OF CHAR ) : BOOLEAN; 136 | 137 | 138 | END SuBase. 139 | -------------------------------------------------------------------------------- /ver1807/src/SuErrors.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE SuErrors; 18 | 19 | TYPE 20 | 21 | SourcePosition = 22 | RECORD line : SHORTCARD; col : SHORTCARD END; 23 | 24 | 25 | VAR 26 | 27 | OK : BOOLEAN; 28 | UndefSourcePos : SourcePosition; 29 | 30 | 31 | PROCEDURE OpenErrorFile; 32 | (* Open the error message file. 33 | (aborts compiler if unsuccessfully) *) 34 | 35 | PROCEDURE CloseErrorFile; 36 | (* Close the error message file. *) 37 | 38 | PROCEDURE ERROR 39 | (VAR msg : ARRAY OF CHAR; pos : SourcePosition); 40 | (* Write an error message 'msg' for source position 'pos' 41 | onto the error file. 42 | Set 'OK' to false. *) 43 | 44 | PROCEDURE ErrorMsgWithId 45 | (VAR msg : ARRAY OF CHAR; VAR id: ARRAY OF CHAR; pos : SourcePosition); 46 | (* Write an error message 'msg' for source position 'pos' 47 | onto the error file. 48 | If 'msg' contains a "@", this is subtituted by 'id'. 49 | Set 'OK' to false. *) 50 | 51 | PROCEDURE CompilerError 52 | (VAR msg : ARRAY OF CHAR); 53 | (* Emit 'msg' and abort. *) 54 | 55 | PROCEDURE Assert(cond: BOOLEAN) ; 56 | (* Abort if 'cond' is FALSE *) 57 | 58 | PROCEDURE ErrorReport; 59 | (* Write sorted error messages *) 60 | 61 | PROCEDURE InitErrorMsg; 62 | (* Initialize. *) 63 | 64 | END SuErrors. 65 | -------------------------------------------------------------------------------- /ver1807/src/SuErrors.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | IMPLEMENTATION MODULE SuErrors; 18 | 19 | FROM SuBase IMPORT 20 | DefineOption, Enabled, 21 | CurOptions, FileName, FileKind, BuildFileName; 22 | FROM InOut IMPORT WriteString, WriteCard, Write, WriteLn; 23 | FROM ByteIO IMPORT 24 | File, GetByte, PutByte, 25 | OpenInput, OpenOutput, Close, Done, EOF; 26 | 27 | VAR 28 | ErrorFile : File; 29 | ErrorFileIsOpen : BOOLEAN; 30 | BlipCount : SHORTCARD; 31 | BlipOn : BOOLEAN; 32 | 33 | PROCEDURE InitErrorMsg; 34 | BEGIN 35 | OK := TRUE; 36 | UndefSourcePos.line := 1; UndefSourcePos.col := 1; 37 | ErrorFileIsOpen := FALSE 38 | END InitErrorMsg; 39 | 40 | PROCEDURE OpenErrorFile; 41 | BEGIN 42 | (* Error file is open only if something is written to the file *) 43 | END OpenErrorFile; 44 | 45 | PROCEDURE OpenError; 46 | VAR ErrorFileName: FileName; 47 | BEGIN 48 | BuildFileName (KindErrorFile, ErrorFileName); 49 | OpenOutput (ErrorFile, ErrorFileName); 50 | IF NOT Done() THEN 51 | WriteLn; 52 | WriteString ("CANNOT WRITE FILE '"); 53 | WriteString (ErrorFileName); 54 | WriteString ("'. COMPILATION ABORTED."); 55 | WriteLn; 56 | HALT; 57 | ELSE ErrorFileIsOpen := TRUE 58 | END; 59 | END OpenError; 60 | 61 | PROCEDURE CloseErrorFile; 62 | BEGIN 63 | IF ErrorFileIsOpen 64 | THEN Close (ErrorFile); 65 | ErrorFileIsOpen := FALSE 66 | END 67 | END CloseErrorFile; 68 | 69 | PROCEDURE PutDecimal (n: SHORTCARD); 70 | VAR last, butlast: CARDINAL; 71 | BEGIN 72 | last := n MOD 10; butlast:= n DIV 10; 73 | IF butlast > 0 THEN PutDecimal(butlast) END; 74 | PutByte(ErrorFile, CHR(ORD("0")+last) ); 75 | END PutDecimal; 76 | 77 | PROCEDURE GetDecimal (VAR n: SHORTCARD); 78 | VAR ch: CHAR; 79 | BEGIN 80 | n := 0; 81 | LOOP 82 | GetByte(ErrorFile, ch); 83 | IF EOF(ErrorFile) THEN 84 | EXIT 85 | END; 86 | IF (ch < '0') OR (ch > '9') THEN 87 | EXIT 88 | END; 89 | n := n * 10 + (ORD(ch) - ORD('0')); 90 | END; 91 | END GetDecimal; 92 | 93 | PROCEDURE ERROR (VAR msg : ARRAY OF CHAR; pos : SourcePosition); 94 | VAR i, high: SHORTCARD; 95 | BEGIN 96 | IF NOT ErrorFileIsOpen THEN OpenError END; 97 | PutDecimal (pos.line); PutByte(ErrorFile, ","); 98 | PutDecimal (pos.col); PutByte(ErrorFile, " "); 99 | i := 0; high := HIGH(msg); 100 | WHILE (i <= high) AND (msg[i] <> 0C) DO 101 | PutByte(ErrorFile, msg[i]); INC(i); 102 | END; 103 | PutByte (ErrorFile, 12C); 104 | OK := FALSE; 105 | END ERROR; 106 | 107 | PROCEDURE ErrorMsgWithId 108 | (VAR msg : ARRAY OF CHAR; VAR id : ARRAY OF CHAR; pos : SourcePosition); 109 | (* print a message msg=@ as *) 110 | VAR 111 | text: ARRAY [0..100] OF CHAR; 112 | textpos,msgpos,idpos,msghigh : SHORTCARD; 113 | BEGIN 114 | textpos := 0; msgpos := 0; idpos := 0; msghigh := HIGH(msg); 115 | WHILE (msg[msgpos] <> '@') DO 116 | text[textpos] := msg[msgpos]; INC(textpos); INC(msgpos); 117 | END; 118 | INC(msgpos); (* skip '@' *) 119 | WHILE id[idpos] <> 0C DO 120 | text[textpos] := id[idpos]; INC(textpos); INC(idpos); 121 | END; 122 | WHILE (msgpos <= msghigh) AND (msg[msgpos] <> 0C) DO 123 | text[textpos] := msg[msgpos]; INC(textpos); INC(msgpos); 124 | END; 125 | text[textpos] := 0C; 126 | ERROR (text, pos); 127 | END ErrorMsgWithId; 128 | 129 | 130 | PROCEDURE Assert (cond : BOOLEAN); 131 | BEGIN 132 | IF NOT cond THEN CompilerError("assert: condition violated") END; 133 | END Assert; 134 | 135 | PROCEDURE CompilerError (VAR msg : ARRAY OF CHAR); 136 | VAR x: SHORTCARD; 137 | BEGIN 138 | WriteLn; 139 | WriteString("COMPILER ERROR. COMPILATION ABORTED."); 140 | WriteLn; 141 | WriteString("["); 142 | WriteString(msg); 143 | WriteString("]"); 144 | WriteLn; 145 | x := 0; 146 | x := x DIV x; 147 | HALT 148 | END CompilerError; 149 | 150 | PROCEDURE ErrorReport; 151 | CONST 152 | errtabmax = 500; 153 | stringtabmax = 20000; 154 | VAR 155 | stringtab: ARRAY [1..stringtabmax] OF CHAR; 156 | stringtablast: SHORTCARD; 157 | errtab: ARRAY [0..errtabmax] OF RECORD line, col, pos: SHORTCARD END; 158 | errtablast: SHORTCARD; 159 | ErrorFileName, SourceFileName: FileName; 160 | 161 | PROCEDURE ReadMsgs; 162 | VAR line, col: SHORTCARD; ch: CHAR; 163 | 164 | PROCEDURE EnterMsg (line, col, pos: SHORTCARD); 165 | VAR i, k: SHORTCARD; 166 | BEGIN 167 | (* there is always at least one (dummy) entry *) 168 | i := errtablast; 169 | WHILE (errtab[i].line > line) 170 | OR ((errtab[i].line = line) AND (errtab[i].col > col)) DO 171 | DEC(i); 172 | END; 173 | (* insert after pos 'i' *) 174 | FOR k := errtablast TO i+1 BY -1 DO errtab[k+1] := errtab[k] END; 175 | errtab[i+1].line := line; errtab[i+1].col := col; 176 | errtab[i+1].pos := pos; 177 | INC (errtablast); 178 | END EnterMsg; 179 | 180 | BEGIN 181 | LOOP 182 | IF (errtablast=errtabmax) OR (stringtablast+100>stringtabmax) THEN 183 | EXIT 184 | END; 185 | GetDecimal(line); 186 | IF EOF(ErrorFile) THEN EXIT END; 187 | GetDecimal(col); 188 | EnterMsg (line, col, stringtablast+1); 189 | LOOP 190 | GetByte(ErrorFile, ch); 191 | INC(stringtablast); 192 | stringtab[stringtablast] := ch; 193 | IF ch = 12C THEN EXIT END; 194 | END; 195 | END; 196 | END ReadMsgs; 197 | 198 | PROCEDURE PrintMsgs; 199 | VAR i, k: SHORTCARD; 200 | BEGIN 201 | FOR i := 1 TO errtablast DO 202 | WriteCard(errtab[i].line,1); Write(','); 203 | WriteCard(errtab[i].col,1); WriteString(': '); 204 | k := errtab[i].pos; 205 | WHILE stringtab[k] <> 12C DO 206 | Write(stringtab[k]); INC(k); 207 | END; 208 | WriteLn; 209 | END; 210 | END PrintMsgs; 211 | 212 | BEGIN 213 | IF NOT OK THEN 214 | BuildFileName (KindErrorFile, ErrorFileName); 215 | OpenInput (ErrorFile, ErrorFileName); 216 | IF NOT Done() THEN 217 | WriteString ("Cannot read error message file."); WriteLn; RETURN; 218 | END; 219 | stringtablast := 0; errtablast := 0; 220 | errtab[0].line := 0; errtab[0].col := 0; errtab[0].pos := 0; 221 | ReadMsgs; PrintMsgs; 222 | Close (ErrorFile); 223 | END; 224 | END ErrorReport; 225 | 226 | BEGIN 227 | ErrorFileIsOpen := FALSE 228 | END SuErrors. 229 | -------------------------------------------------------------------------------- /ver1807/src/SuTokens.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE SuTokens; 18 | 19 | FROM SYSTEM IMPORT 20 | ADDRESS; 21 | FROM SuErrors IMPORT 22 | SourcePosition; 23 | FROM SuValues IMPORT 24 | Value; 25 | 26 | 27 | TYPE 28 | 29 | Symbol = ( 30 | 31 | AndSym, ArraySym, 32 | BeginSym, BySym, 33 | CaseSym, ConstSym, 34 | DefinitionSym, DivSym, DoSym, 35 | ElseSym, ElsifSym, EndSym, ExitSym, ExportSym, 36 | ForSym, FromSym, 37 | IfSym, ImplementationSym, ImportSym, InSym, 38 | LoopSym, 39 | ModSym, ModuleSym, 40 | NotSym, 41 | OfSym, OrSym, 42 | PointerSym, ProcedureSym, 43 | QualifiedSym, 44 | RecordSym, RepeatSym, ReturnSym, 45 | SetSym, StringSym, 46 | ThenSym, ToSym, TypeSym, 47 | UntilSym, 48 | VarSym, 49 | WhileSym, WithSym, 50 | 51 | LeftparSym, (* ) *) 52 | RightparSym, (* ) *) 53 | MulopSym, (* * *) 54 | PlusSym, (* + *) 55 | CommaSym, (* , *) 56 | MinusSym, (* - *) 57 | PointSym, RangeSym, (* . .. *) 58 | RealDivSym, NotEqualSym, (* / /= *) 59 | ColonSym, BecomesSym, (* : := *) 60 | SemicolonSym, (* ; *) 61 | LessSym, LessEqualSym, (* < <= <> *) 62 | EqualSym, (* = *) 63 | GreaterSym, GreaterEqualSym, (* > >= *) 64 | LeftBrackSym, (* [ *) 65 | RightBrackSym, (* ] *) 66 | RefSym, (* ^ *) 67 | LeftSetBrackSym, (* { *) 68 | CaseSepSym, (* | *) 69 | RightSetBrackSym, (* } *) 70 | 71 | OptionSym, 72 | IdentSym, 73 | IntConstSym, 74 | RealConstSym, 75 | StringConstSym, 76 | CharConstSym, 77 | EofSym, 78 | ErrorSym); 79 | 80 | Ident = 81 | POINTER TO IdentDescription; 82 | (* should be opaque, but than "=" cannot be used *) 83 | 84 | IdentRepresentation = 85 | POINTER TO CHAR; 86 | 87 | IdentDescription = 88 | RECORD 89 | ReprStart : IdentRepresentation; 90 | ReprLength : SHORTCARD; 91 | object : ADDRESS (* Place holder for DfTable.Object *); 92 | CollisionList : Ident; 93 | sym : Symbol; 94 | END; 95 | 96 | IdentList = POINTER TO IdentListElem; 97 | 98 | IdentListElem = 99 | RECORD 100 | ident : Ident; 101 | pos : SourcePosition; 102 | next : IdentList; 103 | END; 104 | 105 | 106 | VAR 107 | 108 | CurSym : Symbol; 109 | (* Class of last symbol recognized by GetSym. *) 110 | 111 | CurPos : SourcePosition; 112 | (* Source Position of CurPos. *) 113 | 114 | CurValue : Value; 115 | (* Value of CurPos 116 | - defined if CurSym IN [IntConstSym,RealConstSym,StringConstSym]. *) 117 | 118 | CurIdent : Ident; 119 | (* Ident represented by CurSym 120 | - defined if CurSym=IdentSym. *) 121 | 122 | ErrorIdent : Ident; 123 | (* Error identifier, ''. *) 124 | 125 | 126 | PROCEDURE GetSym; 127 | (* Advances to next token in input stream. 128 | The attributes of this token are stored in 129 | CurSym, CurPos, CurVal, CurIdent. *) 130 | 131 | (* ++ rh ++ *) (* 90/06/05 *) 132 | PROCEDURE ReadFirstLine; 133 | (* Reads first line of source file - to be called before first call 134 | of GetSym *) 135 | 136 | PROCEDURE CloseSourceFile; 137 | (* Close source file 138 | (To be called only if not all tokens -including eof- will be read.) *) 139 | 140 | PROCEDURE GetIdentRepr 141 | ( id : Ident; 142 | VAR str : ARRAY OF CHAR); 143 | (* str := representation of id. *) 144 | 145 | PROCEDURE CreateIdent 146 | (VAR id : Ident; 147 | VAR str : ARRAY OF CHAR); 148 | (* id := ident representing str *) 149 | 150 | PROCEDURE CreateIdentFromBuffer 151 | (VAR id : Ident; 152 | VAR buf : ARRAY OF CHAR; 153 | high : SHORTCARD); 154 | (* buf[0..high] contains the representation of an identifier. 155 | Return in id the corresponding Ident. *) 156 | 157 | PROCEDURE PutAssoc 158 | (id : Ident; 159 | assoc : ADDRESS); 160 | (* Associate assoc with identifier id. *) 161 | 162 | PROCEDURE GetAssoc 163 | (id : Ident; 164 | VAR assoc : ADDRESS); 165 | (* Return in assoc the current association of identifier id. *) 166 | 167 | PROCEDURE InitTokens; 168 | (* Initialize. *) 169 | 170 | END SuTokens. 171 | -------------------------------------------------------------------------------- /ver1807/src/SuTree.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | IMPLEMENTATION MODULE SuTree; 18 | 19 | FROM SYSTEM IMPORT 20 | TSIZE; 21 | FROM SuAlloc IMPORT 22 | ALLOCATE; 23 | FROM SuErrors IMPORT 24 | CompilerError, SourcePosition; 25 | FROM SuValues IMPORT 26 | Value; 27 | FROM SuTokens IMPORT 28 | Ident; 29 | 30 | TYPE 31 | 32 | (* 33 | The following types are variants of type 'NodeDescription'. 34 | The are used only do obtain the size when allocating the corresponding 35 | variant. 36 | 37 | variant MUST BE OF TYPE CARDIAL! 38 | 39 | This assures, that all variants have alignment 8. Then compilers like 40 | gcc [when source is mtc-ed] choose the same alignment for kind in 41 | NodeDescription0 and in NodeDescription1. 42 | *) 43 | 44 | NodeDescription0 = 45 | RECORD 46 | pos : SourcePosition; 47 | CASE variant : CARDINAL OF 48 | 0 : 49 | kind : NodeKind; 50 | END 51 | END; 52 | 53 | NodeDescription1 = 54 | RECORD 55 | pos : SourcePosition; 56 | CASE variant : CARDINAL OF 57 | 1 : 58 | kind : NodeKind; 59 | Son1 : Node; 60 | END 61 | END; 62 | 63 | NodeDescription2 = 64 | RECORD 65 | pos : SourcePosition; 66 | CASE variant : CARDINAL OF 67 | 2 : 68 | kind : NodeKind; 69 | Son1, Son2 : Node; 70 | END 71 | END; 72 | 73 | NodeDescription3 = 74 | RECORD 75 | pos : SourcePosition; 76 | CASE variant : CARDINAL OF 77 | 3 : 78 | kind : NodeKind; 79 | Son1, Son2, Son3 : Node; 80 | END 81 | END; 82 | 83 | NodeDescription4 = 84 | RECORD 85 | pos : SourcePosition; 86 | CASE variant : CARDINAL OF 87 | 4 : 88 | kind : NodeKind; 89 | Son1, Son2, Son3, Son4 : Node; 90 | END 91 | END; 92 | 93 | NodeDescription5 = 94 | RECORD 95 | pos : SourcePosition; 96 | CASE variant : CARDINAL OF 97 | 5 : 98 | kind : NodeKind; 99 | Son1, Son2, Son3, Son4, Son5 : Node; 100 | END 101 | END; 102 | 103 | NodeDescription6 = 104 | RECORD 105 | pos : SourcePosition; 106 | CASE variant : CARDINAL OF 107 | 6 : 108 | ident : Ident; 109 | END 110 | END; 111 | 112 | NodeDescription7 = 113 | RECORD 114 | pos : SourcePosition; 115 | CASE variant : CARDINAL OF 116 | 7 : 117 | value : Value; 118 | END 119 | END; 120 | 121 | PROCEDURE PutIdent (xpos : SourcePosition; xident : Ident; VAR node : Node); 122 | BEGIN 123 | ALLOCATE (node, TSIZE(NodeDescription6)); 124 | 125 | WITH node^ DO 126 | pos := xpos; 127 | ident := xident; 128 | END; 129 | END PutIdent; 130 | 131 | PROCEDURE PutValue (xpos : SourcePosition; xvalue : Value; VAR node : Node); 132 | BEGIN 133 | ALLOCATE (node, TSIZE(NodeDescription7)); 134 | WITH node^ DO 135 | pos := xpos; 136 | value := xvalue; 137 | END; 138 | END PutValue; 139 | 140 | PROCEDURE GetIdent (node : Node; VAR xpos : SourcePosition; VAR xident : Ident); 141 | BEGIN 142 | WITH node^ DO 143 | xpos := pos; 144 | xident := ident; 145 | END; 146 | END GetIdent; 147 | 148 | PROCEDURE GetValue (node : Node; VAR xpos : SourcePosition; VAR xvalue : Value); 149 | BEGIN 150 | WITH node^ DO 151 | xpos := pos; 152 | xvalue := value; 153 | END; 154 | END GetValue; 155 | 156 | PROCEDURE put0 (xkind : NodeKind; xpos : SourcePosition; 157 | VAR father : Node); 158 | BEGIN 159 | ALLOCATE (father, TSIZE(NodeDescription0)); 160 | WITH father^ DO 161 | pos := xpos; 162 | kind := xkind; 163 | END; 164 | END put0; 165 | 166 | PROCEDURE put1 (xkind : NodeKind; xpos : SourcePosition; 167 | son1 : Node; VAR father : Node); 168 | BEGIN 169 | ALLOCATE (father, TSIZE(NodeDescription1)); 170 | WITH father^ DO 171 | pos := xpos; 172 | kind := xkind; 173 | Son1 := son1; 174 | END; 175 | END put1; 176 | 177 | PROCEDURE put2 (xkind : NodeKind; xpos : SourcePosition; 178 | son1, son2 : Node; VAR father : Node); 179 | BEGIN 180 | ALLOCATE (father, TSIZE(NodeDescription2)); 181 | WITH father^ DO 182 | pos := xpos; 183 | kind := xkind; 184 | Son1 := son1; 185 | Son2 := son2; 186 | END; 187 | END put2; 188 | 189 | PROCEDURE put3 (xkind : NodeKind; xpos : SourcePosition; 190 | son1, son2, son3 : Node; VAR father : Node); 191 | BEGIN 192 | ALLOCATE (father, TSIZE(NodeDescription3)); 193 | WITH father^ DO 194 | pos := xpos; 195 | kind := xkind; 196 | Son1 := son1; 197 | Son2 := son2; 198 | Son3 := son3; 199 | END; 200 | END put3; 201 | 202 | PROCEDURE put4 (xkind : NodeKind; xpos : SourcePosition; 203 | son1, son2, son3, son4 : Node; VAR father : Node); 204 | BEGIN 205 | ALLOCATE (father, TSIZE(NodeDescription4)); 206 | WITH father^ DO 207 | pos := xpos; 208 | kind := xkind; 209 | Son1 := son1; 210 | Son2 := son2; 211 | Son3 := son3; 212 | Son4 := son4; 213 | END; 214 | END put4; 215 | 216 | PROCEDURE put5 (xkind : NodeKind; xpos : SourcePosition; 217 | son1, son2, son3, son4, son5 : Node; VAR father : Node); 218 | BEGIN 219 | ALLOCATE (father, TSIZE(NodeDescription5)); 220 | WITH father^ DO 221 | pos := xpos; 222 | kind := xkind; 223 | Son1 := son1; 224 | Son2 := son2; 225 | Son3 := son3; 226 | Son4 := son4; 227 | Son5 := son5; 228 | END; 229 | END put5; 230 | 231 | PROCEDURE append (list : Node; item : Node); 232 | 233 | BEGIN 234 | list^.Son2 := item 235 | END append; 236 | 237 | PROCEDURE get1 (father : Node; VAR son1 : Node); 238 | BEGIN 239 | WITH father^ DO 240 | son1 := Son1; 241 | END; 242 | END get1; 243 | 244 | PROCEDURE get2 (father : Node; VAR son1, son2 : Node); 245 | BEGIN 246 | WITH father^ DO 247 | son1 := Son1; 248 | son2 := Son2; 249 | END; 250 | END get2; 251 | 252 | PROCEDURE get3 (father : Node; VAR son1, son2, son3 : Node); 253 | BEGIN 254 | WITH father^ DO 255 | son1 := Son1; 256 | son2 := Son2; 257 | son3 := Son3; 258 | END; 259 | END get3; 260 | 261 | PROCEDURE get4 (father : Node; VAR son1, son2, son3, son4 : Node); 262 | BEGIN 263 | WITH father^ DO 264 | son1 := Son1; 265 | son2 := Son2; 266 | son3 := Son3; 267 | son4 := Son4; 268 | END; 269 | END get4; 270 | 271 | PROCEDURE get5 (father : Node; VAR son1, son2, son3, son4, son5 : Node); 272 | BEGIN 273 | WITH father^ DO 274 | son1 := Son1; 275 | son2 := Son2; 276 | son3 := Son3; 277 | son4 := Son4; 278 | son5 := Son5; 279 | END; 280 | END get5; 281 | 282 | PROCEDURE get (father : Node; VAR xkind : NodeKind; VAR xpos : SourcePosition); 283 | BEGIN 284 | WITH father^ DO 285 | xkind := kind; 286 | xpos := pos; 287 | END; 288 | END get; 289 | 290 | END SuTree. 291 | -------------------------------------------------------------------------------- /ver1807/src/TrCompat.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE TrCompat; 18 | 19 | FROM SuErrors IMPORT 20 | SourcePosition; 21 | FROM DfTable IMPORT 22 | Type, FormalParam; 23 | FROM TrBase IMPORT 24 | Attributes; 25 | 26 | 27 | PROCEDURE Compatible 28 | (type1, type2 : Type; 29 | EmitErrorMessage : BOOLEAN; 30 | pos : SourcePosition 31 | ) : BOOLEAN; 32 | (* Returns TRUE, if 'type1' and 'type2' are compatible, otherwise 33 | an error message is emitted at 'pos' (if 'EmitErrorMessage'). *) 34 | 35 | PROCEDURE AssignCompatible 36 | (lhs : Type; 37 | rhs : Attributes; 38 | EmitErrorMessage : BOOLEAN; 39 | AssignmentPos : SourcePosition 40 | ) : BOOLEAN; 41 | (* Returns TRUE, if 'rhs' is assignment compatible with 'lhs' 42 | (or 'lhs' denotes an errorneous expression), otherwise 43 | an error message is emitted at 'AssignmentPos' (if 'EmitErrorMessage'). *) 44 | 45 | PROCEDURE ValueParamCompatible 46 | (FormalParameter : Type; 47 | ActualParameter : Attributes; 48 | EmitErrorMessage : BOOLEAN; 49 | ProcPos : SourcePosition 50 | ) : BOOLEAN; 51 | (* Returns TRUE, if 'ActualParameter' is permissible on value 52 | 'FormalParameter' position (or FormalParameter or ActualParameter is 53 | erroneous), otherwise 54 | an error message is emitted at 'ProcPos' (if 'EmitErrorMessage'). *) 55 | 56 | PROCEDURE VarParamCompatible 57 | (FormalParameter : Type; 58 | ActualParameter : Attributes; 59 | EmitErrorMessage : BOOLEAN; 60 | ProcPos : SourcePosition ) : BOOLEAN; 61 | (* Returns TRUE, if 'ActualParameter' is permissible on VAR 'FormalParameter' 62 | position, otherwise 63 | an error message is emitted at 'ProcPos' (if 'EmitErrorMessage'). *) 64 | 65 | PROCEDURE InitTrCompat; 66 | (* Initializes module TrCompat. *) 67 | 68 | END TrCompat. 69 | -------------------------------------------------------------------------------- /ver1807/src/TrDesig.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE TrDesig; 18 | 19 | FROM SuTree IMPORT 20 | Node; 21 | FROM DfTable IMPORT 22 | Object; 23 | FROM TrBase IMPORT 24 | Attributes; 25 | 26 | FROM CgMobil IMPORT 27 | AddressOperand; 28 | 29 | 30 | PROCEDURE OpenArrayHighField 31 | ( DescrOffset : LONGINT; 32 | DefiningProcedure : Object; 33 | VAR high : AddressOperand); 34 | (* Computes the access to the high field of the open array with descriptor 35 | offset 'DescrOffset' and defining procedure 'DefiningProcedure'. *) 36 | 37 | PROCEDURE ClassDesignator 38 | ( des : Node; 39 | VAR result : Attributes ); 40 | (* Analyses and transforms an SuTree subtree that corresponds 41 | to a designator. 'des' is the root of the subtree. *) 42 | 43 | PROCEDURE InitTrDesig; 44 | (* Initializes module TrDesig. *) 45 | 46 | END TrDesig. 47 | -------------------------------------------------------------------------------- /ver1807/src/TrExpr.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE TrExpr; 18 | 19 | FROM SuTree IMPORT 20 | Node; 21 | FROM TrBase IMPORT 22 | Attributes, BooleanLabels; 23 | 24 | PROCEDURE ClassExpression 25 | ( node : Node; 26 | VAR result : Attributes); 27 | (* Analyses and transforms a SuTree subtree that corresponds 28 | to an expression. 'node' is the root of the subtree. *) 29 | 30 | PROCEDURE Condition 31 | (cond : Node; 32 | BLabels : BooleanLabels ); 33 | (* Analyses and transforms a SuTree subtree that corresponds 34 | to a condition. 'node' is the root of the subtree. 35 | The boolean expression 'cond' is translated in such a way that control 36 | passes to 'BLabels.trueLabel' ('BLabels.falseLabel' resp.) when 'cond' 37 | evaluates to TRUE (FALSE resp.). *) 38 | 39 | PROCEDURE InitTrExpr; 40 | (* Initializes module TrExpr. *) 41 | 42 | END TrExpr. 43 | -------------------------------------------------------------------------------- /ver1807/src/TrParam.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE TrParam; 18 | 19 | FROM SuTree IMPORT 20 | Node; 21 | FROM DfTable IMPORT 22 | Object, FormalParam; 23 | FROM TrBase IMPORT 24 | Attributes, tpParNum; 25 | 26 | 27 | PROCEDURE ClassExpressionlist 28 | ( ExprList : (* in *) Node; 29 | ProcAttr : (* in *) Attributes; 30 | FormPar : (* in *) FormalParam; 31 | VAR ParNum : (* inout *) tpParNum; 32 | VAR FirstParAttr : (* out *) Attributes; 33 | VAR ParListOK : (* out *) BOOLEAN ); 34 | 35 | (* Anlyses and transforms a SuTree subtree 36 | that corresponds to a parameter list. 37 | 38 | 'ExprList' denotes the root of the parameter list. 39 | 40 | 'ProcAttr' is the corresponding procedure, function, standard procedure 41 | or type identifier. If 'ProcAttr' describes a procedure or 42 | function, the parameters are passed. If 'ProcAttr' describes 43 | a standard procedure, the parameters are processed by module 44 | TrStProc. If 'ProcAttr' describes a type identifier, the 45 | argument of the type transfer is returned in 'FirstParAttr'. 46 | 47 | 'FormPar' denotes the formal parameter, if 'ProcAttr' describes a 48 | procedure or function, otherwise 'FormPar' is undefined. 49 | 50 | 'ParNum' gives the number of the current actual parameter 51 | to be processed 52 | (on entry) or the total number of actual parameters in the 53 | parameter list for 'ProcAttr' (on exit). 54 | 55 | 'FirstParAttr' returns the argument of the type transfer, if 'ProcAttr' 56 | describes a type identifier. 57 | 58 | 'ParListOK' returns whether actual parameter list of 'ProcAttr' 59 | was correct. *) 60 | 61 | PROCEDURE InitTrParam; 62 | (* Initialises module TrParam. *) 63 | 64 | END TrParam. 65 | -------------------------------------------------------------------------------- /ver1807/src/TrSets.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE TrSets; 18 | 19 | FROM SuTree IMPORT 20 | Node; 21 | FROM DfTable IMPORT 22 | Type; 23 | FROM TrBase IMPORT 24 | Attributes; 25 | 26 | 27 | PROCEDURE ClassMemberlist 28 | ( MemberListNode : Node; 29 | TypeOfSet : Type; 30 | VAR MemberListAttr : Attributes; 31 | VAR MemberListOK : BOOLEAN ); 32 | (* Processes set expressions. 33 | A set expression consists of a list of members; a member may be either 34 | a constant member (i.e. member is a constant expression or is a range 35 | with constant expressions as bounds) or a dynamic member (i.e. member 36 | is a variable or a range with at least one variable in the bound 37 | expressions). 38 | 39 | 'MemberListNode' is the root of an SuTree subtree that 40 | corresponds to a set 41 | member list. 42 | 43 | 'TypeOfSet' is the member list's corresponding set type. 44 | 45 | 'MemberListAttr' describes a set of type 'TypeOfSet' that includes the 46 | members described by 'MemberListNode'. 47 | 48 | 'MemberListOK' returns TRUE, if all set members are semantically 49 | correct (i.e. compatible with set base type). *) 50 | 51 | PROCEDURE InitTrSets; 52 | (* Initialises module TrSets. *) 53 | 54 | END TrSets. 55 | -------------------------------------------------------------------------------- /ver1807/src/TrStProc.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE TrStProc; 18 | 19 | FROM TrBase IMPORT 20 | Attributes, tpParNum; 21 | 22 | 23 | PROCEDURE StandardProc 24 | ( StandProc : (* in *) Attributes; 25 | IsPar : (* in *) BOOLEAN; 26 | ActPar : (* in *) Attributes; 27 | ParNum : (* in *) tpParNum; 28 | VAR ParamOK : (* inout *) BOOLEAN; 29 | VAR result : (* out *) Attributes ); 30 | (* Analyses the parameters of standard procedures an transforms the standard 31 | procedure call. 32 | For a standard procedure X with the parameters p1,p2,...,pn this procedure 33 | has to be called n+1 times, nameley for p1,p2,...,pn and the call itself 34 | (in this order). The n+1 st call has to take place even if the parameter 35 | list is not correct, so that the internal parameter stack can be popped. 36 | 37 | 'StandProc' denotes the standard procedure whose parameter has to be 38 | checked or code has to be generated for the call. 39 | 40 | 'IsPar' is TRUE, if a parameter of 'StandProc' has to be analysed, 41 | and FALSE, if the call has to be generated. 42 | 43 | 'ActPar' denotes the actual parameter to be analysed (if 'IsPar'). 44 | 45 | 'ParNum' gives the number of parameter 'ActPar' to be analysed 46 | (if 'IsPar'), and the total number of parameters of 47 | 'StandProc' (if not 'IsPar'). 48 | 49 | 'ParamOK' returns TRUE, if the already processed part of the actual 50 | parameter list (including 'ActPar') was correct so far 51 | (if 'IsPar'). 52 | 53 | 'result' returns the correct parameter or InitAttr, if 'IsPar'. 54 | 'result' returns the result description of the standard 55 | procedure, if 'StandProc' describes a standard procedure that 56 | is a function and not 'IsPar'. Otherwise 'result' 57 | returns 'InitAttr'. *) 58 | 59 | PROCEDURE InitTrStProc; 60 | (* Initializes module TrStProc. *) 61 | 62 | END TrStProc. 63 | -------------------------------------------------------------------------------- /ver1807/src/TrStmts.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE TrStmts; 18 | 19 | FROM DfTable IMPORT 20 | Object; 21 | FROM SuTree IMPORT 22 | Node; 23 | 24 | 25 | PROCEDURE TranslateStatementpart 26 | (object : Object; 27 | body : Node ); 28 | (* Semantic analysis and transformation of a procedure or module body. 29 | 'object' specifies the procedure or module, whose body is given as an 30 | SuTree subtree with 'body' as its root. 31 | The body is transformed into intermediate code. *) 32 | 33 | PROCEDURE InitStmts; 34 | (* Initialises module TrStmts. *) 35 | 36 | END TrStmts. 37 | -------------------------------------------------------------------------------- /ver1807/src/Unlister.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | MODULE Unlister; 18 | 19 | FROM Arguments IMPORT 20 | ArgTable, GetArgs; 21 | FROM ByteIO IMPORT 22 | File, GetByte, PutByte, OpenInput, OpenOutput, Close, Done, EOF; 23 | FROM InOut IMPORT 24 | WriteString, WriteLn; 25 | FROM Strings IMPORT 26 | Assign, Append; 27 | CONST 28 | MaxFilenameLength = 1024; 29 | 30 | 31 | PROCEDURE StripListing (VAR sourcefilename: ARRAY OF CHAR; 32 | VAR listfilename: ARRAY OF CHAR); 33 | VAR 34 | ListFile, SourceFile: File; 35 | ch: CHAR; 36 | BEGIN 37 | OpenInput (ListFile, listfilename); 38 | IF NOT Done() THEN 39 | WriteString ("Unlister: Cannot read file '"); 40 | WriteString (listfilename); 41 | WriteString ("'."); WriteLn; 42 | RETURN 43 | END; 44 | OpenOutput (SourceFile, sourcefilename); 45 | IF NOT Done() THEN 46 | WriteString ("Unlister: Cannot write file '"); 47 | WriteString (sourcefilename); 48 | WriteString ("'."); WriteLn; 49 | RETURN 50 | END; 51 | WHILE NOT EOF (ListFile) DO 52 | GetByte (ListFile, ch); 53 | IF ch = '@' THEN (* skip line *) 54 | WHILE (ch <> 12C) AND (NOT EOF (ListFile)) DO 55 | GetByte (ListFile, ch) 56 | END 57 | ELSE (* copy line *) 58 | PutByte (SourceFile, ch); 59 | WHILE (ch <> 12C) AND (NOT EOF (ListFile)) DO 60 | GetByte (ListFile, ch); 61 | PutByte(SourceFile, ch) 62 | END 63 | END 64 | END; 65 | Close (ListFile); 66 | Close (SourceFile) 67 | END StripListing; 68 | 69 | 70 | VAR 71 | argc: SHORTCARD; argv: ArgTable; 72 | listfilename: ARRAY [0..MaxFilenameLength] OF CHAR; 73 | BEGIN 74 | GetArgs (argc, argv); 75 | IF (argc < 2) OR (argc > 3) THEN 76 | WriteString ("USAGE Unlister src [list]"); WriteLn 77 | ELSE 78 | IF argc>2 THEN 79 | Assign (listfilename, argv^[2]^) 80 | ELSE 81 | Assign (listfilename, "LISTING") 82 | END; 83 | StripListing (argv^[1]^,listfilename) 84 | END 85 | END Unlister. 86 | -------------------------------------------------------------------------------- /ver1807/src/bootstrap: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # Build Mocka 1807 using default install of Mocka 1208 4 | 5 | export MOCKAM2= 6 | export MOCKALINK= 7 | 8 | echo "-info" | /usr/local/m2/bin/m2 9 | echo p Mocka | /usr/local/m2/bin/m2 10 | 11 | # END OF FILE 12 | -------------------------------------------------------------------------------- /ver1807/src/makemocka: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # Make script for MOCKA 1807 4 | 5 | export MOCKAM2= 6 | export MOCKALINK= 7 | 8 | echo p Mocka | mocka 9 | 10 | # END OF FILE 11 | -------------------------------------------------------------------------------- /ver1808/AAA_SCOPE_OF_WORK.md: -------------------------------------------------------------------------------- 1 | # Scope of Work for Version 1808 2 | 3 | ### Stage 1 4 | * integrate [MockaBuildParams](src/MockaBuildParams.def) 5 | * build and test with build parameters in place 6 | 7 | ### Stage 2 8 | * integrate [MockaOptions](src/MockaOptions.def), remove old option management 9 | * build and test with new option management in place 10 | 11 | ### Stage 3 12 | * integrate [CodeGen](src/CodeGen.def), [Newline](src/Newline.def), [Tabulator](src/Tabulator.def) 13 | * replace version 1807 [Emit.mod](../ver1807/src/Emit.mod) with [revised version](src/Emit.mod) 14 | * build and test with new code generator and emitter 15 | 16 | ### Stage 4 17 | * integrate [MockaArgReader](src/MockaArgReader.def), 18 | [MockaArgLexer](src/MockaArgLexer.def), [MockaArgParser](src/MockaArgParser.def) 19 | * build and test with new command line interface 20 | * write bash script to mimic the old options 21 | 22 | ### Stage 5 23 | * rewrite README 24 | * rewrite man page 25 | * test new man page 26 | 27 | ### Stage 6 28 | * chase Fraunhofer for license confirmation 29 | * build RPM, DPKG and MacOS-PKG install packages 30 | * test install packages 31 | * provide package download 32 | * Announce availability 33 | 34 | \[END OF FILE\] 35 | -------------------------------------------------------------------------------- /ver1808/NEW_MODULES.md: -------------------------------------------------------------------------------- 1 | # New Modules in Version 1808 2 | 3 | #### Module MockaBuildParams 4 | Provides parameters for building MOCKA 5 | * [MockaBuildParams.def](src/MockaBuildParams.def) 6 | * [MockaBuildParams.mod](src/MockaBuildParams.mod) (empty) 7 | 8 | #### Module MockaOptions 9 | Compiler options management module 10 | * [MockaOptions.def](src/MockaOptions.def) 11 | * [MockaOptions.mod](src/MockaOptions.mod) 12 | 13 | #### Module MockaArgReader 14 | Reader for command line arguments 15 | * [MockaArgReader.def](src/MockaArgReader.def) 16 | * [MockaArgReader.mod](src/MockaArgReader.mod) 17 | 18 | #### Module MockaArgLexer 19 | Lexer for command line arguments 20 | * [MockaArgLexer.def](src/MockaArgLexer.def) 21 | * [MockaArgLexer.mod](src/MockaArgLexer.mod) 22 | 23 | #### Module MockaArgParser 24 | Parser for command line arguments 25 | * [MockaArgParser.def](src/MockaArgParser.def) 26 | * [MockaArgParser.mod](src/MockaArgParser.mod) 27 | 28 | #### Module CodeGen 29 | Target independent assembly emitter library 30 | * [CodeGen.def](src/CodeGen.def) 31 | * [CodeGen.mod](src/CodeGen.mod) 32 | 33 | #### Module CodeGenX86 34 | Intel X86 dependent assembly emitter library 35 | * [CodeGenX86.def](src/CodeGenX86.def) 36 | * [CodeGenX86.mod](src/CodeGenX86.mod) 37 | 38 | #### Module Newline 39 | Newline mode management 40 | * [Newline.def](src/Newline.def) 41 | * [Newline.mod](src/Newline.mod) 42 | 43 | #### Module Tabulator 44 | Tabulator mode and width management 45 | * [Tabulator.def](src/Tabulator.def) 46 | * [Tabulator.mod](src/Tabulator.mod) 47 | 48 | \[END OF FILE\] 49 | -------------------------------------------------------------------------------- /ver1808/cli-args-grammar.gll: -------------------------------------------------------------------------------- 1 | /* ------------------------------------------------------------------------ * 2 | * MOCKA Modula-2 Compiler System, Version 1807 * 3 | * * 4 | * Copyright (C) 1988-2000 by * 5 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 6 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 7 | * [EN] German National Research Center for Computer Science, * 8 | * Former GMD Research Lab at the University of Karlsruhe. * 9 | * * 10 | * Copyright (C) 2001-2018 by * 11 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 12 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 13 | * * 14 | * File 'cli-args-grammar.gll' Copyright (C) 2018, Benjamin Kowarsch * 15 | * ------------------------------------------------------------------------ */ 16 | 17 | grammar mockaArgs; 18 | 19 | /* Command Line Argument Grammar */ 20 | 21 | 22 | /* ------------------------------------------------------------------------ 23 | * Non-Terminals 24 | * ------------------------------------------------------------------------ */ 25 | 26 | args : 27 | infoRequest | compilationRequest ( diagOption | pathOption )* 28 | ; 29 | 30 | infoRequest : 31 | "--help" | "--version" | "--copyright" 32 | ; 33 | 34 | compilationRequest : 35 | ( syntaxOption | safetyOption | productOption )* sourceFile 36 | ; 37 | 38 | syntaxOption : 39 | "--octal-literals" | "--no-octal-literals" | 40 | "--synonym-symbols" | "--no-synonym-symbols" 41 | ; 42 | 43 | safetyOption : 44 | "--index-checks" | "--no-index-checks" | 45 | "--range-checks" | "--no-range-checks" 46 | ; 47 | 48 | productOption : 49 | "--elf" | "--mach-o" | "--keep-asm" | "--purge-asm" | 50 | "--build" | "--no-build" | "--static" | "--no-static" 51 | ; 52 | 53 | sourceFile : 54 | ( relativePath | absolutePath | homeDirPath )? filename 55 | ; 56 | 57 | filename : 58 | ModuleIdent ( DefSuffix | ModSuffix )? 59 | ; 60 | 61 | diagOption : 62 | "--debug" | "--no-debug" | "--show-settings" | "--verbose" 63 | ; 64 | 65 | pathOption : 66 | libPath+ workDirPath? | workDirPath libPath* 67 | ; 68 | 69 | libPath : 70 | "--lib-path" path 71 | ; 72 | 73 | workDirPath : 74 | "--workDir" path 75 | ; 76 | 77 | path : 78 | RelativePath | AbsolutePath | HomeDirPath 79 | ; 80 | 81 | 82 | /* ------------------------------------------------------------------------ 83 | * Terminals 84 | * ------------------------------------------------------------------------ */ 85 | 86 | /* Synonyms 87 | * -h = --help 88 | * -I = --index-checks, -i = --no-index-checks 89 | * -R = --range-checks, -r = --no-range-checks 90 | * -A = --keep-asm, -a = --purge-asm 91 | * -B = --build, -b = --no-build 92 | * -S = --static, -s = --no-static 93 | * -D = --debug, -d = --no-debug 94 | * -v = --verbose 95 | * -L = --lib-path 96 | * -W = --work-dir 97 | */ 98 | 99 | ModuleIdent : 100 | Letter ( Letter | Digit ) 101 | ; 102 | 103 | .Letter : 104 | "A" .. "Z" | "a" .. "z" 105 | ; 106 | 107 | .Digit : 108 | "0" .. "9" 109 | ; 110 | 111 | DefSuffix : 112 | ".def" 113 | ; 114 | 115 | ModSuffix : 116 | ".mod" 117 | ; 118 | 119 | RelativePath : 120 | "." PathTail 121 | ; 122 | 123 | AbsolutePath : 124 | "/" ( DirName PathTail? )? 125 | ; 126 | 127 | HomeDirPath : 128 | "~" PathTail 129 | ; 130 | 131 | .PathTail : 132 | ( "/" DirName )+ 133 | ; 134 | 135 | .DirName : 136 | DirNameComponent ( "." DirNameComponent )* 137 | ; 138 | 139 | .DirNameComponent : 140 | ( Letter | Digit | "_" ) ( Letter | Digit | "_" | "+" | "-" )* 141 | ; 142 | 143 | endg mockaArgs. 144 | -------------------------------------------------------------------------------- /ver1808/conf-grammar.gll: -------------------------------------------------------------------------------- 1 | /* ------------------------------------------------------------------------ * 2 | * MOCKA Modula-2 Compiler System, Version 1807 * 3 | * * 4 | * Copyright (C) 1988-2000 by * 5 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 6 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 7 | * [EN] German National Research Center for Computer Science, * 8 | * Former GMD Research Lab at the University of Karlsruhe. * 9 | * * 10 | * Copyright (C) 2001-2018 by * 11 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 12 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 13 | * * 14 | * File 'conf-grammar.gll' Copyright (C) 2018, Benjamin Kowarsch * 15 | * ------------------------------------------------------------------------ */ 16 | 17 | grammar mockaConf; 18 | 19 | /* Configuration File Grammar */ 20 | 21 | 22 | /* ------------------------------------------------------------------------ 23 | * Non-Terminals 24 | * ------------------------------------------------------------------------ */ 25 | 26 | conf : 27 | keyValueList ( ";" keyValueList ) 28 | ; 29 | 30 | keyValueList : 31 | tabSpec | newlineSpec | optSpec | pathSpec | scriptSpec 32 | ; 33 | 34 | tabSpec : 35 | "tab-width" "=" Number 36 | ; 37 | 38 | newlineSpec : 39 | "newline" "=" ( "lf" | "cr" | "crlf" ) 40 | ; 41 | 42 | optSpec : 43 | "options" "=" optionList 44 | ; 45 | 46 | optionList : 47 | option ( "," option ) 48 | ; 49 | 50 | option : 51 | syntaxOption | safetyOption | productOption | diagOption 52 | ; 53 | 54 | syntaxOption : 55 | "--octal-literals" | "--no-octal-literals" | 56 | "--synonym-symbols" | "--no-synonym-symbols" 57 | ; 58 | 59 | safetyOption : 60 | "--index-checks" | "--no-index-checks" | 61 | "--range-checks" | "--no-range-checks" 62 | ; 63 | 64 | productOption : 65 | "--elf" | "--mach-o" | "--keep-asm" | "--purge-asm" | 66 | "--build" | "--no-build" | "--static" | "--no-static" 67 | ; 68 | 69 | diagOption : 70 | "--debug" | "--no-debug" 71 | ; 72 | 73 | pathSpec : 74 | libPathList | workDirPath 75 | ; 76 | 77 | libPathList 78 | "libraries" "=" path ( "," path ) 79 | ; 80 | 81 | workDirPath : 82 | "work-dir" "=" ( RelativePath | HomeDirPath ) 83 | ; 84 | 85 | path : 86 | RelativePath | AbsolutePath | HomeDirPath 87 | ; 88 | 89 | 90 | /* ------------------------------------------------------------------------ 91 | * Terminals 92 | * ------------------------------------------------------------------------ */ 93 | 94 | /* Synonyms 95 | * -h = --help 96 | * -I = --index-checks, -i = --no-index-checks 97 | * -R = --range-checks, -r = --no-range-checks 98 | * -A = --keep-asm, -a = --purge-asm 99 | * -B = --build, -b = --no-build 100 | * -S = --static, -s = --no-static 101 | * -D = --debug, -d = --no-debug 102 | * -v = --verbose 103 | * -L = --lib-path 104 | * -W = --work-dir 105 | */ 106 | 107 | Number : 108 | Digit | Digit 109 | ; 110 | 111 | RelativePath : 112 | "." PathTail 113 | ; 114 | 115 | AbsolutePath : 116 | "/" ( DirName PathTail? )? 117 | ; 118 | 119 | HomeDirPath : 120 | "~" PathTail 121 | ; 122 | 123 | .PathTail : 124 | ( "/" DirName )+ 125 | ; 126 | 127 | .DirName : 128 | DirNameComponent ( "." DirNameComponent )* 129 | ; 130 | 131 | .DirNameComponent : 132 | ( Letter | Digit | "_" ) ( Letter | Digit | "_" | "+" | "-" )* 133 | ; 134 | 135 | .Letter : 136 | "A" .. "Z" | "a" .. "z" 137 | ; 138 | 139 | .Digit : 140 | "0" .. "9" 141 | ; 142 | 143 | 144 | /* ------------------------------------------------------------------------ 145 | * Ignore Symbols 146 | * ------------------------------------------------------------------------ */ 147 | 148 | Comment : 149 | "/*" ( PrintableChar | Tab | Newline )* "*/" 150 | ; 151 | 152 | .PrintableChar : 153 | ASCII(32) .. ASCII(126) 154 | ; 155 | 156 | .Tab : ASCII(9) ; 157 | 158 | .Newline : 159 | LF | CR LF? 160 | ; 161 | 162 | .LF : ASCII(10) ; 163 | 164 | .CR : ASCII(13) ; 165 | 166 | 167 | endg mockaConf. 168 | -------------------------------------------------------------------------------- /ver1808/src/CodeGenX86.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * * 16 | * File 'CodeGenX86.def' Copyright (C) 2018, Benjamin Kowarsch * 17 | * ------------------------------------------------------------------------ *) 18 | 19 | DEFINITION MODULE CodeGenX86; 20 | 21 | (* Intel x86 Specific Part of Assembly Output Emitter *) 22 | 23 | 24 | (* ------------------------------------------------------------------------ 25 | * Procedure CodeGenX86.EmitLabel(n) 26 | * ------------------------------------------------------------------------ 27 | * Writes a declaration for label with suffix 'n' to output buffer. 28 | * ------------------------------------------------------------------------ *) 29 | 30 | PROCEDURE EmitLabel ( n : CARDINAL ); 31 | 32 | 33 | (* ------------------------------------------------------------------------ 34 | * Procedure CodeGen386.EmitLabelRef(n) 35 | * ------------------------------------------------------------------------ 36 | * Writes a reference to the label with suffix 'n' to output buffer. 37 | * ------------------------------------------------------------------------ *) 38 | 39 | PROCEDURE EmitLabelRef ( n : CARDINAL ); 40 | 41 | 42 | (* ------------------------------------------------------------------------ 43 | * Procedure CodeGenX86.EmitProc(ident) 44 | * ------------------------------------------------------------------------ 45 | * Writes a declaration for procedure 'ident' to output buffer. 46 | * ------------------------------------------------------------------------ *) 47 | 48 | PROCEDURE EmitProc ( (*CONST*) VAR ident : ARRAY OF CHAR ); 49 | 50 | 51 | (* ------------------------------------------------------------------------ 52 | * Procedure CodeGenX86.EmitProcRef(ident) 53 | * ------------------------------------------------------------------------ 54 | * Writes a reference to procedure 'ident' to output buffer. 55 | * ------------------------------------------------------------------------ *) 56 | 57 | PROCEDURE EmitProcRef ( (*CONST*) VAR ident : ARRAY OF CHAR ); 58 | 59 | 60 | END CodeGenX86. 61 | -------------------------------------------------------------------------------- /ver1808/src/CodeGenX86.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * * 16 | * File 'CodeGenX86.mod' Copyright (C) 2018, Benjamin Kowarsch * 17 | * ------------------------------------------------------------------------ *) 18 | 19 | IMPLEMENTATION MODULE CodeGenX86; 20 | 21 | (* Intel x86 Specific Part of Assembly Output Emitter *) 22 | 23 | 24 | IMPORT CodeGen, MockaOptions; 25 | 26 | 27 | (* ------------------------------------------------------------------------ 28 | * Public procedure EmitLabel(n) 29 | * ------------------------------------------------------------------------ 30 | * Writes a declaration for label with suffix 'n' to output buffer. 31 | * ------------------------------------------------------------------------ *) 32 | 33 | PROCEDURE EmitLabel ( n : CARDINAL ); 34 | 35 | BEGIN 36 | (* dot prefix if Elf *) 37 | IF MockaOptions.isEnabled(MockaOptions.Elf) THEN 38 | CodeGen.EmitString(".L") 39 | ELSE 40 | CodeGen.EmitChar("L") 41 | END; (* IF *) 42 | 43 | (* label number *) 44 | CodeGen.EmitCard(n) 45 | 46 | (* colon suffix *) 47 | CodeGen.EmitChar(":") 48 | END EmitLabel; 49 | 50 | 51 | (* ------------------------------------------------------------------------ 52 | * Public procedure EmitLabelRef(n) 53 | * ------------------------------------------------------------------------ 54 | * Writes a reference to the label with suffix 'n' to output buffer. 55 | * ------------------------------------------------------------------------ *) 56 | 57 | PROCEDURE EmitLabelRef ( n : CARDINAL ); 58 | 59 | BEGIN 60 | (* dot prefix if Elf *) 61 | IF MockaOptions.isEnabled(MockaOptions.Elf) THEN 62 | CodeGen.EmitString(".L") 63 | ELSE 64 | CodeGen.EmitChar("L") 65 | END; (* IF *) 66 | 67 | (* label number *) 68 | CodeGen.EmitCard(n) 69 | END EmitLabelRef; 70 | 71 | 72 | (* ------------------------------------------------------------------------ 73 | * Public procedure EmitProc(ident) 74 | * ------------------------------------------------------------------------ 75 | * Writes a declaration for procedure 'ident' to output buffer. 76 | * ------------------------------------------------------------------------ *) 77 | 78 | PROCEDURE EmitProc ( (*CONST*) VAR ident : ARRAY OF CHAR ); 79 | 80 | BEGIN 81 | (* lowline prefix if MachO *) 82 | IF MockaOptions.isEnabled(MockaOptions.MachO) THEN 83 | CodeGen.EmitChar("_") 84 | END; (* IF *) 85 | 86 | (* identifier and colon *) 87 | CodeGen.EmitString(ident); 88 | CodeGen.EmitChar(":") 89 | END EmitProc; 90 | 91 | 92 | (* ------------------------------------------------------------------------ 93 | * Public procedure EmitProcRef(ident) 94 | * ------------------------------------------------------------------------ 95 | * Writes a reference to procedure 'ident' to output buffer. 96 | * ------------------------------------------------------------------------ *) 97 | 98 | PROCEDURE EmitProcRef ( (*CONST*) VAR ident : ARRAY OF CHAR ); 99 | 100 | BEGIN 101 | (* lowline prefix if MachO *) 102 | IF MockaOptions.isEnabled(MockaOptions.MachO) THEN 103 | CodeGen.EmitChar("_") 104 | END; (* IF *) 105 | 106 | (* identifier *) 107 | CodeGen.EmitString(ident) 108 | END EmitProcRef; 109 | 110 | 111 | END CodeGenX86. 112 | -------------------------------------------------------------------------------- /ver1808/src/Emit.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * ------------------------------------------------------------------------ *) 16 | 17 | DEFINITION MODULE Emit; 18 | 19 | (* ************************************************************************ * 20 | * This module was generated by BEG V1.84 * 21 | * ************************************************************************ *) 22 | 23 | IMPORT IR; 24 | FROM IR IMPORT RegisterSet; 25 | (*++++++ start insertion IpTypes ++++++*) 26 | 27 | IMPORT CgBase; 28 | FROM Strings IMPORT String; 29 | 30 | 31 | (*------ end insertion IpTypes ------*) 32 | (*++++++ start insertion IpEmit_d ++++++*) 33 | 34 | FROM SuErrors IMPORT SourcePosition; 35 | FROM IR IMPORT MemAdr; 36 | 37 | CONST MaxCallLevel = 32; (* Max. # nested procedurecalls *) 38 | 39 | VAR 40 | SizeTable : ARRAY CgBase.Mode OF SHORTINT; 41 | (* maps Mode to OpSize *) 42 | 43 | SuffixTable : ARRAY CgBase.Mode OF CHAR; 44 | (* maps Mode into suffix of load instruction *) 45 | 46 | SignedTable : ARRAY CgBase.Mode OF BOOLEAN; 47 | (* calculates wether Mode is signed *) 48 | 49 | NullSymb : CgBase.RelSymb; 50 | DisplaySym : CgBase.RelSymb; 51 | 52 | CurPos : SourcePosition; 53 | CurLevel : SHORTCARD; 54 | CallLevel : SHORTCARD; 55 | 56 | PROCEDURE DeclareModule 57 | ( extern : BOOLEAN; 58 | VAR CompUnitName : ARRAY OF CHAR; 59 | VAR ref : CgBase.ModuleIndex); 60 | 61 | PROCEDURE DeclareProcedure 62 | ( extern : BOOLEAN; 63 | isFunction : BOOLEAN; 64 | ProcMode : CgBase.Mode; 65 | VAR ProcName : ARRAY OF CHAR; 66 | ProcNumber : SHORTCARD; 67 | module : CgBase.ModuleIndex; 68 | level : SHORTCARD; 69 | father : CgBase.ProcIndex; 70 | VAR ref : CgBase.ProcIndex); 71 | 72 | PROCEDURE DeclareString 73 | ( length : SHORTCARD; 74 | VAR string : ARRAY OF CHAR; 75 | VAR ref : CgBase.StringIndex); 76 | 77 | PROCEDURE DeclareTempo 78 | ( mode: CgBase.Mode; 79 | VAR tempo: CgBase.Tempo); 80 | 81 | PROCEDURE BeginModule 82 | (AtModulName : ARRAY OF CHAR; 83 | AtFrameSize : LONGINT); 84 | 85 | PROCEDURE IsNilMemAdr (a: MemAdr) : BOOLEAN; 86 | 87 | 88 | 89 | (*------ end insertion IpEmit_d ------*) 90 | 91 | PROCEDURE EmitInstruction (e : IR.Expression); 92 | PROCEDURE EmitStatement (e: IR.Expression); 93 | 94 | 95 | END Emit. 96 | -------------------------------------------------------------------------------- /ver1808/src/MockaArgParser.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * * 16 | * File 'MockaArgParser.def' Copyright (C) 2018, Benjamin Kowarsch * 17 | * ------------------------------------------------------------------------ *) 18 | 19 | DEFINITION MODULE MockaArgParser; 20 | 21 | (* Command Line Argument Parser *) 22 | 23 | 24 | (* ------------------------------------------------------------------------ 25 | * Status type 26 | * ------------------------------------------------------------------------ *) 27 | 28 | TYPE Status = ( 29 | Success, 30 | HelpRequested, 31 | VersionRequested, 32 | CopyrightRequested, 33 | ErrorsEncountered ); 34 | 35 | 36 | (* --------------------------------------------------------------------------- 37 | * function MockaArgParser.parseArgs() 38 | * --------------------------------------------------------------------------- 39 | * Parses command line arguments. Stores settings. Returns status. 40 | * ------------------------------------------------------------------------ *) 41 | 42 | PROCEDURE parseArgs () : Status; 43 | 44 | 45 | END MockaArgParser. 46 | -------------------------------------------------------------------------------- /ver1808/src/MockaArgReader.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * * 16 | * File 'MockaArgReader.def' Copyright (C) 2018, Benjamin Kowarsch * 17 | * ------------------------------------------------------------------------ *) 18 | 19 | DEFINITION MODULE MockaArgReader; 20 | 21 | (* Command Line Argument Reader *) 22 | 23 | 24 | (* ------------------------------------------------------------------------ 25 | * Maximum number of command line arguments 26 | * ------------------------------------------------------------------------ *) 27 | 28 | CONST MaxArgs = 100; 29 | 30 | 31 | (* ------------------------------------------------------------------------ 32 | * Maximum length of a command line argument 33 | * ------------------------------------------------------------------------ *) 34 | 35 | CONST MaxArgLen = 255; 36 | 37 | 38 | (* ------------------------------------------------------------------------ 39 | * Static string type to hold a single command line argument 40 | * ------------------------------------------------------------------------ *) 41 | 42 | TYPE ArgStr = ARRAY [0 .. MaxArgLen] OF CHAR; 43 | 44 | 45 | (* ------------------------------------------------------------------------ 46 | * function MockaArgReader.argCount() 47 | * ------------------------------------------------------------------------ 48 | * Returns the number of available command line arguments. 49 | * ------------------------------------------------------------------------ *) 50 | 51 | PROCEDURE argCount : CARDINAL; 52 | 53 | 54 | (* ------------------------------------------------------------------------ 55 | * proedure MockaArgReader.GetArgN() 56 | * ------------------------------------------------------------------------ 57 | * Passes the n-th command line argument in 'arg'. If 'n' exceeds the 58 | * number of available arguments, an empty string is passed back instead. 59 | * ------------------------------------------------------------------------ *) 60 | 61 | PROCEDURE GetArgN ( n : CARDINAL; VAR arg : ARRAY OF CHAR ); 62 | 63 | 64 | END MockaArgReader. 65 | -------------------------------------------------------------------------------- /ver1808/src/MockaArgReader.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * * 16 | * File 'MockaArgReader.mod' Copyright (C) 2018, Benjamin Kowarsch * 17 | * ------------------------------------------------------------------------ *) 18 | 19 | IMPLEMENTATION MODULE MockaArgReader; 20 | 21 | (* Command Line Argument Reader *) 22 | 23 | 24 | IMPORT (* Mockalib *) Arguments; 25 | 26 | 27 | (* ------------------------------------------------------------------------ 28 | * Argument string terminator 29 | * ------------------------------------------------------------------------ *) 30 | 31 | CONST NUL = CHR(0); 32 | 33 | 34 | (* ------------------------------------------------------------------------ 35 | * Argument string pointer type 36 | * ------------------------------------------------------------------------ *) 37 | 38 | TYPE ArgPtr = POINTER TO ArgStr; 39 | 40 | 41 | (* ------------------------------------------------------------------------ 42 | * Argument string pointer table type 43 | * ------------------------------------------------------------------------ *) 44 | 45 | TYPE ArgTable = POINTER TO ARRAY [0 .. MaxArgs] OF ArgPtr; 46 | 47 | 48 | (* ------------------------------------------------------------------------ 49 | * Argument count obtained from OS environment 50 | * ------------------------------------------------------------------------ *) 51 | 52 | VAR argc : SHORTCARD; 53 | 54 | 55 | (* ------------------------------------------------------------------------ 56 | * Argument table populated from OS environment 57 | * ------------------------------------------------------------------------ *) 58 | 59 | VAR argv : ArgTable; 60 | 61 | 62 | (* ------------------------------------------------------------------------ 63 | * function MockaArgReader.argCount() 64 | * ------------------------------------------------------------------------ 65 | * Returns the number of available command line arguments. 66 | * ------------------------------------------------------------------------ *) 67 | 68 | PROCEDURE argCount : CARDINAL; 69 | BEGIN 70 | RETURN VAL(CARDINAL, argc) 71 | END argCount; 72 | 73 | 74 | (* ------------------------------------------------------------------------ 75 | * proedure MockaArgReader.GetArgN() 76 | * ------------------------------------------------------------------------ 77 | * Passes the n-th command line argument in 'arg'. If 'n' exceeds the 78 | * number of available arguments, an empty string is passed back instead. 79 | * ------------------------------------------------------------------------ *) 80 | 81 | PROCEDURE GetArgN ( n : CARDINAL; VAR arg : ARRAY OF CHAR ); 82 | 83 | VAR 84 | ch : CHAR; 85 | index : CARDINAL; 86 | 87 | BEGIN 88 | (* assert n does not exceed argument count *) 89 | IF n >= VAL(CARDINAL, argc) THEN 90 | arg := NUL; 91 | RETURN 92 | END; (* IF *) 93 | 94 | (* copy chars from n-th entry in argument table to arg *) 95 | index := 0; 96 | REPEAT 97 | ch := argv^[n]^[index]; 98 | arg[index] := ch; 99 | index := index + 1 100 | UNTIL (ch = NUL) OR (index > HIGH(arg)); 101 | 102 | (* assert final char is terminator *) 103 | IF ch # NUL THEN 104 | arg[HIGH(arg)] := NUL 105 | END (* IF *) 106 | END GetArgN; 107 | 108 | 109 | BEGIN (* MockaArgReader *) 110 | Arguments.GetArgs(argc, argv) 111 | END MockaArgReader. 112 | -------------------------------------------------------------------------------- /ver1808/src/MockaBuildParams.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * * 16 | * File 'MockaBuildParams.def' Copyright (C) 2018, Benjamin Kowarsch * 17 | * ------------------------------------------------------------------------ *) 18 | 19 | DEFINITION MODULE MockaBuildParams; 20 | 21 | (* Compile-time parameters to build MOCKA *) 22 | 23 | 24 | (* ------------------------------------------------------------------------ 25 | * MOCKA Version 26 | * ------------------------------------------------------------------------ *) 27 | 28 | CONST Version = "1808"; 29 | 30 | 31 | (* ------------------------------------------------------------------------ 32 | * Significant characters in identifiers 33 | * ------------------------------------------------------------------------ *) 34 | 35 | CONST SignificantChars = 39; 36 | 37 | 38 | (* ------------------------------------------------------------------------ 39 | * Assembly Annotations 40 | * ------------------------------------------------------------------------ *) 41 | 42 | CONST AssemblyAnnotations = FALSE; (* replaces Emit.Kommentar *) 43 | 44 | 45 | (* ------------------------------------------------------------------------ 46 | * Buffer size for assembly output 47 | * ------------------------------------------------------------------------ *) 48 | 49 | CONST EmitBufferSize = 32*1024; (* 32 KBytes *) 50 | 51 | 52 | (* ------------------------------------------------------------------------ 53 | * Constant debug info 54 | * ------------------------------------------------------------------------ *) 55 | 56 | CONST DebugInfoIncludesConsts = TRUE; (* replaces -gc option *) 57 | 58 | 59 | (* ------------------------------------------------------------------------ 60 | * Enumeration debug info 61 | * ------------------------------------------------------------------------ *) 62 | 63 | CONST DebugInfoIncludesEnums = TRUE; (* replaces -ge option *) 64 | 65 | 66 | END MockaBuildParams. 67 | -------------------------------------------------------------------------------- /ver1808/src/MockaBuildParams.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * * 16 | * File 'MockaBuildParams.mod' Copyright (C) 2018, Benjamin Kowarsch * 17 | * ------------------------------------------------------------------------ *) 18 | 19 | IMPLEMENTATION MODULE MockaBuildParams; 20 | 21 | (*empty*) 22 | 23 | END MockaBuildParams. 24 | -------------------------------------------------------------------------------- /ver1808/src/MockaOptions.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * * 16 | * File 'MockaOptions.def' Copyright (C) 2018, Benjamin Kowarsch * 17 | * ------------------------------------------------------------------------ *) 18 | 19 | DEFINITION MODULE MockaOptions; 20 | 21 | (* Compiler Options Management *) 22 | 23 | 24 | (* ------------------------------------------------------------------------ 25 | * Compiler options 26 | * ------------------------------------------------------------------------ *) 27 | 28 | TYPE Option = ( 29 | 30 | (* syntax options *) 31 | 32 | OctalLiterals, (* --octal-literals, --no-octal-literals *) 33 | SynonymSymbols, (* --synonym-symbols, --no-synonym-symbols *) 34 | 35 | (* safety options *) 36 | 37 | IndexChecks, (* --index-checks, --no-index-checks *) 38 | RangeChecks, (* --range-checks, --no-range-checks *) 39 | 40 | (* product options *) 41 | 42 | Elf, (* --elf *) 43 | MachO, (* --mach-o *) 44 | KeepAsm, (* --keep-asm, --purge-asm *) 45 | Build, (* --build, --no-build *) 46 | Static, (* --static, --no-static *) 47 | 48 | (* diagnostic options *) 49 | 50 | Debug, (* --debug, --no-debug *) 51 | Verbose, (* --verbose *) 52 | ShowSettings ); (* --show-settings *) 53 | 54 | 55 | (* ------------------------------------------------------------------------ 56 | * Default object format 57 | * ------------------------------------------------------------------------ *) 58 | 59 | CONST DefaultObjFormat = Elf; (* may be either Elf or MachO *) 60 | 61 | 62 | (* ------------------------------------------------------------------------ 63 | * procedure MockaOptions.ApplyDefaults 64 | * ------------------------------------------------------------------------ 65 | * Sets all compiler options to their default values. 66 | * 67 | * Defaults 68 | * OctalLiterals : off 69 | * SynonymSymbols : off 70 | * IndexChecks : on 71 | * RangeChecks : on 72 | * Elf : on 73 | * MachO : off 74 | * KeepAsm : on 75 | * Build : on 76 | * Static : on 77 | * Debug : on 78 | * Verbose : off 79 | * ShowSettings : off 80 | * ------------------------------------------------------------------------ *) 81 | 82 | PROCEDURE ApplyDefaults; 83 | 84 | 85 | (* ------------------------------------------------------------------------ 86 | * function MockaOptions.alreadySet(option) 87 | * ------------------------------------------------------------------------ 88 | * Returns TRUE if 'option' has been set since module initialisation or 89 | * since default settings have last been applied, otherwise FALSE. 90 | * ------------------------------------------------------------------------ *) 91 | 92 | PROCEDURE alreadySet ( option : Option ) : BOOLEAN; 93 | 94 | 95 | (* ------------------------------------------------------------------------ 96 | * procedure MockaOptions.SetValue(option, value) 97 | * ------------------------------------------------------------------------ 98 | * Sets compiler option 'option' to 'value'. A value of TRUE enables, 99 | * and a value of FALSE disables an option. Options Elf and MachO are 100 | * mutually exclusive. Enabling Elf disables MachO and vice versa. 101 | * ------------------------------------------------------------------------ *) 102 | 103 | PROCEDURE SetValue ( option : Option; value : BOOLEAN ); 104 | 105 | 106 | (* ------------------------------------------------------------------------ 107 | * function MockaOptions.isEnabled(option) 108 | * ------------------------------------------------------------------------ 109 | * Returns TRUE if 'option' is enabled, otherwise FALSE. 110 | * ------------------------------------------------------------------------ *) 111 | 112 | PROCEDURE isEnabled ( option : Option ) : BOOLEAN; 113 | 114 | 115 | END MockaOptions. 116 | -------------------------------------------------------------------------------- /ver1808/src/MockaOptions.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * * 16 | * File 'MockaOptions.mod' Copyright (C) 2018, Benjamin Kowarsch * 17 | * ------------------------------------------------------------------------ *) 18 | 19 | IMPLEMENTATION MODULE MockaOptions; 20 | 21 | (* Compiler Options Management *) 22 | 23 | 24 | (* ------------------------------------------------------------------------ 25 | * Option set type 26 | * ------------------------------------------------------------------------ *) 27 | 28 | TYPE OptionSet = SET OF Options; (* max 32 options *) 29 | 30 | 31 | (* ------------------------------------------------------------------------ 32 | * Active options 33 | * ------------------------------------------------------------------------ *) 34 | 35 | VAR options, modifiedOptions : OptionSet; 36 | 37 | 38 | (* ------------------------------------------------------------------------ 39 | * public procedure ApplyDefaults 40 | * ------------------------------------------------------------------------ 41 | * Sets all compiler options to their default values. 42 | * 43 | * Defaults 44 | * OctalLiterals : off 45 | * SynonymSymbols : off 46 | * IndexChecks : on 47 | * RangeChecks : on 48 | * Elf : on 49 | * MachO : off 50 | * KeepAsm : on 51 | * Build : on 52 | * Static : on 53 | * Debug : on 54 | * Verbose : off 55 | * ShowSettings : off 56 | * ------------------------------------------------------------------------ *) 57 | 58 | PROCEDURE ApplyDefaults; 59 | 60 | BEGIN 61 | (* reset options set *) 62 | options := 63 | OptionSet { IndexChecks, RangeChecks, DefaultObjFormat, Debug, Build, 64 | KeepAsm, Static }; 65 | 66 | (* reset modified options set *) 67 | modifiedOptions := OptionSet { } 68 | END ApplyDefaults; 69 | 70 | 71 | (* ------------------------------------------------------------------------ 72 | * public function alreadySet(option) 73 | * ------------------------------------------------------------------------ 74 | * Returns TRUE if 'option' has been set since module initialisation or 75 | * since default settings have last been applied, otherwise FALSE. 76 | * ------------------------------------------------------------------------ *) 77 | 78 | PROCEDURE alreadySet ( option : Option ) : BOOLEAN; 79 | 80 | BEGIN 81 | RETURN (option IN modifiedOptions) 82 | END alreadySet; 83 | 84 | 85 | (* ------------------------------------------------------------------------ 86 | * public procedure SetValue(option, value) 87 | * ------------------------------------------------------------------------ 88 | * Sets compiler option 'option' to 'value'. A value of TRUE enables, 89 | * and a value of FALSE disables an option. Options Elf and MachO are 90 | * mutually exclusive. Enabling Elf disables MachO and vice versa. 91 | * ------------------------------------------------------------------------ *) 92 | 93 | PROCEDURE SetValue ( option : Option; value : BOOLEAN ); 94 | 95 | BEGIN 96 | CASE option OF 97 | | Elf : 98 | SetFlag(Elf, value); 99 | SetFlag(MachO, NOT value) (* Elf disables MachO *) 100 | 101 | | MachO : 102 | SetFlag(MachO, value); 103 | SetFlag(Elf, NOT value) (* MachO disables Elf *) 104 | 105 | | Static : 106 | (* option static only applies when build is on *) 107 | IF (value = TRUE) AND (Build IN optionSet) THEN 108 | SetFlag(Static, TRUE) 109 | END (* IF *) 110 | 111 | ELSE (* all other options *) 112 | SetFlag(option, value) 113 | END (* CASE *) 114 | END SetValue; 115 | 116 | 117 | (* ------------------------------------------------------------------------ 118 | * public function isEnabled(option) 119 | * ------------------------------------------------------------------------ 120 | * Returns TRUE if 'option' is enabled, otherwise FALSE. 121 | * ------------------------------------------------------------------------ *) 122 | 123 | PROCEDURE isEnabled ( option : Option ) : BOOLEAN; 124 | 125 | BEGIN 126 | RETURN (option IN options) 127 | END isEnabled; 128 | 129 | 130 | (* ------------------------------------------------------------------------ 131 | * private procedure SetFlag(option, value) 132 | * ------------------------------------------------------------------------ 133 | * Sets 'option' to 'value' and records its modification status. 134 | * No integrity checking and no integrity adjustment is performed. 135 | * ------------------------------------------------------------------------ *) 136 | 137 | PROCEDURE SetFlag ( option : Option; value : BOOLEAN ); 138 | 139 | BEGIN 140 | (* set value *) 141 | IF value = TRUE THEN 142 | INCL(options, option) 143 | ELSE 144 | EXCL(options, option) 145 | END; (* IF *) 146 | 147 | (* remember modification status *) 148 | INCL(modifiedOptions, option) 149 | END SetFlag; 150 | 151 | 152 | BEGIN (* MockaOptions *) 153 | ApplyDefaults 154 | END MockaOptions. 155 | -------------------------------------------------------------------------------- /ver1808/src/Newline.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * * 16 | * File 'Newline.def' Copyright (C) 2018, Benjamin Kowarsch * 17 | * ------------------------------------------------------------------------ *) 18 | 19 | DEFINITION MODULE Newline; 20 | 21 | (* Newline Settings *) 22 | 23 | 24 | (* ------------------------------------------------------------------------ 25 | * Default newline mode 26 | * ------------------------------------------------------------------------ *) 27 | 28 | CONST DefaultMode = LF; 29 | 30 | 31 | (* ------------------------------------------------------------------------ 32 | * Newline mode type 33 | * ------------------------------------------------------------------------ *) 34 | 35 | TYPE Mode = ( 36 | CR, (* ASCII CR *) 37 | CRLF, (* ASCII CR+LF *) 38 | LF ); (* ASCII LF *) 39 | 40 | 41 | (* ------------------------------------------------------------------------ 42 | * Procedure Newline.SetMode(mode) 43 | * ------------------------------------------------------------------------ 44 | * Sets the newline mode to 'mode'. 45 | * ------------------------------------------------------------------------ *) 46 | 47 | PROCEDURE SetMode ( mode : Mode ); 48 | 49 | 50 | (* ------------------------------------------------------------------------ 51 | * Function Newline.mode() 52 | * ------------------------------------------------------------------------ 53 | * Returns the current newline mode. 54 | * ------------------------------------------------------------------------ *) 55 | 56 | PROCEDURE mode : Mode; 57 | 58 | 59 | END Newline. 60 | -------------------------------------------------------------------------------- /ver1808/src/Newline.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * * 16 | * File 'Newline.mod' Copyright (C) 2018, Benjamin Kowarsch * 17 | * ------------------------------------------------------------------------ *) 18 | 19 | IMPLEMENTATION MODULE Newline; 20 | 21 | (* Newline Settings *) 22 | 23 | 24 | (* ------------------------------------------------------------------------ 25 | * Current newline mode 26 | * ------------------------------------------------------------------------ *) 27 | 28 | VAR newlineMode : Mode; 29 | 30 | 31 | (* ------------------------------------------------------------------------ 32 | * Procedure Newline.SetMode(mode) 33 | * ------------------------------------------------------------------------ 34 | * Sets the newline mode to 'mode'. 35 | * ------------------------------------------------------------------------ *) 36 | 37 | PROCEDURE SetMode ( mode : Mode ); 38 | 39 | BEGIN 40 | newlineMode := mode 41 | END SetMode; 42 | 43 | 44 | (* ------------------------------------------------------------------------ 45 | * Function Newline.mode() 46 | * ------------------------------------------------------------------------ 47 | * Returns the current newline mode. 48 | * ------------------------------------------------------------------------ *) 49 | 50 | PROCEDURE mode : Mode; 51 | 52 | BEGIN 53 | RETURN newlineMode 54 | END mode; 55 | 56 | 57 | BEGIN (* Newline *) 58 | newlineMode := DefaultMode 59 | END Newline. 60 | -------------------------------------------------------------------------------- /ver1808/src/Tabulator.def: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * * 16 | * File 'Tabulator.def' Copyright (C) 2018, Benjamin Kowarsch * 17 | * ------------------------------------------------------------------------ *) 18 | 19 | DEFINITION MODULE Tabulator; 20 | 21 | (* Tabulator Settings *) 22 | 23 | 24 | (* ------------------------------------------------------------------------ 25 | * Maximum tabulator width 26 | * ------------------------------------------------------------------------ *) 27 | 28 | CONST MaxWidth = 16; 29 | 30 | 31 | (* ------------------------------------------------------------------------ 32 | * Default tabulator width 33 | * ------------------------------------------------------------------------ *) 34 | 35 | CONST DefaultWidth = 4; 36 | 37 | 38 | (* ------------------------------------------------------------------------ 39 | * Tabulator width type 40 | * ------------------------------------------------------------------------ *) 41 | 42 | TYPE Width = CARDINAL [0 .. MaxWidth]; 43 | 44 | 45 | (* ------------------------------------------------------------------------ 46 | * Procedure Tabulator.SetWidth(n) 47 | * ------------------------------------------------------------------------ 48 | * Sets the tabulator width to value 'n'. A value of zero indicates that 49 | * ASCII TAB codes shall not be replaced by whitespace, but passed through 50 | * transparently. A value greater than zero indicates that any ASCII TAB 51 | * code shall be replaced by the number of spaces given by 'n'. 52 | * ------------------------------------------------------------------------ *) 53 | 54 | PROCEDURE SetWidth ( n : Width ); 55 | 56 | 57 | (* ------------------------------------------------------------------------ 58 | * Function Tabulator.width() 59 | * ------------------------------------------------------------------------ 60 | * Returns the current tabulator width. 61 | * ------------------------------------------------------------------------ *) 62 | 63 | PROCEDURE width : Width; 64 | 65 | 66 | END Tabulator. 67 | -------------------------------------------------------------------------------- /ver1808/src/Tabulator.mod: -------------------------------------------------------------------------------- 1 | (*!m2pim+mocka*) 2 | 3 | (* ------------------------------------------------------------------------ * 4 | * MOCKA Modula-2 Compiler System, Version 1807 * 5 | * * 6 | * Copyright (C) 1988-2000 by * 7 | * GMD Gesellschaft fuer Mathematik und Datenverarbeitung, * 8 | * Ehemalige GMD Forschungsstelle an der Uni Karlsruhe; * 9 | * [EN] German National Research Center for Computer Science, * 10 | * Former GMD Research Lab at the University of Karlsruhe. * 11 | * * 12 | * Copyright (C) 2001-2018 by * 13 | * Fraunhofer-Gesellschaft zur Foerderung der angewandten Forschung; * 14 | * [EN] Fraunhofer Society for the Advancement of Applied Research. * 15 | * * 16 | * File 'Tabulator.mod' Copyright (C) 2018, Benjamin Kowarsch * 17 | * ------------------------------------------------------------------------ *) 18 | 19 | IMPLEMENTATION MODULE Tabulator; 20 | 21 | (* Tabulator Settings *) 22 | 23 | 24 | (* ------------------------------------------------------------------------ 25 | * Current tabulator width 26 | * ------------------------------------------------------------------------ *) 27 | 28 | VAR tabWidth : Width; 29 | 30 | 31 | (* ------------------------------------------------------------------------ 32 | * Public procedure SetWidth(n) 33 | * ------------------------------------------------------------------------ 34 | * Sets the tabulator width to value 'n'. A value of zero indicates that 35 | * ASCII TAB codes shall not be replaced by whitespace, but passed through 36 | * transparently. A value greater than zero indicates that any ASCII TAB 37 | * code shall be replaced by the number of spaces given by 'n'. 38 | * ------------------------------------------------------------------------ *) 39 | 40 | PROCEDURE SetWidth ( n : Width ); 41 | 42 | BEGIN 43 | tabWidth := n 44 | END SetWidth; 45 | 46 | 47 | (* ------------------------------------------------------------------------ 48 | * Public function width() 49 | * ------------------------------------------------------------------------ 50 | * Returns the current tabulator width. 51 | * ------------------------------------------------------------------------ *) 52 | 53 | PROCEDURE width : Width; 54 | 55 | BEGIN 56 | RETURN tabWidth 57 | END width; 58 | 59 | 60 | BEGIN (* Tabulator *) 61 | tabWidth := DefaultWidth 62 | END Tabulator. 63 | --------------------------------------------------------------------------------